Retro1.org codex

OPLEDIT

[00010] OPL EDITING PROGRAM.
[00108] ASSEMBLY CONSTANTS AND MACRO DEFINITIONS.
[00132] READK - READ CODED LINE TO CHARACTER BUFFER.
[00156] WRITEK - WRITE CODED LINE FROM CHARACTER BUFFER.
[00176] ADDWRD - ADD A WORD TO A TABLE.
[00193] CARD - GENERATE LIST AND CALL FOR DIRECTIVE TRANSLATION.
[00225] ALLOC - ALLOCATE SPACE TO TABLE.
[00241] LISTOP - CHECK LIST OPTION.
[00265] OPTION - DEFINE BIT VALUE OF OPTION.
[00288] PRINT - PRINT LINE.
[00305] SEARCH - SEARCH TABLE.
[00327] TABLE - GENERATE MANAGED TABLE.
[00351] FETS AND TEMPORARY STORAGE.
[00383] MANAGED TABLES.
[00393] TDKN - TABLE OF DECK NAMES.
[00405] TPRG - TABLE OF MODIFIERS TO BE PURGED.
[00411] TDKI - TABLE OF DECK IDENTIFIERS.
[00420] TEDT - TABLE OF DECKS FOR WHICH EDITING IS REQUESTED.
[00428] TPAT - TABLE OF PULLALL IDENTS.
[00435] TPMI - TABLE OF PULLMOD IDENTS.
[00440] TNDK - TABLE OF NEW DECKS.
[00446] TCED - TABLE OF CHARACTER SETS OF EDITED DECKS.
[00465] OPTION - LIST OPTION TABLE.
[00473] STORAGE ASSIGNMENTS.
[00516] TCST - TABLE OF SYMBOLIC NAMES OF CHARACTER SETS.
[00616] MAIN PROGRAM.
[00661] BDK - BEGIN DECK.
[00743] BNI - BEGIN NEXT IDENT.
[00787] CDK - COMPLETE DECK.
[00870] SCS - SET CARD STATUS.
[00940] SUBROUTINES.
[00942] ABT - ABORT OPLEDIT.
[00953] ADW - ADD ENTRY TO A TABLE.
[00994] ASN - ASSEMBLE NAME.
[01062] ATS - ALLOCATE TABLE SPACE.
[01126] CKC - CHECK CARD.
[01171] CMF - COMPLETE FILES.
[01198] ECD - EXPAND CARD.
[01330] PLE - PROCESS LIBRARY ERROR.
[01346] POC - PROCESS OPL CHARACTER SET.
[01426] RMT - READ MODIFIER TABLE.
[01493] RPF - READ CARD FROM PROGRAM LIBRARY.
[01555] SSR - SELECT *S* READ FUNCTION.
[01579] SSW - SELECT *S* WRITE FUNCTION.
[01603] STB - SEARCH TABLE FOR ENTRY WITH MASK.
[01637] UPN - UNPACK NAME.
[01663] WDR - WRITE DIRECTORY TO PROGRAM LIBRARY.
[01711] WMT - WRITE MODIFIER TABLE.
[01792] WNF - WRITE CARD TO NEW PROGRAM LIBRARY.
[01849] WOF - WRITE OUTPUT FILE.
[01913] LCS - LIST CARD STATUS.
[01948] LDS - LIST DECK STATUS.
[01975] LER - LIST ERROR MESSAGE.
[02008] LST - LIST STATISTICS.
[02051] LTB - LIST TABLE.
[02126] PPM - PROCESS PULLED MODS.
[02254] CDC - COMPLETE DIRECTIVE CARD.
[02328] CID - CONVERT *ID* FOR DIRECTIVE.
[02376] SFI - SEARCH FOR IDENT IN DECK.
[02476] DIRECTIVE CARD PROCESSORS.
[02484] PDC - PROCESS DIRECTIVE CARDS.
[02532] ERR - DIRECTIVE ERROR PROCESSORS.
[02730] DIRECTIVE CARD PROCESSING SUBROUTINES.
[02732] LDC - LIST DIRECTIVE CARD.
[02769] RDR - READ DIRECTORY FROM PROGRAM LIBRARY.
[02851] OPLEDIT PRESET.
[02853] PRS - PRESET OPLEDIT.
[02939] PRESET DATA.
[02941] ARGT - ARGUMENT TABLE.
[02959] PRESET SUBROUTINES.
[02961] SLC - SET LIST CONTROL.
[02998] SOF - SET OUTPUT FORMAT.
Source Code

          IDENT  OPLEDIT,FETS,OPLEDIT
          ABS
          ENTRY  OPLEDIT
          ENTRY  MFL=
          SYSCOM B1
 OPLEDIT  TITLE  OPLEDIT - OPL EDITING PROGRAM.
*COMMENT  OPLEDIT - OPL EDITING PROGRAM.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
          SPACE  4
***       OPLEDIT - OPL EDITING PROGRAM.
*         G. R. MANSFIELD.   69/06/29.
*         A. D. FORET.       74/10/01.
 OPLEDIT  SPACE  4
***              OPLEDIT PROVIDES ADDITIONAL PL EDITING CAPABILITIES
*         SUCH AS *PURGE* AND *PULLMOD*, TO COMPLEMENT THE *MODIFY*
*         PROGRAM.
 CARD     SPACE  4,25
***       THE COMMAND.
*
*         OPLEDIT(P1,P2,P3,,,PN)
*
*         WHERE  *PI*  MAY BE ANY OF THE FOLLOWING -
*
*         I      DIRECTIVE INPUT FILE NAME, DEFAULT IS *INPUT*.
*
*         P      OLD PROGRAM LIBRARY FILE NAME, DEFAULT IS *OPL*.
*
*         N      NEW PROGRAM LIBRARY FILE NAME, DEFAULT IS *NPL*.
*
*         L      OUTPUT FILE NAME, DEFAULT IS *OUTPUT*.
*
*         M      FILE TO RECEIVE MODSETS, DEFAULT IS *MODSETS*.
*
*         LO     LIST OPTIONS.  DEFAULT IS *E* IF LIST OUTPUT FILE IS
*                ASSIGNED TO AN INTERACTIVE TERMINAL, OTHERWISE
*                DEFAULT IS *ECMDS*.
*
*                OPTION      DESCRIPTION
*
*                E           ERRORS.
*                C           INPUT DIRECTIVES.
*                M           MODIFICATIONS MADE.
*                D           DECK STATUS.
*                S           DIRECTORY LISTS.
*
*         F      MODIFY ALL DECKS, DEFAULT IS NOT SELECTED.
*
*         D      IGNORE ERRORS, DEFAULT NOT SET.
*
*         Z      PROCESS DIRECTIVES FROM COMMAND.
*                FORMAT IS- OPLEDIT(Z)SDDDSDDDSDDD
*                WHERE *S* IS ANY SEPARATOR AND *D* IS ANY
*                VALID DIRECTIVE.
*
*         U      DETERMINES WHAT *EDIT DIRECTIVES ARE GENERATED
*                ON *MODSETS*.
*                U OMITTED = *EDIT DIRECTIVES ARE GENERATED
*                FOR COMMON DECKS.
*                U SPECIFIED = *EDIT DIRECTIVES ARE GENERATED
*                FOR ALL DECKS.
*                U=0 = NO *EDIT-S ARE GENERATED.
 DAYFILE  SPACE  4,20
***       DAYFILE MESSAGES.
*
*         * CSET - UNKNOWN CHARACTER SET.* - THE CHARACTER SET
*                ON THE *CSET* DIRECTIVE IS UNKNOWN.
*
*         * ERROR IN ARGUMENTS.* - AN INCORRECT ARGUMENT WAS
*                ENCOUNTERED.  THIS IS A FATAL ERROR.
*
*         * DIRECTIVE ERRORS.* - AN INCORRECT DIRECTIVE
*                WAS ENCOUNTERED.
*
*         * MEMORY OVERFLOW.* - NOT ENOUGH STORAGE WAS
*                ALLOWED FOR THE OPLEDIT RUN.  THIS IS A FATAL ERROR.
*
*         * PL ERROR IN DECK   DNAME* - ERROR ENCOUNTERED IN
*                PROCESSING DECK *DNAME*.  THIS IS A FATAL ERROR.
*
*         * ERROR IN DIRECTORY.* - PROGRAM LIBRARY DOES NOT
*                HAVE OR HAS AN INCORRECTLY FORMATTED
*                DIRECTORY RECORD.  THIS IS A FATAL ERROR.
*
*         * PROGRAM LIBRARY EMPTY.* - THE OLD PROGRAM LIBRARY
*                CONTAINED NO DATA.  THIS IS A FATAL ERROR.
*
*         * NO DIRECTIVES.* - DIRECTIVE FILE WAS EMPTY.  THIS IS
*                A FATAL ERROR.
*
*         * OPLEDIT ERRORS.* - ERRORS ENCOUNTERED DURING
*                THE OPLEDIT RUN.
*
*         * OPLEDIT COMPLETE.* - NORMAL OPLEDIT COMPLETION
*                MESSAGE.
*
*         * FILE NAME CONFLICT.* - TWO FILES HAVE THE SAME NAME.
*                THIS IS A FATAL ERROR.
*
*         * DECKNAM - INCORRECT CS, 63 ASSUMED.* - DECK *DECKNAM*
*                HAD AN INCORRECT CHARACTER SET DESIGNATION.  OPLEDIT
*                ASSUMES IT TO BE A 63 CHARACTER SET RECORD AND
*                MAKES IT SUCH ON A NEW PROGRAM LIBRARY IF ONE
*                IS BEING GENERATED.
*
*         * MIXED CHARACTER SET OPL.* - RECORDS OF BOTH 63 AND
*                64 CHARACTER SET WERE FOUND ON THE PROGRAM
*                LIBRARY.  THIS IS A FATAL ERROR.
          TITLE  ASSEMBLY CONSTANTS AND MACRO DEFINITIONS.
 ASSEMBLY SPACE  4,10
****      ASSEMBLY CONSTANTS.
 
 
 OBUFL    EQU    1001B       LENGTH OF O-BUFFER (OUTPUT)
 SBUFL    EQU    1001B       LENGTH OF S-BUFFER (SOURCE)
 MBUFL    EQU    1001B       LENGTH OF M-BUFFER (MODSETS)
 PBUFL    EQU    2001B       LENGTH OF P-BUFFER (OPL)
 NBUFL    EQU    2001B       LENGTH OF N-BUFFER (NPL)
 MTBSL    EQU    10000B      NOMINAL TABLE LENGTH
 MXCCL    EQU    37B         MAXIMUM LENGTH OF COMPRESSED LINE IMAGE
 LIST     EQU    153B        DEFAULT LIST OPTIONS (ALL OPTIONS SET)
****
 COMMON   SPACE  4,10
*         COMMON DECKS.
 
 
*CALL     COMCMAC
*CALL     COMCCMD
*CALL     COMSSRT
 MACROS   SPACE  4,10
*         MACRO DEFINITIONS.
 READK    SPACE  4,15
**        READK - READ CODED LINE TO CHARACTER BUFFER.
*
*         READK  FILE,BUF,N
*
*         WORDS ARE UNPACKED AND STORED IN THE WORKING BUFFER 1 6/12
*         CHARACTER/WORD UNTIL THE END OF LINE (0000) BYTE IS SENSED.
*         CHARACTERS STORED ARE OF THE TYPE 6 BIT DISPLAY OR 6/12 BIT
*         DISPLAY BASED ASCII.
*         IF THE CODED LINE TERMINATES BEFORE *N* CHARACTERS ARE
*         STORED, THE WORKING BUFFER IS FILLED WITH SPACE CODES.
*
*         CALLS  SSR.
 
 
          PURGMAC READK
 
 READK    MACRO  F,S,N
  MACREF READK
  R= B6,S
  R= B7,N
  R= X2,F
  RJ =XSSR
  ENDM
 WRITEK   SPACE  4,10
**        WRITEK - WRITE CODED LINE FROM CHARACTER BUFFER.
*
*         WRITEK FILE,BUF,N
*
*         CHARACTERS ARE PACKED FROM THE WORKING BUFFER.
*         TRAILING CODES ARE DELETED BEFORE CHARACTERS ARE PACKED.
*
*         CALLS  SSW.
 
 
          PURGMAC WRITEK
 
 WRITEK   MACRO  F,S,N
  MACREF WRITEK
  R= B6,S
  R= B7,N
  R= X2,F
  RJ =XSSW
  ENDM
 ADDWRD   SPACE  4
**        ADDWRD - ADD A WORD TO A TABLE.
*
*         ADDWRD TNAM,WORD
*
*         TNAM   TABLE NAME.
*         WORD   WORD TO ADD.
*
*         CALLS  ADW.
 
 
 ADDWRD   MACRO  TNAM,WORD
          IFC    NE,$X1$WORD$,1
          BX1    WORD
          R=     A0,TNAM
          RJ     ADW
          ENDM
 CARD     SPACE  4,10
**        CARD - GENERATE LIST AND CALL FOR DIRECTIVE TRANSLATION.
*
*         CARD   NAME,ADDR
*
*         NAME   DIRECTIVE NAME.
*         ADDR   ADDRESS TO BEGIN EXECUTION.
*                IF *ADDR* IS NOT SPECIFIED, BEGIN EXECUTION AT *NAME*.
*
*         CALLS  CKC.
 
 
          NOREF  .X
 
 CARD     MACRO  NAM,ADR
          LOCAL  A,B,C
          IF     DEF,.X,1
 .1       IFNE   .X,*
          RMT
          DATA   0
 A        BSS    0
          RMT
          SA0    A
          RJ     CKC
 B        BSS    0
 .X       SET    B
 .1       ENDIF
          RMT
 C        SET    ADR NAM
          VFD    42/0L_NAM,18/C
          RMT
          ENDM
 ALLOC    SPACE  4,10
**        ALLOC - ALLOCATE SPACE TO TABLE.
*
*         ALLOC  TNAM,WORDS
*
*         TNAM   TABLE NAME.
*         WORDS  NUMBER OF WORDS TO ALLOCATE.
*
*         CALLS  ATS.
 
 
 ALLOC    MACRO  TNAM,N
          R=     X1,N
          R=     A0,TNAM
          RJ     ATS
          ENDM
 LISTOP   SPACE  4,15
**        LISTOP - CHECK LIST OPTION.
*
*         LISTOP TYPE,ADDR,INS,REG
*
*         ENTRY  TYPE - OPTION LETTER.
*                ADDR - ADDRESS TO JUMP TO.
*                INS  - ALTERNATE INSTRUCTION TO EXECUTE, DEFAULT IS
*                       *PL*.
*                REG  - ALTERNATE REGISTER TO USE, DEFAULT IS  *X1*.
*
*         EXIT   CONTROL IS TRANSFERRED TO SPECIFIED ADDRESS IF THE
*                SPECIFIED OPTION LETTER WAS SELECTED ON THE CONTROL
*                COMMAND.
 
          PURGMAC LISTOP
 
 LISTOP   MACRO  T,A,I,R
 .INS MICRO 1,2,*I_PL*
 .REG MICRO 1,1,*R_1*
  SA".REG" LO
  LX".REG" 59-LO.T
  ".INS" X".REG",A
 LISTOP   ENDM
 OPTION   SPACE  4,15
