OPLEDIT 
          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