**        OPTION - DEFINE BIT VALUE OF OPTION.
*
*         OPTION TYPE
*
*         ENTRY  TYPE - OPTION LETTER.
*
*         EXIT   THE SYMBOL LO.X IS GENERATED, WHERE X IS THE OPTION
*                BIT CORRESPONDING TO THE LETTER  *X*.
 
 
 .OPT     SET    0
          NOREF  .OPT
          PURGMAC OPTION
 
 OPTION   MACRO  T
 LO.T EQU .OPT
 .OPT SET .OPT+1
 OPTION RMT
  CON 0R_T
 OPTION RMT
 LO.T DECMIC LO.T
 OPTION   ENDM
 PRINT    SPACE  4,10
**        PRINT - PRINT LINE.
*
*         PRINT  FWA,N
*
*         FWA    LINE FWA.
*         N      IF *FWA* .GE. 0, N IS IGNORED.  IF *FWA* .LT. 0, N IS
*                THE CHARACTER COUNT.  IF N IS OMITTED, *B0* IS USED.
*
*         CALLS  WOF.
 
 
 PRINT    MACRO  FWA,N
          SX1    FWA
          R=     X2,N
          RJ     WOF
          ENDM
 SEARCH   SPACE  4,10
**        SEARCH - SEARCH TABLE.
*
*         SEARCH TNAM,WORD,BITS
*
*         TNAM   TABLE NAME TO BE SEARCHED.
*         WORD   WORD TO FIND.
*         BITS   ADDITIONAL BITS (0-16) TO COMPARE ON.
*
*         CALLS  STB.
 
 
 SEARCH   MACRO  TNAM,ENTRY,BITS
          R=     A0,TNAM
          IFC    NE,$X6$ENTRY$,1
          BX6    ENTRY
          MX1    42
          IFC    NE,*BITS**,2
          R=     X2,BITS
          BX1    X1+X2
          RJ     STB
          ENDM
 TABLE    SPACE  4,10
**        TABLE - GENERATE MANAGED TABLE.
*
* TNAM    TABLE  N
*
*         TNAM   NAME OF TABLE TO BE GENERATED.
*         N      NUMBER OF WORDS TO BE ALLOCATED WHEN TABLE IS FULL.
*
*         GENERATES TABLE POINTERS FOR TABLE *TNAM*.
*         *F.TNAM*  NAME OF A WORD CONTAINING TABLE FWA.
*         *L.TNAM*  NAME OF A WORD CONTAINING TABLE LENGTH.
 
 
          MACRO  TABLE,TNAM,N
 TNAM     EQU    *
          VFD    60/MTBS
 F.TNAM   EQU    FTAB+TNAM
          RMT
 L.TNAM   EQU    LTAB+TNAM
          ORG    L.TNAM
          DATA   0
          ORG    NTAB+TNAM
          VFD    60/N
          RMT
          ENDM
          TITLE  FETS AND TEMPORARY STORAGE.
 FETS     SPACE  4
**        FETS.
 
 
          ORG    110B
 FETS     BSS    0
 
 I        BSS    0           DIRECTIVES FILE FET
 INPUT    FILEC  SBUF,SBUFL,FET=8
 
 O        BSS    0           OUTPUT FILE FET
 OUTPUT   FILEC  OBUF,OBUFL,FET=8
 
 M        BSS    0           MODSET OUTPUT FILE FET
 MODSETS  FILEC  MBUF,MBUFL,FET=8
          ORG    M+7
          CON    0LMODSETS+1
 
 N        BSS    0           NEW PROGRAM LIBRARY FET
 NPL      RFILEB NBUF,NBUFL,FET=8
          ORG    N
          CON    0
          ORG    N+8
 
 P        BSS    0           OLD PROGRAM LIBRARY FET
 OPL      RFILEB PBUF,PBUFL,FET=8
          ORG    P+7
          CON    0LOPL+3
 
 
 FETSL    BSS    0
          TITLE  MANAGED TABLES.
**        MANAGED TABLES ARE REFERENCED BY THE TABLE NUMBER *TNAM*.
*         THE FWA OF A TABLE IS CONTAINED IN *F.TNAM*.
*         THE LENGTH OF A TABLE IS CONTAINED IN *L.TNAM*.
*         THESE SYMBOLS ARE GENERATED BY THE *TABLE* MACRO.
 
 
 FTAB     BSS    0
          LOC    0
          SPACE  4
**        TDKN - TABLE OF DECK NAMES.
*         ENTRY = 2 WORDS.
*
*         WORD 1 -
*                BITS 18 - 59 = DECK NAME LEFT JUSTIFIED
*
*         WORD 2 -
*                BITS 00 - 35 = RANDOM ADDRESS ON PROGRAM LIBRARY
 
 
 TDKN     TABLE  10          DECK NAMES
          SPACE  4
**        TPRG - TABLE OF MODIFIERS TO BE PURGED.
*         ENTRY = 1 WORD.
 
 
 TPRG     TABLE  10          MODIFIERS TO BE PURGED
 TDKI     SPACE  4
**        TDKI - TABLE OF DECK IDENTIFIERS.
*         ENTRY = 1 WORD.
*                BITS 18 - 59 = IDENTIFIER LEFT JUSTIFIED
*                BIT 16 = YANK FLAG
*                BITS 00 - 15 = MODIFIER EQUIVALENCE
 
 
 TDKI     TABLE  10          DECK IDENTIFIERS
          SPACE  4
**        TEDT - TABLE OF DECKS FOR WHICH EDITING IS REQUESTED.
*         ENTRY = 1 WORD.
*                BITS 18 - 59 = DECK NAME LEFT JUSTIFIED
*                BITS 00 - 17 = ADDRESS OF DECK IN DECK NAME TABLE.
 
 
 TEDT     TABLE  10          DECKS REQUESTED FOR EDITING
 TPAT     SPACE  4,13
**        TPAT - TABLE OF PULLALL IDENTS.
*         ENTRY = 1 WORD.
*         BITS 18 - 59 = IDENTIFIER LEFT JUSTIFIED.
 
 
 TPAT     TABLE  10          PULLALL IDENTIFIERS
          SPACE  4
**        TPMI - TABLE OF PULLMOD IDENTS.
 
 
 TPMI     TABLE  10
          SPACE  4
**        TNDK - TABLE OF NEW DECKS.
*         SAME FORMAT AS *TDKN*.
 
 
 TNDK     TABLE  10          NEW DECK NAMES
 TCED     SPACE  4,10
**        TCED - TABLE OF CHARACTER SETS OF EDITED DECKS.
*         ENTRY = 1 WORD.
*                BITS 18 - 59 = DECK NAME LEFT JUSTIFIED.
*                BITS 00 - 17 = CHARACTER SET OF DECK.
*                               1 = ASCII  0 = DISPLAY.
 
 TCED     TABLE 10           CHARACTER SETS OF EDITED DECKS
          SPACE  4
*         REMAINDER OF MANAGED TABLE VALUES.
 
 
 FTABL    BSS    0
          LOC    *O
 
          VFD    60/MTBS     LWA+1 ALL TABLES
 LTAB     BSS    0
 NTAB     EQU    LTAB+FTABL
          HERE
 OPTION   SPACE  4,10
**        OPTION - LIST OPTION TABLE.
 
 
          OPTION E           ERRORS
          OPTION C           OTHER INPUT DIRECTIVES
          OPTION M           MODIFICATIONS
          OPTION D           DECK STATUS
          OPTION S           DIRECTORY LISTS
          TITLE  STORAGE ASSIGNMENTS.
*         COMMON DATA.
 
 
 T1       DATA   0           TEMPORARY STORAGE
 T2       DATA   0
 FL       DATA   0           FIELD LENGTH
 CH       DATA   0           CHARACTER POINTER
 PL       DATA   0LOPL       PROGRAM LIBRARY NAME
          SPACE  4
*         MODIFICATION CONTROLS.
 
 
 ACTIVE   DATA   0           DIRECTIVE IN PROGRESS FLAG
 DF       DATA   0           DELETE IN PROGRESS FLAG
 DL       DATA   0           *DIRECTIVE LAST* FLAG
 IF       DATA   0           INSERT IN PROGRESS FLAG
 RF       DATA   0           RESTORE IN PROGRESS FLAG
 II       DATA   -0          IDENT INDEX
 IN       DATA   0           IDENT NAME
 IP       DATA   0           IDENT PRESENT FLAG
 PA       DATA   0           *PULL ALL* FLAG
          DATA   0           *PULLALL,IDENT* IDENT FLAG
 PI       DATA   0           *PULLMOD* INDEX
 EI       DATA   0           EDIT TABLE INDEX
 MD       DATA   0           MODIFICATION FLAG
 DN       DATA   0           CURRENT DECK NAME
 DA       DATA   0           CURRENT DECK ADDRESS
 EC       DATA   0           DECK ERROR COUNTER
 CC       DATA   0           INACTIVE CARD COUNTER
          DATA   0           ACTIVE CARD COUNTER
          DATA   0           INSERTED CARD COUNTER
          SPACE  4
*         LIST CONTROLS.
 
 
 LC       CON    99999,0     LINE COUNT
 LL       EQU    LC+1        LINE LIMIT
 LO       CON    0           LIST OPTION
 PN       DATA   1           PAGE NUMBER
 TL       CON    CCDR        ADDRESS OF TITLE TEXT
 TO       DATA   0           TERMINAL OUTPUT FORMAT FLAG
 TCST     SPACE  4,10
**        TCST - TABLE OF SYMBOLIC NAMES OF CHARACTER SETS.
*
*T TCST   42/ CS NAME,18/ CS ORDINAL
*
 
 TCST     BSS    0
          CON    0LDISPLAY+.DIS        DISPLAY
          CON    0LASCII+.AS612        ASCII (6/12)
          CON    0                     MAXIMUM CHARACTER SETS
 
 CSD      SPACE  4,20
*         CHARACTER SET DEFINITIONS.
 
 .DIS     EQU    0           DISPLAY CODE 63/64
 .AS612   EQU    1           DISPLAY CODE BASED 6/12 ASCII (63/64)
          SPACE  4
*         FLAGS.
 
 
 CSM      DATA   -1          OPL CHARACTER SET FLAG
 CSC      CON    .DIS        OPL 6 OR 6/12 CHARACTER SET FLAG
 EF       DATA   0           ERROR (TOTAL ERRORS DURING MODIFICATION)
 CD       DATA   0           COMMON DECK
 IGNORE   DATA   0           SET ON MULTIPLE MODSET PULLMODS
 LF       CON    0           SET IF DATA TRANSMITTED TO LIST FILE
 SETC     CON    -1          0 = CSET DISPLAY  1 = CSET ASCII
 
*         FLAGS SET BY COMMAND PARAMETERS.
 
 CL       DATA   0           CARD LISTED
 DB       DATA   0           DEBUG
 FM       DATA   0           -F- MODE
 UM       DATA   -1          -1=COMMON, +1=ALL, 0=NO *EDIT-S
 
**        MODIFY DIRECTIVE TEMPLATES.
 
 DCKD     DATA   17C*DECK     DNAME
 DELD     DATA   03L*D,
 EDTD     DATA   17C*EDIT     DNAME
 IDND     DATA   17C*IDENT    MNAME
 INSD     DATA   03L*I,
 RESD     DATA   09L*RESTORE,
 
**        TABLE OF DIRECTIVE TEMPLATE ADDRESSES.
 
 TDTA     CON    DCKD        *DECK
          CON    DELD        *D
          CON    EDTD        *EDIT
          CON    IDND        *IDENT
          CON    INSD        *I
          CON    RESD        *RESTORE
          CON    0
          SPACE  4,10
**        BLOCK STORAGE.
 
 
          USE    BUFFERS
 
*         TITLE LINE.
 
 TITL     DATA   20H OPLEDIT - VER 1.2
 DATE     DATA   1H
 TIME     DATA   1H
          DATA   4APAGE
 PAGE     DATA   1H
 TITLL    EQU    *-TITL
 
*         TERMINAL TITLE LINE.
 
 TERL     DATA   50H OPLEDIT - VER 1.2
 TERDT    CON    1H
 TERTM    CON    1H
 TERLL    EQU    *-TERL
 
*         SUBTITLE LINE
 
 SBTL     DATA   30H
          DATA   0
          DATA   2L
 SBTLL    EQU    *-SBTL
 
*         IDENT TABLE.
 
 TIDT     VFD    12/7700B,12/TIDTL-1,36/0
          BSS    16B
 TIDTL    EQU    *-TIDT
 
*         PROGRAM LIBRARY CARD PROCESSING BUFFERS.
*         THE ORDER OF THE FOLLOWING MUST BE MAINTAINED.
 
 CDAC     DATA   1S59        CARD ACTIVITY
 CDWC     DATA   0           WORD COUNT OF COMPRESSED CARD
 CDID     DATA   1           CARD ID
 CDTX     BSS    MXCCL       TEXT OF COMPRESSED LINE
 
 NMHB     DATA   1           NUMBER OF MODIFICATION HISTORY BYTES
 TMHB     DATA   1S16        MODIFICATION HISTORY BYTE TABLE
          BSS    199
          USE    *
 OPLEDIT  TITLE  OPLEDIT - MAIN PROGRAM.
**        OPLEDIT - MAIN PROGRAM.
 
 
 OPLEDIT  SB1    1           (B1) = 1
          RJ     PRS         PRESET PROGRAM
          RJ     PDC         PROCESS DIRECTIVE CARDS
          SX6    B1          SET WORDS/ENTRY
          SA6    LTBA
          RJ     BNI         BEGIN FIRST IDENT
          EQ     OPL3        BEGIN FIRST DECK
 
*         PROCESS MODIFICATIONS.
 
 OPL1     MX6    0           CLEAR CARD LIST
          SX7    B0          CLEAR CARD ACTIVITY
          SA6    CL
          SA7    CDAC
          RJ     RPF         READ CARD FROM PROGRAM LIBRARY
          NZ     X1,OPL2     IF EOR
          RJ     PPM
          RJ     SCS         SET CARD STATUS
          SA1    NMHB
          ZR     X1,OPL1     IF CARD REMOVED
          RJ     WNF         WRITE NEW PROGRAM LIBRARY
          EQ     OPL1        LOOP
 
*         COMPLETE PROCESSING.
 
 OPL2     RJ     CDK         COMPLETE DECK
 OPL3     RJ     BDK         BEGIN NEXT DECK
          NZ     X7,OPL1     IF DECK TO BE PROCESSED
 
          RJ     WDR         WRITE DIRECTORY
          RJ     LST         LIST STATISTICS
          SA1    EF
          SA2    DB
          ZR     X1,OPL4     IF NO ERRORS
          NZ     X2,OPL4     IF DEBUG SET
          SA0    =C* OPLEDIT ERRORS.*
          EQ     ABT
 
 OPL4     RJ     CMF         COMPLETE FILES
          MESSAGE (=C* OPLEDIT COMPLETE.*)
          ENDRUN
 BDK      SPACE  4,20
**        BDK - BEGIN DECK.
*
*         EXIT   (X7) - .NE. 0 IF DECK READY FOR PROCESSING.
*
*         USES   ALL.
*
*         CALLS  CDC, LDS, RMT, SFI, SFN, WMT.
 
 
 BDK      PS     0           ENTRY/EXIT
 BDK0     RJ     CDC         COMPLETE DIRECTIVE CARD
          SX6    B0
          SA6    DL          CLEAR DL
          RECALL P
          SA1    P+1
          SX6    X1          *REWIND* OPL FET
          SA6    A1+B1
          SA6    A6+B1
          SA1    EI          CHECK EDIT TABLE
          SA2    L.TEDT
          IX7    X2-X1
          SX6    X1+B1       ADVANCE EDIT INDEX
          ZR     X7,BDK1     IF END OF TABLE
          SA3    F.TEDT      LOOK UP EDIT TABLE ENTRY
          SB2    X1
          SA2    X3+B2
          SA6    A1
          MX0    42          MASK DECK NAME
          BX6    X0*X2
          SX7    X2          SET DECK ADDRESS
          SA6    DN          SET DECK NAME
          SA6    ID1         SET TO DECK.0
          SA6    ID3         SET LAST ORIGINAL CARD ID
          SA6    EDTD+1      IN EDIT MESSAGE
          SA7    DA
          BX1    X6
          RJ     SFN         SPACE FILL NAME
          SA6    SBTL+2
          SA6    BDKA+1      ENTER NAME IN MESSAGE
          MX7    0           CLEAR DECK IDENTIFIER TABLE LENGTH
          SA7    L.TDKI
          RJ     RMT         READ MODIFIER TABLE
          RJ     SFI         SEARCH FOR IDENT IN THIS DECK
          SA1    PA+1
          NZ     X1,BDK0.0   IF *PULLMOD,IDENT*
          SA1    A1-B1
          NZ     X1,BDK0.1   IF *SUMMARY MODE*
 BDK0.0   SA1    IP
          NZ     X1,BDK0.1   IF FOUND
          SA1    IGNORE
          NZ     X1,BDK0     IF NOT *NORMAL* MODE
 BDK0.1   MESSAGE BDKA,1
          RJ     LDS         LIST DECK STATUS
          RJ     WMT         WRITE MODIFIER TABLE
          SX6    B0          CLEAR CARD COUNTS
          SX7    B1
          SA6    CC
          SA6    A6+B1
          SA6    A6+B1
          SA6    MD          CLEAR MODIFICATION FLAG
          EQ     BDK
 
 
 BDK1     SA1    PA
          MX7    0
          SA7    A1          CLEAR PA
          SA7    A1+B1
          ZR     X1,BDK2     IF NOT PULL ALL MOD
          WRITER M,R
 BDK2     RJ     BNI         BEGIN NEXT IDENT
          ZR     X7,BDK      IF EXHAUSTED
          SX6    B1
          SA6    IGNORE      SET *MODSETS ONLY* MODE
          MX6    0
          SA6    EI          RESET EDIT INDEX
          EQ     BDK0        PROCESS FIRST DECK AGAIN
 
 BDKA     DATA   10H  EDITING
          DATA   0
          DATA   10H  PULLING
 BDKB     DATA   10C * NONE *
 BNI      SPACE  4,20
**        BNI - BEGIN NEXT IDENT.
*
*         USES   X - 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 3, 4, 6, 7.
*                B - ALL.
*
*         CALLS  WTW=.
 
 
 BNI      PS     0
          SA1    PA
          NZ     X1,BNI2     IF *SUMMARY* MODE
          SA1    PI
          SA2    L.TPMI
          IX7    X2-X1
          SX6    X1+B1
          ZR     X7,BNI      IF NO NEXT IDENT
          SA3    F.TPMI
          SB2    X1
          SA2    X3+B2       LOOK UP ENTRY
          SA6    A1
          MX0    42
          BX6    X0*X2
          SA6    IN          STORE IDENT NAME
          SA6    IDND+1      STORE IN IDENT HEADER LINE
          SA6    BDKB        ENTER INTO MESSAGE
          SA1    PI          EOR IF NOT NEW
          SX1    X1-1
          ZR     X1,BNI1     IF FILE NEVER WRITTEN
          WRITER M,R
 BNI1     WRITEW M,IDND+1,1  WRITE HEADER
          WRITEW M,IDND,2
          SX7    B1
          EQ     BNI         EXIT
 
 
 BNI2     SA1    =C+*******+ SET PSEUDO-IDENT FOR SUMMARY
          BX6    X1
          SA6    IDND+1
          SA6    BDKB        INTO MESSAGE
          MX7    0
          SA7    II
          EQ     BNI1        TO FINISH
 CDK      SPACE  4,20
**        CDK - COMPLETE DECK.
*
*         ISSUE ERROR MESSAGE IF APPROPRIATE, COMPLETE DECK
*         ON NEW PROGRAM LIBRARY IF SELECTED AND RESET
*         MISCELLANEOUS FLAGS.
*
*         USES   X - 1, 2, 6, 7.
*                A - 1, 2, 6, 7.
*                B - 7.
*
*         CALLS  CDD.
*
*         MACROS LISTOP, MESSAGE, PRINT, WRITER, WRITEW.
 
 
 CDK      SUBR               ENTRY/EXIT
          SA1    IP
          ZR     X1,CDK.2    IF IDENT NOT IN DECK
          SA1    UM
          ZR     X1,CDK.2    IF *NONE* SELECTED
          PL     X1,CDK.1    IF *ALL* SELECTED
          SA1    CD
          ZR     X1,CDK.2    IF *COMMON* SELECTED BUT NOT COMMON
 CDK.1    WRITEW M,EDTD,2
 CDK.2    SA2    IGNORE
          NZ     X2,CDKX     IF *MODSETS ONLY* MODE
          SA2    EF          PROPAGATE ERRORS
          SA1    EC
          MX7    0           CLEAR ERROR COUNT
          IX6    X2+X1
          SA7    A1
          SA6    A2
          ZR     X1,CDK3     IF NO ERRORS
          SA2    SBTL+2
          SB7    X1
          BX6    X2
          SA2    =10H ERRORS IN
          NE     B7,B1,CDK2  IF MORE THAN 1
          SA2    =10H ERROR IN
          LX6    6           SHIFT NAME
 CDK2     BX7    X2
          LX6    60-6
          SA7    CDKA+1
          SA6    A7+B1
          SX1    B7          CONVERT COUNT
          RJ     CDD
          SA6    A7-B1
          MESSAGE A6,3,R
 CDK3     WRITER N
          LISTOP D,CDKX,,2   IF NO LIST FOR DECK STATUS - RETURN
          PRINT  (=C*  *)
          SA1    CC          CONVERT INACTIVE CARD COUNT
          RJ     CDD
          SA6    CDKC
          SA1    A1+B1       CONVERT ACTIVE CARD COUNT
          RJ     CDD
          SA6    CDKB+1
          SA1    A1+B1       CONVERT INSERTED CARD COUNT
          RJ     CDD
          SA6    CDKD
          PRINT  CDKB
          SA1    MD
          ZR     X1,CDKX     IF NO MODIFICATIONS - RETURN
          SX6    99999       FORCE PAGE EJECT
          SA6    LC
          EQ     CDKX        RETURN
 
 CDKA     DATA   10H
          DATA   10HERRORS IN
          DATA   10H
          DATA   0
 
 CDKB     DATA   10H
          DATA   10H
          DATA   20H ACTIVE CARD(S).
 
 CDKC     DATA   10H
          DATA   20H INACTIVE CARD(S).
 
 CDKD     DATA   10H
          DATA   20H INSERTED CARD(S).
          DATA   0
 SCS      SPACE  4,20
**        SCS - SET CARD STATUS.
*
*         SET CARD ACTIVITY ACCORDING TO LAST MHB AND YANK
*         STATUS.  LIST MODIFICATION TO CARD.
*
*         USES   X - ALL.
*                A - 1, 2, 3, 6, 7.
*                B - 2, 3, 4.
*
*         CALLS  ECD, LCS.
*
*         MACROS LISTOP.
 
 
 SCS      SUBR               ENTRY/EXIT
          SA1    IGNORE
          NZ     X1,SCSX     IF *MODSETS ONLY* MODE
          SA1    NMHB        (B2) = MHB COUNT
          SA2    F.TDKI      (B3) = FWA DECK IDENTIFIER TABLE
          MX0    60-16       MHB INDEX MASK
          SB2    X1
          SB3    X2
          MX7    0           CLEAR STATUS
          SB4    B0          CLEAR NEW MHB COUNT
          SA2    A1+B1       FIRST MHB
          BX3    -X0*X2
          ZR     X3,SCS1     IF ORIGINAL CARD
          SA2    CC+2        ADVANCE INSERTED CARD COUNT
          SX6    X2+B1
          SA6    A2
 SCS1     SA1    A1+B1       NEXT MHB
          BX3    -X0*X1      SET MODIFIER INDEX
          SB2    B2-B1       COUNT MHB
          SA2    X3+B3
          BX1    X1*X0
          BX6    -X0*X2
          BX6    X6+X1       STORE MHB
          LX2    59-16       CHECK YANK
          SA6    TMHB+B4
          LX5    X2,B1       CHECK PURGE
          NG     X5,SCS2     IF PURGED
          SB4    B4+B1       COUNT NEW MHB
          NG     X2,SCS2     IF YANKED
          BX7    X1          STATUS = MHB STATUS
 SCS2     NZ     B2,SCS1     IF NOT END OF MHB-S
          SX6    B4          SET NEW MHB COUNT
          SA6    NMHB
          SA3    CDAC        COMPARE STATUS
          LX7    59-16
          BX6    X7-X3
          SA7    A3          SET NEW STATUS
          SX1    B1
          LX7    1
          BX2    X1*X7
          SA3    CC+X2       COUNT CARD
          SX7    X3+B1
          SA7    A3
          PL     X6,SCSX     IF UNCHANGED - RETURN
          LISTOP M,SCSX      IF NO LIST FOR MODIFICATIONS - RETURN
          RJ     ECD         EXPAND CARD
          SA3    CDAC        CHECK STATUS
          SX6    1RA
          SX7    1R
          NG     X3,SCS3     IF ACTIVE
          SX6    1R
          SX7    1RD
 SCS3     SA6    CHSP+5
          SA7    A6+B1
          RJ     LCS         LIST CARD STATUS
          EQ     SCSX        RETURN
          TITLE  SUBROUTINES.
 ABT      SPACE  4,10
**        ABT - ABORT OPLEDIT.
*
*         ENTRY  (A0) - ADDRESS OF MESSAGE.
*
*         CALLS  CMF.
 
 
 ABT      RJ     CMF         COMPLETE FILES
 ABT1     MESSAGE A0
          ABORT
 ADW      SPACE  4,20
**        ADW - ADD ENTRY TO A TABLE.
*
*         ENTRY  (A0) - TABLE POINTER ADDRESS.
*                (X1) - ENTRY.
*
*         EXIT   (X6) - ENTRY.
*                (A6) - ADDRESS OF ENTRY.
*                (X3) - INDEX OF ENTRY.
*
*         USES   X - 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 3, 4, 6, 7.
*                B - 2.
*
*         CALLS  ATS.
 
 
 ADW1     BX6    X1          ENTER WORD
          SX7    X3+B1       ADVANCE LENGTH
          SA6    X2+B2
          SA7    A3
 
 ADW      PS     0           ENTRY/EXIT
          SA2    FTAB+A0     CHECK TABLE ROOM
          SA3    LTAB+A0
          SA4    A2+B1
          IX6    X2+X3
          SB2    X3
          IX7    X4-X6
          NZ     X7,ADW1     IF ROOM FOR WORD
          SA2    NTAB+A0     ALLOCATE TABLE
          BX6    X1          SAVE WORD
          SA6    ADWA
          ALLOC  A0,X2
          SA4    NTAB+A0     RESET LAST LENGTH
          SA1    ADWA        RESTORE WORD
          IX3    X3-X4
          SB2    X3
          EQ     ADW1        ENTER WORD
 
 ADWA     CON    0
 ASN      SPACE  4,20
**        ASN - ASSEMBLE NAME.
*
*         ASSEMBLE UP TO 7 CHARACTER NAME TO A SEPARATOR.
*         THE CHARACTER STRING BUFFER CAN CONTAIN EITHER
*         6 OR 6/12 CHARACTERS.
*
*
*         ENTRY  (CHAR) - CHARACTER STRING BUFFER.
*                (CH) - CHARACTER POINTER.
*
*         EXIT   (X6) - NAME LEFT JUSTIFIED ZERO FILL.
*                (X6) = 0 IF SEPARATOR FOUND, OR MORE THAN
*                            7 CHARACTERS ASSEMBLED.
*
*         USES   X - 1, 2, 6, 7.
*                A - 1, 2, 7.
*                B - 2.
*
 
 
 ASN3     LX6    6
          BX2    X1*X6
          ZR     X2,ASN3     IF NAME NOT LEFT JUSTIFIED
          SA7    A1          UPDATE CHARACTER POINTER
          MX1    42
          BX7    -X1*X6
          ZR     X7,ASN      IF @ 7 CHARACTERS
          SX6    B0          RETURN WITH BLANK NAME
 
 ASN      PS     0           ENTRY/EXIT
          SA1    CH          CHECK FIRST CHARACTER
          MX7    -6
          SA2    X1
          MX6    0           CLEAR ASSEMBLY
          BX2    -X7*X2      USE LOWER 6 BIT ONLY
          SB2    X2-1R
          ZR     X2,ASN      IF SEPARATOR
          NG     B2,ASN1     IF NOT SEPARATOR
 
*         CHECK POSSIBLE 6/12 ESCAPE CODE.
 
          SB2    X2-76B
          NZ     B2,ASN      IF SEPARATOR
          SA2    A2+B1       LOWER PORTION OF 6/12 CHARACTER
          BX2    -X7*X2
          SB2    X2-1RZ-1
          ZR     X2,ASN      IF SEPARATOR
          PL     B2,ASN      IF SEPARATOR
 ASN1     LX6    6           SHIFT ASSEMBLY
          BX6    X6+X2       MERGE NEW CHARACTER
          SA2    A2+B1       NEXT CHARACTER
          BX2    -X7*X2
          SB2    X2-1R
          NG     B2,ASN1     IF NOT SEPARATOR
 
*         CHECK POSSIBLE 6/12 ESCAPE CODE.
 
          SB2    X2-76B
          NZ     B2,ASN2     IF NOT ESCAPE CODE, THEN SEPARATOR
          SA2    A2+B1       LOWER PORTION OF 6/12 CHARACTER
          BX2    -X7*X2
          SB2    X2-1RZ-1
          ZR     X2,ASN2     IF SEPARATOR
          NG     B2,ASN1     IF NOT SEPARATOR
 ASN2     MX1    6
          SX7    A2
          EQ     ASN3        LEFT JUSTIFY NAME
 ATS      SPACE  4,20
**        ATS - ALLOCATE TABLE SPACE.
*
*         ENTRY  (A0) - TABLE NUMBER.
*
*         EXIT   (X2) - TABLE FWA.
*                (X3) - TABLE LANGTH.
*
*         USES   X - 1, 2, 3, 4, 6, 7.
*                A - 0, 1, 2, 3, 4, 6, 7.
*                B - ALL.
*
*         CALLS  ABT, WTW=.
 
 
 ATSX     SA2    FTAB+A0     SET RESPONSE
          SA3    LTAB+A0
 
 ATS      PS     0           ENTRY/EXIT
          SA2    FTAB+A0     CHECK TABLE SPACE
          SA3    LTAB+A0
          IX7    X3+X1       ADVANCE LENGTH
          SA4    A2+B1
          IX6    X2+X7
          SA7    A3
          IX4    X4-X6
          NG     X4,ATS1     IF NO ROOM FOR CHANGE
          BX3    X7
          EQ     ATS         RETURN
 
*         CHECK AVAILABLE STORAGE.
 
 ATS1     SA2    FTAB+FTABL  CHECK STORAGE
          SA3    FL
          IX6    X2+X1
          IX7    X3-X6
          NG     X7,ATS4     IF NO ROOM FOR INCREASE
          SA6    A2          UPDATE LWA+1 OF ALL TABLES
          SB2    A0+B1
          SB3    FTABL
          BX4    X2
          EQ     B2,B3,ATSX  RETURN IF LAST TABLE
 
*         MOVE HIGHER TABLE UP.
 
 ATS2     SA2    A2-B1       ADVANCE FWA OF HIGHER TABLES
          IX6    X2+X1
          SA6    A2
          SB2    B2+B1
          NE     B2,B3,ATS2
          IX3    X4-X2       (B2) = WORD COUNT
          SB3    X1          (B3) = MOVE INCREMENT
          ZR     X3,ATSX     IF NO MOVE NEEDED
          SB2    X3
          SA1    X4-1        BEGIN AT LWA
 ATS3     BX6    X1          MOVE TABLE UP
          SA6    A1+B3
          SB2    B2-B1
          SA1    A1-B1
          NZ     B2,ATS3     LOOP TO END OF MOVE
          EQ     ATSX        RETURN
 
 ATS4     SA0    =C* MEMORY OVERFLOW.*
          EQ     ABT
 CKC      SPACE  4,20
**        CKC - CHECK CARD.
*
*         ENTRY  (A0) - ADDRESS OF FLAG LIST WORD.
*                     (00-17) - ADDRESS OF PROCESSOR.
*                     (18-59) - FLAG NAME.
*
*         USES   X - 0, 1, 2, 3, 6, 7.
*                A - 1, 2, 7.
*                B - 2, 3, 5.
*
*         CALLS  ASN.
 
 
 CKC      PS     0           ENTRY/EXIT
          SA1    CHAR        CHECK FIRST CHARACTER
          SX2    -1R*        CHECK PREFIX CHARACTER
          SX7    A1+B1
          BX6    X1+X2
          NZ     X6,CKC      RETURN IF FIRST CHARACTER " PREFIX
          SA7    CH          SET SECOND CHARACTER
          RJ     ASN         ASSEMBLE NAME
          MX0    42
          SA1    A0
          SB3    64
          NZ     X6,CKC1     IF NOT BLANK NAME
          SA2    CHAR+1      SET SECOND CHARACTER
          BX6    X2
          LX6    54
 CKC1     ZR     X1,CKC      RETURN IF END OF LIST
          IX7    X1-X6       COMPARE NAMES
          SB5    X1          SET PROCESSOR ADDRESS
          BX3    X0*X7
          SA1    A1+B1       NEXT LIST ENTRY
          NZ     X3,CKC1     IF NO MATCH
          SA1    CH          CHECK NEXT CHARACTER
          SA2    X1+B1
 CKC2     SB2    X2-1R
          NZ     B2,CKC3     IF NOT * *
          SA2    A2+B1       NEXT CHARACTER
          SB3    B3-B1
          PL     B3,CKC2     LOOP TO END OF CARD
 CKC3     SX7    A2          SET NEXT CHARACTER ADDRESS
          SA7    A1
          JP     B5          PROCESS SPECIAL CARD
 CMF      SPACE  4,20
**        CMF - COMPLETE FILES.
*
*         COMPLETE *MODSETS* FILE, ENSURE EVEN PAGE COUNT, AND
*         COMPLETE *OUTPUT* FILE IF USED.
*
*         USES   X - 1, 2, 3.
*                A - 1, 2, 3.
*
*         MACROS REWIND, WRITER, WRITEW.
 
 
 CMF      SUBR               ENTRY/EXIT
          WRITER M,R
          REWIND M
          SA1    O
          SA2    LF
          ZR     X1,CMFX     IF NO OUTPUT FILE - RETURN
          SA3    PN
          ZR     X2,CMFX     IF NOTHING LISTED TO OUTPUT - RETURN
          LX3    59
          NG     X3,CMF1     IF PAGE NUMBER EVEN
          SA3    TO
          ZR     X3,CMF1     IF TERMINAL OUTPUT
          WRITEW O,(=2L1 ),1 EJECT
 CMF1     WRITER O,R
          EQ     CMFX        RETURN
 ECD      SPACE  4,20
**        ECD - EXPAND CARD.
*
*         ENTRY  (CDTX) - TEXT OF COMPRESSED CARD.
*
*         EXIT   (CHAR) - EXPANDED CARD CHARACTER STRING.
*
*         USES   X - 0, 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 3, 4, 6, 7.
*                B - ALL.
*
*         CALLS  CDD.
 
 
 ECD      PS     0           ENTRY/EXIT
          SA1    CSC         SET CHARACTER SET
          SB6    X1
          SX1    300         SET LAST COLUMN
          SX6    1R          (X6) = * *
          SB7    X1+B1
          SA6    CHAR        PRESET (A6)
          MX0    60-6        (X0) = CHARACTER MASK
          SB2    -B7
          SB5    10          (B5) = 10
          SB4    B5
 ECD1     SB7    B7-B1       CLEAR CARD
          SA6    A6+B1
          PL     B7,ECD1
          SB3    CHAR+1+X1
          SA1    CDTX
          EQ     ECD3
 
*         EXPAND CARD TEXT.
 
 ECD1.1   SX2    X7-76B
          SX4    X7-74B
          ZR     X2,ECD1.2   IF 76B ESCAPE CODE
          NZ     X4,ECD2     IF NO ESCAPE CODES
          BX3    X1
          LX3    6
          BX2    -X0*X3
          SX4    X2-1
          SX3    X2-2
          ZR     X4,ECD1.3   IF 7401B UNPACK AT SIGN
          ZR     X3,ECD1.3   IF 7402B UNPACK CIRCUMFLEX
          SX4    X2-4
          SX3    X2-7
          ZR     X4,ECD1.3   IF 7404B UNPACK COLON (64) OR PERCENT (63)
          ZR     X3,ECD1.3   IF 7407B UNPACK GRAVE ACCENT
          EQ     ECD2        OTHERWISE UNPACK 6 BIT CHARACTERS
 
 ECD1.2   BX4    X1          76B PREFIX FOUND
          LX4    6
          BX3    -X0*X4
          SX4    X3-37B
          PL     X4,ECD2     IF .GT. 7636B UNPACK 6 BIT CHARACTERS
 ECD1.3   LX7    6           12 BIT CHARACTER
          SB4    B4-B1
          LX1    6
          BX2    -X0*X1
          BX7    X7+X2
          NZ     B4,ECD2     IF NOT END OF WORD
          SA1    A1+B1
          SB4    B5
 
 ECD2     PL     B2,ECD6     IF CARD LIMIT REACHED
          SA7    B2+B3       STORE CHARACTER
          SB2    B2+B1
 ECD3     SB4    B4-B1       SHIFT TO NEXT CHARACTER
          LX1    6
          BX7    -X0*X1
          NZ     B4,ECD4     IF NOT END OF WORD
          SA1    A1+B1       SET NEXT WORD
          SB4    B5
 ECD4     ZR     X7,ECD4.1   IF *00* CHARACTER
          NZ     B6,ECD1.1   IF 6/12 ASCII CHARACTER SET
          EQ     ECD2        IF DISPLAY CHARACTER SET
 
 ECD4.1   SB4    B4-B1
          LX1    6           EXTRACT SPACE COUNT
          BX7    -X0*X1
 
 ECDA     BSS    0
          NZ     B4,ECD5     IF NOT END OF WORD
          SA1    A1+B1       SET NEXT WORD
          SB4    B5          RESET CHARACTER COUNT
*         NZ     B4,ECD5.1   * 63        *
*         SA1    A1+B1       * CHARACTER *
*         SB4    B5          * SET       *
 
 ECDB     BSS    0
 ECD5     SB7    X7
          NE     B7,B1,ECD5.1  IF NOT  *0001*
          BX7    X7-X7
*         EQ     ECD5.1      * 63 CHARACTER SET *
          EQ     ECD2
 
 
 ECD5.1   SX4    X7+B1       SET COMPRESSION COUNT
          SB2    X4+B2       SET BLANKS IN BUFFER
          NZ     X7,ECD3     IF NOT END OF WORD
 
*         ENTER IDENTIFIER NAME.
 
 ECD6     SA2    CDID        GET CARD IDENTIFICATION
          SB2    7
          MX3    60-16
          LX2    6
 ECD7     BX7    -X0*X2      NEXT CHARACTER
          SB2    B2-B1
          LX2    6
          NZ     X7,ECD8     IF NOT 00
          BX7    X6          SUBSTITUTE * *
 ECD8     SA7    B3-B1
          SB3    B3+B1
          NZ     B2,ECD7     LOOP TO END OF NAME
 
*         ENTER CARD NUMBER.
 
          LX2    12          CONVERT CARD NUMBER
          BX1    -X3*X2
          RJ     CDD
          SB2    9
          LX6    24
          MX0    60-6
 ECD9     BX7    -X0*X6      ENTER SEQUENCE NUMBER
          SB2    B2-B1
          SA7    A7+B1
          LX6    6
          NZ     B2,ECD9
          SB3    A7+B1       RETURN WITH NEXT CHARACTER POSITION
          EQ     ECD
 PLE      SPACE  4,20
**        PLE - PROCESS LIBRARY ERROR.
*
*         ISSUES LIBRARY ERROR MESSAGE AND ABORTS JOB.
*
*         CALLS  ABT.
 
 
 PLE      SA1    DN          SET DECK NAME IN MESSAGE
          BX6    X1
          SA6    PLEB
          SA0    PLEA        ABORT JOB
          EQ     ABT
 
 PLEA     DATA   20H PL ERROR IN DECK
 PLEB     DATA   0
 POC      SPACE  4,15
**        POC - PROCESS OPL CHARACTER SET.
*
*         CHECK AND/OR INITIALIZE *OPLEDIT* FOR 63/64 CHARACTER
*         AND 6/12 CHARACTER SET OPL PROCESSING.
*
*         ENTRY  (TIDT - TIDT+16B) - IDENT TABLE FOR DECK.
*
*         EXIT   IF INITIAL ENTRY.
*                (ECDA) INITIALIZED.
*                (ECDB) INITIALIZED.
*
*         USES   X - 1, 2, 3, 4, 5, 6, 7.
*                A - 0, 1, 2, 6, 7.
 
 
 POC      SUBR               ENTRY/EXIT
          SA5    TIDT+16B    CHECK OPL CHARACTER SET
          MX1    -6
          BX5    -X1*X5
 
*         VERIFY OPL CHARACTER SET.
 
          SX3    X5-64B      CHECK FOR 64 CHARACTER SET PL
          ZR     X3,POC1     IF 64 CHARACTER SET
          ZR     X5,POC1     IF 63 CHARACTER SET (*00*)
          SA1    TIDT+1      SET NAME OF DECK WITH INVALID CHARACTER SET
          RJ     SFN         SPACE FILL DECK NAME
          SX2    1R &1R-     FORM MESSAGE
          BX5    X5-X5       SET 63 CHARACTER SET
          LX6    -6
          BX6    X6-X2
          SA6    POCB        SET MESSAGE
          SA1    TIDT+16B    CORRECT CHARACTER SET IN RECORD HEADER
          MX2    54
          BX7    X2*X1
          SA7    A1
          MESSAGE A6,3       * DECKNAM - INCORRECT CS, 63 ASSUMED.*
 
*         CHECK FOR MIXED PL,S.
 
 POC1     SA2    CSM         PREVIOUS CHARACTER SET
          SA5    A5          REREAD CHARACTER SET INDICATORS
          MX1    -6          EXCLUDE 6/12 FLAG FROM MASK
          BX5    -X1*X5
          BX4    X2-X5       COMPARE CHARACTER SETS
          MI     X2,POC2     IF INITIAL ENTRY
 
*         COMPARE AGAINST PREVIOUS RECORD.
 
          ZR     X4,POCX     IF CHARACTER SET SAME AS PREVIOUS RECORD
          SA0    =C* MIXED CHARACTER SET OPL.*
          EQ     ABT1
 
*         ON INITIAL ENTRY SET CHARACTER SET AND PRESET INSTRUCTIONS.
 
 POC2     BX6    X5
          SA6    A2          SET CHARACTER SET
          ZR     X3,POC3     IF 64 CHARACTER SET DECK
          SA1    POCA        SET INSTRUCTIONS
          SA2    A1+B1
          BX6    X1
          LX7    X2
          SA6    ECDA
          SA7    ECDB
 POC3     MX3    -6          MASK FOR 0 = DISPLAY, 1 = 6/12
          SA5    A5
          AX5    6
          BX7    -X3*X5
          SA7    CSC         STORE CURRENT CHARACTER SET
          EQ     POCX        RETURN
 
 
 POCA     NZ     B4,ECD5.1   IF NOT END OF WORD
          SA1    A1+B1
          SB4    B5
 
+         EQ     ECD5.1
 
 POCB     DATA   C* DECKNAM - INCORRECT CS, 63 ASSUMED.*
 RMT      SPACE  4,25
**        RMT - READ MODIFIER TABLE.
*
*         ENTRY  (DN) - DECK NAME.
*                (MA) - MODIFICATION TABLE ADDRESS.
*
*         USES   ALL.
*
*         CALLS  AMD, ATS, POC.
 
 
 RMT      PS     0           ENTRY/EXIT
          SA1    DA          GET DECK TABLE ENTRY
          SA3    X1+B1       SET RANDOM ADDRESS
          LX7    X3
          SA7    P+6
          READ   P           INITIATE NEW READ
          READW  X2,TIDT,TIDTL READ IDENT TABLE
          NZ     X1,PLE      IF EOR
          SA1    TIDT
          LX1    12
          SB2    X1-7700B
          NZ     B2,PLE      IF NO IDENT TABLE
          SA1    TIDT+1      CHECK DECK NAME
          SA2    DN
          BX3    X1-X2
          NZ     X3,PLE      IF NO MATCH
          ADDWRD TDKI,X1     ADD DECK NAME TO DECK IDENTIFIER TABLE
          RJ     POC         PROCESS OPL CHARACTER SET
          READW  P,T1,1      READ MODIFIER TABLE LENGTH
          NZ     X1,PLE      IF EOR
          SA1    T1          CHECK TABLE
          SX6    B0
          LX1    18
          SB2    X1-700100B
          SB3    X1-700200B
          ZR     B2,RMT1     IF NORMAL DECK
          NZ     B3,PLE      IF NOT COMMON DECK
          SX6    B1
 RMT1     SA6    CD          SET DECK STATUS
          LX1    42          SET TABLE LENGTH
          SB7    X1
          ZR     B7,RMT      RETURN IF NO MODIFIERS
          ALLOC  TDKI,B7     ALLOCATE FOR MODIFIERS
          READW  P,X2+B1,B7  READ MODIFIERS
          SA1    L.TDKI      MODIFIER LENGTH
          SA2    F.TDKI
          SB7    X1-1
          SA5    X2+B1
          SX0    B1
 RMT2     SEARCH TPRG,X5     SEARCH FOR PURGE
          ZR     X2,RMT4     IF NOT FOUND
 RMT3     SX0    X0-1        DECREMENT POINTER
          SX3    1S15        SET PURGE FLAG
          BX5    X5+X3
          SA1    MD          COUNT MODIFICATIONS
          SX6    X1+B1
          SA6    A1
 RMT4     BX6    X5+X0
          SA6    A5
          SB2    X2
          SB7    B7-B1
          SX0    X0+B1
          SA5    A5+B1
          ZR     B7,RMT      RETURN IF END OF TABLE
          ZR     B2,RMT2     IF NOT ALL AFTER
          EQ     RMT3        LOOP
 RPF      SPACE  4,25
**        RPF - READ CARD FROM PROGRAM LIBRARY.
*
*         EXIT   (X1) .NE. 0, IF EOR READ.
*                (CDAC) - CARD ACTIVITY.
*                (CDID) - CARD IDENTIFICATION.
*                (CDWC) - WORD COUNT OF COMPRESSED CARD.
*                (CDTX) - TEXT OF COMPRESSED CARD.
*                (NMHB) - NUMBER OF MHB,S.
*                (THMB) - MHB,S.
*
*         USES   ALL.
*
*         CALLS  RDC=.
 
 
 RPF      PS     0           ENTRY/EXIT
          READC  P,BUF,BUFL  READ MHBS
          NZ     X1,RPF      RETURN IF EOR
          SA1    BUF         SHIFT TO FIRST MHB
          LX1    24
          SX6    -B1         CLEAR MHB COUNT
          MX0    60-18
          SB2    B1          2 MHB-S ON FIRST PASS
 RPF1     LX1    18          SHIFT TO NEXT MHB
          BX7    -X0*X1
          SB2    B2-B1
          SX6    X6+B1
          ZR     X7,RPF2     IF END OF MHB LIST
          SA7    TMHB+X6     STORE MHB
          PL     B2,RPF1     LOOP TO END OF WORD
          SA1    A1+B1       NEXT WORD
          SB2    B1+B1       RESET MHB COUNT
          LX1    6
          EQ     RPF1        LOOP
 
*         READ COMPRESSED CARD.
 
 RPF2     SA5    BUF         SET CARD ACTIVITY
          MX0    60-16       SET IDENTIFIER INDEX MASK
          BX7    X5
          SA6    NMHB
          SA7    CDAC
          READC  P,CDTX,MXCCL  READ COMPRESSED IMAGE
          NZ     X1,PLE      IF EOR
          SX7    B6-CDTX     SET WORD COUNT OF CARD
          LX5    60-18       EXTRACT IDENTIFIER INDEX
          SA7    CDWC
          BX4    -X0*X5
          SA2    F.TDKI
          SB2    X4
          AX5    18          SET CARD NUMBER
          SA2    X2+B2       SET CARD IDENTIFIER
          SX3    X5
          BX6    X0*X2
          IX7    X6+X3
          SA7    CDID
          NZ     B2,RPF      IF NOT ORIGINAL CARD
          SA3    CDAC        CHECK CARD ACTIVITY
          PL     X3,RPF      IF ORIGINAL CARD ACTIVE
          SA7    ID3         LAST ORIGINAL ACTIVE CARD SEQUENCE NUMBER
          EQ     RPF         RETURN
 SSR      SPACE  4,15
**        SSR - SELECT *S* READ FUNCTION.
*
*         SELECT *RDS=* OR *RDA=* DEPENDING ON CHARACTER SET.
*
*         ENTRY  (CSC) = CURRENT CHARACTER SET.
*
*         USES   X - 3.
*                A - 3.
*                B - 3.
*
*         CALLS  RDA=, RDS=.
 
 
 SSR      SUBR               ENTRY/EXIT
          SA3    CSC         GET CURRENT CHARACTER SET
          LX3    1           TWO INSTRUCTION WORDS PER ENTRY
          SB3    X3
          JP     B3+SSR1     GO TO PROPER PROCESSOR
 
 SSR1     RJ     =XRDS=      DISPLAY CODE
          EQ     SSRX        RETURN
          RJ     =XRDA=      6/12 DISPLAY BASED ASCII
          EQ     SSRX        RETURN
 SSW      SPACE  4,15
**        SSW - SELECT *S* WRITE FUNCTION.
*
*         SELECT *WTS=* OR *WTA=* DEPENDING ON CHARACTER SET.
*
*         ENTRY  (CSC) = CURRENT CHARACTER SET.
*
*         USES   X - 3.
*                A - 3.
*                B - 3.
*
*         CALLS  WTA=, WTS=.
 
 
 SSW      SUBR               ENTRY/EXIT
          SA3    CSC         GET CURRENT CHARACTER SET
          LX3    1           TWO INSTRUCTION WORDS PER ENTRY
          SB3    X3
          JP     B3+SSW1     GO TO PROPER PROCESSOR
 
 SSW1     RJ     =XWTS=      DISPLAY CODE
          EQ     SSWX        RETURN
          RJ     =XWTA=      6/12 DISPLAY BASED ASCII
          EQ     SSWX        RETURN
 STB      SPACE  4,20
**        STB - SEARCH TABLE FOR ENTRY WITH MASK.
*
*         ENTRY  (A0) - TABLE NUMBER.
*                (X1) - MASK.
*                (X6) - ENTRY.
*
*         EXIT   (X2) - 0, IF ENTRY NOT FOUND.
*                (X2) .NE. 0, ENTRY IF FOUND.
*                (A2) - ADDRESS OF ENTRY.
*                (X3) - INDEX OF ENTRY.
*
*         USES   X - 2, 3.
*                A - 2, 3.
*                B - 2, 3.
 
 STB2     SA2    A2-B1       RESTORE ENTRY
          SX3    A2-B3       SET INDEX
 
 STB      PS     0           ENTRY/EXIT
          SA3    FTAB+A0
          SA2    LTAB+A0
          ZR     X2,STB      RETURN IF TABLE EMPTY
          SB2    X2
          SB3    X3
          SA2    X3
 STB1     BX3    X6-X2       CHECK ENTRY
          SB2    B2-B1
          BX3    X1*X3
          SA2    A2+B1
          ZR     X3,STB2     IF REQUESTED ENTRY FOUND
          NZ     B2,STB1     LOOP TO END OF TABLE
          MX2    0           RESPOND WITH 0
          EQ     STB
 UPN      SPACE  4,20
**        UPN - UNPACK NAME.
*
*         ENTRY  (X6) - NAME LEFT JUSTIFIED.
*                (B3) - CHARACTER ADDRESS.
*
*         EXIT   (B3) - UPDATED CHARACTER ADDRESS.
*
*         USES   X - 1, 6, 7.
*                A - 7.
*                B - 2.
 
 
 UPN      PS     0           ENTRY/EXIT
          MX1    60-6
          LX6    6
          SB2    B3+10
 UPN1     BX7    -X1*X6
          ZR     X7,UPN2     IF END OF NAME
          SA7    B3
          SB3    B3+B1
          LX6    6
          NE     B3,B2,UPN1
 UPN2     SX7    1R          SET TERMINAL * *
          SA7    B3
          EQ     UPN
 WDR      SPACE  4,25
**        WDR - WRITE DIRECTORY TO PROGRAM LIBRARY.
*
*         SET DATE IN IDENT TABLE AND WRITE TO *NPL*.
*
*         USES   X - 1, 2, 3, 4, 5, 6, 7.
*                A - 1, 2, 3, 4, 5, 6, 7.
*                B - ALL.
*
*         CALLS  WTW=.
 
 
 WDR      PS     0           ENTRY/EXIT
          SA1    N
          SA2    L.TNDK
          ZR     X1,WDR      RETURN IF NO NEW PROGRAM LIBRARY
          ZR     X2,WDR      RETURN IF NO NEW DECKS
          RECALL N
          SA1    PL          ENTER PROGRAM LIBRARY NAME
          SA2    DATE        ENTER DATE IN IDENT TABLE
          BX6    X1
          LX7    X2
          SA6    TIDT+1
          SA7    A6+B1
          MX7    0           CLEAR MODIFICATION DATE
          SA7    A7+B1
          WRITEW N,TIDT,TIDTL
          SA5    L.TNDK      MERGE DECK COUNT AND DIRECTORY ID
          SA2    WDRA
          BX6    X5+X2
          SA6    T1
          WRITEW N,T1,1
          SA1    F.TNDK      REMOVE FILE NAME POINTERS
          SB2    B1+B1
          SB3    X5
          MX4    24
          SA2    X1+B1
          BX6    -X4*X2
 WDR1     SA6    A2
          SB3    B3-B2
          SA2    A2+B2
          BX6    -X4*X2
          NZ     B3,WDR1
          WRITEW N,X1,X5     WRITE DECK NAME TABLE
          WRITEF X2,R
          EQ     WDR         RETURN
 
 WDRA     DATA   7000BS48   DIRECTORY ID
 WMT      SPACE  4,20
**        WMT - WRITE MODIFIER TABLE.
*
*         ADD DECK TO NEW DECK NAME TABLE.  WRITE MODIFIER TABLE
*         TO *NPL*.
*
*         USES   ALL.
*
*         CALLS  ADW, WTW=.
 
 
 WMT      PS     0           ENTRY/EXIT
          SA1    IGNORE
          NZ     X1,WMT      IF *MODSETS ONLY* MODE
          RECALL N
          SA1    MD
          SA2    DN          ENTER DECK NAME IN IDENT TABLE
          ZR     X1,WMT1     IF NO MODIFICATIONS
          SA1    DATE        ENTER NEW DATE
          LX7    X1
          SA7    TIDT+3
 WMT1     SA1    CD
          SX3    X1+6
          LX6    X2
          SA6    TIDT+1
          ADDWRD TNDK,X2+X3  ENTER DECK NAME
          ADDWRD A0,X6-X6
          SX2    A6          SET RANDOM RETURN ADDRESS
          SX3    A6
          LX2    30
          BX6    X2+X3
          SA6    N+6
          SA5    DN          DECK NAME
          SEARCH TCED,X5     CHECK FOR CHARACTER SET CHANGE
          ZR     X2,WMT1.1   IF NO CHANGE OF CHARACTER SET
          SA1    TIDT+16B    CHARACTER SET WORD
          MX4    -6
          LX2    6           POSITION NEW CHARACTER SET
          LX4    6
          BX5    -X4*X2      NEW CHARACTER SET
          BX6    X4*X1
          BX6    X5+X6       ADD TO 63 - 64 CHARACTER SET INDICATOR
          SA6    A1+
 WMT1.1   WRITEW N,TIDT,TIDTL  WRITE IDENT TABLE
          SA1    L.TDKI      CHECK MODIFIERS
          SA2    F.TDKI
          SX6    -B1
          SB3    X1
          SA3    X2
 WMT2     LX3    59-15
          NG     X3,WMT3     IF PURGED
          SX6    X6+B1
 WMT3     SB3    B3-B1
          SA3    A3+B1
          NZ     B3,WMT2
          SA1    CD
          SA2    WMTA
          ZR     X1,WMT4     IF NOT COMMON DECK
          SA2    WMTB
 WMT4     BX6    X2+X6       MERGE MODIFIER COUNT AND TABLE ID
          SA6    T1
          WRITEW N,T1,1      WRITE MODIFIER ID
          SA5    L.TDKI      WRITE ACTIVE MODIFIERS
          SA1    F.TDKI      WRITE DECK MODIFIERS
          MX0    60-16
          SX5    X5-1
          SA0    X1+B1
 WMT5     ZR     X5,WMT      RETURN IF END OF MODIFIERS
          SA1    A0          SET MODIFIER
          BX6    X0*X1
          LX1    59-15
          NG     X1,WMT6     IF PURGED
          SA6    T1
          WRITEW X2,T1,1
 WMT6     SA0    A0+B1
          SX5    X5-1
          EQ     WMT5        LOOP
 
 WMTA     DATA   7001BS48    MODIFIER TABLE ID
 
 WMTB     DATA   7002BS48    MODIFIER TABLE ID FOR COMMON DECK
 WNF      SPACE  4,25
**        WNF - WRITE CARD TO NEW PROGRAM LIBRARY.
*
*         ENTRY  (CDAC) - CARD ACTIVITY.
*                (CDID) - CARD IDENTIFICATION.
*                (CDWC) - WORD COUNT OF COMPRESSED CARD.
*                (CDTX) - TEXT OF COMPRESSED CARD.
*                (NMHB) - NUMBER OF MHB,S.
*                (TMHB) - MHB,S.
*
*         USES   ALL.
*
*         CALLS  WTW=.
 
 
 WNF      PS     0           ENTRY/EXIT
          SA2    IGNORE
          NZ     X2,WNF      IF *MODSETS ONLY* MODE
          SA2    N
          ZR     X2,WNF      RETURN IF NO NEW PROGRAM LIBRARY
          SA1    CDAC        ACTIVITY TO BIT 59
          SA5    NMHB        STORE MHB TERMINATORS
          MX3    1
          SA2    A1+B1       WORD COUNT OF CARD TO BITS 54 - 58
          SX6    B0
          BX1    X3*X1
          SA6    TMHB+X5
          LX1    24
          SA3    A2+B1       CARD NUMBER TO BITS 36 - 53
          MX0    60-16
          SA6    A6+B1
          LX2    18
          SB3    X5          MHB COUNT
          BX3    -X0*X3
          SA6    A6+B1
          BX1    X1+X2
          SA5    A5+B1       FIRST MHB
          SB2    B1          2 MHB-S ON FIRST PASS
          IX7    X1+X3
          SA7    BUF
 
*         PACK AND WRITE MHB TABLE.
 
 WNF1     LX7    18          PACK MHB-S
          SB3    B3-B1
          BX7    X5+X7
          SB2    B2-B1
          SA5    A5+B1       NEXT MHB
          PL     B2,WNF1     LOOP FOR 1 WORD OF MHB-S
          SA7    A7+B1       STORE WORD
          SB2    B1+B1
          MX7    0
          PL     B3,WNF1     LOOP FOR ALL MHB-S
          WRITEW N,BUF+1,A7-BUF
          SA5    CDWC        WRITE COMPRESSED CARD
          WRITEW X2,CDTX,X5
          EQ     WNF         RETURN
WOF       SPACE  4,20
**        WOF - WRITE OUTPUT FILE.
*
*         ENTRY  (X1) - FWA OF LINE.
*                     .LT. 0, LINE IS IN *S* FORMAT.
*                (X2) - 0, IF LINE IS IN *C* FORMAT.
*
*         USES   X - 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 3, 4, 6, 7.
*
*         CALLS  CDD.
*
*         MACROS WRITEC, WRITEK, WRITEW.
 
 
 WOF      SUBR               ENTRY/EXIT
          SX6    B1+
          SA3    LC          ADVANCE LINE COUNT
          SA6    LF
          SX6    X3+B1
          SA6    A3
          SA4    A3+B1
          IX7    X6-X4
          NG     X7,WOF3     IF BOTTOM OF PAGE NOT REACHED
          BX6    X1          SAVE REQUEST
          LX7    X2
          SA6    WOFA
          SA7    A6+B1
          SA1    PN          ADVANCE PAGE NUMBER
          SX7    X1+B1
          SX6    3           RESET LINE COUNT
          SA6    A3
          SA7    A1
          RJ     CDD         CONVERT PAGE NUMBER
          MX1    60-12
          LX6    4*6         STORE PAGE NUMBER
          BX6    X1*X6
          SA6    PAGE
          SX2    O
          SA1    TO
          ZR     X1,WOF1     IF TERMINAL OUTPUT
          WRITEW X2,(=1H1),1
          SA1    TL
          WRITEW X2,X1,4
          WRITEW X2,TITL,TITLL
          WRITEW X2,SBTL,SBTLL
          EQ     WOF2        CONTINUE PROCESSING
 
 WOF1     SA3    PN
          SX3    X3-2
          NZ     X3,WOF2     IF NOT FIRST TIME
          WRITEW X2,TERL,TERLL
          WRITEW X2,(=C*  *),1  WRITE END OF LINE
 WOF2     SA1    WOFA        RESTORE REQUEST
          SA2    A1+B1
 WOF3     NG     X1,WOF4     IF *S* FORMAT
          WRITEC O,X1
          EQ     WOFX        RETURN
 
 WOF4     BX1    -X1
          WRITEK O,X1,X2
          EQ     WOFX        RETURN
 
 WOFA     DATA   0,0
 LCS      SPACE  4,15
**        LCS - LIST CARD STATUS.
*
*         USES   X - 0, 1, 2, 3, 6.
*                A - 1, 2, 3, 6.
*                B - 2, 3, 4, 5.
*
*         CALLS  CDD, UPN.
 
 
 LCS      PS     0           ENTRY/EXIT
          SA1    IGNORE
          NZ     X1,LCS      IF *MODSETS ONLY* MODE
          SA1    CL
          NZ     X1,LCS      RETURN IF CARD LISTED
          SA1    TMHB
          SX2    80
          MX0    60-16
          BX6    -X0*X1
          SB5    CHAR+15+X2
          ZR     X6,LCS1     IF DECK CARD
          SA2    F.TDKI      ADD CURRENT DECK NUMBER
          SA3    X2
          BX1    -X0*X3
          RJ     CDD
          LX6    6*4
          SB3    B5
          RJ     UPN
 LCS1     PRINT  -CHSP,B3+X1
          SX6    1R          CLEAR STATUS
          SA6    CHSP+4
          SA6    A6+B1
          SA6    A6+B1
          SA6    CL          SET CARD LISTED
          EQ     LCS         RETURN
 LDS      SPACE  4,15
**        LDS - LIST DECK STATUS.
*
*         USES   X - 0, 1, 2, 3, 5, 6.
*                A - 1, 2, 3, 6.
*
*         CALLS  LTB, SFN.
*
*         MACROS LISTOP, PRINT.
 
 
 LDS      SUBR               ENTRY/EXIT
          SA2    IGNORE
          NZ     X2,LDSX     IF *MODSETS ONLY* MODE
          LISTOP D,LDSX,,2   IF NO LIST FOR DECK STATUS - RETURN
          SA1    DN          SPACE FILL DECK NAME
          RJ     SFN
          SA2    F.TDKI
          LX6    60-12
          SX4    X2+B1
          SA6    BUF
          SA3    L.TDKI
          SX0    =C*MODIFIERS.*
          SX5    X3-1
          RJ     LTB
          PRINT  (=C*  *)
          EQ     LDSX        RETURN
 LER      SPACE  4,20
**        LER - LIST ERROR MESSAGE.
*
*         ENTRY  (X0) = ERROR MESSAGE ADDRESS.
*
*         EXIT   (CHSP) CLEARED.
*                (EC) ADVANCED.
*
*         USES   X - 1, 2, 6, 7.
*                A - 1, 2, 6, 7.
*                B - 2.
*
*         MACROS LISTOP, WRITEC, WRITEW.
 
 
 LER      SUBR               ENTRY/EXIT
          SA2    O
          LISTOP E,LER1      IF NO ERROR LIST
          ZR     X2,LER1     IF NO OUTPUT FILE
          WRITEW O,(=8A******* ),1
          WRITEC X2,X0
          SA2    LC          ADVANCE LINE COUNT
          SX7    X2+B1
          SA7    A2
 LER1     SB2    9           CLEAR CHARACTER SPACING
          SX6    1R
 LER2     SA6    CHSP+B2
          SB2    B2-B1
          PL     B2,LER2
          SA1    EC          ADVANCE ERROR COUNT
          SX6    X1+B1
          SA6    A1
          EQ     LERX        RETURN
 LST      SPACE  4,20
**        LST - LIST STATISTICS.
*
*         LIST DECKS ON PROGRAM LIBRARY.  LIST DECKS ON *NPL*.
*
*         USES   X - 0, 1, 4, 5, 6, 7.
*                A - 1, 4, 5, 6, 7.
*
*         CALLS  LTB.
*
*         MACROS LISTOP.
 
 
 LST      SUBR               ENTRY/EXIT
          LISTOP S,LSTX      IF NO LIST FOR STATISTICS - RETURN
          SX6    =40HSTATISTICS.
          SX7    99999       FORCE PAGE EJECT
          SA6    TL
          SA7    LC
          SA1    =1H         CLEAR FIRST WORD OF BUFFER
          SX7    B1+B1       RESET WORDS/ENTRY
          BX6    X1
          SA6    BUF
          SA7    LTBA
          SA6    SBTL+1      CLEAR SUBTITLE
          SA6    A6+B1
 
*         LIST DECKS ON PROGRAM LIBRARY.
 
          SX0    =C*DECKS ON PROGRAM LIBRARY.*
          SA4    F.TDKN
          SA5    L.TDKN
          RJ     LTB
 
*         LIST DECKS ON NEW PROGRAM LIBRARY.
 
          SA1    N
          ZR     X1,LSTX     IF NO NEW PROGRAM LIBRARY - RETURN
          SX0    =C*DECKS ON NEW PROGRAM LIBRARY.*
          SA4    F.TNDK
          SA5    L.TNDK
          RJ     LTB
          EQ     LSTX        RETURN
 LTB      SPACE  4,20
**        LTB - LIST TABLE.
*
*         LIST SPECIFIED TABLE ON OUTPUT FILE.
*
*         ENTRY  (X0) - MESSAGE.
*                (X4) - TABLE.
*                (X5) = TABLE LENGTH.
*
*         USES   ALL.
*
*         CALLS  SFN, WOF.
 
 
 LTB6     MX6    0
          SA6    A6+B1
          PRINT  BUF
 
 LTB      PS     0           ENTRY/EXIT
          SA1    LC          CHECK LINE COUNT
          SA0    X4          (A0) = TABLE ADDRESS
          SA2    A1+B1
          SX6    X1+4
          IX7    X6-X2
          PL     X7,LTB1     IF NOT ROOM FOR FIRST LINE OF TABLE
          PRINT  (=C*  *)
          SA1    LC
          BX6    X1
 LTB1     SA6    A1          UPDATE LINE COUNT
          MX3    60-12       COPY MESSAGE TO BUFFER
          SA2    X0
          LX6    X2
          SB2    BUF+1
 LTB2     SA6    B2
          BX7    -X3*X2
          SB2    B2+B1
          SA2    A2+B1
          LX6    X2
          NZ     X7,LTB2
          PRINT  BUF
          SA1    =1H         CLEAR FIRST WORD OF BUFFER
          BX6    X1
          MX0    42
          SA6    BUF
          PRINT  (=C*  *)
          NZ     X5,LTB3     IF TABLE NOT EMPTY
          PRINT  (=C+           * NONE * +)
          EQ     LTB         RETURN
 
 LTB3     SB6    -12
          ZR     X5,LTB      RETURN IF END OF TABLE
 LTB4     ZR     X5,LTB6     IF END OF TABLE
          SA1    A0          SPACE FILL NAME
          BX7    -X0*X1
          BX1    X0*X1
          RJ     SFN
          SA4    LTBA        TABLE WORD COUNT
          LX7    59-16
          PL     X7,LTB5     IF CLEAR
          SA2    A4+B1       ADD ()
          IX6    X6+X2
 LTB5     LX6    60-6        STORE NAME
          SA6    BUF+13+B6
          SB6    B6+B1
          SB2    X4          ADVANCE TABLE
          IX5    X5-X4
          SA0    A0+B2
          NG     B6,LTB4     LOOP TO END OF LINE
          MX6    0
          SA6    A6+B1
          PRINT  BUF
          EQ     LTB3        LOOP
 
 LTBA     DATA   2           WORDS/TABLE ENTRY
          VFD    60/10H       ) (-1H
 PPM      SPACE  4,20
**        PPM - PROCESS PULLED MODS.
*
*         USES   ALL.
*
*         CALLS  CDC, ECD.
*
*         MACROS WRITEK.
 
 
 PPM      PS     0
          SA1    IP
          ZR     X1,PPM      IF NOT IN DECK
          SA1    II
          SA2    NMHB
          SB6    X2          NUMBER OF MHB-S
          SB5    X2
          MX2    -16D        MASK FOR IDENT INDEX
          SA3    TMHB        GET FIRST MHB
          SA4    PA
          NZ     X4,PPM10    IF *SUMMARY* MODE
          BX4    -X2*X3
          IX5    X1-X4
          NG     X5,PPM      IF CARD INSERTED *LATER* THAN THIS IDENT
 PPM1     BX4    -X2*X3
          IX5    X4-X1
          ZR     X5,PPM2     IF MATCH
          SB6    B6-B1
          SA3    A3+B1
          NZ     B6,PPM1     IF MORE MHB-S
          SA3    PA
          NZ     X3,PPM9     IF NON-ORIGINAL IN *SUMMARY* MODE
 PPM1.1   SX6    B0
          SA6    DL          CLEAR DL
          RJ     CDC         COMPLETE DIRECTIVE CARD
          SA1    CDID
          BX6    X1
          SA6    ID1         SET FIRST IDENTIFIER
          EQ     PPM
 
 
*         DETERMINE *I *D OR *RESTORE
 
 PPM2     SA1    PA
          NZ     X1,PPM8     IF *SUMMARY* MODE
          BX2    X2*X3
          ZR     X2,PPM3     IF PROCESS *D
          EQ     B5,B6,PPM4  IF PROCESS *I
 
*         PROCESS *RESTORE
 
 PPM2.1   SA1    RF
          NZ     X1,PPM6     IF (STILL) RESTORING
          RJ     CDC         COMPLETE DIRECTIVE CARD
          SX6    B1
          SA6    RF          INDICATE RESTORING
          SA6    DL          SET DL
          EQ     PPM5        SET ACTIVE AND EXIT
 
 
*         PROCESS *D
 
 PPM3     SA1    DF
          NZ     X1,PPM6     IF (STILL) DELETING
          RJ     CDC         COMPLETE DIRECTIVE CARD
          SX6    B1
          SA6    DF          INDICATE DELETING
          SA6    DL          SET DL
          EQ     PPM5        SET ACTIVE AND EXIT
 
*         PROCESS *I
 
 PPM4     SA1    IF
          NZ     X1,PPM7     IF (STILL) INSERTING
          RJ     CDC         COMPLETE DIRECTIVE CARD
          SX6    B1
          SA6    IF          INDICATE INSERTING
          SA1    DL
          NZ     X1,PPM7     IF DIRECTIVE LAST, OMIT *I
          SA6    ACTIVE
          RJ     CDC         FLUSH INSERT IMMEDIATELY
          SX6    B1          TURN IF BACK ON
          SA6    IF
          EQ     PPM7        AND THE FIRST INSERT
 
 
*         SET ACTIVE AND EXIT
 
 PPM5     SA6    ACTIVE
          SA1    CDID
          BX6    X1
          SA6    ID1
          EQ     PPM         EXIT
 
 PPM6     SA1    CDID
          BX6    X1          STORE ID2
          SA6    ID2
          EQ     PPM         EXIT
 
 PPM7     RJ     ECD         EXPAND CARD IMAGE
          WRITEK M,CHAR,B3-CHAR-16D
          SX6    B0
          SA6    ACTIVE      PREVENT SECOND *I CARD
          EQ     PPM
 
 PPM8     SA1    CDAC
          NG     X1,PPM1.1   IF NO NET CHANGE
          EQ     PPM3        IF DELETED (NET)
 
 PPM9     SA1    CDAC
          NG     X1,PPM4     PROCESS ACTIVE INSERTION
          EQ     PPM         IF INACTIVE INSERTION - IGNORE
 
 PPM10    SA4    A4+B1
          ZR     X4,PPM1     IF *SUMMARY IDENT* MODE
 PPM11    BX4    -X2*X3
          IX5    X1-X4
          NG     X5,PPM12    IF CARD ACTED UPON LATER THAN THIS IDENT
          ZR     X5,PPM12    IF CARD ACTED UPON BY THIS IDENT
          SB6    B6-B1
          SA3    A3+B1
          NZ     B6,PPM11    IF MORE MHB-S
          EQ     PPM1.1      EXIT NOT A MOD OF THIS COMPOSITE
 
 PPM12    EQ     B6,B5,PPM9  IF FIRST COMPOSITE EQUAL TO ORIGINAL MOD
          BX2    X2*X3
          NZ     X2,PPM2.1   IF RESTORE
          EQ     PPM8
 CDC      SPACE  4,20
**        CDC - COMPLETE DIRECTIVE CARD.
*
*         USES   ALL.
*
*         CALLS  CID, WTS=.
 
 
 CDC      PS     0
          SA1    ACTIVE
          ZR     X1,CDC8     IF NOT CURRENTLY PROCESSING DIRECTIVE
          SA1    DELD        GET -*D,- DIRECTIVE
          SA2    DF
          NZ     X2,CDC1     IF SET *D
          SA1    INSD        GET -*I,- DIRECTIVE
          SA2    IF
          NZ     X2,CDC1     IF SET *I
          SA1    RESD        GET -*RESTORE- DIRECTIVE
 CDC1     SX6    B0
          SA6    CHAR
          MX7    -6
 CDC2     LX1    6           STORE DIRECTIVE
          BX6    -X7*X1
          ZR     X6,CDC3     IF LAST CHARACTER
          SA6    A6+B1
          EQ     CDC2        LOOP FOR NEXT CHARACTER
 
 CDC3     SA1    ID1         CONVERT FIRST IDENTIFIER
          SX0    B0
          RJ     CID
          SA1    ID2         CONVERT ID2, IF ANY
          ZR     X1,CDC4     IF NO SECOND IDENTIFIER REQUIRED
          SX6    1R,         INSERT THE , REQUIRED
          SA6    A6+B1
          SX0    B0
          RJ     CID
 CDC4     SA1    ID1         CHECK FOR ORIGINAL CARD
          SA2    DN          DECK NAME
          MX0    42
          BX1    X0*X1
          BX1    X1-X2
          ZR     X1,CDC7     IF ORIGINAL CARD
 
*         APPEND LAST ORIGINAL CARD NUMBER TO MODIFY DIRECTIVE.
 
          SX6    1R          PAD AT LEAST ONE BLANK
          SA6    A6+1
          SB3    CHAR+29     CHECK LINE POSITION
          SB2    A6+
          GE     B2,B3,CDC6  IF AT OR AFTER COLUMN 30
 CDC5     SA6    A6+B1       ADD A BLANK
          SB2    B2+B1
          LT     B2,B3,CDC5  IF NOT AT COLUMN 30
 CDC6     SX6    1R(         ADD PARENTHESIS
          SA1    ID3         ORIGINAL CARD SEQUENCE NUMBER
          SX0    B0
          SA6    A6+B1
          RJ     CID         CONVERT SEQUENCE NUMBER
          SX6    1R)         ADD CLOSING PARENTHESIS
          SA6    A6+1
 CDC7     SX1    A6-CHAR
          WRITES M,CHAR+1,X1 WRITE OUT DIRECTIVE
 CDC8     SX6    B0+         CLEAR FLAGS
          SA6    ACTIVE
          SA6    DF
          SA6    IF
          SA6    RF
          SA6    ID2
          EQ     CDC         EXIT
 
 
 ID1      DATA   0           FIRST CARD ID
 ID2      DATA   0           SECOND CARD ID
 ID3      CON    0           LAST ORIGINAL CARD ID
 CID      SPACE  4,20
**        CID - CONVERT *ID* FOR DIRECTIVE.
*
*         ENTRY  (X1) - ID.
*                (A6) - STRING BUFFER IN WHICH TO INSERT *ID*.
*
*         EXIT   *ID* INSERTED.
*                (A6) ADVANCED.
*
*         USES   X - 0, 1, 2, 3, 4, 6, 7.
*                A - 4, 6.
*                B - 2, 3, 4, 5, 6.
*
*         CALLS  CDD.
 
 
*         PROCESS IDENT.
 
 CID      PS     0
 CID1     SB6    6
          MX2    42          IDENT MASK
          MX7    6
          BX3    X2*X1
          SA4    DN
          IX4    X3-X4
          ZR     X4,CID4     IF DECK.NUMBER
 CID2     BX4    X7*X3
          ZR     X4,CID3     INSERT .
          LX6    X4,B6
          LX3    X3,B6
          SX4    X6-1R
          ZR     X4,CID2     NO BLANKS
          SA6    A6+B1       STORE IN CHARACTER BUFFER
          EQ     CID2
 
 CID3     NZ     X0,CID      IF JUST FINISHED NUMBER
          SX6    1R.
          SA6    A6+B1
 
*         PROCESS NUMBER.
 
 CID4     MX2    -16         EXTRACT CARD NUMBER
          BX1    -X2*X1
          RJ     CDD
          LX6    24
          BX1    X6
          SX0    B1          SET TO SECOND PASS
          EQ     CID1
 SFI      SPACE  4,15
**        SFI - SEARCH FOR IDENT IN DECK.
*
*         USES   X - ALL.
*                A - ALL.
*                B - ALL.
*
*         CALLS  WTW=.
*
*         MACROS SEARCH, WRITEW.
 
 
 SFI      PS     0
          SX7    B0+
          SA7    IP          PRESET TO *NOT PRESENT*
          SA1    PA
          ZR     X1,SFI1     IF NOT *PULLALL* REQUEST
          SA1    A1+B1
          BX7    X1
          SA7    IN
          SX3    B0          INITIAL IDENT
          ZR     X1,SFI2     IF NOT *PULLALL,IDENT*
          SA1    L.TDKI
          SB7    X1-1
          NZ     B7,SFI3     IF MODIFIERS PRESENT
          EQ     SFI         EXIT
 
 SFI1     SA5    IN
          MX7    60
          SA7    II          PRESET TO *NOT FOUND*
          SEARCH TDKI,X5
          ZR     X2,SFI      IF NO MATCH
 SFI2     SA2    DN
          BX7    X2
          SA7    DCKD+1      STORE INTO DECK MESSAGE
          SX7    X3          IDENT ORDINAL
          SA7    II          SHOW FOUND
          SX6    B1
          SA6    IP          SHOW PRESENT
          WRITEW M,DCKD,2    WRITE *DECK XXXX
          EQ     SFI
 
*         SEARCH THE DECK *IDENT* TABLE IN CHRONOLOGICAL ORDER
*         FOR A MATCHING ENTRY IN THE PULLALL *IDENT* TABLE.
 
 SFI3     SA5    F.TDKI      GET FWA OF IDENT TABLE
          SA4    L.TDKI      GET LENGTH OF IDENT TABLE
          SX6    B0          CLEAR IDENT NAME
          MX7    60          PRESET *NOT FOUND*
          SA6    IN
          SA7    II
          SB6    B0          PRESET IDENT ORDINAL
          SB7    X4          SET IDENT TABLE LENGTH
 SFI4     SB6    B6+B1       INCREMENT IDENT ORDINAL
          GE     B6,B7,SFI   IF END OF TABLE, EXIT
          SA2    X5+B6       READ IDENT TABLE ENTRY
          SEARCH TPAT,X2     SEARCH PULLALL TABLE
          ZR     X2,SFI4     IF MATCH NOT FOUND, LOOP
          BX6    X2          SET IDENT NAME
          SX3    B6          SET IDENT ORDINAL
          SA6    IN
          EQ     SFI2        COMPLETE ENTRY
 BUFFERS  TITLE  COMMON DECKS AND BUFFERS.
*CALL     COMCCDD
*CALL     COMCCIO
*CALL     COMCRDA
*CALL     COMCRDC
*CALL     COMCRDS
*CALL     COMCRDW
*CALL     COMCSFN
*CALL     COMCSYS
*CALL     COMCWTA
*CALL     COMCWTC
*CALL     COMCWTS
*CALL     COMCWTW
          SPACE  4
**        BUFFERS.
 
 
          USE    BUFFERS
 
*         CHARACTER STRING BUFFER.
 
 CHSP     BSS    0           SPACING FOR LIST
          DUP    10,1
          DATA   1R
 USBB     BSS    0           STRING BUFFER
 CHAR     BSS    326         150 UPPER/LOWER CASE + SEQUENCE
 
 BUF      BSS    0           SCRATCH BUFFER
 BUFL     EQU    101B
 
 PBUF     EQU    BUF+BUFL
 OBUF     EQU    PBUF+PBUFL
 SBUF     EQU    OBUF+OBUFL
 MBUF     EQU    SBUF+SBUFL
 NBUF     EQU    MBUF+MBUFL
 MTBS     EQU    NBUF+NBUFL
 MFL=     EQU    MTBS+MTBSL+200000B
 IDENT    SPACE  4
          IDENT              TERMINATE BLOCK
          TITLE  DIRECTIVE CARD PROCESSORS.
          ORG    NBUF
          SPACE  4,10
**        DIRECTIVE STATEMENT PROCESSOR TEMPORARY STORAGE.
 
 
 ZP       CON    0           *Z* ARGUMENT PROCESSING FLAG
 PDC      SPACE  4,10
**        PDC - PROCESS DIRECTIVE CARDS.
 
 
 PDC      PS     0           ENTRY/EXIT
          RJ     RDR         READ DIRECTORY
          SA1    ZP          *Z* MODE PROCESSING FLAG
          NZ     X1,PDC0     IF *Z* ARGUMENT SELECTED
          SA1    I
          ZR     X1,PDC3     IF NO INPUT FILE
          READ   I
 PDC0     BSS    0
          READS  I,CHAR,80   READ DIRECTIVE
          NZ     X1,PDC3     IF EOR
 PDC1     CARD   CSET
          CARD   EDIT
          CARD   PREFIX
          CARD   PURGE
          CARD   PULLMOD
          CARD   PULLALL
          EQ     ERR1
 
*         DIRECTIVE PROCESSORS RETURN HERE TO LIST CARD.
 
 PDC2     RJ     LDC         LIST CARD
 
*         DIRECTIVE PROCESSORS RETURN HERE TO READ NEXT CARD.
 
          READS  I,CHAR,80   READ NEXT DIRECTIVE
          ZR     X1,PDC1     LOOP TO EOR
          SA1    EC
          SA2    DB
          ZR     X1,PDC      RETURN IF NO ERRORS
          NZ     X2,PDC      RETURN IF DEBUG SET
          SX6    B0          CLEAR EDIT TABLE
          SA6    L.TEDT
          RJ     LST         LIST STATISTICS
          SA0    =C* DIRECTIVE ERRORS.*
          EQ     ABT
 
*         PROCESS EMPTY INPUT FILE.
 
 PDC3     SA0    =C/ NO DIRECTIVES./
          SA1    FM
          NZ     X1,PDC      IF -F- MODE
          EQ     ABT1
 
 ERRM     CON    0           ERROR MESSAGE ADDESSS
 ERR      SPACE  4
**        ERR - DIRECTIVE ERROR PROCESSORS.
 
 
 ERR      SA6    ERRM        SET ERROR MESSAGE ADDRESS
          EQ     PDC2        EXIT
 
 ERR1     SX6    =C*INCORRECT DIRECTIVE.*
          EQ     ERR
 
 ERR2     SX6    =C*FORMAT ERROR IN DIRECTIVE.*
          EQ     ERR
 CSET     SPACE  4,10
***       CSET   DNAME
*
*         DECLARE CHARACTER SET TO BE USED IN PROCESSING
*         MODIFICATION DIRECTIVES AND TEXT. THIS CHARACTER
*         SET MUST MATCH THAT OF THE DECKS TO BE EDITED.
 
 
 CSET     RJ     ASN         ASSEMBLE NAME OF *CSET*
          SA1    TCST-1      FWA-1 OF CHARACTER SET TABLE
          MX3    42
 CSET1    SA1    A1+B1
          ZR     X1,CSET2    IF UNKNOWN CHARACTER SET
          BX4    X3*X1
          BX7    X6-X4
          NZ     X7,CSET1    IF NO MATCH
          BX7    -X3*X1
          SA7    SETC        SET NEW CHARACTER SET
          EQ     PDC2        RETURN
 CSET2    SX6    =C* CSET - UNKNOWN CHARACTER SET.*
          EQ     ERR         PROCESS ERROR
 EDIT     SPACE  4
***       EDIT   D1
*         EDIT   D1,D2,...DN
*         EDIT   D1.DN
*
*         REQUEST EDITING OF DECK(S) D1 - DN.
 
 
 EDIT     RJ     ASN         ASSEMBLE NAME
          ZR     X6,ERR2     IF ASSEMBLY ERROR
          SEARCH TDKN,X6     CHECK FOR NAME=DECK
          ZR     X2,EDT3     IF NOT FOUND
          SA1    CH          CHECK NEXT CHARACTER
          SA3    X1
          SB7    B0          1 ENTRY
          SB2    X3-1R.
          SA5    A2          PRESET (A5)
          NZ     B2,EDT1     IF NOT *.*
          SX7    X1+B1       SKIP *.*
          SA7    A1
          RJ     ASN         ASSEMBLE NAME
          ZR     X6,ERR2     IF ASSEMBLY ERROR
          SEARCH A0,X6       CHECK FOR NAME=DECK
          ZR     X2,EDT3     IF NOT FOUND
          SB6    A5          SET NUMBER OF ENTRIES
          SB7    A2-B6
          PL     B7,EDT1     IF SECOND NAME AFTER FIRST
          SX6    =C+NAMES SEPARATED BY *.* IN WRONG ORDER.+
          EQ     ERR
 
 EDT1     SEARCH TEDT,X5     SEARCH FOR PREVIOUS ENTRY
          NZ     X2,EDT2     IF FOUND
          BX5    X1*X5       ENTER DECK
          SX2    A5
          ADDWRD A0,X5+X2
          SA4    SETC        CHECK FOR CSET
          NG     X4,EDT2     IF NO CSET DIRECTIVE FOUND
          MX0    42
          BX0    X0*X6
          BX4    X0+X4
          ADDWRD TCED,X4     TABLE OF CHARACTER SETS OF EDITED DECKS
 EDT2     SB7    B7-2
          SA5    A5+2
          PL     B7,EDT1     LOOP TO END OF REQUESTED DECKS
 
          SA1    CH          CHECK NEXT CHARACTER
          SA2    X1
          SX6    X1+B1
          SB2    X2-1R
          ZR     B2,PDC2     EXIT IF * *
          NE     B2,B1,ERR2  FORMAT ERROR IF NOT *,*
          SA6    A1          SKIP *,*
          EQ     EDIT        LOOP
 
 EDT3     SA1    EDTA+1      SET NAME IN MESSAGE
          MX2    30
          BX1    X2*X1
          LX6    30
          BX3    -X2*X6
          IX7    X1+X3
          MX2    12
          BX6    X2*X6
          SA7    A1
          SA6    A1+B1
          SX6    EDTA        SET MESSAGE ADDRESS
          EQ     ERR
 
 EDTA     DATA   30HUNKNOWN DECK -
 PREFIX   SPACE  4,10
***       PREFIX C
*
*         SET THE PREFIX CHARACTER FOR THE GENERATED DIRECTIVES TO *C*.
 
 
 PREFIX   BSS    0           ENTRY
          SA1    CH          GET THE CHARACTER
          MX2    6
          SA1    X1
          SX6    X1-1R
          ZR     X6,ERR2     IF BLANK
          LX1    -6          USE ONLY THE LOWER CHARACTER
          BX7    X2*X1
          SA1    TDTA        UPDATE THE PREFIX OF EACH DIRECTIVE
 PRF1     ZR     X1,PDC2     IF END OF TABLE
          SA3    X1
          SA1    A1+B1
          BX3    -X2*X3      CLEAR PREFIX CHARACTER
          BX6    X3+X7
          SA6    A3+
          EQ     PRF1        CONTINUE
 PURGE    SPACE  4
***       PURGE  MNAME
*
*         PURGE MODIFIER *MNAME* IN DECKS SELECTED FOR EDITING.
 PURGE    SPACE  4
***       PURGE  MNAME,*
*
*         PURGE MODIFIER *MNAME* AND ALL AFTER
 
 
 PURGE    RJ     ASN         ASSEMBLE IDENT NAME
          ZR     X6,ERR2     IF ASSEMBLY ERROR
          SEARCH TPRG,X6     SEARCH FOR PURGE NAME
          NZ     X2,PRG1     IF FOUND
          ADDWRD A0,X1*X6    ENTER NEW PURGE NAME
          SA2    A6
 PRG1     SA1    CH          CHECK NEXT CHARACTER
          SA3    X1
          SB2    X3-1R,
          NZ     B2,PDC2     EXIT IF NOT *,*
          SA3    A3+B1       CHECK NEXT CHARACTER
          SX4    B1
          SB2    X3-1R*
          NZ     B2,ERR1     ERROR IF NOT (*)
          BX6    X4+X6       SET ALL AFTER FLAG
          SA6    A2
          EQ     PDC2        EXIT
 PULLMOD  SPACE  4
***       PULLMOD IDENT
*
*         PULLMOD IDENT1,IDENT2,IDENT3, . . . ,IDENTN
*         CREATE MODSET CORRESPONDING TO *IDENT* ON EDITED DECKS.
 
 
 PULLMOD  RJ     ASN         ASSEMBLE IDENT NAME
          ZR     X6,ERR2     IF ASSEMBLY ERROR
          SEARCH TPMI,X6     SEARCH FOR PULLMOD NAME ALREADY STORED
          NZ     X2,PMOD0    IF FOUND
          ADDWRD A0,X1*X6    ADD NEW PULLMOD
 PMOD0    SA1    CH
          SA2    X1          CHECK NEXT CHARACTER
          SX6    X1+B1
          SB2    X2-1R
          ZR     B2,PDC2     IF * *
          NE     B2,B1,ERR2  IF NOT *,*
          SA6    A1
          EQ     PULLMOD
 PULLALL  SPACE  4,10
***       PULLALL  IDENT
*
*         CREATE A COMPOSITE MODSET FROM ALL EDITED DECKS
*         REFLECTING CHANGES FROM *IDENT* AND LATER MODSETS.
*
***       PULLALL
*
*         CREATE A COMPOSITE MODSET FROM ALL EDITED DECKS
 
 
 PULLALL  SX6    B1
          SA6    PA          SET *PULL ALL* FLAG
          SA1    CH
          SA2    X1          CHECK NEXT CHARACTER
          SB2    X2-1R
          ZR     B2,PDC2     IF A BLANK
          RJ     ASN
          ZR     X6,ERR2     IF MORE THAN 7 CHARACTERS OR BAD CHARACTER
          SA6    A6+B1       SET FLAG THAT THERE ARE IDENT ENTRIES
          BX5    X6
          SEARCH TPAT,X5
          NZ     X2,PUL      IF DUPLICATE REQUEST
          ADDWRD A0,X5
 PUL      SA1    CH
          SA2    X1          CHECK NEXT CHARACTER
          SB2    X2-1R
          NZ     B2,ERR2     IF NOT A BLANK
          EQ     PDC2
          TITLE  DIRECTIVE CARD PROCESSING SUBROUTINES.
 LDC      SPACE  4,20
**        LDC - LIST DIRECTIVE CARD.
*
*         ENTRY  (CHAR) - CARD IN *S* FORMAT.
*                (ERRM) - ERROR MESSAGE, IF NEEDED.
*
*         USES   X - 0, 1, 2, 6, 7.
*                A - 1, 2, 6, 7.
*                B - 3.
*
*         CALLS  LER, UPN.
*
*         MACROS LISTOP, PRINT.
 
 
 LDC      SUBR               ENTRY/EXIT
          SA1    ERRM
          ZR     X1,LDC1     IF NO ERROR MESSSAGE
          SA2    =9L  *ERROR*
          BX6    X2
          SB3    CHSP
          RJ     UPN
          LISTOP E,LDC2,NG   IF ERROR LIST ON
          SA2    EC          ADVANCE ERROR COUNT
          SX6    X2+B1
          SA6    A2
          EQ     LDCX        RETURN
 
 LDC1     LISTOP C,LDC3      IF NO LIST SELECTED ON INPUT DIRECTIVES
 LDC2     PRINT  -CHSP,90
 LDC3     SA1    ERRM
          ZR     X1,LDCX     IF NO ERROR MESSAGE - RETURN
          SX6    B0          CLEAR ERROR MESSAGE
          SA6    A1
          SX0    X1
          RJ     LER         LIST ERROR MESSAGE
          EQ     LDCX        RETURN
 RDR      SPACE  4,20
**        RDR - READ DIRECTORY FROM PROGRAM LIBRARY.
*
*         CHECK PROGRAM LIBRARY FORMAT.  READ DECK NAME TABLE.
*
*         USES   ALL.
*
*         CALLS  ABT, ADW, ATS, RDW=.
 
 
 RDR      PS     0           ENTRY/EXIT
          SA5    P
          ZR     X5,RDR      RETURN IF NO PROGRAM LIBRARY
          SKIPEI P
          SKIPB  X2,2        BACKSPACE OVER DIRECTORY
          READ   X2
          READW  X2,TIDT,TIDTL READ IDENT TABLE
          ZR     X1,RDR1     IF NO EOR
          SA0    =C* PROGRAM LIBRARY EMPTY.*
          EQ     ABT
 
 RDR1     SA1    TIDT
          LX1    18
          SA2    A1+B1
          SB2    X1-770000B
          NZ     B2,RDR7     IF NO IDENT TABLE
          BX6    X2          SET PROGRAM LIBRARY NAME
          SA6    PL
          READW  P,T1,1      READ FIRST WORD
          NZ     X1,RDR7     IF EOR
          SA1    T1
          SX5    X1          SET DIRECTORY LENGTH
          LX1    18
          SB2    X1-700000B
          NZ     B2,RDR7     IF NOT DIRECTORY
          ZR     X5,RDR7     IF EMPTY
 RDR2     READW  P,T1,2      READ RECORD NAME AND RANDOM ADDRESS
          SA1    T1          CHECK TYPE
          SB2    X1-OPRT
          ZR     B2,RDR3     IF OPL DECK
          NE     B2,B1,RDR4  IF NOT OPL COMMON DECK
          ERRNZ  OPRT+1-OCRT CODE ASSUMES VALUE
 RDR3     ADDWRD TDKN,X1     ENTER DECK NAME
          SA1    T2          ENTER RANDOM ADDRESS
          ADDWRD A0,X1
 RDR4     SX5    X5-2
          NZ     X5,RDR2     LOOP TO END OF DIRECTORY
          SA1    FM
          ZR     X1,RDR      RETURN IF *F* MODE NOT USED
 
*         ENTER ALL DECKS IN EDIT TABLE IF -F- MODE.
 
          SA1    L.TDKN      ALLOCATE EDIT TABLE
          LX1    -1          COMPENSATE FOR DIFFERENT ENTRY LENGTHS
          ALLOC  TEDT,X1
          SA1    F.TDKN      COPY DECK NAMES TO EDIT TABLE
          SB4    X3
          SB2    B1+B1
          MX0    42
          SA1    X1
          BX6    X0*X1
          SB3    B0
 RDR5     SX1    A1
          BX6    X6+X1
          SA6    X2+B3
          SA1    A1+B2
          SB3    B3+B1
          BX6    X0*X1
          NE     B3,B4,RDR5  LOOP FOR ALL DECK NAMES
          EQ     RDR         RETURN
 
 RDR7     SA0    =C* ERROR IN DIRECTORY.*
          EQ     ABT
 COMMON   SPACE  4,10
**        INPUT DIRECTIVE PROCESSOR TABLE.
 
 
          HERE
          DATA   0           END OF TABLE
 IDENT    SPACE  4
          IDENT              TERMINATE BLOCK
          SPACE  4
          ERRNG  NBUF+NBUFL-*  DIRECTIVE PROCESSOR OVERFLOW
          TITLE  OPLEDIT PRESET.
 PRS      SPACE  4,10
**        PRS - PRESET OPLEDIT.
*
*         ENTRY  (A0) - FL.
*
*         USES   X - 0, 1, 2, 3, 4, 6, 7.
*                A - 0, 1, 2, 4, 6.
*                B - 2, 4, 5, 6, 7.
*
*         CALLS  ARG, SOF, ZAP.
*
*         MACROS CLOCK, DATE, EVICT, GETPP, WRITEC.
 
 
 PRS      SUBR               ENTRY/EXIT
          SX6    A0-4
          SA6    FL
          SA1    ACTR        ARGUMENT COUNT
          SA4    ARGR        ADDRESS OF FIRST ARGUMENT
          SB4    X1
          SB5    ARGT        ARGUMENT TABLE
          RJ     ARG         PROCESS ARGUMENTS
          ZR     X1,PRS2     IF NO ARGUMENT ERROR
 PRS1     SA0    =C* ERROR IN ARGUMENTS.*
          EQ     ABT1
 
*         PROCESS LIST CONTROL.
 
 PRS2     RJ     SOF         SET OUTPUT FORMAT
          CLOCK  TIME        REQUEST TIME
          DATE   DATE        REQUEST DATE
          SA1    TIME        SET DATE AND TIME IN SHORT TITLE
          SA2    DATE
          BX6    X1
          LX7    X2
          SA6    TERTM
          SA7    TERDT
          SB6    FETS        CHECK FILE NAMES
          MX0    42
          SB7    FETSL
          SB2    8
          SA0    =C* FILE NAME CONFLICT.*
 PRS3     SA1    B6
          SB5    B6+B2
          BX1    X0*X1
 PRS4     SA2    B5
          BX2    X0*X2
          ZR     X2,PRS5     IF FILE NOT DEFINED
          BX7    X2-X1
          ZR     X7,ABT1     IF FILE NAME CONFLICT
 PRS5     SB5    B5+B2       ADVANCE TO NEXT FILE
          LT     B5,B7,PRS4  IF NOT DONE (INNER LOOP)
          SB6    B6+B2
          NE     B6,B7,PRS3  IF NOT DONE (OUTER LOOP)
 
          SA1    N           INITIALIZE PL,S
          ZR     X1,PRS6     IF NO *NPL*
          SX6    B1
          BX6    X6+X1       SET COMPLETE BIT
          SA6    A1
          SA6    A1+7        SAVE FILE NAME
          EVICT  A1
 PRS6     SA1    M           INITIALIZE MODSET FILE
          ZR     X1,PRS7     IF NO MODSET FILE REQUESTED
          SX6    B1
          BX6    X6+X1
          SA6    A1          SET COMPLETE
          SA6    A1+7        SAVE NAME
          EVICT  A1
 PRS7     SA1    ZP
          ZR     X1,PRS8     IF *Z* ARGUMENT NOT SELECTED
          SX2    I           SET INPUT FET ADDRESS
          RJ     ZAP         PROCESS *Z* ARGUMENT
 
*         SPACE FILL COMMAND.
 
 PRS8     SB7    4
 PRS9     SA1    CCDR+B7
          RJ     SFN
          SA6    A1
          SB7    B7-B1
          PL     B7,PRS9     IF NOT COMPLETE
          GETPP  BUF,LL,BUF  GET PAGE SIZE PARAMETERS
          SA1    TO
          ZR     X1,PRSX     IF TERMINAL OUTPUT
          WRITEC O,BUF       WRITE PRINT DENSITY FORMAT CONTROL
          EQ     PRSX        RETURN
          TITLE  PRESET DATA.
 ARGT     SPACE  4,20
**        ARGT - ARGUMENT TABLE.
 
 
 ARGT     BSS    0           ARGUMENT TABLE
 I        ARG    I,I         INPUT FILE
 L        ARG    O,O         LIST OUTPUT
 P        ARG    P,P         *OPL* FILE
 N        ARG    NNPL,N      *NPL* FILE
 U        ARG    =1,UM       *U* MODE FLAG
 M        ARG    NMODSET,M   *MODSET* FILE
 LO       ARG    LO,LO,400B  LIST OPTIONS
 F        ARG    -=1,FM      *F* MODE FLAG
 D        ARG    -=1,DB      *D* MODE FLAG
 Z        ARG    -*,ZP       *Z* MODE FLAG
          ARG
 
 NNPL     CON    0LNPL+3
 NMODSET  CON    0LMODSETS+3
          TITLE  PRESET SUBROUTINES.
 SLC      SPACE  4,10
**        SLC - SET LIST CONTROL.
*
*         EXIT   (LO) INITIALIZED.
*
*         USES   X - ALL.
*                A - 0, 1, 3, 6.
*                B - 2, 3, 4.
 
 
 SLC3     SA6    LO
 
 SLC      SUBR               ENTRY/EXIT
          SX4    B1+         BIT CONSTANT
          SA1    LO          GET *LO* OPTIONS
          MX0    -6
          BX6    X6-X6       INITIALIZE RESULT REGISTER
          ZR     X1,SLCX     IF  NOT SELECTED
          SA0    =C* INCORRECT -LO- PARAMETER.*
          SB2    SLCA        LIST OPTION TABLE
 SLC1     LX1    6           PICK NEXT LETTER
          BX5    -X0*X1
          ZR     X5,SLC3     IF COMPLETE
          SB3    B0+
 SLC2     SA3    B2+B3       GET NEXT OPTION
          BX2    X5-X3       COMPARE
          ZR     X3,ABT1     IF END OF OPTION TABLE
          SB3    B3+B1       ADVANCE INDEX
          NZ     X2,SLC2     IF NO MATCH
          SB4    B3-B1
          LX7    X4,B4
          BX6    X6+X7       ADD CURRENT OPTION
          EQ     SLC1        LOOP FOR NEXT LETTER
 
 SLCA     BSS    0           OPTION TABLE
 OPTION   HERE
          CON    0           END OF TABLE
 SOF      SPACE  4,15
**        SOF - SET OUTPUT FORMAT.
*
*         SET TERMINAL OUTPUT FLAG AND DEFAULT LIST OPTIONS.
*
*         ENTRY  (LO) = COMMAND *LO* PARAMETERS.
*                     = 0 IF OMITTED.
*
*         EXIT   (LO) = LIST OPTION BIT MAP.
*                     = DEFAULT OPTIONS IF OMITTED FROM
*                       COMMAND.
*                (TO) = 0 IF OUTPUT ASSIGNED TO
*                       INTERACTIVE TERMINAL.
*
*         USES   X - 1, 2, 6.
*                A - 1, 2, 6.
*
*         CALLS  SLC, STF.
 
 
 SOF      SUBR               ENTRY/EXIT
 
*         SET TERMINAL FILE DEFAULT OPTIONS.
 
          SX2    O           CHECK OUTPUT FILE RESIDENCE
          RJ     STF
          SA6    TO          SET TERMINAL OUTPUT FLAG
          SA2    SOFA
          ZR     X6,SOF2     IF ASSIGNED TO TERMINAL
 
*         SET NON-TERMINAL FILE DEFAULT OPTIONS.
 
          SA2    SOFB        SET DEFAULT LIST OPTIONS
 
*         PROCESS SPECIFIED OR DEFAULT OPTIONS.
 
 SOF2     SA1    LO          READ COMMAND OPTIONS
          NZ     X1,SOF3     IF OPTIONS ENTERED
          BX6    X2          STORE DEFAULT OPTIONS
          SA6    A1
 SOF3     RJ     SLC         SET LIST CONTROLS
          EQ     SOFX        RETURN
 
 SOFA     CON    0LE         DEFAULT TERMINAL OPTIONS
 SOFB     CON    0LECMDS     DEFAULT NON-TERMINAL OPTIONS
 COMMON   SPACE  4,10
**        PRESET COMMON DECKS.
 
 
*CALL     COMCARG
*CALL     COMCCPM
*CALL     COMCSTF
*CALL     COMCUSB
*CALL     COMCZAP
 OPLEDIT  TTL    OPLEDIT - OPL EDITING PROGRAM.
          SPACE  4
          END    OPLEDIT     OPL EDITING PROGRAM
Retro1.org codex

Table of Contents

OPLEDIT

Table Of Contents

Source Code
