LIBEDIT 
          IDENT  LIBEDIT,LIBEDIT,LIBEDIT
          ABS 
          ENTRY  LIBEDIT
          ENTRY  SSM= 
          ENTRY  MFL= 
          SYSCOM B1 
*COMMENT  LIBEDIT - LIBRARY EDITING PROGRAM.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          TITLE  LIBEDIT - LIBRARY EDITING PROGRAM. 
          SPACE  4
***       LIBEDIT - LIBRARY EDITING PROGRAM.
*         D. A. CAHLANDER.   69/02/13.
*         P. D. HAAS.        73/07/29.
          SPACE  4,10 
***       LIBEDIT PROVIDES EDITING AND REPLACEMENT OF RECORDS ON
*         A BINARY FILE BY RECORDS FROM ONE OR MORE SECONDARY FILES.
          SPACE  4
***       COMMAND CALL -
* 
*         LIBEDIT(P1,P2,P3,P4,.....,PN) 
* 
*         WHERE PARAMETER KEYWORDS ARE ORDER INDEPENDENT, 
*         AND ARE ONE OR MORE OF THE FOLLOWING -
* 
*         I  OMITTED, USE *INPUT* FOR INPUT DIRECTIVES FILE.
*         I         , USE *INPUT* FOR INPUT DIRECTIVES FILE.
*         I=0       , NO INPUT DIRECTIVE FILE IS TO BE USED.
*         I=FN      , USE *FN* FOR INPUT DIRECTIVES FILE. 
* 
*         P  OMITTED, USE *OLD* FOR OLD FILE. 
*         P         , USE *OLD* FOR OLD FILE. 
*         P=0       , NO OLD FILE TO BE USED. 
*         P=FN      , USE *FN* FOR OLD FILE.
* 
*         N  OMITTED, USE *NEW* FOR NEW FILE. 
*         N         , USE *NEW* FOR NEW FILE. 
*         N=FN      , USE *FN* FOR NEW FILE.
* 
*         B  OMITTED, USE *LGO* FOR CORRECTION FILE.
*         B         , USE *LGO* FOR CORRECTION FILE.
*         B=0       , NO CORRECTION FILE TO BE USED.
*         B=FN      , USE *FN* FOR CORRECTION FILE. 
* 
*         L  OMITTED, USE *OUTPUT* FOR LISTING FILE.
*         L         , USE *OUTPUT* FOR LISTING FILE.
*         L=0       , NO LISTING FILE TO BE WRITTEN.
*         L=FN      , USE *FN* FOR LISTING FILE.
* 
*         LO=E      , LIST PROCESSING ERRORS. 
*         LO=C      , LIST INPUT DIRECTIVES.
*         LO=M      , LIST MODIFICATIONS MADE.
*         LO=N      , LIST RECORDS WRITTEN TO NEW FILE. 
*         LO=F      , FULL LIST INCLUDING PROCESSING ERRORS, INPUT
*                     DIRECTIVES, MODIFICATIONS MADE AND RECORDS
*                     WRITTEN TO NEW FILE.
*            (NOTE - ANY COMBINATION MAY BE SPECIFIED FOR *LO*.)
* 
*            LO OMITTED --- 
*              LO=EM   , TIME SHARING JOB, LISTING FILE ASSIGNED
*                        TO EQUIPMENT *TT*. 
*              LO=ECF  , ALL OTHER CASES. 
* 
*         U  OMITTED, NO USER LIBRARY TO BE GENERATED.
*         U         , GENERATE USER LIBRARY *ULIB* ON FILE *NEW*. 
*         U=0       , NO USER LIBRARY TO BE GENERATED.
*         U=LN      , GENERATE USER LIBRARY *LN* ON FILE *NEW*. 
*           (NOTE - *LIBGEN* IS CALLED TO GENERATE USER LIBRARY.) 
* 
*         NX OMITTED, PASS *NX=0* TO *LIBGEN*.
*         NX        , PASS *NX=1* TO *LIBGEN*.
*         NX=0      , PASS *NX=0* TO *LIBGEN*.
*         NX=N      , PASS *NX=N* TO *LIBGEN*.
* 
*         C  OMITTED, DO NOT RECOPY NEW FILE TO OLD FILE. 
*         C         , RECOPY NEW FILE TO OLD FILE AFTER EDITING.
* 
*         D         , SAME AS *NA* (INCLUDED FOR UPWARD COMPATABILITY). 
* 
*         V  OMITTED, DO NOT VERIFY OLD FILE AGAINST NEW FILE.
*         V         , VERIFY NEW FILE AGAINST NEW FILE. 
*            (NOTE - *VFYLIB* IS CALLED TO PERFORM THE VERIFY.) 
* 
*         NA OMITTED, ABORT ON DIRECTIVE ERRORS.
*         NA        , DO NOT ABORT ON DIRECTIVE ERRORS. 
*            (NOTE - TIME SHARING JOBS WITH DIRECTIVE INPUT FILE
*                    ASSIGNED TO *TT* SET *NA* AUTOMATICALLY.)
* 
*         NI OMITTED, INSERT NEW RECORDS FROM CORRECTION FILE AT EOF. 
*         NI        , DO NOT INSERT NEW RECORDS AT EOF. 
*            (NOTE - ONLY THOSE RECORDS NOT RERERENCED BY ANY DIRECTIVE 
*                    ARE ADDED AT EOF.  ANY DIRECTIVE SUCH AS *INSERT 
*                    *NOREP, OR *IGNORE TAKES PRECEDENCE. 
* 
*         NR OMITTED, REWIND *OLD* AND *NEW* BEFORE AND AFTER EDITING.
*         NR        , DO NOT REWIND *OLD* OR *NEW* FILES. 
* 
*         Z  OMITTED, NO DIRECTIVE INPUT ON COMMAND.
*         Z         , GET DIRECTIVE INPUT FROM COMMAND. 
*            (NOTE - *Z* PARAMETER WILL OVERRIDE *I* PARAMETER.)
* 
* 
*         SINCE THE *U* AND *V* OPTIONS ARE PERFORMED BY LOADING
*         DIFFERENT UTILITIES, IF BOTH ARE SPECIFIED, *U* WILL
*         TAKE PRECEDENCE.
          SPACE  4,10 
***       DAYFILE MESSAGES. 
* 
*         * DIRECTIVE ERRORS.* = A *LIBEDIT* DIRECTIVE HAS INCORRECT
*                SYNTAX.
* 
*         * EDITING COMPLETE.* = INFORMATIVE MESSAGE INDICATING THAT
*                THE LIBRARY EDITING HAS COMPLETED. 
* 
*         * FILE NAME CONFLICT.* = THE SAME FILE NAME HAS BEEN
*                SPECIFIED FOR MORE THAN ONE PARAMETER. 
* 
*         * FILENAM NOT DECLARED NRANDOM.* = AN EOF WAS ENCOUNTERED 
*                ON THE NONRANDOM FILE, FILENAM.
* 
*         * INCORRECT DEVICE TYPE - LFN.* = A NON-MASS STORAGE FILE WAS 
*                INCORRECTLY SPECIFIED AS EITHER THE OLD FILE OR THE
*                CORRECTION FILE. 
* 
*         * LIBEDIT ARGUMENT ERROR(S).* = THE *LIBEDIT* COMMAND 
*                CONTAINS AN INCORRECT PARAMETER. 
* 
*         * LIST OPTION ERROR.* = AN INCORRECT OPTION WAS SPECIFIED 
*                FOR THE *LO* PARAMETER.
* 
*         * N DIRECTIVE ERRORS.* = *LIBEDIT* COULD NOT INTERPRET
*                N NUMBER OF DIRECTIVES.
* 
*         * N RECORDS NOT REPLACED.* = AN INFORMATIVE MESSAGE.
*                *LIBEDIT* ENCOUNTERED N NUMBER OF RECORDS ON A 
*                REPLACEMENT FILE THAT WERE NOT NAMED IN THE DIRECTIVES 
*                AND DID NOT REPLACE OLD FILE RECORDS.
* 
*         * NO NEW FILE.* = N=0 WAS INCORRECTLY SPECIFIED FOR THE 
*                *N* PARAMETER. 
* 
*         * OVERLAPPING INSERT OR DELETE.* = *LIBEDIT* ENCOUNTERED AN 
*                OVERLAP IN THE RECORD NAMES SPECIFIED IN THE 
*                DIRECTIVES.
* 
*         * RENAME NOT ALLOWED FOR PROC OR TEXT RECORD.* = ATTEMPT TO 
*                RENAME A PROC OR TEXT TYPE RECORD WAS NOT ALLOWED. 
* 
*         * REQUIRED FL EXCEEDS VALIDATED LIMIT.* = THE JOB FIELD 
*                LENGTH REQUIRED FOR *LIBEDIT* IS GREATER THAN THE
*                MAXIMUM FOR WHICH THE USER IS VALIDATED. 
* 
          SPACE  4
****      ASSEMBLY CONSTANTS. 
  
  
 BUFL     EQU    4020B       MINIMUM BUFFER REQUIRED
 DCBL     EQU    16          DIRECTIVE BUFFER LENGTH
 INPL     EQU    2010B       *INPUT* *CIO* BUFFER LENGTH
 LGOL     EQU    10021B      *LGO* *CIO* BUFFER LENGTH
 NEWL     EQU    20041B      *NEW* *CIO* BUFFER LENGTH
 OLDL     EQU    20041B      *OLD* *CIO* BUFFER LENGTH
 OUTL     EQU    4020B       *OUTPUT* *CIO* BUFFER LENGTH 
 SBUFL    EQU    4020B       *SCR* BUFFER LENGTH
 TTYL     EQU    301B        *TTYOUT* *CIO* BUFFER LENGTH 
 TWIDE    EQU    80+1        WIDTH LIMIT FOR TERMINAL OUTPUT
 ODEBL    EQU    16 
  
****
  
  
*         SPECIAL ENTRY POINT.
  
 SSM=     EQU    0           SUPPRESS DUMPS OF FIELD LENGTH 
          TITLE  INPUT DIRECTIVES.
***       INPUT DIRECTIVES. 
* 
*         ON ALL DIRECTIVE DESCRIPTIONS, THE PARAMETERS ARE - 
*           FN    FILE NAME.
*           NAME  RECORD NAME.
*           N     NUMERIC PARAMETER.
*           ABCD  ALPHANUMERIC PARAMETER. 
*           TYPE  LIBRARY TYPE - (MAY BE ONE OF THE FOLLOWING)
*                   *ABS*   ABSOLUTE PROGRAM. 
*                   *CAP*   FAST DYNAMIC LOAD CAPSULES. 
*                   *OPL*   OLD PROGRAM LIBRARY.
*                   *OPLC*  OLD PROGRAM LIBRARY COMMON DECK.
*                   *OPLD*  OPL DIRECTORY.
*                   *OVL*   SCOPE CPU OVERLAY PROGRAM.
*                   *PP*    PERIPHERAL PROCESSOR PROGRAM. 
*                   *PPL*   16-BIT PERIPHERAL PROCESSOR PROGRAM.
*                   *PPU*   7600 PPU PROGRAM. 
*                   *PROC*  PROCEDURE TYPE RECORD.
*                   *REL*   RELOCATABLE CPU PROGRAM.
*                   *TEXT*  UNRECOGNIZED AS A PROGRAM.
*                   *ULIB*  USER LIBRARY. 
* 
* 
*         FOR THOSE DIRECTIVES REQUIRING RECORD NAME(S), THE
*         FOLLOWING CONVENTIONS ARE USED -
* 
*         RID    RECORD IDENTIFIER
*                TYPE/NAME      RECORD *NAME* OF TYPE *TYPE*. 
*                NAME           RECORD *NAME*, USING DEFAULT TYPE.
*                *              EOF  (USED ONLY WITH *BEFORE).
* 
*         GID    RECORD GROUP IDENTIFIER
*                TYPE/NAME      RECORD *NAME* OF TYPE *TYPE*. 
*                NAME           RECORD *NAME*, USING DEFAULT TYPE.
*                TYPE1/NAME1-   GROUP OF RECORDS STARTING WITH
*                 TYPE2/NAME2    *RID1* AND ENDING WITH *RID2*. 
*                TYPE/NAME1-    GROUP OF *TYPE* RECORDS STARTING WITH 
*                  NAME2         *NAME1* AND ENDING WITH *NAME2*. 
*                NAME1-NAME2    GROUP OF DEFAULT TYPE RECORDS STARTING
*                                WITH *NAME1* AND ENDING WITH *NAME2*.
*                TYPE/NAME-*    ALL *TYPE* RECORDS STARTING WITH *NAME* 
*                NAME-*         ALL DEFAULT TYPE RECORDS STARTING 
*                                WITH *NAME*. 
*                TYPE/*         ALL RECORDS OF THE SPECIFIED *TYPE*.
*                *              ALL DEFAULT TYPE RECORDS. 
*                0              ZERO LENGTH RECORD (USED ONLY 
*                                WITH *INSERT). 
* 
* 
*         DIRECTIVES -
* 
*         *AFTER     RID,GID1,GID2,....GIDN 
*         *A         RID,GID1,GID2,...,GIDN 
*         *INSERT    RID,GID1,GID2,...,GIDN 
*         *I         RID,GID1,GID2,...,GIDN 
*            INSERT *GID1* THROUGH *GID2* FROM CURRENT CORRECTION 
*            FILE AFTER *RID* ON FILE *NEW*.
*            (NOTE - ANY RECORDS ON *OLD* WITH SAME NAME ARE DELETED.)
* 
*         *BEFORE    RID,GID1,GID2,...,GIDN 
*         *B         RID,GID1,GID2,...,GIDN 
*            INSERT *GID1* THROUGH *GID2* FROM CURRENT CORRECTION 
*            FILE BEFORE *RID* ON FILE *NEW*. 
*            (NOTE - ANY RECORDS ON *OLD* WITH SAME NAME ARE DELETED.)
* 
*         *DELETE    GID1,GID2,...,GIDN 
*         *D         GID1,GID2,...,GIDN 
*            DELETE *GID1* THROUGH *GIDN*.
* 
*         *NAME      TYPE 
*         *TYPE      TYPE 
*            CHANGE DEFAULT RECORD TYPE TO *TYPE*.
* 
*         *ADD       LIB,GID1,GID2,...,GIDN.
*            ADD *GID1* THROUGH *GIDN* AT END OF LIBRARY *LIB*. 
*            *LIB* CAN BE ANY OF THE FOLLOWING -
*                1.  *DDS*   DEADSTART LIBRARY. 
*                2.  *MOV*   MONITOR OVERLAY. 
*                3.  *RPL*   RESIDENT PERIPHERAL OVERLAY. 
*                4.  *RSL*   RESIDENT *SCOPE* LIBRARY.
*                5.  *SLD*   *SCOPE* LIBRARY DIRECTORY. 
*                6.  ANY NAME FROM *LIB1* TO *LIB9999*. 
*                (A LIBRARY IS DEFINED AS A GROUP OF RECORDS
*                TERMINATED BY A ZERO-LENGTH RECORD.) 
* 
*         *IGNORE    GID1,GID2,...,GIDN 
*            IGNORE *GID1* THROUGH *GIDN* WHEN READING CORRECTION 
*            FILE(S).  THESE RECORDS ARE NOT REPLACED.
* 
*         *RENAME    RID1,RID2
*            CHANGE THE NAME OF *RID1* TO *RID2*. 
* 
*         *REPLACE   GID1,GID2,...GIDN
*            REPLACE ONLY *GID1* THROUGH *GIDN* WHEN READING CORRECTION 
*            FILE.  THE REST OF THE RECORDS ARE IGNORED.
* 
*         *LIBGEN    UN 
*            CALL *LIBGEN* AT END OF EDITING TO GENERATE USER LIBRARY 
*            *UN* ON FILE *NEW*.  IF *UN* IS OMITTED, 
*            USE *UN* = *ULIB*. 
*            (OVERRIDES *U* PARAMETER IF *UN* IS SPECIFIED).
* 
*         *OLD       FN 
*            USE *FN* AS OLD FILE (OVERRIDES *P* PARAMETER).
* 
*         *NEW       FN 
*            USE *FN* AS NEW FILE (OVERRIDES *N* PARAMETER).
* 
*         *LGO       FN1,FN2,...,FNN
*         *FILE      FN1,FN2,...,FNN
*            ADD *FN1* THROUGH *FNN* TO LIST OF CORRECTION FILES. 
* 
*         *NOREP     FN1,FN2,...,FNN
*            DO NOT REPLACE RECORDS FROM FILES *FN1* THROUGH *FNN*. 
* 
*         *REWIND    FN1,FN2,...,FNN
*            REWIND *FN1* THROUGH *FN2* BEFORE AND AFTER EDITING. 
* 
*         *BUILD     ABCD 
*            BUILD AN *OPLD* INDEX AT THE END OF FILE *NEW*.
*            THE NAME GIVEN TO THIS RECORD IS *ABCD*. 
* 
*         *COMMENT   RID,ABCD 
*            ADDS 70 CHARACTER COMMENT *ABCD* TO THE 7700 
*            TABLE OF *RID* FROM *OLD* OR CORRECTION FILE.
* 
*         *DATE      RID,ABCD 
*            ADDS THE CURRENT DATE AND 70 CHARACTER COMMENT *ABCD*
*            TO THE 7700 TABLE OF *RID* FROM *OLD* OR CORRECTION FILE.
* 
*         *LIST      FN,ABCD
*            CHANGES LISTING FILE TO *FN*, AND LIST OPTIONS TO *ABCD* 
*            (SEE *LO* PARAMETER).  IF EITHER PARAMETER IS OMITTED, 
*            IT IS NOT CHANGED  (OVERRIDES *L* AND *LO* PARAMETERS).
* 
*         *COPY 
*            COPY *NEW* TO *OLD* AFTER EDITING
*            (EQUIVALENT TO *C* COMMAND PARAMETER). 
* 
*         *DEBUG
*            IGNORE SUBSEQUENT DIRECTIVE ERRORS (EQUIVALENT TO
*            *NA* PARAMETER, SET AUTOMATICALLY IF OUTPUT ASSIGNED 
*            TO EQUIPMENT *TT*. 
* 
*         *NOINS
*            DO NOT INSERT UNREPLACEABLE RECORDS AT EOF.
*            (EQUIVALENT TO *NI* PARAMETER.)
* 
*         *NOREW
*            DO NOT REWIND *OLD* OR *NEW * FILES. 
*            (EQUIVALENT TO *NR* PARAMETER) 
* 
*         *VERIFY 
*         *VFYLIB 
*            VERIFY *NEW* AGAINST *OLD* AFTER EDITING.
*            (EQUIVALENT TO *V* PARAMETER, USES *VFYLIB*.)
* 
*         */     TEXT 
*            COMMENT CARD, *TEXT* IS COPIED TO LISTING FILE.
* 
* 
* 
*         CARDS WITHOUT AN *** IN COLUMN 1 ARE TREATED AS A CONTINUATION
*         OF THE PREVIOUS CARD.  IF NO CARD PRECEEDS THIS CARD, 
*         (*BEFORE *,LIB/PN) IS ASSUMED.
          TITLE  TABLE STRUCTURE. 
**        TABLE STRUCTURE.
*         ALL TABLES ARE VARIABLE LENGTH, MANAGED TABLES.  POINTERS 
*         TO THE TABLE ABC ARE
*                P.ABC = FWA OF TABLE ABC.
*                L.ABC = LENGTH OF TABLE ABC. 
*                N.ABC = NUMBER OF WORDS/ENTRY. 
*                D.ABC = NUMBER OF WORDS THE LENGTH OF TABLE IS 
*         INCREASED IF TABLE IS FULL. 
* 
*         FNT - NAME TABLE. 
*                42/FILE,18/RANDOM
*                  1. FILE = FILE NAME LEFT JUSTIFIED 
*                  2. RANDOM = 0 IF FILE IS RANDOM. 
*                     RANDOM = CURRENT POSITION IF FILE IS NON RANDOM.
* 
*         PNT - PROGRAM NAME TABLE. 
* 
*                42/PROGRAM,18/TYPE 
*                42/FILE,18/0 
*                60/POSITION
*                  1. PROGRAM = PROGRAM NAME LEFT JUSTIFIED.
*                  2. TYPE = PROGRAM TYPE.
*                    0 = *TEXT* 
*                    1 = *PP* 
*                    3 = *REL* RELOCATABLE
*                    4 = *OVL* OVERLAY
*                    5 = *ULIB* USER LIBRARY
*                    6 = *OPL* OLD PROGRAM LIBRARY
*                    7 = *OPLC* OLD PROGRAM LIBRARY COMMON DECK 
*                    8 = *OPLD* OPL DIRECTORY 
*                    9 = *ABS* ABSOLUTE PROGRAM 
*                   10 = *PPU* 7600 PPU PROGRAM 
*                   14 = *CAP* FAST DYNAMIC LOAD CAPSULE
*                   16 = *PROC* PROCEDURE TYPE RECORD 
*                   20 = *PPL* 16-BIT PP PROGRAM
*                  3. FILE = CORRECTION FILE NAME.
*                  4. POSITION = RANDOM INDEX.
* 
*         DPT - DELETE PROGRAM TABLE. 
* 
*                42/PROGRAM1,6/IP,12/TYPE 
*                42/PROGRAM2,6/0,12/TYPE
*                  1. PROGRAM1 = START OF DELETE. 
*                  2. PROGRAM2 = END OF DELETE. 
*                  3. IP = 0, IF DELETE NOT IN PROGRESS.
*                        = 1, IF DELETE IN PROGRESS.
* 
*         IDT - IMPLIED DELETE TABLE. 
* 
*                42/PROGRAM, 18/TYPE
*                42/FILE,18/0 
*                  1. PROGRAM = PROGRAM DELETED IF PRESENT. 
*                  2. TYPE = PROGRAM TYPE.
*                  3. FILE = CORRECTION FILE NAME.
* 
*         PIT - PROGRAM IGNORE TABLE. 
* 
*                42/FILE,18/0 
*                42/PROGRAM1,18/TYPE1 
*                42/PROGRAM2,18/TYPE2 
*                  1. FILE = FILE NAME LEFT JUSTIFIED.
*                  2. PROGRAM1 = START OF IGNORE. 
*                  3. PROGRAM2 = END OF IGNORE. 
* 
* 
*         RFT - REWIND FILE TABLE.
* 
*                42/FILE,18/0 
*                  1. FILE = FILE NAME LEFT JUSTIFIED.
* 
* 
*         IPT - INSERT PROGRAM TABLE. 
* 
*                42/PROG1,1/BEFORE,17/TYPE1 
*                42/FILE,18/0 
*                42/PROG2,18/TYPE2
*                42/PROG3,18/TYPE3
*                  1. PROG1 = PROGRAM NAME ON FILE *OLD*. 
*                     PROG1 = LIBRARY NUMBER OF FILE *OLD*. 
*                  2. BEFORE = 0 IF INSERT AFTER PROG1. 
*                     BEFORE = 1 IF INSERT BEFORE PROG1.
*                  3. FILE = CORRECTION FILE NAME.
*                  4. PROG2 = PROGRAM NAME FOR START OF INSERT. 
*                  5. PROG3 = PROGRAM NAME FOR END OF INSERT. 
* 
* 
*         CDT - COMMENT AND DATE TABLE. 
* 
*                42/PROGRAM,1/DATE,17/TYPE
*                60/COMMENT TEXT
*                60/COMMENT TEXT
*                60/COMMENT TEXT
*                60/COMMENT TEXT
*                60/COMMENT TEXT
*                60/COMMENT TEXT
*                60/COMMENT TEXT
*                  1. PROGRAM = PROGRAM NAME ON FILE *NEW*. 
*                  2. DATE = 1 IF DATE IS INSERTED IN 7700 TABLE. 
*                  3. COMMENT TEXT = 70-CHARACTERS OF TEXT. 
* 
* 
*         NRT - NO REPLACE TABLE. 
* 
*                42/FILE,18/0 
*                  1. FILE = FILE NAME LEFT JUSTIFIED.
* 
* 
*         NPT - NEW PROGRAM TABLE.
* 
*                42/PROGRAM,18/TYPE 
*                60/POSITION
*                  1. PROGRAM = PROGRAM NAME. 
*                  2. TYPE = PROGRAM TYPE.
*                  3. POSITION = RANDOM FILE INDEX. 
* 
* 
*         RNT - RENAME TABLE. 
* 
*                42/PROG1,18/TYPE1
*                42/PROG2,18/TYPE2
*                  1. PROG1 = OLD PROGRAM NAME. 
*                  2. PROG2 = NEW PROGRAM NAME. 
          TITLE  MACRO DEFINITIONS. 
*         MACROS. 
  
*CALL     COMCMAC 
*CALL     COMCCMD 
*CALL     COMSSRT 
*CALL     COMSTCM 
          SPACE  4
**        CALL - SUBROUTINE CALL. 
*         THIS MACRO SETS UP A STANDARD CALLING SEQUENCE. 
*         CALL   SUB,P1,P2,P3,P4,P5,P6
*         ENTRY  SUB = SUBROUTINE NAME. 
*                PI = ADDRESS OF I-TH PARAMETER.
*         PARAMETER ADDRESSES ARE PASSED IN B-REGISTERS (AS IN FORTRAN) 
*         WITH THE FIRST PARAMETER ADDRESS IN B2, SECOND IN B3, ETC.
  
  
 CALL     MACRO  SUB,P1,P2,P3,P4,P5,P6
          IFC    NE,$P1$$,1 
          R=     B2,P1
          IFC    NE,$P2$$,1 
          R=     B3,P2
          IFC    NE,$P3$$,1 
          R=     B4,P3
          IFC    NE,$P4$$,1 
          R=     B5,P4
          IFC    NE,$P5$$,1 
          R=     B6,P5
          IFC    NE,$P6$$,1 
          R=     B7,P6
          ENDIF 
          RJ     SUB
          ENDM
          SPACE  4
**        ADDWRD - ADD WORD TO MANAGED TABLE. 
*         THIS MACRO SETS UP A CALL TO ADD AN ENTRY TO A MANAGED TABLE: 
*         ADDWRD TABLE,ENTRY
*         ENTRY  TABLE = NAME OF MANAGED TABLE. 
*                ENTRY = ADDRESS OF ENTRY.
  
  
 ADDWRD   MACRO  TABLE,ENTRY
          CALL   ADD,P.TABLE,ENTRY
          ENDM
          SPACE  4
**        TABLE - DEFINE MANAGED TABLE POINTERS.
*         MANAGED TABLES HAVE 4 POINTERS ASSOCIATED WITH THEM:  
*         (P.NAME) = FWA OF MANAGED TABLE.
*         (L.NAME) = LENGTH OF MANAGED TABLE. 
*         (N.NAME)  = NUMBER OF WORDS IN AN ENTRY.
*         (D.NAME) = NUMBER OF WORDS TABLE LENGTH IS INCREASED AT 
*                A TIME.
*         TABLE  NAME,WORD,DELTA
*         ENTRY  NAME = NAME OF TABLE.
*                WORD = NUMBER OF WORDS/ENTRY.
*                DELTA = SIZE OF TABLE INCREASE (NUMBER OF ENTRIES).
  
  
 TABLE    MACRO  NAME,WORD,DELTA
          LOCAL  NW,DW
 NW       SET    WORD   1 
 DW       SET    DELTA  4 
 P.NAME   VFD    42D/0L_NAME,18D/BUF
 L.NAME   VFD    60D/0
 N.NAME   VFD    60D/NW 
 D.NAME   VFD    60D/NW*DW
          ENDM
          SPACE  4
**        SEARCH - SEARCH FOR ENTRY IN MANAGED TABLE. 
*         THIS MACRO SETS UP A CALL TO SEARCH FOR AN ENTRY
*         IN A MANAGED TABLE
*         SEARCH TABLE,ENTRY,MASK,INDEX,RETURN
*         ENTRY TABLE = NAME OF MANAGED TABLE.
*                ENTRY = ADDRESS OF ENTRY.
*                MASK = ADDRESS OF SEARCH MASK. 
*                INDEX = INDEX INTO TABLE.
*                RETURN = ADDRESS OF RETURN PARAMETER.
  
  
 SEARCH   MACRO TABLE,ENTRY,MASK,INDEX,RETURN 
          SB2    P.TABLE
          SB3    ENTRY
          SB4    MASK   =77777777777777777777B
          SB5    INDEX  B0
          SB6    RETURN SMTA
          RJ     SMT
          ENDM
 READW    SPACE  4
**        READW - REDEFINE READ WORDS MACRO TO USE CONTROL WORDS. 
  
  
          PURGMAC READW 
  
 READW    MACRO F,S,N 
          R=     B6,S 
          R=     B7,N 
          R=     X2,F 
          RJ     RDA
          ENDM
 WRCW     SPACE  4
**        WRCW - WRITE WORKING STORAGE WITH CONTROL WORDS.
  
  
 WRCW     MACRO  F,S,N,E
          R=     B6,S 
          R=     B7,N 
          R=     X2,F 
          RJ     WDA
          IFC    NE,*E**,2
 +        NZ     B7,*+1 
 -        RJ     WDA
          ENDM
          TITLE 
**        LIBEDIT - LIBRARY EDITING PROGRAM.
* 
*         1. FILE INPUT IS READ TO DETERMINE DIRECTIVES.
*         2. ALL FILES WITH REWIND SELECTED ARE REWOUND.
*         3. ALL CORRECTION FILES ARE READ TO DETERMINE PROGRAM 
*         NAMES AND BUILD AN INDEX. 
*         4. CORRECTION FILES WITH REWIND SELECTED ARE REWOUND. 
*         5. FILE OLD IS READ.
*         6. INSERT BEFORE IS CHECKED.
*         7. IMPLIED DELETE IS CHECKED. 
*         8. REPLACEMENT IS CHECKED.
*         9. INSERT AFTER IS CHECKED. 
*         10. FILE NEW IS WRITTEN.
*         11. REPEAT STEPS 5.-11. 
*         12. COPY ADDED PROGRAMS ONTO *NEW*, IF APPLICABLE.
*         13. REWIND ALL FILES WITH REWIND SELECTED.
*         14. CALL *VFYLIB* IF VERIFY REQUESTED.
*         15. CALL *LIBGEN* IF USER LIBRARY REQUESTED.
  
  
          ORG    104B 
  
 LIBEDIT  BSS    0           ENTRY
          SB1    1           (B1) = CONSTANT ONE
          RJ     PRS         PRESET 
          RJ     RDC         READ DIRECTIVES
          CALL   RWF         REWIND ALL FILES 
          CALL   RCF         READ ALL CORRECTION FILES
          CALL   RWS         REWIND SEQUENTIAL CORRECTION FILES 
          CALL   BID         BUILD IMPLIED DELETE TABLE 
          SA2    CCPY 
          SA1    P           SET *OLD* IN HEADER
          NZ     X2,LIB0     IF *C* OPTION
          SA2    CULB 
          SA1    N           SET *NEW* IN HEADER
          ZR     X2,LIB0     IF NO *U* OPTION 
          SA1    GULF        SET *NEW* IN HEADER
 LIB0     MX0    42 
          BX6    X0*X1
          SA6    LIBF+3 
          SB6    B0+
          CALL   STB,LIBF    SET TITLE OF PAGE
          SB6    B1 
          CALL   STB,LIBG 
          WRITECW N,*        SET FILE STATUS
          SA4    N+4
          AX4    18 
          SX6    X4          SET SECTOR WORD COUNT
          SA1    OLD
          SA6    N-1
          ZR     X1,LIB19    IF NO FILE *OLD* 
          OPEN   A1,READNR,R
          SA1    P+1         CHECK DEVICE TYPE
          RJ     CVD
          ZR     X7,IDT      IF INCORRECT DEVICE
          READCW P,17B
 LIB1     READW  P,WSA,WSAL 
          BX6    X1          SET EOR INDICATOR
          SA6    LIBA 
          PL     X1,LIB2     IF NOT EOF ON FILE *OLD* 
          SB5    WSA
          EQ     B5,B6,LIB19 IF NO DATA READ
          EQ     LIB2.1      PROCESS DATA 
  
 LIB2     SA1    LIBA        CHECK EOR INDICATOR
          NG     X1,LIB19    IF EOF ON FILE OLD 
 LIB2.1   SB6    WSA
          SB7    X1+
          EQ     B6,B7,LIB17 IF 0-LENGTH RECORD 
          SA1    P-LWP       LWA+1 OF DATA TRANSFERED FROM OLD FILE 
          SX2    WSA
          RJ     SRT         SET RECORD TYPE
          SA6    LIBB 
          SA6    LIBH 
          MX0    -18         CREATE -TYPE/*- PSEUDO-ENTRY 
          SX7    1R*
          BX6    -X0*X6      EXTRACT RECORD TYPE
          LX7    54 
          BX7    X7+X6       MERGE TYPE AND -*- 
          SA7    LIBB+2 
          SX3    X6-ODRT
          SA2    CULB 
          BX4    X3+X2
          ZR     X4,LIB19    IF OPLD AND NOT *ULIB* MODE
          ZR     X2,LIB2.3   IF NOT *ULIB* MODE 
          SA1    LIBA 
          ZR     X3,LIB2.2   IF OPLD
          SX4    X6-ULRT
          NZ     X4,LIB2.3   IF NOT *ULIB* RECORD 
 LIB2.2   NZ     X1,LIB1     IF END OF RECORD 
          READW  P,WSA,WSAL 
          EQ     LIB2.2      SKIP RECORD
  
*         CHECK INSERT BEFORE.
  
 LIB2.3   SA1    LIBB        SET SEARCH NAME
          MX6    1
          LX6    18 
          BX6    X6+X1
          SA6    A1+B1
 LIB3     SEARCH IPT,(LIBB+1) 
          ZR     X6,LIB4     IF NO MORE INSERT BEFORE 
          SA1    P.IPT       SET IPT INDEX
          SX1    X1 
          IX6    X6-X1
  
*         INSERT PROGRAMS BEFORE SPECIFIED PROGRAM. 
  
          CALL   CPP,X6 
          EQ     LIB3        CHECK FOR ANOTHER INSERT 
  
*         CHECK FOR DELETE. 
  
 LIB4     SEARCH DPT,LIBN,LIBP  SEARCH FOR DELETE IN PROGRESS 
          NZ     X6,LIB6     IF DELETE IN PROGRESS
          SEARCH DPT,LIBB 
          NZ     X6,LIB5     IF START OF DELETE 
          SEARCH DPT,LIBB+2  CHECK FOR -TYPE/*- 
          SX7    X6 
          BX6    X6-X6
          NZ     X7,LIB6     IF DELETING ALL OF THIS TYPE 
          SEARCH IDT,LIBB 
          ZR     X6,LIB9     IF PROGRAM IS NOT INSERTED 
          SX6    B0 
          EQ     LIB6        ISSUE OUTPUT MESSAGE 
  
 LIB5     SA1    X6+B1       CHECK FOR /*DELETE NAME-*/ FORM
          SA2    LIBB+2 
          BX7    X1-X2
          NZ     X7,LIB5.1   IF NORMAL DELETE RANGE 
          BX7    X1 
          SA7    X6          UPDATE *DPT* 
          BX6    X6-X6
          EQ     LIB6        CONTINUE PROCESSING
  
 LIB5.1   SA1    LIBP        SET START OF DELETE
          SA2    X6 
          BX7    -X1*X2 
          SA3    LIBN 
          BX7    X3+X7
          SA7    X6 
 LIB6     SA6    LIBC        SET DPT ADDRESS
          CALL   ODP,LIBB    OUTPUT DELETED PROGRAM 
  
*         SKIP RECORD FROM FILE *OLD*.
  
          CALL   DIS,LIBB,(=H*SKIPPING  *)
          SA1    LIBA 
 LIB7     NZ     X1,LIB8     IF EOR OR EOF
          READW  OLD,WSA,WSAL 
          EQ     LIB7        LOOP TO END OF RECORD
 LIB8     CALL   SUL,LIBB,LIBA
          SA1    LIBC        CHECK FOR END OF DELETE
          ZR     X1,LIB16    IF IMPLIED DELETE
          SA2    X1+B1
          SA3    LIBB 
          BX6    X2-X3
          NZ     X6,LIB16    IF NOT END OF DELETE 
          SX6    7777B       DELETE FLAG
          SA6    X1          CLEAR DPT ENTRY
          SA6    X1+B1
          EQ     LIB16       CHECK INSERT AFTER 
  
*         CHECK FOR REPLACEMENT.
  
 LIB9     SEARCH PNT,LIBB 
          ZR     X6,LIB12    IF NO REPLACEMENT
          SA1    P.PNT
          SX1    X1 
          IX6    X6-X1
          SA6    LIBE 
          CALL   CNR,X6      CHECK FOR NO REPLACE 
          NZ     X6,LIB9     IF NO REPLACE
          CALL   DIS,LIBB,(=H*REPLACING *)
          SA1    LIBE 
          CALL   CPY,X1      COPY REPLACEMENT RECORD
          CALL   ORW,(=8HREPLACED),LGO
          SA1    LIBA 
          NZ     X1,LIB11    IF EOR ON PREVIOUS READ
 LIB10    READW  OLD,WSA,WSAL SKIP RECORD ON *OLD*
 LIB11    ZR     X1,LIB10    IF NOT EOR 
          CALL   SUL,LIBB,LIBA
          EQ     LIB16       CHECK INSERT AFTER 
  
*         COPY FROM *OLD* TO *NEW*. 
  
 LIB12    CALL   DIS,LIBB,(=H*COPYING  *) 
          CALL   CCM,WSA,LIBB 
          SB6    X6 
          SA1    LIBA        CHECK FOR EOR
          NZ     X1,LIB14    IF EOR/EOF/EOI 
 LIB13    SB7    WSA+WSAL 
          WRCW   N,B6,B7-B6 
          READW  OLD,WSA,WSAL 
          SB6    WSA
          ZR     X1,LIB13    IF NOT EOR/EOF/EOI 
 LIB14    SA1    P-LWP       LWA + 1 OF DATA TRANSFERED 
          SB7    X1 
          WRCW   N,B6,B7-B6,R WRITE LAST PORTION OF RECORD
          SA1    N-2
          NG     X1,LIB15    IF *WRITECW* NOT DISABLED
          RJ     RCW
  
 LIB15    ADDWRD NPT,NIND 
          CALL   ORW,(=1H ),OLD 
          CALL   CPL,LIBB,LIBA
  
*         CHECK INSERT AFTER. 
  
 LIB16    SEARCH IPT,LIBB 
          ZR     X6,LIB2     IF NO INSERT 
          SA1    P.IPT       SET IPT INDEX
          SX1    X1 
          IX6    X6-X1
  
*         INSERT PROGRAMS AFTER SPECIFIED PROGRAM.
  
          CALL   CPP,X6 
          EQ     LIB16       LOOP 
  
*         PROCESS ZERO LENGTH RECORD. 
  
 LIB17    SEARCH IPT,LIBI 
          ZR     X6,LIB18    IF NO ADD
          SA1    P.IPT       SET IPT INDEX
          SX1    X1 
          IX6    X6-X1
          CALL   CPP,X6 
          EQ     LIB17       LOOP 
  
 LIB18    SB2    =0          ENTER ZERO LENGTH RECORD NAME AND TYPE 
          RJ     EPN
          ADDWRD NPT,NIND 
          WRCW   N,B0,B0     WRITE ZERO LENGTH RECORD 
          SA1    LIBI        INCREMENT LIBRARY NUMBER 
          SX6    B1 
          LX6    42 
          IX6    X6+X1
          SA6    A1 
          CALL   OZR,(=1H ),OLD,(=2H00) 
          JP     LIB1        READ NEXT RECORD 
  
*         CHECK INSERT BEFORE EOF.
  
 LIB19    SEARCH IPT,LIBD,(=77777777777777400000B)
          ZR     X6,LIB20    IF NO INSERT 
          SA1    P.IPT       SET IPT INDEX
          SX1    X1 
          IX6    X6-X1
  
*         INSERT PROGRAM(S) BEFORE EOF. 
  
          CALL   CPP,X6 
          EQ     LIB19       CHECK FOR ANOTHER INSERT 
  
*         PROCESS EOF ON FILE OLD.
  
 LIB20    RJ     CAP         COPY ADDED PROGRAMS
          SB2    LIBH 
          SA1    LIBA        GET EOR INDICATOR
          RJ     WPD         WRITE PROGRAM DIRECTORY
          CALL   RWF         REWIND FILES 
          CALL   CRR         CHECK RECORDS REPLACED 
          CALL   CNO         COPY NEW TO OLD
          MESSAGE (=C* EDITING COMPLETE.*),,R 
          RETURN S           RETURN SCRATCH FILE
          SA1    OUTPUT+2    CLOSE OUT FILE *OUTPUT*
          SA2    A1+B1
          BX6    X1-X2
          ZR     X6,LIB21    IF NO OUTPUT 
          WRITER OUTPUT,R 
 LIB21    RJ     GUL         GENERATE USER LIBRARY
          RJ     VFY         VERIFY *OLD* AND *NEW* 
          ENDRUN
  
  
 LIBA     DATA   0           EOR INDICATOR
 LIBB     DATA   0           PROGRAM NAME 
          DATA   0           PROGRAM NAME WITH INSERT BEFORE SET
          BSSZ   1           TYPE/* PSUEDO-ENTRY
 LIBC     DATA   0           ADDRESS OF DPT ENTRY 
 LIBD     VFD    42/1L*,1/1,17/ 
 LIBE     DATA   0           PROGRAM NAME TABLE INDEX 
 LIBF     DATA   C*      RECORDS WRITTEN ON FILE XXX* 
 LIBG     DATA   H*          RECORD    TYPE      FILE      *
          DATA   C* DATE      COMMENT*
 LIBH     DATA   0           OPL DIRECTORY NAME 
 LIBI     DATA   1S42        LIBRARY NUMBER 
 LIBN     VFD    42/0,6/1,12/0  DELETE IN PROGRESS FLAG 
 LIBP     VFD    42/0,6/77B,12/0  DELETE IN PROGRESS MASK 
          TITLE  DIRECTIVE CARD PROCESSING. 
**        RDC - READ DIRECTIVES.
  
  
 RDC      SUBR               ENTRY/EXIT 
          SA1    INPUT       CHECK FOR NO INPUT FILE
          SA2    CZOP        CHECK FOR *Z* OPTION 
          NZ     X2,RDC1     IF *Z* OPTION SELECTED 
          ZR     X1,RDC12    IF NO INPUT FILE 
          SA1    TTYI 
          NZ     X1,RDC0.1   IF NOT TTY INPUT 
          WRITEC TTYOUT,(=C*ENTER DIRECTIVES -*)
 RDC0.1   READ   I
 RDC1     READH  I,DCB,DCBL 
          SB2    DCB         UNPACK DIRECTIVE COMMAND BUFFER
          SB3    DCB+DCBL 
          SB4    DSB
          MX0    54 
          NZ     X1,RDC12    IF END-OF-RECORD 
 RDC2     SB5    B4+10
          SA1    B2 
 RDC3     LX1    6
          BX6    -X0*X1 
          SA6    B4 
          SB4    B4+B1
          NE     B4,B5,RDC3  LOOP FOR 10 CHARACTERS 
          SB2    B2+B1
          SX6    B0 
          NE     B2,B3,RDC2  LOOP FOR END OF BUFFER 
          SB4    DSB         SUPPRESS TRAILING BLANKS 
 RDC4     SA6    B5 
          EQ     B4,B5,RDC5  IF START OF BUFFER 
          SB5    B5-B1
          SA1    B5 
          SX6    X1-1R
          ZR     X6,RDC4     IF CHARACTER IS * *
  
*         ASSEMBLE DIRECTIVE AND GO TO DIRECTIVE PROCESSOR. 
  
 RDC5     SX6    DSB         SET COLUMN POINTER AT COLUMN 1 
          SA6    RDCA 
          SA1    X6          CHECK COLUMN 1 
          SA3    A1+B1       CHECK COLUMN 2 
          SX2    X1-1R* 
          NZ     X2,RDC11    IF NOT *** IN COLUMN 1 
          SX6    X3-1R/ 
          ZR     X6,LST      IF COMMENT TEXT
          CALL   AFN,RDCA,RDCB
          SA1    RDCA        IGNORE TRAILING BLANKS 
          SA2    X1 
 +        SA2    A2+B1
          SX6    X2-1R
          ZR     X6,*-1      LOOP 
          SX6    A2-B1
          SA6    B2 
          SA1    RDCC        SEARCH FOR LEGAL DIRECTIVE 
          SA2    RDCB 
 RDC6     ZR     X1,RDC14    IF DIRECTIVE INCORRECT 
          MX0    42 
          BX6    X1-X2
          BX6    X0*X6
          SX7    X1 
          LX7    30 
          SA1    A1+B1
          NZ     X6,RDC6     LOOP 
          SA7    SDA         SET DIRECTIVE ADDRESS
          LX7    30 
          SX6    X7+COPY
          ZR     X6,COPY     IF *COPY DIRECTIVE 
          SX6    X7+DEBUG 
          ZR     X6,DEBUG    IF *DEBUG DIRECTIVE
          SX6    X7+VFYLIB
          ZR     X6,VFYLIB   IF *VFYLIB DIRECTIVE 
          SX6    X7+LSTDR 
          ZR     X6,LSTDR    IF *LIST DIRECTIVE 
          SX6    X7+NOREW 
          ZR     X6,NOREW    IF *NOREW DIRECTIVE
          SX6    X7+NOINS 
          ZR     X6,NOINS    IF *NOINS DIRECTIVE
          SX6    X7+LIBGEN
          ZR     X6,LIBGEN   IF *LIBGEN DIRECTIVE 
  
**        PROCESS DIRECTIVE.
  
 RDC7     SA1    RDCA        CHECK SERARATOR CHARACTER
          SA2    X1 
          SB5    X2+B1
          SA1    =20000000000005000000B 
          LX7    X1,B5
          NG     X7,ERR9     IF CHARACTER = EOL */* *-* 
          SA3    SDA
 RDC8     PL     X3,RDC9     IF LIBRARY/PROGRAM TO BE ASSEMBLED 
          CALL   AFN,RDCA,RDCD
          SA3    SDA
          BX3    -X3
          AX3    30 
          SB7    X3 
          EQ     RDC10       CHECK FILE NAME
  
 RDC9     CALL   APN,RDCA,RDCD
          SA3    SDA
          AX3    30 
          SB7    X3 
 RDC10    MX0    42          CHECK FILE NAME
          SA1    RDCD 
          BX1    X0*X1
          SX7    =C* REQUIRED PARAMETER(S) NOT SPECIFIED.*
          ZR     X1,ERR      IF FILE NAME = 0 
          SA1    RDCA 
          SA2    X1+         (X2) = CHARACTER 
          SB5    X2-1R,      (B5) = CHARACTER - *,* 
          JP     B7          GO TO DIRECTIVE PROCESSOR. 
  
*         PROCESS DIRECTIVE CONTINUATION. 
  
 RDC11    SX6    DSB-1       SET STRING BUFFER POINTER
          SA6    RDCA 
          SA3    SDA
          EQ     RDC8        CHECK DIRECTIVE FORMAT 
  
*         END OF DIRECTIVES. CHECK FOR ERRORS.
  
 RDC12    RETURN TTYOUT 
          RJ     SUM         SET *ULIB* MODE
          SA1    TTYI 
          SA2    RDCF 
          ZR     X1,RDCX     IF TTY INPUT 
          ZR     X2,RDCX     IF NO DIRECTIVE ERRORS 
          MESSAGE  (=C* DIRECTIVE ERRORS.*),3 
          SA1    CDOP 
          NZ     X1,RDCX     IF DEBUG OPTION ON 
          RJ     ABT         ABORT
  
 RDC14    SX7    =C* UNRECOGNIZED KEYWORD IN DIRECTIVE.*
          EQ     ERR         LIST ERROR MESSAGE 
          SPACE  4
**        SET NEW DIRECTIVE ADDRESS.
*         RJ  SDA  TO SET NEW ADDRESS.  LIBRARY/PROGRAM WILL
*         BE ASSEMBLED. 
  
  
 SDA      EQ     INS5        PROCESS NEXT FIELD 
          SPACE  4
**        RET - RETURN FOR PROCESSING DUPLICATE FIELD.
  
  
 RET      SA1    RDCA        CHECK SEPARATOR CHARACTER
          SA2    X1 
          ZR     X2,LST      IF END-OF-LINE 
          SB5    X2-1R
          ZR     B5,LST      IF CHARACTER = * * 
          EQ     RDC7        IF MORE PARAMETERS 
  
 RDCA     VFD    60/DSB      DIRECTIVE STRING BUFFER POINTER
 RDCB     DATA   0           DIRECTIVE
  
 RDCC     VFD    42/0LAFTER,18/INSERT 
          VFD    42/0LA,18/INSERT 
          VFD    42/0LADD,18/-ADP 
          VFD    42/0LBEFORE,18/BEFORE
          VFD    42/0LB,18/BEFORE 
          VFD    42/0LBUILD,18/BUILD
          VFD    42/0LCOMMENT,18/COMMENT
          VFD    42/0LCOPY,18/-COPY 
          VFD    42/0LDATE,18/DATE
          VFD    42/0LDEBUG,18/-DEBUG 
          VFD    42/0LDELETE,18/DELETE
          VFD    42/0LD,18/DELETE 
          VFD    42/0LFILE,18/-FILE 
          VFD    42/0LIGNORE,18/IGNORE
          VFD    42/0LINSERT,18/INSERT
          VFD    42/0LI,18/INSERT 
          VFD    42/0LLIBGEN,18/-LIBGEN 
          VFD    42/0LLIST,18/-LSTDR
          VFD    42/0LLGO,18/-FILE
          VFD    42/0LNAME,18/-NAME 
          VFD    42/0LNEW,18/-NEWF
          VFD    42/0LNOINS,18/-NOINS 
          VFD    42/0LNOREP,18/-NOREP 
          VFD    42/0LNOREW,18/-NOREW 
          VFD    42/0LOLD,18/-OLDF
          VFD    42/0LRENAME,18/RENAME
          VFD    42/0LREPLACE,18/REPLACE
          VFD    42/0LREWIND,18/-REWIND 
          VFD    42/0LTYPE,18/-NAME 
          VFD    42/0LVERIFY,18/-VFYLIB 
          VFD    42/0LVFYLIB,18/-VFYLIB 
          VFD    60/0 
  
 RDCD     DATA   0           ASSEMBLED NAME 
 RDCE     DATA   0LTEXT      DEFAULT RECORD TYPE
 RDCF     DATA   0           DIRECTIVE ERROR COUNT
          SPACE  4
**        ERR - ERROR DETECTED IN DIRECTIVE SCAN. 
* 
*         ENTRY  (X7) = 0  IF NO EXTRA ERROR MESSAGE TO BE ISSUED.
*                (X7) = ADDRESS OF EXPLANATORY ERROR MESSAGE. 
  
  
 ERR      SA1    TTYI 
          SA7    ERRB        SAVE ERROR MESSAGE ADDRESS 
          ZR     X1,ERR2     IF TTY INPUT 
          SA1    =10H  ERROR* 
          BX6    X1 
          SA6    OUTPUTB
          CALL   LOL         LIST ONE LINE
          WRITEC OUTPUT,(=C* *) 
          SA1    RDCF        INCREMENT ERROR COUNT
          SX6    X1+B1
          SA6    A1 
          SA1    ERRB 
 ERR1     ZR     X1,RDC1     IF NO ERROR MESSAGE TO BE ISSUED 
          WRITEC OUTPUT,X1
          EQ     RDC1        READ NEXT DIRECTIVE
  
 ERR2     SX2    1R          BLANK FILL LINE
          SB6    OUTPUTB+1
          SB7    OUTPUTB+DCBL+1 
          SA1    B6 
          MX0    54 
 ERR3     BX6    X1 
          SA6    A1 
          EQ     B6,B7,ERR5  IF END OF LINE 
          SA1    B6 
          SB6    B6+B1
          SB5    10D
 ERR4     ZR     B5,ERR3     IF END OF WORD 
          LX0    6
          LX2    6
          BX6    -X0*X1 
          SB5    B5-B1
          NZ     X6,ERR4     IF CHARACTER .NE. 00 
          BX1    X1+X2
          EQ     ERR4        LOOP 
  
 ERR5     WRITEW TTYOUT,ERRA,ERRAL
          WRITEH TTYOUT,OUTPUTB+1,DCBL
          SA1    ERRB 
          ZR     X1,ERR1     IF NO EXPLANATORY MESSAGE
          WRITEC TTYOUT,X1
          WRITEC TTYOUT,ERRC
          SA1    TTYO 
          ZR     X1,RDC1     IF TTY OUTPUT
          SA1    ERRB 
          EQ     ERR1        ISSUE EXPLANATION
  
 ERR9     SX7    =C* -- UNRECOGNIZED SEPARATOR CHARACTER.*
          EQ     ERR         ISSUE ERROR MESSAGE
  
  
 ERRA     DATA   22HINCORRECT DIRECTIVE - 
 ERRAL    EQU    *-ERRA 
  
 ERRB     CON    0
 ERRC     DATA   C*   (CORRECTED DIRECTIVE MAY BE RE-ENTERED...)* 
          SPACE  4
**        LST - LIST DIRECTIVE. 
* 
*         USES   A - 1, 6.
*                X - 1, 2, 6. 
  
  
 LST      SA1    =10H 
          BX6    X1 
          SA6    OUTPUTB
          SA1    LIST 
          SX2    4B 
          BX1    X1*X2
          ZR     X1,RDC1     IF DIRECTIVE LIST OPTION OFF 
          CALL   LOL         LIST ONE LINE
          EQ     RDC1        LOOP TO READ NEXT DIRECTIVE
          SPACE  4
**        *ADD   LIB,LIB1/PN1 
* 
*         ADD PROGRAM(S) AT END OF SPECIFIED LIBRARY. 
*         ENTRY  (X2) = SEPARATOR CHARACTER.
  
  
 ADP      SA1    RDCD        CHECK LIBRARY NAME 
          SA3    ADPA 
          MX0    42 
 ADP1     BX3    X3-X1
          BX6    -X0*X3 
          ZR     X6,ADP3     IF NO MATCH ON LIBRARY NAME
          BX7    X0*X3
          SA3    A3+B1
          NZ     X7,ADP1     IF NOT FOUND 
 ADP2     LX6    42          SET LIBRARY NUMBER 
          SA6    A1 
          EQ     INSERT      PROCESS INSERT 
  
 ADP3     MX0    18 
          BX7    X0*X3
          NZ     X7,ADP4     IF NOT *LIBN..N* 
          BX5    -X0*X1 
          LX5    18 
          SB7    B1+         SET DECIMAL BASE 
          RJ     DXB         CONVERT DECIMAL TO BINARY
          SA2    RDCA        RESTORE SEPARATOR CHARACTER
          SA2    X2+         (X2) = CHARACTER 
          ZR     X4,ADP2     IF CORRECT CONVERSION
 ADP4     SX7    =C* UNRECOGNIZED LIBRARY NAME.*
          EQ     ERR         ISSUE ERROR MESSAGE
  
  
 ADPA     BSS    0
          CON    0LDDS+1
          CON    0LIDS+2
          CON    0LMOV+3
          CON    0LRPL+4
          CON    0LRSL+5
          CON    0LSLD+6
 ADPB     CON    0LLIB
          SPACE  4
**        *BEFORE   LIB1/PN1,LIB2/PN2-LIB3/PN3,LIB4/PN4 
* 
*         INSERT PROGRAM(S) BEFORE SPECIFIED PROGRAM. 
*         ENTRY  (X2) = SEPARATOR CHARACTER.
  
  
 BEFORE   MX6    1           SET INSERT BEFORE FLAG 
          LX6    18 
          EQ     INS1 
          SPACE  4
**        *BUILD    PN
* 
*         BUILD A DIRECTORY OF FILE *NEW* WITH NAME *PN*. 
  
  
 BUILD    SA1    RDCD 
          BX6    X1 
          SA6    NPLN 
          EQ     LST
          SPACE  4
**        *COMMENT   LIB/PN COMMENT 
* 
*         ADD A 70-CHARACTER COMMENT TO THE 7700 TABLE OF THE 
*         SPECIFIED RECORD. 
  
  
 COMMENT  SX6    B0 
 COM1     SA1    RDCD        SET PROGRAM NAME 
          SB5    X2-1R       CHECK SEPARATOR
          ZR     B5,COM2     IF CHARACTER = * * 
          SB5    X2-1R, 
          ZR     B5,COM2     IF CHARACTER = *,* 
          NZ     X2,ERR9     IF NOT EOL 
 COM2     BX6    X6+X1
          SA1    RDCA 
          SA2    X1+B1
          SA6    COMA 
          SB2    COMA 
          SB3    COMA+7 
 COM3     SX6    B0          ASSEMBLE COMMENT 
          SB7    60 
          SB2    B2+B1
 COM4     SB7    B7-6 
          LX6    6
          BX6    X6+X2
          ZR     X2,COM6     IF END-OF-LINE 
          LX6    6
          SA2    A2+B1
          SB7    B7-6 
          NZ     X2,COM5     IF NOT END-OF-LINE 
          SX2    1R 
 COM5     BX6    X6+X2
          SA2    A2+B1
          NZ     B7,COM4     LOOP FOR 1 WORD
 COM6     LX6    X6,B7       STORE 10-CHARACTERS OF COMMENT 
          SA6    B2 
          NE     B2,B3,COM3  LOOP FOR 7 WORDS 
          ADDWRD CDT,COMA 
          EQ     LST         LIST DIRECTIVE 
  
 COMA     VFD    42/,1/,17/  42/PROGRAM,1/DATE,17/TYPE
          DATA   0           420/COMMENT
          DATA   0
          DATA   0
          DATA   0
          DATA   0
          DATA   0
          DATA   0
          SPACE  4
**        *COPY 
* 
*         COPY FILE *NEW* TO FILE *OLD* AFTER EDITING.
  
  
 COPY     SX6    B1          SET COPY FLAG
          SA6    CCPY 
          EQ     LST
          SPACE  4
**        *DATE     LIB/PN COMMENT
* 
*         ADD A 70-CHARACTER COMMENT AND THE DATE TO THE 7700 
*         TABLE OF THE SPECIFIED PROGRAM. 
  
  
 DATE     MX6    1           SET DATE FLAG
          LX6    18 
          EQ     COM1        GO ASSEMBLE COMMENT
 DEBUG    SPACE  4,10 
**        *DEBUG
* 
*         IGNORE SUBSEQUENT DIRECTIVE ERRORS. 
  
  
 DEBUG    SX6    B1+         SET DEBUG FLAG 
          SA6    CDOP 
          EQ     LST         LIST DIRECTIVE 
          SPACE  4
**        *DELETE   LIB1/PN1,LIB2/PN2-LIB3/PN3
* 
*         DELETE SELECTED PROGRAM(S) FROM FILE *OLD*. 
*         ENTRY  (X2) = SEPARATOR CHARACTER.
  
  
 DELETE   SB5    X2-1R- 
          SA1    RDCD        SET DELETE START AND STOP
          BX6    X1 
          SA6    DELA 
          SA6    A6+B1
          NZ     B5,DEL1     IF NO CONTINUATION FIELD 
  
*         ASSEMBLE SECOND FIELD 
  
          CALL   APN,RDCA,(DELA+1)
 DEL1     ADDWRD DPT,DELA 
          EQ     RET         RETURN 
  
  
 DELA     VFD    42/,6/,12/  42/PROGRAM,6/IP,12/TYPE
          VFD    42/,6/,12/  42/PROGRAM,6/0,12/TYPE 
          SPACE  4
**        *FILE  FN,FN,FN 
* 
*         DECLARE ADDITIONAL CORRECTION FILES.
  
  
 FILE     SA1    RDCD 
          BX6    X1 
          SA6    LGO. 
          SEARCH FNT,RDCD,FILA
          NZ     X6,RET      IF FILE IN FNT 
          ADDWRD FNT,RDCD 
          EQ     RET         RETURN 
  
  
 FILA     DATA   77777777777777000000B
          SPACE  4
**        *IGNORE   LIB/PN
*         *IGNORE   LIB1/PN1-LIB2/PN2 
* 
*         IGNORE PROGRAM(S) WHEN CORRECTION FILE IS READ. 
*         ENTRY  (X2) = SEPARATOR CHARACTER.
  
  
 IGNORE   SA1    LGO.        SET CORRECTION FILE NAME 
          SA3    RDCD        SET PROGRAM NAME 
          BX6    X1 
          LX7    X3 
          SA6    IGNA 
          SA7    A6+B1
          SA7    A7+B1
          SB5    X2-1R-      CHECK FOR CONTINUATION FIELD 
          NZ     B5,IGN1     IF NO CONTINUATION FIELD 
  
*         ASSEMBLE SECOND FIELD.
  
          CALL   APN,RDCA,(IGNA+2)
 IGN1     ADDWRD PIT,IGNA 
          EQ     RET         RETURN 
  
  
 IGNA     VFD    42/,18/     42/FILE,18/
          VFD    42/,18/     42/PROGRAM,18/TYPE 
          VFD    42/,18/     42/PROGRAM,18/TYPE 
          SPACE  4
**        *INSERT   LIB1/PN1,LIB2/PN2,LIB3/PN3
* 
*         INSERT PROGRAMS AFTER SPECIFIED PROGRAM.
*         ENTRY  (X2) = SEPARATOR CHARACTER.
  
 INSERT   SX6    B0          SET INSERT AFTER FLAG
 INS1     SB5    X2-1R, 
          ZR     B5,INS2     IF SEPARATOR = *,* 
          SB5    X2-1R
          NZ     B5,ERR9     IF SEPARATOR NOT * * OR *,*
 INS2     SA1    RDCA        CHECK FOR SECOND FIELD 
          SA3    X1+1 
          SX7    =C* RECORD(S) TO BE INSERTED NOT SPECIFIED.* 
          ZR     X3,ERR      IF NO SECOND FIELD 
          SA3    RDCD        SET INSERT POINT 
          BX6    X6+X3
          SA6    INSA 
  
*         ASSEMBLE PROGRAM NAME OF START. 
  
          CALL   APN,RDCA,(INSA+2)
 INS3     SB5    X2-1R- 
          SA1    INSA+2 
          SA4    LGO.        SET FILE NAME
          LX7    X4 
          SA7    A1-B1
          BX6    X1 
          SA6    A1+B1
          NZ     B5,INS4     IF NO CONTINUATION FIELD 
  
*         PROCESS CONTINUATION FIELD
  
          CALL   APN,RDCA,(INSA+3)
 INS4     ADDWRD IPT,INSA 
          RJ     SDA         SET DIRECTIVE ADDRESS AND READ NEXT FIELD
  
*         PROCESS NEXT FIELD. 
  
 INS5     SA3    RDCD 
          BX6    X3 
          SA6    INSA+2 
          EQ     INS3        LOOP TO END OF CARD
  
  
 INSA     VFD    42/1L*,1/1,17/   42/PROG1,1/BEFORE,17/TYPE1
          VFD    42/,18/     42/FILE,18/
          VFD    42/,18/     42/PROG2,18/TYPE2
          VFD    42/,18/     42/PROG3,18/TYPE3
 LIBGEN   SPACE  4,10 
**        *LIBGEN  UN 
* 
*         SET *ULIB* MODE, CALLING *LIBGEN* AFTER EDITING 
*         TO GENERATE A USER LIBRARY *UN* ON FILE *NEW*.
*         IF *UN* IS OMITTED, *UN* = *ULIB* IS USED.
  
  
 LIBGEN   SA1    RDCA 
          SA2    X1+
          ZR     X2,LIBG2    IF EOL 
          SB5    X2+1 
          SA2    =20000000000005000000B 
          LX7    X2,B5
          NG     X7,ERR9     IF ERROR 
          SB2    RDCA 
          SB3    RDCD 
          RJ     AFN         ASSEMBLE *UN* NAME 
          SA1    RDCD 
          MX0    42 
          BX6    X0*X1
          ZR     X1,LIBG2    IF NULL *UN* NAME
 LIBG1    SA6    CULB 
          EQ     LST         LIST DIRECTIVE 
 LIBG2    SA1    LIBGA
          BX6    X1 
          EQ     LIBG1       LIST DIRECTIVE 
  
  
 LIBGA    VFD    24/4LULIB,36/0  DEFAULT USER LIBRARY NAME
 LSTDR    SPACE  4,10 
**        *LIST  LFN,OPT
* 
*         DECLARE LISTING FILE AND LIST OPTIONS.
  
  
 LSTDR    SA1    RDCA        CHECK SEPARATOR CHARACTER
          SA2    X1 
          SB5    X2+B1
          SA2    =20000000000005000000B 
          LX7    X2,B5
          NG     X7,ERR9     IF ERROR 
          SB2    RDCA 
          SB3    RDCD 
          RJ     AFN         ASSEMBLE LIST FILE NAME
          MX0    42 
          SA1    RDCD 
          BX6    X1*X0
          ZR     X6,LSTDR1   IF FILE NAME NULL
          SA1    FLST+/FLST/OUTPUT
          RJ     RFN         REPLACE FILE NAME
 LSTDR1   SA1    RDCA 
          SA2    X1+
          ZR     X2,LST      IF EOL 
          SB2    RDCA 
          SB3    RDCD 
          RJ     AFN         ASSEMBLE LIST OPTIONS
          SA2    RDCD 
          SA1    LIST 
          MX0    42 
          BX1    X2*X0
          ZR     X1,LST      IF LIST OPTIONS NULL 
          RJ     ILO         INTERPRET LIST OPTIONS 
          SX7    =C* UNRECOGNIZED LIST OPTION(S).*
          NZ     X1,ERR      IF ERRORS
          EQ     LST         LIST DIRECTIVE 
          SPACE  4
**        *NAME     LIB 
* 
*         SET DEFAULT LIBRARY NAME. 
  
  
 NAME     SA1    RDCD        CHECK LIBRARY NAME 
          SA2    NAMA 
 NAM1     ZR     X2,NAM2     IF INCORRECT LIBRARY 
          BX6    X1-X2
          SA2    A2+B1
          NZ     X6,NAM1     IF NOT FOUND 
          BX6    X1 
          SA6    RDCE 
          EQ     LST         LIST LINE
  
 NAM2     SX7    =C* UNRECOGNIZED RECORD TYPE.* 
          EQ     ERR         ISSUE ERROR MESSAGE
  
  
 NAMA     BSS    0
 .E       ECHO   ,RT=("RTMIC")
 .A       IFC    NE,/RT// 
          DATA   L/RT/
 .A       ELSE
          DATA   1
 .A       ENDIF 
 .E       ENDD
          DATA   0
 NEWF     SPACE  4,10 
**        *NEW   FN 
* 
*         CHANGE/SPECIFY NAME OF *NEW* FILE.
  
  
 NEWF     SA1    FLST+/FLST/NEW 
 NEW1     SA2    RDCD        GET FILE NAME
          BX6    X2 
          RJ     RFN         REPLACE FILE NAME
          EQ     LST         LIST DIRECTIVE 
 NOINS    SPACE  4,10 
**        *NOINS
* 
*         SET NO INSERT OF NEW RECORDS. 
  
  
 NOINS    SX6    B1+
          SA6    CADD        SET NO INSERT AT EOF 
          EQ     LST         LIST DIRECTIVE 
 NOREP    SPACE  4,10 
**        *NOREP    FN,FN,FN
* 
*         DO NOT REPLACE RECORDS FROM FILE *FN*.
  
  
 NOREP    SEARCH NRT,RDCD 
          NZ     X6,RET      IF FILE IN NRT 
          ADDWRD NRT,RDCD 
          EQ     RET         RETURN 
 NOREW    SPACE  4,10 
**        *NOREW
* 
*         SET NO REWIND OF FILES. 
  
  
 NOREW    SX6    B1+
          SA6    CREW        SET NO REWIND FLAG 
          EQ     LST         LIST DIRECTIVE 
 OLDF     SPACE  4,10 
**        *OLD   FN 
* 
*         CHANGE/SPECIFY NAME OF OLD FILE.
  
  
 OLDF     SA1    FLST+/FLST/OLD 
          EQ     NEW1        PROCESS FILE NAME
          SPACE  4
**        *RENAME    LIB1/PN1,PN2 
* 
*         CHANGE THE NAME OF PROGRAM *PN1* TO *PN2*.
*         ENTRY  (B5) = (SEPARATOR CHARACTER - *,*).
  
  
 RENAME   SA3    RDCD        SET REPLACE NAME 
          BX6    X3 
          SA6    RENA 
          ZR     B5,REN1     IF SEPARATOR = *,* 
          SB5    X2-1R
          NZ     B5,ERR9     IF SEPARATOR NOT *,* OR * *
 REN1     SEARCH RNT,A6 
          SX7    =C* RECORD ALREADY RENAMED.* 
          NZ     X6,ERR      IF NAME IN RNT 
          CALL   AFN,RDCA,(RENA+1)
          MX0    42 
          SA3    RENA 
          SA4    A3+B1
          BX6    -X0*X3 
          BX6    X4+X6
          SA6    A4 
          ADDWRD RNT,RENA 
          EQ     LST         LIST LINE
  
 RENA     VFD    42/,18/     42/PRG1,18/LIB1
          VFD    42/,18/     42/PRG1,18/LIB1
          SPACE  4
**        *REPLACE  LIB1/PN1,LIB2/PN2-LIB3/PN3
* 
*         REPLACE PROGRAM(S) FROM FILE *OLD* WITH PROGRAMS FROM 
*         THE CURRENT CORRECTION FILE.
*         ENTRY  (X2) = SEPARATOR CHARACTER.
  
  
 REPLACE  SA3    RDCD        SET REPLACE NAME 
          BX6    X3 
          SA6    INSA 
          SEARCH NRT,(LGO.) 
          NZ     X6,REP1     IF FILE IN NRT 
          SB3    LGO. 
          ADDWRD NRT,B3 
 REP1     SA1    RDCA 
          SA2    X1 
          EQ     INS5        ASSEMBLE AS INSERT 
          SPACE  4
**        *REWIND   FN,FN,FN
* 
*         REWIND FN BEFORE AND AFTER EDITING. 
  
  
 REWIND   SEARCH RFT,RDCD 
          NZ     X6,RET      IF IN RFT TABLE
          ADDWRD RFT,RDCD 
          EQ     RET
 VFYLIB   SPACE  4,10 
**        *VFYLIB 
* 
*         CALL *VFYLIB* AFTER EDITING.
  
  
 VFYLIB   SX6    B1+         SET *VFYLIB* FLAG
          SA6    CVFY 
          EQ     LST         LIST DIRECTIVE 
          TITLE  SUBROUTINES. 
**        ABT - ABORT JOB.
  
  
 ABT      SUBR               ENTRY/EXIT 
          SA1    OUTPUT+2    CLOSE OUT FILE *OUTPUT*
          SA2    A1+B1
          BX6    X1-X2
          ZR     X6,ABT1     IF NO OUTPUT 
          WRITER OUTPUT,R 
 ABT1     ABORT 
          SPACE  4
**        ADD - ADD WORD(S) TO MANAGED TABLE. 
* 
*         ENTRY  (B2) = ADDRESS OF TABLE POINTER. 
*                (B3) = FWA OF ENTRY. 
  
  
 ADD      SUBR               ENTRY/EXIT 
 ADD1     SA1    B2          SET TABLE ADDRESS
          SA2    B2+B1
          SA3    A2+B1
          SA4    A3+B1
          SA5    A4+B1
          IX7    X2-X5
          SB6    X1 
          SX6    B6+X7
          SB7    X4          (B7) = NUMBER OF WORDS TO MOVE 
          ZR     X6,ADD3     IF NO ROOM FOR ENTRY 
          SA1    B3          STORE ENTRY
 ADD2     BX7    X1 
          SA7    B6+X2
          SX2    X2+B1
          SA1    A1+B1
          SX3    X3-1 
          NZ     X3,ADD2     LOOP FOR ENTIRE ENTRY
          BX7    X2 
          SA7    A2 
          EQ     ADDX        RETURN 
  
*         NO ROOM FOR ENTRY.  MOVE OTHER TABLES UP TO MAKE ROOM FOR 
*         ENTRY.
  
 ADD3     SA1    P.BUF
          SA2    L.BUF
          IX6    X2-X4
          PL     X6,ADD4     IF ENOUGH FL 
          SX6    B0          CLEAR STATUS WORD
          SA6    ADDA 
          MX6    29 
          SA6    A6+B1
          MEMORY CM,ADDA,R
          MEMORY CM,ADDB,R
          SA1    ADDA        GET PRESENT FL 
          AX1    30 
          SA2    A1+B1       GET MAXIMUM FL 
          AX2    30 
          SX6    X1+1000B    ADD INCREMENT
          IX2    X2-X6
          PL     X2,ADD3.1   IF NOT BEYOND MAXIMUM FL 
          MESSAGE  (=C* REQUIRED FL EXCEEDS VALIDATED LIMIT.*)
          CALL   ABT         ABORT JOB
  
 ADD3.1   LX6    30          BUILD STATUS WORD
          SA6    FL 
          MEMORY CM,FL,R     REQUEST ADDITIONAL FL
          SA2    L.BUF       UPDATE SPARE BUFFER LENGTH 
          SX6    X2+1000B 
          SA6    A2 
          EQ     ADD3        TRY AGAIN
  
 ADD4     SB5    X1          (B5) = LWA OF MOVE 
          SB6    X5          (B6) = FWA OF MOVE 
          SA6    A2 
          SB4    A1 
 ADD5     SA1    B4          INCREMENT TABLE POINTERS 
          SB4    B4-4 
          IX7    X1+X4
          SA7    A1 
          NE     B4,B2,ADD5  LOOP 
          SA2    B5 
          EQ     B5,B6,ADD1  JUMP IF NO DATA TO MOVE
 +        SA1    A2-B1       MOVE TABLES
          SA2    A1-B1
          SB5    B5-2 
          BX6    X1 
          LX7    X2 
          SA6    A1+B7
          SA7    A2+B7
          NE     B5,B6,*-2
          SX7    B0          CLEAR NEW AREA 
          SB7    B6+B7
 +        SA7    B6 
          SB6    B6+B1
          NE     B6,B7,*
          EQ     ADD1        MAKE ENTRY 
  
  
 ADDA     CON    0
 ADDB     VFD    30/-1,30/0 
          ERRNZ  ADDB-ADDA-1
 AFN      SPACE  4,14 
**        AFN - ASSEMBLE FILE NAME. 
* 
*         CHARACTER MASK: 
*                EOL = 2000 0000 0000 0000 0000 
*                *-* = 0000 0000 0000 0400 0000 
*                */* = 0000 0000 0000 0100 0000 
*                * * = 0000 0000 0000 0002 0000 
*                *,* = 0000 0000 0000 0001 0000 
*         ENTRY  (B2) = ADDRESS OF STRING BUFFER POINTER. 
*                (B3) = ADDRESS TO STORE FILE NAME. 
*         EXIT   (B2) = ADDRESS OF UPDATED STRING BUFFER POINTER. 
* 
*         USES   A - 1, 2, 6. 
*                X - 0, 1, 2, 6, 7. 
*                B - 4, 5, 7. 
  
  
 AFN      SUBR               ENTRY/EXIT 
          SA1    B2 
          SB4    X1+B1
          SB7    60 
          SX6    B0 
 AFN1     SA1    B4          READ CHARACTER 
          SB5    X1+B1
          SA2    =20000000000005030000B 
          LX2    X2,B5
          NG     X2,AFN2     IF CHARACTER = EOL  */*  *,*  *-*
          LX6    6
          BX6    X6+X1
          SB4    B4+B1
          SB7    B7-6 
          EQ     AFN1        LOOP FOR NEXT CHARACTER
  
 AFN2     LX2    X6,B7       STORE FILE NAME
          MX0    42 
          BX6    X0*X2
          BX2    -X0*X2 
          SX7    =C* FILE NAME TOO LONG.* 
          NZ     X2,ERR      IF FILE NAME, DIRECTIVE .GT. 7 CHARACTERS
          SA6    B3 
          AX6    42          CHECK FOR FILE NAME (*)
          SX6    X6-1L* 
          NZ     X6,AFN3     IF NOT MAIN CORRECTION FILE
          SA1    LGO
          BX6    X0*X1
          SA6    A6 
 AFN3     SX6    B4          STORE STRING POINTER 
          SA6    B2 
          EQ     AFNX        RETURN 
 APN      SPACE  4,10 
**        APN - ASSEMBLE PROGRAM NAME.
* 
*         ASSEMBLE ENTRY OF TYPE *LIB/PN,*
*         ENTRY  (B2) = ADDRESS OF STRING BUFFER POINTER. 
*                (B3) = ADDRESS TO RETURN ENTRY.
*         EXIT   (X2) = SEPARATOR CHARACTER 
* 
*         USES   A - 1, 2, 6, 7.
*                X - 0, 1, 2, 6, 7. 
*                B - 4, 5, 7. 
  
  
 APN      SUBR               ENTRY/EXIT 
          SA1    B2 
          SB4    X1+B1       (B4) = STRING BUFFER POINTER 
          SA1    RDCE        SET DEFAULT LIBRARY
          BX7    X1 
          SA7    APNA 
          SX6    B0 
          SB7    60 
  
*         ASSEMBLE FIRST ENTRY. 
  
 APN1     SA2    B4 
          SB5    X2-1R/ 
          ZR     B5,APN2     IF CHARACTER = */* 
          SA1    =20000000000004030000B 
          SB5    X2+B1
          LX1    X1,B5
          NG     X1,APN4     IF CHARACTER = EOL  *-*  * *  *,*
          LX6    6
          SB7    B7-6 
          IX6    X6+X2
          SB4    B4+B1
          EQ     APN1        LOOP 
  
*         CHARACTER = */* SET LIBRARY NAME.  ASSEMBLE PROGRAM NAME. 
  
 APN2     LX6    X6,B7
          SA6    APNA 
          SX6    B0 
          SB7    60 
          SB4    B4+B1
 APN3     SA2    B4 
          SB5    X2-1R/ 
          ZR     B5,ERR9     IF CHARACTER = */* 
          SA1    =20000000000004030000B 
          SB5    X2+B1
          LX1    X1,B5
          NG     X1,APN4     IF CHARACTER = EOL *-*  * *  *,* 
          LX6    6
          IX6    X6+X2
          SB7    B7-6 
          SB4    B4+B1
          EQ     APN3        LOOP 
  
*         CHARACTER = EOL *-*  * *  *,*.  STORE PROGRAM NAME. 
  
 APN4     SA1    APNA        CHECK LIBRARY TYPE 
          SA2    NAMA 
 APN5     ZR     X2,NAM2     IF INCORRECT LIBRARY 
          BX7    X1-X2
          SA2    A2+B1
          NZ     X7,APN5     IF NOT FOUND 
          BX7    X1          SET DEFAULT TYPE 
          SA7    RDCE 
          MX0    42          SET PROGRAM AND LIBRARY NAMES
          LX2    X6,B7
          BX6    X0*X2
          BX2    -X0*X2 
          SX7    =C* FILE NAME TOO LONG.* 
          NZ     X2,ERR      IF FILE NAME .GT. 7 CHARACTERS 
          SX7    A2-NAMA-1
          BX7    X6+X7
          SA7    B3 
          SA2    B4 
          SX6    B4 
          SA6    B2 
          SX6    X2 
          EQ     APNX        RETURN 
  
  
 APNA     DATA   0           LIBRARY NAME 
          SPACE  4
**        BID - BUILD IMPLIED DELETE TABLE. 
* 
*         THE INSERT PROGRAM TABLE IS SCANNED TO DETERMINE WHICH
*         PROGRAMS ARE TO BE INSERTED.  EACH PROGRAM TO BE INSERTED 
*         IS ADDED TO THE IMPLIED DELETE TABLE. 
  
  
 BID      SUBR               ENTRY/EXIT 
          CALL   LIT         LIST IGNORE TABLE
          SA6    BIDE        SET ERROR COUNT
          SX6    B0          SET IPT INDEX
          SA6    BIDA 
 BID1     SA1    P.IPT
          SA2    L.IPT
          SA3    BIDA 
          BX6    X2-X3
          ZR     X6,BID8     IF END OF INSERT PROGRAM TABLE 
          SB6    X1 
          SB6    B6+X3       (B6) = IPT ADDRESS 
          SA4    B6+B1       SET IPT ENTRY
          SA5    A4+B1
          BX6    X4 
          LX7    X5 
          SA6    BIDB 
          SA7    A6+B1
          AX7    42 
          SX7    X7-1L0 
          ZR     X7,BID6     IF ZERO-LENGTH RECORD INSERT 
          SA4    A5+B1
          BX6    X4 
          SA6    A7+B1
          SB7    B0          SEARCH PNT FOR START OF INSERT 
          SA1    P.PNT
          SA2    L.PNT
          SB5    X1 
          SB6    X2 
          SA5    BIDB 
          MX0    42 
 BID2     EQ     B6,B7,BID5  IF END OF PNT
          SB7    B7+B1
          SA1    B5+B7       CHECK FILE NAME
          SB7    B7+2 
          BX6    X1-X5
          BX6    X0*X6
          NZ     X6,BID2     IF FILE NAME NOT FOUND 
          SA4    BIDB+1      CHECK PROGRAM NAME 
          BX6    X4 
          AX6    42 
          SX1    X6-1L* 
          SB7    B7-3 
          ZR     X1,BID7     IF ENTIRE FILE INSERT
 BID3     EQ     B6,B7,BID5  IF END OF PNT
          SA1    B5+B7
          SA2    A1+B1
          BX6    X2-X5
          BX6    X0*X6
          NZ     X6,BID5     IF END OF FILE 
          SB7    B7+3 
          BX6    X1-X4
          NZ     X6,BID3     IF FIRST PROGRAM NOT FOUND 
  
*         FIRST PROGRAM FOUND, MAKE ENTRIES IN IMPLIED DELETE TABLE.
  
          SX6    B7-3 
 BID4     SA6    BIDC 
          SA1    P.PNT
          SB5    X1 
          SA2    B5+X6
          SA3    A2+B1
          BX6    X2 
          LX7    X3 
          SA6    BIDD 
          SA7    A6+B1
          ADDWRD IDT,A6 
          SA1    P.PNT
          SA2    L.PNT
          SA3    BIDC 
          SB5    X1 
          SB6    X2 
          SB7    X3 
          SA5    BIDB        CHECK FILE 
          SA4    BIDB+2      CHECK FOR LAST PROGRAM 
          MX0    42 
          SA1    B5+B7
          BX6    X1-X4
          ZR     X6,BID6     IF LAST PROGRAM FOUND
          SB7    B7+3 
          BX6    X4 
          AX6    42 
          SX1    X6-1L* 
          ZR     X1,BID7     IF ADD FULL FILE 
          SB4    B5+B7       CHECK FILE OF NEXT ENTRY IN THE PNT
          SA1    B4+B1
          EQ     B6,B7,BID5  IF END OF PNT
          BX6    X1-X5
          BX7    X0*X6
          SX6    B7 
          ZR     X7,BID4     IF FILE CONTINUES
  
*         AN ERROR HAS BEEN DETECTED.  OUTPUT INCORRECT DIRECTIVE.
  
 BID5     CALL   OIC,BIDA 
          SA1    BIDE        INCREMENT ERROR COUNT
          SX6    X1+B1
          SA6    A1 
  
*         END OF INSERT SCAN.  LOOP FOR NEXT INSERT CARD. 
  
 BID6     SA1    BIDA 
          SX6    X1+4 
          SA6    A1 
          EQ     BID1        LOOP 
  
*         ADD ENTIRE FILE TO IDT. 
  
 BID7     EQ     B6,B7,BID6  IF END OF PNT
          SA1    B5+B7       SET IDT ENTRY
          SA2    A1+B1
          SA5    BIDB 
          SA4    A5+B1
          BX6    X1 
          LX7    X2 
          SA6    BIDD 
          SA7    A6+B1
          MX0    42 
          BX6    X5-X2
          BX6    X0*X6
          NZ     X6,BID6     IF END OF FILE 
          BX6    X4-X1
          BX6    -X0*X6 
          SB7    B7+3 
          NZ     X6,BID7     IF NOT CORRECT PROGRAM TYPE
          SX7    B7 
          SA7    BIDC 
          ADDWRD IDT,A6      ADD ENTRY TO IDT 
          SA1    P.PNT
          SA2    L.PNT
          SA3    BIDC 
          SB5    X1 
          SB6    X2 
          SB7    X3 
          EQ     BID7        LOOP 
  
*         CHECK ERROR COUNT.
  
 BID8     SA1    BIDE 
          ZR     X1,BIDX     IF NO ERRORS 
          SA1    TTYI 
          ZR     X1,BIDX     IF TTY INPUT 
          CALL   C6S,BIDE,BIDF
          CALL   MSG,BIDF,(=C*       DIRECTIVE ERROR(S).*)
          SA1    CDOP        CHECK *NA* OPTION
          NZ     X1,BIDX     IF NO ABORT
          CALL   ABT         ABORT JOB
* 
  
 BIDA     DATA   0           INSERT PROGRAM TABLE INDEX 
  
 BIDB     VFD    42/,18/     IPT ENTRY - 42/FILE,18/0 
          VFD    42/,18/     42/PROG1,18/LIB1 
          VFD    42/,18/     42/PROG2,18/LIB2 
  
 BIDC     DATA   0           PROGRAM NAME TABLE INDEX 
  
 BIDD     VFD    42/,18/     IDT ENTRY - 42/PROG,18/LIB 
          VFD    42/,18/     42/FILE,18/POSITION
  
 BIDE     DATA   0           ERROR COUNT
 BIDF     DATA   0           ERROR COUNT (DISPLAY CODE) 
 CAP      SPACE  4,10 
**        CAP - COPY ADDED PROGRAMS.
* 
*         COPY NEW RECORDS (THOSE NOT ON FILE *OLD*) ONTO 
*         THE END OF FILE *NEW* (JUST BEFORE EOF).
* 
*         ENTRY  (CADD) = 0 IF RECORDS TO BE INSERTED AT EOF. 
* 
*         EXIT   RECORDS WRITTEN TO FILE *NEW*. 
* 
*         USES   A - 1, 2, 3, 4, 6. 
*                X - 1, 2, 3, 4, 6. 
*                B - 2, 3, 6, 7.
* 
*         CALLS  CPY, DIS, ORW. 
* 
*         MACROS SEARCH.
  
  
 CAP      SUBR               ENTRY/EXIT 
          SA1    CADD 
          NZ     X1,CAPX     IF NO INSERT AT EOF
          SX6    B0+
          SA6    CAPA 
 CAP1     SA1    P.PNT
          SA2    L.PNT
          SA3    CAPA 
          SB6    X2 
          SB7    X3 
 CAP2     EQ     B6,B7,CAPX  IF END OF ADD
          SA4    X1+B7       CHECK PNT ENTRY
          SB7    B7+3 
          ZR     X4,CAP2     IF RECORD REPLACED 
          SX6    B7 
          SA6    A3 
          BX6    X4 
          SA1    A4+B1
          SA6    CAPB 
          BX6    X1 
          SA6    A6+B1
          SEARCH NRT,(A4+B1),(=77777777777777000000B) 
          NZ     X6,CAP1     IF FILE A NO REPLACE FILE
          SB2    CAPB 
          SB3    =H* ADDING*
          RJ     DIS
          SA1    CAPA 
          SB2    X1-3 
          RJ     CPY         COPY NEW RECORD
          SB2    =5HADDED 
          SB3    CAPB+1 
          RJ     ORW
          EQ     CAP1        GET NEXT RECORD
  
  
 CAPA     BSS    1           PNT INDEX
 CAPB     BSS    2           PNT ENTRY
          SPACE  4
**        CCM - COPY COMMENT ONTO FILE *NEW*. 
* 
*         ENTRY  (B2) = ADDRESS OF WORKING STORAGE. 
*                (B3) = ADDRESS OF PROGRAM NAME.
* 
*         EXIT   (X6) = ADDRESS OF TEXT FWA.
* 
*         USES   X - 0, 1, 2, 3, 5, 6, 7. 
*                A - 1, 2, 3, 5, 6, 7.
*                B - 2, 3, 4, 5, 6, 7.
* 
*         CALLS  COB, CPT, EPN, RNP.
* 
*         MACROS CALL, SEARCH, WRITE, WRITECW.
  
  
 CCM      SUBR               ENTRY/EXIT 
          SX6    B2          SAVE WORKING STORAGE ADDRESS 
          SA6    CCMA 
          SA1    B3          SET PROGRAM NAME 
          BX6    X1 
          SA6    CCMC 
          CALL   COB         CLEAR OUTPUT BUFFER
          SA1    CCMC 
          MX0    42 
          BX6    X0*X1
          SA6    OUTPUTB+1
          SA2    X1+NAMA
          BX6    X2 
          SA6    A6+B1
          SX6    B0          CLEAR COMMENT/DATE BUFFER
          SA6    OUTPUTB+4
          SB7    7
 CCM1     SA6    A6+B1
          SB7    B7-B1
          NZ     B7,CCM1     IF NOT END OF BUFFER 
          SEARCH CDT,B3,(=77777777777777377777B)
          SA1    CCMA 
          ZR     X6,CCM14    IF NO COMMENT OR DATE
          SA2    CCMC        CHECK RECORD TYPE
          SB3    X2 
          ERRNZ  TXRT        CODE ASSUMES VALUE 
          SB2    X2-PRRT+TXRT  CHECK FOR TYPE *PROC*
          ZR     B3,CCM14    IF TYPE *TEXT* 
          ZR     B2,CCM14    IF TYPE *PROC* 
          SB6    X1 
          SB5    X6 
          SB3    5           COPY WORDS 3 - 7 OF 7700 TABLE 
          SB2    2
 CCM2     SB2    B2+B1
          SA1    B6+B2
          BX6    X1 
          SA6    CCMB+B2
          SB3    B3-B1
          NZ     B3,CCM2     IF MORE WORDS TO COPY
          SA1    B5+B1       COPY COMMENT 
          SX2    -7 
 CCM3     BX6    X1 
          SA6    A6+B1
          MX7    -12
          BX7    -X7*X1 
          ZR     X7,CCM4     IF END OF DATA 
          SA1    A1+B1
          SX2    X2+B1
          NZ     X2,CCM3     IF NOT END OF TABLE
 CCM4     BX6    X6-X6       SET TO CLEAR COMMENT FIELD 
          SB3    CCMB+CCMBL-1  LWA OF COMMENT FIELD 
 CCM5     SB2    A6          CHECK FOR END OF COMMENT FIELD 
          GE     B2,B3,CCM6  IF AT END OF COMMENT FIELD 
          SA6    A6+B1
          EQ     CCM5        LOOP TO END OF PREFIX TABLE
  
 CCM6     SA1    DATE.       COPY DATE
          BX6    X1 
          SA6    CCMB+2 
          SA1    B6          CHECK FOR 7700 TABLE 
          MX0    6
          BX1    X1-X0
          AX1    36 
          SB3    X1+B1       SET 7700 TABLE LENGTH
          SB4    X1 
          AX1    12 
          NZ     X1,CCM7     IF NO 7700 TABLE 
          SB6    B6+B3       SET TEXT ADDRESS 
          SA2    A1+B1       SET PROGRAM NAME 
          SA1    B5 
          LX1    42 
          NG     X1,CCM7     IF DATE FLAG SET 
          SA1    A2+B1       SET OLD DATE 
          SX6    B0 
          SA6    CCMB+2 
          BX6    X1 
          LE     B4,B1,CCM7  IF 1 WORD 7700 TABLE 
          SA6    A6+
 CCM7     SX6    B6+         SAVE TEXT FWA
          SA6    CCMA 
          SB7    X4-OPRT     CHECK FOR OPL/OPLC RECORD TYPE 
          ZR     B7,CCM8     IF OPL 
          NE     B7,B1,CCM9  IF NOT OPLC
          ERRNZ  OPRT+1-OCRT CODE ASSUMES VALUE 
 CCM8     SA1    B6-B1
          BX6    X1 
          SA6    CCMB+16B 
 CCM9     SX6    B0 
          SX6    B0          CLEAR COMMENT
          SA6    B5 
          SB7    7
 CCM10    SA6    A6+B1
          SB7    B7-B1
          NZ     B7,CCM10    IF NOT END OF COMMENT FIELD
          CALL   RNP,CCMC,(CCMB+1)
          MX0    42          SET NAME IN 7700 TABLE 
          BX6    X0*X6
          SA6    CCMB+1 
          CALL   EPN,CCMC    ENTER PROGRAM NAME 
          WRITECW N,R 
          WRITE  X2,* 
          SA1    SC 
          BX6    X6-X6
          LX1    30 
          SA6    N-2         DISABLE CONTROL WORD WRITE 
          BX7    X1 
          SA7    N+6         STORE SECTOR COUNT 
          WRITEW NEW,CCMB,CCMBL WRITE 17-WORD 7700 TABLE
          SB6    CCMB+10B    COPY COMMENT TO OUTPUT 
          SA1    CCMB+2      COPY DATE FIRST
          MX2    -12
          SB7    CCMB+16B 
          SB5    OUTPUTB+4
 CCM11    BX6    X1 
          SA1    B6 
          SB6    B6+B1
          SA6    B5 
          BX3    -X2*X6 
          ZR     X3,CCM12    IF END OF DATA 
          SB5    B5+B1
          NE     B6,B7,CCM11 IF NOT END OF DATA 
 CCM12    EQ     B6,B7,CCM13 IF END OF BUFFER 
          SX6    B0 
          SB5    B5+B1
          SA6    B5 
          SB6    B6+B1
          EQ     CCM12       CONTINUE TO END OF BUFFER
  
 CCM13    SA1    CCMA 
          SX6    X1 
          EQ     CCMX        RETURN 
  
 CCM14    SA1    CCMA 
          SA2    X1          CHECK FOR 7700 TABLE 
          MX0    6
          BX2    X2-X0
          AX2    48 
          NZ     X2,CCM15    IF NO 7700 TABLE 
          CALL   RNP,CCMC    CHECK FOR RENAME 
          SA5    CCMA 
          SB2    CCMC 
          BX6    X0*X6       STORE NAME IN PREFIX TABLE 
          SA6    X5+B1
          RJ     EPN         ENTER PROGRAM NAME 
          SA3    OUTPUTB+3
          BX6    X3          SET (A6) FOR *CPT* CALL
          SA1    X5 
          SA6    A3 
          RJ     CPT         COPY PREFIX TABLE
          BX6    X5 
          EQ     CCMX        RETURN 
  
 CCM15    SB2    CCMC 
          RJ     RNP         CHECK FOR RENAME 
          SA2    CCMC 
          SA5    CCMA 
          SB2    X2 
          ERRNZ  TXRT        CODE ASSUMES VALUE 
          NE     B2,B1,CCM16 IF NOT TYPE *PP* 
          ERRNZ  TXRT+1-PPRT CODE ASSUMES VALUE 
          MX0    18 
 CCM16    SB4    B2+TXRT-PRRT  CHECK FOR TYPE *PROC*
          ZR     B2,CCM17    IF TYPE *TEXT* 
          ZR     B4,CCM17    IF TYPE *PROC* 
          SA3    X5 
          BX6    X0*X6
          BX3    -X0*X3 
          BX6    X3+X6
          SA6    X5 
 CCM17    SB2    A2 
          RJ     EPN         ENTER PROGRAM NAME 
          BX6    X5 
          EQ     CCMX        RETURN 
  
  
 CCMA     DATA   0           ADDRESS OF WORKING STORAGE 
  
 CCMB     DATA   77000016000000000000B
          BSSZ   16B
 CCMBL    EQU    *-CCMB 
  
 CCMC     DATA   0           PROGRAM NAME AND TYPE
 CFN      SPACE  4,10 
**        CFN - CONVERT FILE NAME.
* 
*         CONVERT LEFT JUSTIFIED FILE NAME INTO A STRING IN 
*         THE STRING BUFFER.
*         ENTRY  (B2) = ADDRESS OF FILE NAME. 
* 
*         USES   A - 1, 2, 6. 
*                X - 0, 1, 2, 5, 6. 
*                B - 6. 
  
  
 CFN      SUBR               ENTRY/EXIT 
          SA1    B2 
          MX0    42 
          SA2    SBP
          BX5    X0*X1
          NZ     X5,CFN1     IF NOT ZERO FILE NAME
          SX5    3R(0)
          BX5    -X0*X5 
          LX5    -18
 CFN1     SB6    X2 
          MX0    54 
 +        LX5    6
          BX6    -X0*X5 
          SA6    B6 
          SB6    B6+B1
          NZ     X6,*-1 
          SX6    B6-B1
          SA6    A2 
          EQ     CFNX        RETURN 
 CIT      SPACE  4,15 
**        CIT - CHECK IGNORE TABLE. 
* 
*         SEARCH THE PROGRAM IGNORE TABLE FOR CURRENT FILE. 
*         CHECK FOR IGNORING, START OF IGNORE, OR END OF IGNORE.
*         DELETE ENTRY IN IGNORE TABLE ON END OF IGNORE.
*         ENTRY  (B2) = ADDRESS OF FILE NAME. 
*                (B3) = ADDRESS OF PROGRAM NAME.
*         EXIT   (X6) = 0 IF PROGRAM IS IGNORED.
* 
*         USES   A - 1, 2, 3, 4, 5. 
*                X - 1, 2, 3, 4, 5, 6, 7. 
*                B - 6, 7.
  
  
 CIT      SUBR               ENTRY/EXIT 
          SX6    B1          CLEAR IGNORE PROGRAM FLAG
          SA1    P.PIT       CHECK FILE NAME IN IGNORE TABLE
          SA2    L.PIT
          SB6    X1 
          SB7    X2+B6
          SA4    B2          (X4) = FILE NAME 
          SA5    B3          (X5) = PROGRAM NAME
 CIT1     EQ     B6,B7,CITX  IF END OF IGNORE TABLE 
          SA1    B6 
          BX7    X1-X4
          SB6    B6+3 
          NZ     X7,CIT1     LOOP IF FILE IS NOT CURRENT FILE 
          SA2    A1+B1       CHECK PROGRAM NAME 
          SA3    A2+B1
          SX1    1R*         BUILD TYPE/* 
          SX7    X5          PROPOGATE TYPE 
          LX1    54 
          BX1    X7+X1
          ZR     X2,CIT3     IF IGNORE-ALL IN PROGRESS
          BX7    X5-X2
          BX1    X2-X1
          ZR     X7,CIT4     IF TYPE/NAME MATCHES TABLE 
          ZR     X1,CIT2     IF TABLE ENTRY IS THIS TYPE/*
          AX1    18 
          NZ     X1,CIT1     IF TABLE ENTRY NOT ANOTHER TYPE/*
          BX7    X5-X3       CHECK END OF IGNORE GROUP
          NZ     X7,CIT1     IF NOT END 
 CIT2     SX6    B0          SET IGNORE PROGRAM FLAG
          BX7    X5-X3
          NZ     X7,CIT1     IF NOT END OF IGNORE 
          SA7    A1          CLEAR IGNORE ENTRY 
          SA7    A7+1 
          SA7    A3 
          EQ     CIT1        LOOP 
  
*         CHECK FOR IGNORING ALL RECORDS OF ANOTHER TYPE. 
  
 CIT3     BX7    X1-X3
          ZR     X7,CIT2     IF IGNORING ALL OF THIS TYPE 
          AX7    18 
          NZ     X7,CIT2     IF NOT IGNORING ALL OF DIFFERENT TYPE
          JP     CIT1        LOOP 
  
*         SET IGNORE-ALL FLAG.
  
 CIT4     SA7    A2 
          JP     CIT2        GO IGNORE THIS RECORD
          SPACE  4
**        COB - CLEAR OUTPUT BUFFER.
* 
*         USES   X - 1, 6.
*                A - 1, 6.
*                B - 6, 7.
  
  
 COB      SUBR               ENTRY/EXIT 
          SA1    =1H
          SB6    OUTPUTB
          SB7    OUTPUTB+DCBL+1 
          BX6    X1 
 COB1     SA6    B6 
          SB6    B6+B1
          NE     B6,B7,COB1  LOOP TO END OF BUFFER
          EQ     COBX        RETURN 
 CNO      SPACE  4,15 
**        CNO - COPY *NEW* TO *OLD*.
* 
*         PERFORMS *C* OR *COPY OPTION. 
* 
*         USES   X - 1, 2, 3, 6, 7. 
*                A - 1, 3, 6, 7.
*                B - 6, 7.
* 
*         CALLS  DIS, SRT.
* 
*         MACROS READCW, READW, REWIND, WRCW, WRITECW.
  
  
 CNO      SUBR               ENTRY/EXIT 
          SA1    CCPY        CHECK COPY FLAG
          ZR     X1,CNO      IF NO COPY 
          READCW N,17B
          SA3    P+4
          MX7    60 
          AX3    18 
          SA7    N-2         SET FIRST READ FLAG
          SA7    P-2
          SX6    X3          STORE PRU SIZE 
          SA6    A7+B1
          WRITECW A6+B1,*    SET FILE STATUS
 CNO1     READW  NEW,WSB,WSBL 
          NG     X1,CNO4     IF EOF 
          SB6    WSB
          SB7    X1 
          EQ     B6,B7,CNO3  IF NO DATA 
          BX6    X1 
          SA6    CNOA 
          SA1    X2-LWP      LWA+1 OF DATA TRANSFERED 
          SX2    WSB
          RJ     SRT         SET RECORD TYPE
          SA6    CNOB 
          CALL   DIS,CNOB,(=H*RECOPYING *)
          SA1    CNOA 
          NZ     X1,CNO3     IF EOR 
 CN02     WRCW   P,WSB,WSBL 
          READW  NEW,WSB,WSBL 
          ZR     X1,CN02     IF NOT EOR 
          NG     X1,CNO4     IF EOF 
 CNO3     WRCW   P,WSB,X1-WSB,R 
          EQ     CNO1        LOOP TO EOF
  
 CNO4     SX6    X1+2 
          ZR     X6,CNO5     IF *EOI* 
          MX7    4
          LX7    4+48 
          SA7    WDAA+1      SET LEVEL 17 EOR 
          WRCW   P,0,0
 CNO5     WRITECW P,R        FLUSH BUFFER 
          REWIND OLD
          REWIND NEW
          EQ     CNOX        RETURN 
  
  
 CNOA     DATA   0           EOR INDICATOR
 CNOB     DATA   0           PROGRAM NAME 
          SPACE  4
**        CNR - CHECK NO REPLACE TABLE. 
* 
*         ENTRY  (B2) = PROGRAM NAME TABLE INDEX. 
*         EXIT   (X6) " 0 IF PROGRAM IS IN A NO REPLACE FILE. 
*                (X6) = 0 IF PROGRAM IS NOT IN A NO REPLACE FILE. 
* 
*         USES   A - 1, 2, 6, 7.
*                X - 1, 2, 6, 7.
*                B - 4, 6.
  
  
 CNR      SUBR               ENTRY/EXIT 
          SA1    P.PNT
          SB4    B2+X1
          SX6    B2 
          SA6    CNRA 
          SEARCH NRT,(B4+B1),(=77777777777777000000B) 
          ZR     X6,CNRX     IF NOT IN NO REPLACE TABLE 
          SA1    P.PNT       DELETE PROGRAM FROM PNT
          SA2    CNRA 
          SB6    X1 
          SX7    B0 
          SA7    B6+X2
          EQ     CNRX        RETURN 
  
  
 CNRA     DATA   0           PROGRAM NAME TABLE INDEX 
          SPACE  4,15 
**        CPL - COPY USER LIBRARY.
* 
*         ENTRY  (B2) = ADDRESS OF PROGRAM TYPE.
*                (B3) = ADDRESS TO RETURN STATUS OF NEXT READ.
*         USES   A - 1, 2, 6. 
*                X - 1, 2, 5, 6, 7. 
*                B - 6, 7.
* 
*         CALLS  SRT. 
* 
*         MACROS READW,WRCW.
  
  
 CPL4     READW  P,WSA,WSAL 
 CPL5     SA2    CPLA 
          BX6    X1          RETURN RECORD STATUS 
          SA6    X2 
  
 CPL      SUBR               ENTRY/EXIT 
          SA1    B2 
          SX6    B3 
          SX7    X1-ULRT
          SA6    CPLA 
          NZ     X7,CPL4     IF NOT *ULIB*
          SX6    0
          SA6    CPLB 
 CPL1     READW  P,WSA,WSAL 
          NG     X1,CPL5     IF EOF 
          SB6    WSA
          SB7    X1 
          EQ     B6,B7,CPL3  IF ZERO LENGTH RECORD
          BX5    X1 
          SA1    X2-LWP      LWA+1 OF DATA TRANSFERED 
          SX2    WSA
          RJ     SRT         SET RECORD TYPE
          SA6    CPLB 
  
*         COPY FROM *OLD* TO *NEW*. 
  
          BX7    X5 
          SA2    A6-B1
          BX1    X5 
          SA7    X2 
          NZ     X5,CPL3     IF EOR ON PREVIOUS READ
 CPL2     WRCW   N,WSA,WSAL 
          READW  OLD,WSA,WSAL 
          ZR     X1,CPL2     IF NOT EOR 
 CPL3     WRCW   N,WSA,X1-WSA,R 
          SA2    CPLB 
          SB7    X2-ODRT
          NZ     B7,CPL1     LOOP TO END OF USER LIBRARY
          EQ     CPL4 
  
  
 CPLA     BSSZ   2
 CPLB     EQU    CPLA+1 
          SPACE  4
**        CPP - COPY SPECIFIED PROGRAM(S).
* 
*         COPY RECORDS FROM FILE TO *NEW*.
*         ENTRY  (B2) = IPT INDEX.
* 
*         USES   A - 1, 2, 3, 4, 5, 6, 7. 
*                X - ALL. 
*                B - 2, 3, 4, 5, 6, 7.
* 
*         CALLS  CPY, DIS, OIC, ORW.
* 
*         MACROS CALL, MESSAGE, WRCW. 
  
  
 CPP      SUBR               ENTRY/EXIT 
          SA1    P.IPT
          SX6    B2 
          SA6    CPPA 
          SX5    B2+X1
          SA5    X5+B1       SET FILE NAME
          SA2    A5+B1       SET FIRST PROGRAM
          SA3    A2+B1       SET LAST PROGRAM 
          BX6    X5 
          LX7    X2 
          SA6    CPPB 
          SA7    A6+B1
          BX6    X3 
          SA6    A7+B1
  
*         CHECK FOR 0-LENGTH RECORD INSERT. 
  
          AX2    42 
          SX2    X2-1L0 
          ZR     X2,CPP4     IF 0-LENGTH RECORD 
  
*         SEARCH PNT FOR START OF INSERT
  
          SB7    B0 
          SA1    P.PNT
          SA2    L.PNT
          SB5    X1 
          ZR     X2,CPP2     IF EMPTY PNT 
          SB6    X2 
          MX0    42 
          SB4    3
          SB3    B5+B7
          SA1    B3+B1       CHECK FILE NAME
 +        EQ     B6,B7,CPP2  IF END OF PNT
          BX6    X1-X5
          SB7    B7+B4
          BX6    X0*X6
          SA1    A1+B4
          NZ     X6,*-1      IF FILE NAME NOT FOUND 
          SB7    B7-B4
          SA4    A5+B1       CHECK PROGRAM NAME 
          BX6    X4 
          AX6    42 
          SX1    X6-1L* 
          ZR     X1,CPP3     IF ENTIRE FILE INSERT
 +        EQ     B6,B7,CPP2  IF END OF PNT
          SA1    B5+B7
          SA2    A1+B1
          BX6    X2-X5
          BX6    X0*X6
          NZ     X6,CPP2     IF END OF FILE 
          SB7    B7+B4
          BX6    X1-X4
          NZ     X6,*-2      LOOP FOR FIRST PROGRAM 
          SX6    B7-B4       SET PNT INDEX
          SA6    CPPC 
  
*         FIRST PROGRAM FOUND, START COPY.
  
 CPP1     SA1    CPPC 
          SA2    P.PNT
          IX3    X1+X2
          CALL   DIS,X3,(=H*INSERTING *)
          SA1    CPPC 
          CALL   CPY,X1 
          CALL   ORW,(=8HINSERTED),CPPB 
          SA1    P.PNT       CHECK FOR END OF COPY
          SA2    L.PNT
          SA3    CPPC 
          SB5    X1 
          SB6    X2 
          SB4    3
          SA5    CPPB        CHECK FILE 
          SA1    A5+B1       CHECK PROGRAM NAME 
          SA4    A1+B1
          MX0    42 
          SB7    X3+B4
          BX6    X1-X4
          ZR     X6,CPP5     IF LAST PROGRAM FOUND RETURN 
          BX6    X4 
          AX6    42 
          SX1    X6-1L* 
          ZR     X1,CPP3     IF ADD FULL FILE 
          SB2    B5+B7       CHECK FILE OF NEXT ENTRY IN THE PNT
          SA1    B2+B1
          EQ     B6,B7,CPP2  IF END OF PNT
          BX6    X1-X5
          SX7    B7 
          SA7    CPPC 
          SA1    B2          SET CURRENT PROGRAM NAME 
          BX7    X1 
          SA7    A5+B1
          BX6    X0*X6
          ZR     X6,CPP1     IF FILE CONTINUES
  
*         AN ERROR HAS BEEN DETECTED.  SEND MESSAGE AND ABORT.
  
 CPP2     CALL   OIC,CPPA    OUTPUT INSERT DIRECTIVE
          SA1    TTYI 
          ZR     X1,CPP5     IF TERMINAL INPUT
          MESSAGE (=C*OVERLAPPING INSERT OR DELETE.*) 
          SA1    CDOP        CHECK *NA* OPTION
          NZ     X1,CPP5     RETURN IF NO ABORT 
          CALL   ABT         ABORT JOB
  
*         ADD ENTIRE FILE TO FILE NEW.
  
 CPP3     EQ     B6,B7,CPP5  RETURN IF END OF PNT 
          SX6    B7 
          SA2    B5+B7       CHECK PROGRAM TYPE 
          SA6    CPPC 
          SA5    CPPB        CHECK FILE NAME
          SA4    A5+B1
          SA1    A2+B1
          BX7    X1-X5
          BX7    X0*X7
          NZ     X7,CPP5     RETURN IF END OF FILE
          BX7    X2-X4
          BX7    -X0*X7 
          SB7    B7+B4
          NZ     X7,CPP3     IF NOT CORRECT PROGRAM TYPE
          ZR     X2,CPP3     IF PROGRAM ALREADY INSERTED
          SA1    P.PNT
          IX3    X6+X1
          CALL   DIS,X3,(=H*INSERTING *)
          SA1    CPPC 
          CALL   CPY,X1      COPY RECORD
          CALL   ORW,(=8HINSERTED),CPPB 
          SA1    P.PNT
          SA2    L.PNT
          SA3    CPPC 
          SB5    X1 
          SB6    X2 
          SB4    3
          MX0    42 
          SB7    X3+B4
          EQ     CPP3        LOOP 
  
*         WRITE 0-LENGTH RECORD.
  
 CPP4     SB2    =0          ENTER ZERO LENGTH RECORD 
          RJ     EPN
          ADDWRD NPT,NIND 
          WRCW   N,B0,B0     WRITE ZERO LENGTH RECORD 
          CALL   OZR,(=8HINSERTED),(=1H ),(=2H00) 
  
*         CLEAR IPT ENTRY.
  
 CPP5     SA1    P.IPT
          SA2    CPPA 
          SB5    X1 
          SX6    B0 
          SA6    B5+X2
          SA6    A6+B1
          SA6    A6+B1
          SA6    A6+B1
          EQ     CPPX        RETURN 
  
  
 CPPA     DATA   0           INSERT PROGRAM TABLE INDEX 
  
 CPPB     VFD    42/,18/     FILE NAME
          VFD    42/,18/     FIRST PROGRAM
          VFD    42/,18/     LAST PROGRAM 
  
 CPPC     DATA   0           PROGRAM NAME TABLE INDEX 
          SPACE  4
**        CPY - COPY RECORD TO FILE NEW.
* 
*         ENTRY  (B2) = PNT INDEX.
* 
*         USES   A - 1, 2, 3, 4, 5, 6, 7. 
*                X - 1, 2, 3, 4, 5, 6, 7. 
*                B - 2, 4, 5, 6.
* 
*         CALLS  ABT, CCM, COB, MSG, RCW, SFN.
* 
*         MACROS BKSP, CALL, READ, READCW, READW, RECALL, WRCW. 
  
  
 CPY      SUBR               ENTRY/EXIT 
          CALL   COB         CLEAR OUTPUT BUFFER
          SX6    B2 
          SA1    P.PNT       SET PROGRAM NAME 
          SA4    B2+X1
          ZR     X4,CPY      IF PROGRAM ALREADY REPLACED
          SA6    CPYA 
          SA5    A4+B1
          BX6    X4 
          LX7    X5 
          SA6    CPYB 
          SA7    LGO
          SA7    A6+B1
          SA4    A5+B1       SET RANDOM ADDRESS 
          BX6    X4 
          SX7    B0 
          SA6    S+6
          SA7    CW 
  
*         COPY RECORD.
  
          READ   S           READ FILE *S*
          READW  S,WSB,WSBL 
          NG     X1,CPY11    IF END OF FILE 
          SX6    X1 
          SA6    CPYD 
          CALL   CCM,WSB,CPYB 
          SA1    CPYB 
          SB2    X1 
          ERRNZ  TXRT        CODE ASSUMES VALUE 
          NZ     B2,CPY1     IF NOT TEXT
          SA3    WSB         CHECK FIRST WORD OF TEXT RECORD
          MX7    6
          BX7    X3-X7
          AX7    48 
          ZR     X7,CPY1     IF 7700 TABLE PRESENT
          SA1    X6          REMOVE BLANKS FROM RECORD NAME 
          RJ     SFN         GENERATE MASK OF BLANKS
          BX7    X7*X1       REMOVE BLANKS
          SX6    A1          RESTORE X6 
          SA7    A1 
 CPY1     SA3    SC 
          SA1    CPYD 
          BX7    X3          SET RANDOM ADDRESS 
          SB6    X6 
          SA7    NIND+1 
          NZ     X1,CPY3     IF EOR SENSED
          SB7    WSB+WSBL 
          WRCW   N,B6,B7-B6 
 CPY2     READW  S,WSB,WSBL 
          SB6    WSB
          NZ     X1,CPY3     IF EOR SENSED
          WRCW   N,B6,WSBL
          EQ     CPY2        CONTINUE READ
 CPY3     SB7    X1 
          WRCW   N,B6,B7-B6,R 
          SA1    CPYB        CHECK PROGRAM TYPE 
          SB4    X1-ULRT
          NZ     B4,CPY9     IF NOT USER LIBRARY
  
*         COPY USER LIBRARY.
  
          SX6    1
          SA6    CW          SET CONTROL WORD READ FLAG 
          READCW S,17B
 CPY4     READW  S,WSB,WSBL 
          PL     X1,CPY5     IF NOT EOF 
          BKSP   S,R
          EQ     CPY9        CLEAR PROGRAM NAME 
 CPY5     SB6    WSB
          SB7    X1 
          EQ     B6,B7,CPY8  IF 0-LENGTH RECORD 
          SX6    X1 
          SA6    CPYD 
          SA1    X2-LWP      LWA+1 OF DATA TRANSFERED 
          SX2    WSB
          RJ     SRT         SET RECORD TYPE
          SA6    CPYB 
          SA1    CPYD 
          EQ     CPY7        CHECK FOR EOR
  
 CPY6     WRCW   N,WSB,WSBL 
          READW  S,WSB,WSBL 
 CPY7     ZR     X1,CPY6     IF NOT EOR 
 CPY8     WRCW   N,WSB,X1-WSB,R 
          SA2    CPYB 
          SX6    X2-ODRT
          NZ     X6,CPY4     IF NOT END OF USER LIBRARY 
          RECALL S
          SA3    S+2
          BX7    X3          SET BUFFER EMPTY 
          SA7    A3+B1
  
*         CLEAR PROGRAM NAME. 
  
 CPY9     SA1    N-2
          NG     X1,CPY10    IF CONTROL WORD WRITE ENABLED
          RJ     RCW
  
 CPY10    ADDWRD NPT,NIND    WRITE NEW INDEX
          SA1    P.PNT       CLEAR PROGRAM NAME 
          SA2    CPYA 
          SB5    X1 
          SX6    B0 
          SA6    B5+X2
          SX7    B1 
          SA7    CW 
          EQ     CPYX        RETURN 
  
*         END OF FILE DETECTED.  ABORT JOB. 
  
 CPY11    CALL   MSG,(CPYB+1),(=C*          NOT DECLARED NRANDOM.*) 
          SA1    CDOP        CHECK *NA* OPTION
          NZ     X1,CPY9     IF NO ABORT
          CALL   ABT
  
  
 CPYA     DATA   0           PNT INDEX
  
 CPYB     VFD    42/,18/     PROGRAM NAME 
          VFD    42/,18/     FILE AND POSITION
  
 CPYD     DATA   0           EOR INDICATION 
 CRR      SPACE  4,10 
**        CRR - CHECK RECORDS REPLACED. 
* 
*         USES   A - ALL. 
*                X - ALL. 
*                B - 2, 3, 6, 7.
* 
*         CALLS  ABT, CFN, COB, C6S, MST, LOL, OCC, OIC, OSB, STB.
* 
*         MACROS CALL, SEARCH.
  
  
 CRR      SUBR               ENTRY/EXIT 
          CALL   STB,CRRC    SET TITLE BUFFER 
          SB6    B0+
          CALL   STB,CRRD 
          SB6    B1 
          SX6    B0 
          SA6    CRRA 
 CRR1     SA1    P.PNT       CHECK PROGRAM NAME TABLE 
          SA2    L.PNT
          SA3    CRRA 
          SB6    X2 
          SB7    X3 
 CRR2     EQ     B6,B7,CRR3  IF END OF PNT
          SA4    X1+B7       CHECK PNT ENTRY
          SB7    B7+3 
          ZR     X4,CRR2     IF PROGRAM REPLACED
          SX6    B7 
          SA6    A3 
          SEARCH NRT,(A4+B1),(=77777777777777000000B) 
          NZ     X6,CRR1     IF FILE IN NO REPLACE TABLE
          SA1    CRRB        INCREMENT ERROR COUNT
          SX6    X1+B1
          SA6    A1 
          CALL   COB         CLEAR OUTPUT BUFFER
          SA1    CRRA        OUTPUT RECORD, TYPE, AND FILE
          SA2    P.PNT
          SB6    X1-3 
          SA1    B6+X2
          SA2    A1+B1
          MX0    42 
          BX6    X0*X1
          BX7    X0*X2
          SA6    OUTPUTB+1
          SA3    X1+NAMA
          BX6    X3 
          SA6    A6+B1
          SA7    A6+B1
          CALL   LOL         LIST ONE LINE
          EQ     CRR1        LOOP TO END OF PNT 
  
*         CHECK DELETE PROGRAM TABLE. 
  
 CRR3     SB6    B0+         SET TITLE
          CALL   STB,CRRF 
          SB6    B1+
          CALL   STB,CRRG 
          SX6    B0 
          SA6    CRRA 
  
*         OUTPUT ERROR MESSAGE. 
  
          SA1    CRRB 
          BX6    X1 
          SA6    CRRB+2 
          ZR     X1,CRR4     IF NO ERRORS 
          CALL   C6S,CRRB,CRRA
          CALL   MSG,CRRA,(=C*       RECORD(S) NOT REPLACED.*)
          SX6    B0 
          SA6    CRRA 
          SA6    CRRB 
 CRR4     CALL   COB         CLEAR OUTPUT BUFFER
          SA1    P.DPT
          SA2    L.DPT
          SA3    CRRA 
          SB6    X2 
          SB7    X3 
          SX0    7777B       DELETE FLAG
 CRR5     EQ     B6,B7,CRR7  IF END OF DPT
          SA4    X1+B7
          BX5    X0-X4       COMPARE WITH DELETE FLAG 
          SB7    B7+2 
          ZR     X5,CRR5     IF PROGRAM DELETED 
          MX5    -12         CHECK FOR -TYPE/*- 
          LX4    12 
          BX5    -X5*X4 
          LX4    -12
          SX5    X5-1R**100B
          ZR     X5,CRR5     IF -TYPE/*- ENTRY
          SA1    CRRB        INCREMENT ERROR COUNT
          SX6    X1+B1
          SA6    A1 
          SA5    A4+B1       SET DELETE ENTRY 
          SA1    LIBP        ISOLATE RECORD NAME
          BX6    -X1*X4 
          MX0    -12         ISOLATE RECORD TYPE
          BX4    -X0*X4 
          LX7    X5 
          SA6    CRRE 
          SA7    A6+B1
          SX6    B7 
          SA6    A3 
          SA1    =10H*DELETE
          BX7    X1 
          SA7    OUTPUTB+1
          CALL   CFN,(X4+OICD)
          CALL   CFN,CRRE    OUTPUT PROGRAM NAME
          SA1    CRRE        CHECK FOR END OF DELETE
          SA2    A1+B1
          BX6    X1-X2
          ZR     X6,CRR6     IF FIRST PROGRAM = LAST PROGRAM
          CALL   CFN,(=1L-) 
          SA2    CRRE+1      OUTPUT LIBRARY NAME
          CALL   CFN,(X2+OICD)
          CALL   CFN,(CRRE+1) 
 CRR6     CALL   OSB         OUTPUT STRING BUFFER 
          EQ     CRR4        LOOP TO END OF DPT 
  
**        CHECK INSERT PROGRAM TABLE. 
  
 CRR7     SA1    CRRB        SAVE ERROR COUNT 
          SA2    A1+B1
          IX6    X1+X2
          SA6    A2 
          SX6    B0 
          SA6    A1 
          SA6    CRRA 
 CRR8     SA1    P.IPT
          SA2    L.IPT
          SA3    CRRA 
          SB6    X2 
          SB7    X3 
 CRR9     EQ     B6,B7,CRR10 IF END OF INSERT PROGRAM TABLE 
          SA4    X1+B7
          SB7    B7+4 
          ZR     X4,CRR9     IF PROGRAMS INSERTED 
          SX6    B7 
          SA6    A3 
          SX6    X6-4 
          SA6    CRRH 
          CALL   OIC,A6      OUTPUT INSERT DIRECIVE 
          SA2    CRRB        INCREMENT ERROR COUNT
          SX6    X2+B1
          SA6    A2 
          EQ     CRR8        LOOP TO END OF IPT 
  
**        CHECK COMMENT/DATE TABLE. 
  
 CRR10    SA1    CRRB        SAVE ERROR COUNT 
          SA2    A1+B1
          IX6    X1+X2
          SA6    A2 
          SX6    B0 
          SA6    A1 
          SA6    CRRA 
 CRR11    SA1    P.CDT
          SA2    L.CDT
          SA3    CRRA 
          SB6    X2 
          SB7    X3 
 CRR12    EQ     B6,B7,CRR13 IF END OF COMMENT/DATE TABLE 
          SA4    X1+B7       CHECK ENTRY
          SB7    B7+8 
          ZR     X4,CRR12    IF COMMENT PROCESSED 
          SX6    B7 
          SA6    A3 
          CALL   OCC,(B7-8)  OUTPUT COMMENT DIRECTIVE 
          SA2    CRRB 
          SX6    X2+B1
          SA6    A2 
          EQ     CRR11       LOOP TO END OF CDT 
  
**        OUTPUT ERROR MESSAGE. 
  
 CRR13    SA1    CRRB 
          SA2    A1+B1
          IX6    X1+X2
          SA6    A1 
          SA3    A2+B1
          IX3    X6+X3
          ZR     X3,CRRX     IF NO ERRORS 
          ZR     X6,CRR14    IF ALL DIRECTIVES PROCESSED
          SA1    TTYI 
          ZR     X1,CRRX     IF TTY INPUT 
          CALL   C6S,CRRB,CRRA
          CALL   MSG,CRRA,(=C*       DIRECTIVE ERROR(S).*)
 CRR14    SA1    CDOP        CHECK D OPTION 
          NZ     X1,CRRX     IF NO ABORT
          CALL   ABT         ABORT JOB
  
  
 CRRA     DATA   0           TABLE INDEX
  
 CRRB     DATA   0           ERROR COUNT
          DATA   0
          DATA   0
  
 CRRC     DATA   C*      ERROR DIRECTORY - RECORDS NOT REPLACED.* 
 CRRD     DATA   C*          RECORD    TYPE      FILE*
  
 CRRE     VFD    42/,18/     DPT ENTRY - 42/PROG1,18/LIB1 
          VFD    42/,18/     42/PROG2,18/LIB2 
  
 CRRF     DATA   C*      ERROR DIRECTORY - DIRECTIVES NOT PERFORMED.* 
 CRRG     DATA   C*  *
 CRRH     DATA   0           INSERT PROGRAM TABLE INDEX 
          SPACE  4
**        C6S - CONVERT 6 DIGITS WITH LEADING ZERO SUPPRESSION. 
* 
*         ENTRY  (B2) = ADDRESS OF RIGHT JUSTIFIED NUMBER.
*                (B3) = ADDRESS TO STORE RESULT.
* 
*         USES   X - 0, 1, 2, 3, 4, 5, 6. 
*                A - 1, 2, 3, 6.
*                B - 2, 7.
  
  
 C6S      SUBR               ENTRY/EXIT 
          SA2    =0.1000000001P48 
          SA3    =10.0P0
          SA4    =1H
          SB6    6
          SB5    1R0-1R 
          SA1    B2 
          SB2    18 
          PX1    X1 
          BX6    X4 
 C6S1     DX4    X1*X2
          FX1    X1*X2
          SB7    X1 
          LX6    54 
          SB2    B2+B6
          FX5    X4*X3       CALCULATE REMAINDER DIGIT
          SX0    X5+B5
          IX6    X0+X6
          NZ     B7,C6S1     IF NOT ENTIRE NUMBER 
          LX6    X6,B2       POSITION NUMBER
          SA6    B3 
          EQ     C6SX        RETURN 
          SPACE  4
**        DIS - DISPLAY MESSAGE.
* 
*         ENTRY  (B2) = ADDRESS OF PROGRAM NAME.
*                (B3) = ADDRESS OF MESSAGE. 
* 
*         USES   A - 1, 2, 6, 7.
*                X - 0, 1, 2, 6, 7. 
  
  
 DIS      SUBR               ENTRY/EXIT 
          SA1    B2 
          SA2    B3 
          MX0    42 
          BX6    X2 
          BX7    X0*X1
          SA6    DISA 
          SA7    A6+B1
          MESSAGE A6,1
          EQ     DISX        RETURN 
  
  
 DISA     BSS    2
          SPACE  4
**        EPN - ENTER PROGRAM NAME IN NEW PROGRAM TABLE.
* 
*         ENTRY  (B2) = ADDRESS OF PROGRAM NAME AND TYPE. 
* 
*         USES   A - 1, 6, 7. 
*                X - 1, 6, 7. 
  
  
 EPN      SUBR               ENTRY/EXIT 
          SA1    B2 
          BX6    X1 
          SA6    NIND 
          SA1    SC 
          LX7    X1          SET RELATIVE SECTOR ADDRESS
          SA7    A6+B1
          EQ     EPNX        RETURN 
 GUL      SPACE  4,15 
**        GUL - GENERATE USER LIBRARY (*LIBGEN* CALL).
* 
*         SET UP CALLING PARAMETERS AND CALL *LIBGEN* 
*         PROGRAM (OVERLAYING PRESENT *LIBEDIT* ROUTINE)
*         TO GENERATE USER LIBRARY. 
* 
*         ENTRY  (GULC) THRU (GULJ) SET UP FOR CALL.
* 
*         EXIT   TO *LIBGEN*. 
* 
*         MACROS MESSAGE, OVERLAY, RECALL, SETLOF.
  
  
 GUL      SUBR               ENTRY/EXIT 
          SA1    CULB 
          ZR     X1,GULX     IF NO *U* OPTION 
          RECALL OUTPUT 
          MESSAGE (=C* LIBGEN*),1 
          RECALL S
          RECALL OLD
          RECALL NEW
          SA1    GULC        MOVE PARAMETERS TO ARGR
          BX6    X1 
          SA6    ARGR 
 GUL2     ZR     X6,GUL3     IF END OF MOVE 
          SA1    A1+B1
          BX6    X1 
          SA6    A6+1 
          EQ     GUL2        MOVE NEXT ARGUMENT 
  
 GUL3     SX7    A6-ARGR
          SA2    FL 
          SA7    ACTR        SET NUMBER OF PARAMETERS 
          LX2    30 
          SA0    X2+
          SETLOF =0          CLEAR LIST OF FILES POINTER
          OVERLAY GULA,,SYSTEM
          PS
  
  
 GULA     VFD    36/6LLIBGEN,24/0 
  
 GULC     VFD    42/0LF,18/1R=
 GULD     VFD    42/0LZZZZZG2,18/0
          VFD    42/0LP,18/1R=
 GULF     VFD    42/0LNEW,18/0
          VFD    42/0LN,18/1R=
 GULH     VFD    42/0LULIB,18/0 
          VFD    42/0LNX,18/1R= 
 GULJ     VFD    42/0L0,18/0
          CON    0           END OF ARGUMENTS FOR *LIBGEN*
 ILO      SPACE  4,10 
**        ILO - INTERPRET LIST OPTIONS. 
* 
*         ENTRY  (A1) = ADDRESS OF OPTION WORD. 
*                (X1) = LIST OPTIONS. 
* 
*         EXIT   ((A1)) = INTERPRETTED LIST OPTIONS.
*                 (X1)  = 0  IF NO ERROR. 
* 
*         USES   X - 0, 1, 2, 3, 4, 6.
*                A - 2, 6.
  
  
 ILO4     SA6    A1+         SET LIST OPTIONS 
  
 ILO      SUBR               ENTRY/EXIT 
          SX6    B0+         INITIALIZE INTERPRETTED LIST OPTIONS 
          MX0    6
 ILO1     SA2    ILOA-1 
          BX4    X0*X1
 ILO2     SA2    A2+B1
          ZR     X2,ILO3     IF END OF OPTIONS
          BX2    X4-X2
          BX3    X0*X2
          NZ     X3,ILO2     IF NO MATCH
          SX3    X2 
          BX6    X3+X6
          BX1    -X0*X1 
          ZR     X1,ILO4     IF ALL OPTIONS PROCESSED 
          LX1    6
          EQ     ILO1        PROCESS NEXT OPTION
  
 ILO3     SX1    B1+         SET ERROR
          EQ     ILOX        RETURN 
  
  
 ILOA     CON    1LF+17B     FULL 
          CON    1LC+4B      DIRECTIVES 
          CON    1LM+2B      SHORT
          CON    1LE+1B      ERRORS 
          CON    1LN+10B     RECORDS WRITTEN
          CON    0
 LIT      SPACE  4,15 
**        LIT - LIST IGNORE TABLE.
* 
*         EXIT   (X6) = ERROR COUNT.
* 
*         USES   A - 1, 2, 3, 6, 7. 
*                X - 1, 2, 3, 6, 7. 
*                B - 2. 
* 
*         CALLS  CFN, COB, LOL, OSB.
* 
*         MACROS CALL, WRITEC.
  
  
 LIT      SUBR               ENTRY/EXIT 
 LIT1     SA1    P.PIT
          SA2    L.PIT
          SA3    LITA        PIT INDEX
          BX6    X2-X3
          NZ     X6,LIT2     IF NOT END OF TABLE
          SA1    LITB        ERROR COUNT
          BX6    X1 
          EQ     LITX        RETURN 
  
 LIT2     IX1    X1+X3
          SA2    X1 
          NZ     X2,LIT4     IF ENTRY NOT PROCESSED 
 LIT3     SA3    LITA        ADVANCE PIT INDEX
          SX6    X3+3 
          SA6    LITA 
          EQ     LIT1        LOOP 
  
*         LIST UNPROCESSED ENTRY. 
  
 LIT4     BX6    X2          COPY IPT ENTRY 
          SA1    A2+B1
          SA6    LITC 
          BX7    X1 
          SA2    A1+B1
          SA7    A6+B1
          BX6    X2 
          SA6    A7+B1
          SX1    1R*
          LX1    54 
          ZR     X7,LIT5     IF START OF IGNORE FOUND 
          BX6    X6-X1
          AX6    18 
          NZ     X6,LIT6     IF NOT IGNORE ALL OF TYPE
 LIT5     BX7    X7-X1
          AX7    18 
          ZR     X7,LIT3     IF IGNORE TO END OF FILE 
 LIT6     CALL   COB         CLEAR OUTPUT BUFFER
          WRITEC OUTPUT,(=C* *) 
          SA1    =H/ *ERROR*  DIRECTIVE CANNOT BE PERFORMED./ 
          SB2    4
          BX6    X1 
          SA6    OUTPUTB
 LIT7     SA1    A1+B1
          SB2    B2-B1
          BX6    X1 
          SA6    A6+B1
          NZ     B2,LIT7     IF NOT 4 WORDS 
          CALL   LOL         LIST ONE LINE
          CALL   COB         CLEAR OUTPUT BUFFER
          SA2    =5H*FILE    LIST FILE NAME 
          BX6    X2 
          SA6    OUTPUTB+1
          CALL   CFN,LITC    OUTPUT FILE NAME 
          CALL   OSB         OUTPUT STRING BUFFER 
          SA2    =7H*IGNORE  OUTPUT IGNORE CARD 
          SA1    LITC+1 
          BX6    X2 
          SA6    OUTPUTB+1
          NZ     X1,LIT8     IF IGNORE NOT STARTED
          CALL   CFN,(=6LTEXT/,)
          EQ     LIT9        OUTPUT PROGRAM NAME
 LIT8     CALL   CFN,X1+OICD
          CALL   CFN,LITC+1  OUTPUT PROGRAM NAME
          SA1    LITC+1      CHECK SINGLE IGNORE
          SA2    A1+B1
          BX6    X1-X2
          ZR     X6,LIT10    IF FIRST PROGRAM = LAST PROGRAM
 LIT9     CALL   CFN,(=1L-) 
          SA2    LITC+2      OUTPUT LIBRARY NAME
          CALL   CFN,X2+OICD
          CALL   CFN,LITC+2 
 LIT10    CALL   OSB         OUTPUT STRING BUFFER 
          SA1    LITB        ADVANCE ERROR COUNT
          SX6    X1+B1
          SA6    A1 
          EQ     LIT3        LOOP 
  
  
 LITA     CON    0           PIT INDEX
 LITB     CON    0           ERROR COUNT
  
 LITC     VFD    42/,18/     PIT ETRY - 42/FILE,18/ 
          VFD    42/,18/     42/PROG1,18/LIB1 
          VFD    42/,18/     42/PROG2,18/LIB2 
 LOL      SPACE  4,20 
**        LOL - LIST ONE LINE.
* 
*         ENTRY  (OUTPUTB) = LINE TO BE WRITTEN.
*                (LINE) = LINE NUMBER.
*                (BRFM) = 1  IF BRIEF MODE SET (NO TITLE).
*                (PAGE) = PAGE NUMBER.
*                (LL) = PAGE LINE LIMIT.
*                (PD) = PRINT DENSITY FORMAT CONTROL. 
*                (PDFLG) = 1 IF FORMAT CONTROL NOT WRITTEN. 
* 
*         EXIT   LINE AND PAGE NUMBER UPDATED.
* 
*         USES   A - 1, 2, 3, 6.
*                X - 0, 1, 2, 3, 6. 
*                B - 2, 5, 6, 7.
* 
*         CALLS  C6S. 
* 
*         MACROS CALL, WRITEC, WRITEH.
  
  
 LOL      SUBR               ENTRY/EXIT 
          SA1    LINE        CHECK LINE NUMBER
          SX6    X1+B1
          SA6    A1 
          SA3    A1+B1       GET LINE LIMIT 
          ERRNZ  LL-LINE-1   CODE DEPENDS ON CONSECUTIVE LOCATIONS
          IX6    X6-X3
          NG     X6,LOL1     IF NOT END OF PAGE 
          SX6    B0          RESET LINE COUNT 
          SA6    A1 
          SA3    TTYO 
          NZ     X3,LOL0     IF NOT TTY OUTPUT
          SA1    BRFM 
          NZ     X1,LOL1     IF BRIEF MODE SET
          WRITEH OUTPUT,TITA,TITAL  TITLE LINE
          WRITEH OUTPUT,TITE,TITEL  SUBTITLE
          WRITEC OUTPUT,(=C* *) 
          EQ     LOL1        CONTINUE 
  
 LOL0     SA2    PAGE 
          SX6    X2+B1
          SA6    A2 
          CALL   C6S,PAGE,LOLA
          SA1    TITD        INSERT PAGE NUMBER 
          LX6    36 
          MX0    24 
          BX1    X0*X1
          BX6    -X0*X6 
          BX6    X6+X1
          SA6    A1 
          SA3    PDFLG       FLAG THAT FORMAT CONTROL WAS WRITTEN 
          BX7    X7-X7
          SA7    A3 
          WRITEW O,A3-B1,X3  CONDITIONALLY WRITE FORMAT EFFECTOR
          ERRNZ  PDFLG-PD-1  CODE DEPENDS ON CONSECUTIVE LOCATIONS
          WRITEC OUTPUT,(=C*1*) 
          WRITEH OUTPUT,TITA,TITE-TITA WRITE TITLE LINE 
          WRITEC OUTPUT,(=C* *) 
          WRITEH OUTPUT,TITE,TITF-TITE WRITE SUBTITLE LINE
          WRITEC OUTPUT,(=C* *) 
          SX6    5           RESET LINE COUNT 
          SA6    LINE 
 LOL1     SX2    1R          BLANK FILL LINE
          SB6    OUTPUTB
          SB7    OUTPUTB+DCBL+1 
          SA1    B6 
          MX0    54 
 LOL2     BX6    X1 
          SA6    A1 
          EQ     B6,B7,LOL4  IF END-OF-LINE 
          SA1    B6 
          SB6    B6+B1
          SB5    10 
 LOL3     ZR     B5,LOL2     IF END-OF-WORD 
          LX0    6
          LX2    6
          BX6    -X0*X1 
          SB5    B5-B1
          NZ     X6,LOL3     IF CHARACTER .NE. 00 
          BX1    X1+X2
          EQ     LOL3        LOOP 
  
 LOL4     WRITEH OUTPUT,OUTPUTB,DCBL+1
          EQ     LOLX        RETURN 
  
  
 LOLA     VFD    60/         PAGE NUMBER (DISPLAY CODE) 
 MSG      SPACE  4,10 
**        MSG - SEND DAYFILE MESSAGE. 
* 
*         ENTRY  (B2) = ADDRESS OF PROGRAM NAME.
*                (B3) = ADDRESS OF MESSAGE. 
* 
*         USES   A - 1, 2, 6. 
*                X - 0, 1, 2, 3, 4, 6.
* 
*         MACROS MESSAGE. 
  
  
 MSG      SUBR               ENTRY/EXIT 
          MX0    42 
          SA1    B3 
          SA2    B2 
          BX3    X0*X2
          BX1    -X0*X1 
          BX6    X3+X1
          MX0    6
          SA6    B3 
          SX4    1R 
          LX0    24 
          LX4    18 
          BX1    X0*X6
          NZ     X1,MSG2     IF NO BLANKS 
 MSG1     IX6    X6+X4       BLANK FILL FILE NAME 
          LX0    6
          LX4    6
          BX1    X0*X6
          ZR     X1,MSG1
          SA6    B3 
 MSG2     MESSAGE B3,,R      SEND MESSAGE TO DAYFILE
          EQ     MSGX        RETURN 
  
 IDT      SPACE  4
**        IDT - ISSUE INCORRECT DEVICE MESSAGE. 
* 
*         ENTRY  (A1) = FET ADDRESS + 1.
*                (X7) = 0.
* 
*         EXIT   TO ABT.
* 
*         USES   A - 1, 7.
*                B - 4. 
*                X - 0, 1, 2, 3, 4, 6, 7. 
* 
*         CALLS  MSG=.
  
  
 IDT      MX0    42 
          SA1    A1-B1       READ FILE NAME 
          MX3    26+10
          BX6    X0*X1
          MX2    6
          LX3    59          POSITION LEGAL CHARACTER MASK
          BX1    X1-X1
          MX0    -6 
 IDT1     LX7    6
          BX7    X7+X1       ASSEMBLE FILE NAME 
          LX6    6
          BX1    -X0*X6 
          SB4    X1          FIND END OF FILE NAME
          LX4    B4,X3
          NG     X4,IDT1     IF NOT END OF NAME 
          LX7    6
          SX1    1R.         ADD *.* TO FILE NAME 
          BX7    X7+X1
 +        LX7    6           LEFT JUSTIFY ASSEMBLY
          BX6    X2*X7
          ZR     X6,*        IF NOT LEFT JUSTIFIED
          SA7    IDTB 
          MESSAGE IDTA
          CALL   ABT
  
  
 IDTA     DATA   30H UNKNOWN DEVICE TYPE -- LFN = 
 IDTB     CON    0
          SPACE  4
**        OCC - OUTPUT COMMENT DIRECTIVE. 
* 
*         ENTRY  (B2) = INDEX IN COMMENT/DATE TABLE.
*         USES   A - 1, 5, 6. 
*                X - 0, 1, 5, 6, 7. 
*                B - 4, 6, 7. 
* 
*         CALLS  CFN, OSB.
* 
*         MACROS CALL.
  
  
 OCC      SUBR               ENTRY/EXIT 
          SA1    P.CDT
          SX6    X1+B2
          SA6    OCCA 
          SA2    =1H
          BX6    X2 
          SA6    OUTPUTB
          SA1    X1+B2       SET *DATE OR *COMMENT
          LX1    60-17
          SX7    B1 
          BX6    X7*X1
          SA2    OCCB+X6
          BX6    X2 
          SA6    A6+B1
          AX1    -17+60      OUTPUT LIBRARY NAME
          CALL   CFN,(X1+OICD)
          SA1    OCCA        OUTPUT PROGRAM NAME
          CALL   CFN,X1 
          CALL   CFN,(=1L )  OUTPUT BLANK 
          SA1    OCCA        OUTPUT COMMENT 
          SB6    X1 
          MX0    54 
          SB7    B6+8 
          SA1    SBP         SET STRING BUFFER POINTER
          SB4    X1 
 OCC1     SB6    B6+B1       DISASSEMBLE COMMENT INTO STRING BUFFER 
          EQ     B6,B7,OCC3  IF END OF COMMENT
          SA5    B6 
          SB5    B4+10
 OCC2     EQ     B4,B5,OCC1  IF END OF WORD 
          LX5    6
          BX6    -X0*X5 
          SA6    B4 
          SB4    B4+B1
          NZ     X6,OCC2     IF NOT END OF COMMENT
 OCC3     SX6    B0          SET END OF BUFFER
          SA6    B4 
          SX7    B4 
          SA7    A1 
          CALL   OSB         OUTPUT STRING BUFFER 
          EQ     OCCX        RETURN 
  
  
 OCCA     VFD    60/         COMMENT ADDRESS
 OCCB     DATA   10H*COMMENT
          DATA   10H*DATE 
          SPACE  4
**        ODP - OUTPUT DELETED PROGRAM. 
* 
*         ENTRY  (B2) = ADDRESS OF PROGRAM NAME.
* 
*         USES   A - 1, 2, 6, 7.
*                X - 0, 1, 2, 3, 6, 7.
*                B - 2. 
* 
*         CALLS  COB, ORW.
* 
*         MACROS CALL.
  
  
 ODP      SUBR               ENTRY/EXIT 
          CALL   COB         CLEAR OUTPUT BUFFER
          MX0    42 
          SA1    B2          SET PROGRAM NAME 
          SA2    X1+NAMA
          BX1    X0*X1
          SX3    1R)         ADD *)* AT END OF NAME 
          MX0    54 
 +        LX3    54 
          LX0    54 
          BX7    -X0*X1 
          BX6    X1+X3
          NZ     X7,*-1      LOOP FOR END OF NAME 
          SA6    OUTPUTB+1
          LX7    X2 
          SA7    A6+B1
          SB2    =9HDELETED-( 
          CALL   ORW,B2,OLD 
          EQ     ODPX        RETURN 
 OIC      SPACE  4,15 
 ODPL     BSS    0
          SPACE  4
**        OIC - OUTPUT INSERT DIRECTIVE.
* 
*         OUTPUT AN INSERT DIRECTIVE THAT CAN NOT BE FOLLOWED.
* 
*         ENTRY  (B2) = ADDRESS OF INSERT PROGRAM TABLE INDEX.
* 
*         USES   A - 1, 2, 3, 4, 5, 6, 7. 
*                X - ALL. 
*                B - 2, 5, 6, 7.
* 
*         CALLS  CFN, LOL.
* 
*         MACROS CALL.
  
  
 OIC      SUBR               ENTRY/EXIT 
          SA2    B2 
          SA1    P.IPT
          SB6    X1 
          SA4    B6+X2
          SA5    A4+B1
          BX6    X4 
          LX7    X5 
          SA6    OICA 
          SA7    A6+B1
          SA4    A5+B1
          SA5    A4+B1
          BX6    X4 
          LX7    X5 
          SA6    A7+B1
          SB6    OICB        *DIRECTIVE CAN NOT BE PERFORMED.*
          SB7    OICB+OICBL 
          SB5    OUTPUTB
          SA7    A6+B1
          SB5    B6-B5
 +        SA1    B6 
          BX6    X1 
          SA6    B6-B5
          SB6    B6+B1
          NE     B6,B7,*-1
          CALL   LOL         LIST ONE LINE
          SA1    =10H 
          BX6    X1 
          SA6    OUTPUTB
          SA1    =10H*FILE
          BX6    X1 
          SA6    A6+B1
          SB2    OICA+1      CONVERT FILE NAME
          CALL   CFN,B2 
          CALL   OSB         OUTPUT STRING BUFFER 
          SA1    OICA        CHECK FOR *REPLACE* *INSERT* OR *BEFORE* 
          SA3    OICA+2 
          BX7    X1-X3
          SA2    =10H*REPLACE 
          SX6    B1 
          BX3    X1 
          LX1    60-17
          ZR     X7,OIC1     IF *REPLACE* 
          BX6    X6*X1
          SA2    OICC+X6
          MX0    6
          BX6    X0*X3
          NZ     X6,OIC1     IF *INSERT* OR *BEFORE*
          SA2    =10H*ADD 
          BX6    X2 
          SA6    OUTPUTB+1
          CALL   CFN,ADPB    OUTPUT *LIB* PREFIX
          BX1    X3          CONVERT LIBRARY NAME 
          AX1    42 
          RJ     CDD         CONVERT LIBRARY NUMBER TO DISPLAY
          SB2    B2-B1       OUTPUT CONVERTED LIBRARY NUMBER
          MX6    1
          AX6    B2 
          BX6    X6*X4
          SA6    OICE 
          CALL   CFN,OICE 
          EQ     OIC2 
  
 OIC1     BX6    X2 
          SA6    OUTPUTB+1
          AX1    -17+60      OUTPUT LIBRARY NAME
          CALL   CFN,(X1+OICD)
          CALL   CFN,OICA    OUTPUT PROGRAM NAME
 OIC2     CALL   CFN,(=1L,) 
          SA1    OICA+2      OUTPUT FIRST PROGRAM NAME
          CALL   CFN,(X1+OICD)
          CALL   CFN,(OICA+2) 
          SA1    OICA+2      OUTPUT LAST PROGRAM NAME 
          SA2    A1+B1
          BX6    X1-X2
          ZR     X6,OIC3     IF FIRST PROGRAM = LAST PROGRAM
          CALL   CFN,(=1L-) 
          SA2    OICA+3 
          CALL   CFN,(X2+OICD)
          CALL   CFN,(OICA+3) 
 OIC3     CALL   OSB         OUTPUT STRING BUFFER 
          EQ     OICX        RETURN 
  
  
 OICA     VFD    42/,1/,17/  IPT ENTRY - 42/PROG1,1/BEFORE,17/LIB1
          VFD    42/,18/     42/FILE,18/0 
          VFD    42/,18/     42/PROG2,18/LIB2 
          VFD    42/,18/     42/PROG3,18/LIB3 
  
 OICB     DATA   H/ *ERROR* - *DIRECTIVE CAN NOT BE PERFORMED./ 
 OICBL    EQU    *-OICB 
  
 OICC     DATA   0H*INSERT
          DATA   0H*BEFORE
  
 OICD     BSS    0
 .E       ECHO   ,RT=("RTMIC")
 .A       IFC    NE,/RT// 
          DATA   L.RT/. 
 .A       ELSE
          DATA   0
 .A       ENDIF 
 .E       ENDD
  
OICE      BSS    1
          SPACE  4
**        ORW - OUTPUT RECORDS WRITTEN ON FILE *NEW*. 
* 
*         ENTRY  (B2) = ADDRESS OF *INSERT*, *DELETED*, *REPLACED*, 
*                OR *       *.
*                (B3) = ADDRESS OF FILE NAME. 
* 
*         USES   A - 1, 2, 3, 6, 7. 
*                X - 0, 1, 2, 3, 6, 7.
*                B - 2. 
* 
*         CALLS  LOL. 
  
  
 ORW      SUBR               ENTRY/EXIT 
          SA1    LIST 
          SX2    10B+2B 
          BX1    X2*X1
          ZR     X1,ORWX     IF LIST OPTION IS OFF
          SA2    B2          SET STATUS AND FILE NAME 
          SX6    10B
          BX1    X6*X1
          NZ     X1,ORW1     IF FULL LIST OPTION ON 
          SA3    =1H
          BX6    X2-X3
          NZ     X6,ORW1     IF COMMENT MESSAGE 
          SA3    OUTPUTB+1   CHECK FOR RENAME 
          MX0    60-12
          BX6    -X0*X3 
          SX7    X6-2R* 
          NZ     X7,ORWX     IF NO RENAME 
 ORW1     SA3    B3 
          BX6    X2 
          MX0    42 
          LX6    54 
          BX7    X0*X3
          SA6    OUTPUTB
          SA7    OUTPUTB+3
          SA1    TTYO 
          NZ     X1,ORW3     IF NOT TTY OUTPUT
          BX6    X6-X6
          SB2    DCBL-5 
          SA6    OUTPUTB+5
 ORW2     SA6    A6+B1       CLEAR COMMENT FIELD
          SB2    B2-B1
          NZ     B2,ORW2     IF NOT END OF BUFFER 
 ORW3     RJ     LOL         LIST ONE LINE
          EQ     ORWX        RETURN 
          SPACE  4
**        OSB - OUTPUT STRING BUFFER. 
* 
*         ENTRY (OUTPUTB) = STRING BUFFER.
* 
*         USES   X - 1, 6.
*                A - 1, 6.
*                B - 4, 5, 6, 7.
* 
*         CALLS  LOL. 
* 
*         MACROS CALL.
  
  
 OSB      SUBR               ENTRY/EXIT 
          SX6    DSB         RESET STRING BUFFER POINTER
          SA6    SBP
          SB6    OUTPUTB+2
          SB7    OUTPUTB+DCBL 
          SA1    DSB
          SB4    10 
          SX6    B0 
          SB5    B4 
          EQ     OSB2 
  
 OSB1     SA6    B6          STORE WORD 
          SB6    B6+B1
          SB5    B4 
          SX6    B0 
 OSB2     ZR     B5,OSB1     IF END OF WORD 
          LX6    6
          BX6    X6+X1
          SA1    A1+B1
          SB5    B5-B1
          NZ     X1,OSB2     IF NOT END OF STRING BUFFER
          SA1    A1-B1
          SX1    1R 
          NZ     B5,OSB2     IF NOT END OF WORD 
          SA1    =10H 
          SA6    B6 
          BX6    X1 
 OSB3     SB6    B6+B1       BLANK FILL WORKING STORAGE 
          SA6    B6 
          NE     B6,B7,OSB3 
          CALL   LOL
          EQ     OSBX        RETURN 
 OZR      SPACE  4,15 
**        OZR - OUTPUT ZERO LENGTH RECORD.
* 
*         ENTRY  (B2) = ADDRESS OF STATUS.
*                (B3) = ADDRESS OF FILE NAME. 
*                (B4) = ADDRESS OF PROGRAM NAME.
* 
*         USES   A - 1, 6.
*                X - 1, 2, 6. 
* 
*         CALLS  COB, LOL, ORW. 
* 
*         MACROS CALL.
  
  
 OZR      SUBR               ENTRY/EXIT 
          CALL   COB         CLEAR OUTPUT BUFFER
          SA1    B4 
          BX6    X1          SET PROGRAM NAME 
          SA6    OUTPUTB+1
          CALL   ORW,B2,B3   OUTPUT RECORD WRITTEN
          CALL   COB         CLEAR OUTPUT BUFFER
          SA1    LIST        CHECK LIST OPTION
          SX2    10B
          BX1    X2*X1
          ZR     X1,OZR      IF FULL LIST OPTION OFF
          CALL   LOL         LIST ONE LINE
          EQ     OZRX        RETURN 
          SPACE  4
**        RCF - READ ALL CORRECTION FILES.
* 
*         READ CORRECTION FILES, IGNORING RECORDS IN THE IGNORE TABLE.
*         MAKE ENTRYS IN THE PROGRAM NAME TABLE.
* 
*         USES   A - 1, 2, 3, 4, 6, 7.
*                X - 0, 1, 2, 3, 4, 6, 7. 
*                B - 2, 3, 6, 7.
* 
*         CALLS  CIT, CVD, DIS, SRT.
* 
*         MACROS ADDWRD, BKSP, CALL, OPEN, READCW, READW, REWIND, WRCW, 
*                WRITECW. 
  
  
 RCF11    WRITECW  S,R       FLUSH BUFFER 
          REWIND X2,R 
          SX7    1           INITIALIZE SECTOR COUNT
          SA7    SC 
  
 RCF      SUBR               ENTRY/EXIT 
          OPEN   S,WRITE,R
          WRITECW S,*        SET FILE STATUS
          SA3    S+4
          BX6    X6-X6
          AX3    18          EXTRACT PRU SIZE 
          SA6    RCFA 
          SX7    X3+
          SA7    S-1
 RCF1     SX6    B0          CLEAR PROGRAM TYPE 
          SA6    RCFE 
          SA1    P.FNT       DO LOOP TO READ CORRECTION FILE
          SA2    L.FNT
          SA3    RCFA 
          SB2    X2 
          SB3    X3 
          EQ     B2,B3,RCF11 IF END OF TABLE
          SA4    X1+B3       READ FILE NAME 
          MX0    42 
          BX6    X4 
          SA6    RCFC+1 
          BX6    X0*X4
          SX7    17B         SET NAME IN FET
          BX7    X6+X7
          SA6    RCFB 
          SA7    LGO
          OPEN   A7,READ,R
          SA1    LGO+1       CHECK VALID DEVICE 
          RJ     CVD
          ZR     X7,IDT      IF CONTROL WORD I/O NOT SUPPORTED
          READCW LGO,17B
 RCF2     SA1    SC 
          BX7    X1          STORE RANDOM ADDRESS 
          SA7    RCFC+2 
          READW  LGO,WSB,WSBL READ 1 SECTOR 
          PL     X1,RCF4     IF NOT EOF 
 RCF3     BKSP   LGO,R
          SA1    RCFA        INCREMENT FILE INDEX 
          SX6    X1+B1
          SA6    A1 
          EQ     RCF1        LOOP TO READ NEXT FILE 
  
 RCF4     BX6    X1          SET EOR INDICATOR
          SA6    RCFD 
          SB7    X1 
          SB6    WSB
          EQ     B6,B7,RCF2  IF 0-LENGTH RECORD 
  
*         CHECK PROGRAM TYPE, CHECK IGNORE TABLE, AND MAKE
*         ENTRY INTO THE PROGRAM NAME TABLE.
  
          SA1    X2-LWP      LWA+1 OF DATA TRANSFERED 
          SX2    WSB         FWA OF BUFFER
          RJ     SRT         SET RECORD TYPE
          SA6    RCFC 
          CALL   DIS,RCFC,(=H*READING  *) 
  
*         COPY REST OF RECORD.
  
          SA1    RCFD 
          NZ     X1,RCF6     IF EOR READ
 RCF5     WRCW   S,WSB,WSBL 
          READW  LGO,WSB,WSBL 
          ZR     X1,RCF5     IF NOT EOR READ
          SA1    LGO-LWP     LWA + 1 OF DATA TRANSFERED 
 RCF6     WRCW   S,WSB,X1-WSB,R 
          CALL   CIT,RCFB,RCFC
          SA1    RCFC        GET RECORD TYPE
          NZ     X6,RCF7     IF NOT IGNORED 
          SB7    X1-ULRT
          ZR     B7,RCF8     IF TYPE *ULIB* 
          JP     RCF2        READ NEXT RECORD 
  
 RCF7     SX6    X1-ODRT
          ZR     X6,RCF2     IF RECORD IS *OPLD*
          SA2    CULB 
          ZR     X2,RCF7.1   IF NOT *ULIB* MODE 
          SX6    X1-ULRT
          ZR     X6,RCF2     IF *ULIB* SKIP RECORD
 RCF7.1   ADDWRD PNT,RCFC 
          SA1    RCFC        CHECK PROGRAM TYPE 
          SB7    X1-ULRT
          NZ     B7,RCF2     IF NOT TYPE *ULIB* 
  
*         COPY USER LIBRARY.
  
 RCF8     READW  LGO,WSB,WSBL 
          NG     X1,RCF3     IF EOF 
          SB6    WSB
          SB7    X1 
          EQ     B6,B7,RCF10 IF 0-LENGTH RECORD 
          BX6    X1          SET EOR INDICATOR
          SA6    RCFD 
          SA1    X2-LWP      LWA+1 OF DATA TRANSFERED 
          SX2    WSB
          RJ     SRT         SET RECORD TYPE
          SA6    RCFE 
          SA1    RCFD 
          NZ     X1,RCF10    IF EOR 
 RCF9     WRCW   S,WSB,WSBL 
          READW  LGO,WSB,WSBL 
          ZR     X1,RCF9     IF NOT EOR 
 RCF10    WRCW   S,WSB,X1-WSB,R 
          SA2    RCFE 
          SX6    X2-ODRT
          NZ     X6,RCF8     IF NOT OPLD
          EQ     RCF2        READ NEXT RECORD 
  
  
 RCFA     DATA   0           INDEX IN FNT 
 RCFB     VFD    42/,18/     CURRENT FILE NAME
  
 RCFC     VFD    42/,18/     42/PROGRAM,18/TYPE 
          VFD    42/,18/     42/FILE,18/ADDRESS 
          VFD    60/         60/POSITION
  
 RCFD     DATA   0           EOR INDICATOR
 RCFE     DATA   0           USER LIBRARY RECORD NAME 
 RFN      SPACE  4,10 
**        RFN - REPLACE FILE NAME.
* 
*         ENTRY  (A1) = ADDRESS OF ENTRY IN LIST OF FILES.
*                (X1) = CONTENTS OF ENTRY IN LIST OF FILES. 
*                (X6) = NEW FILE NAME.
* 
*         EXIT   FILE NAME CHANGED. 
* 
*         USES   A - 3, 6.
*                X - 0, 1, 2, 3, 6. 
  
  
 RFN      SUBR               ENTRY/EXIT 
          MX0    -18
          BX1    -X0*X1      EXTRACT ADDRESS OF FET 
          SA3    X1          READ FET+0 
          BX2    X0*X6
          SX6    1R0
          LX6    -6 
          BX6    X6-X2
          ZR     X6,RFN1     IF FILE NAME = *0* 
          BX6    X2 
          ZR     X6,RFN1     IF NO NEW FILE NAME
          BX3    -X0*X3 
          BX6    X3+X6
 RFN1     SA6    A3 
          BX6    X0*X6
          BX6    X6+X1
          SA6    A1 
          EQ     RFNX        RETURN 
 RNP      SPACE  4,10 
**        RNP - RENAME PROGRAM. 
*         ENTRY  (B2) = ADDRESS OF PROGRAM NAME.
*         EXIT   (X6) = NEW PROGRAM NAME AND TYPE.
* 
*         USES   A - 1, 2, 3, 6.
*                X - 0, 1, 2, 3, 6. 
*                B - 2, 3, 4. 
* 
*         MACROS MESSAGE, SEARCH. 
  
  
 RNP      SUBR               ENTRY/EXIT 
          SX6    B2          SAVE PROGRAM NAME ADDRESS
          MX0    42 
          SA6    RNPA 
          SEARCH RNT,X6 
          SA1    RNPA 
          SB2    X6 
          SA2    X1 
          BX6    X2 
          ZR     B2,RNPX     IF NO RENAME 
          SA2    RNPA        CHECK RECORD TYPE
          SA3    X2 
          SB3    X3 
          ERRNZ  TXRT        CODE ASSUMES VALUE 
          SB4    B3+TXRT-PRRT  CHECK FOR TYPE *PROC*
          ZR     B3,RNP1     IF TYPE *TEXT* 
          NZ     B4,RNP2     IF NOT TYPE *PROC* 
 RNP1     MESSAGE  (=C* RENAME NOT ALLOWED FOR PROC OR TEXT RECORD.*) 
          EQ     RNPX        RETURN 
  
 RNP2     SA2    B2+B1
          BX6    X0*X2
          SX3    2R*
          BX6    X6+X3
          SA6    OUTPUTB+1
          BX6    X2 
          SA6    X1 
          EQ     RNPX        RETURN 
  
  
 RNPA     DATA   0           ADDRESS OF PROGRAM NAME
          SPACE  4
**        RWF - REWIND ALL FILES. 
* 
*         REWIND ALL RANDOM FILES ALONG WITH THE FILES IN THE RFT.
* 
*         USES   X - 0, 1, 2, 3, 6. 
*                A - 1, 2, 3, 6.
*                B - 6, 7.
* 
*         MACROS EVICT, REWIND. 
  
  
 RWF      SUBR               ENTRY/EXIT 
          EVICT  S,R
          SA1    P.FNT
          SA2    L.FNT
          SB6    X1 
          SB7    X2+B6
 RWF1     EQ     B6,B7,RWF2  IF END OF TABLE
          SA1    B6          CHECK IF FILE IS RANDOM
          MX0    42 
          SX6    3
          BX2    -X0*X1 
          BX1    X0*X1
          SB6    B6+B1
          BX6    X6+X1
          NZ     X2,RWF1     LOOP IF FILE IS NON-RANDOM 
          SA6    LGO
          REWIND A6,R 
          EQ     RWF1 
  
 RWF2     SA1    P.RFT       REWIND FILES IN THE REWIND FILE TABLE
          SA2    L.RFT
          SB6    X1 
          SB7    X2+B6
 RWF3     EQ     B6,B7,RWF4  IF END OF TABLE
          SA1    B6 
          SX6    3
          SB6    B6+B1
          BX6    X6+X1
          SA6    LGO
          REWIND A6,R 
          EQ     RWF3        LOOP 
  
 RWF4     SA1    CREW        CHECK FOR NO REWIND OPTION 
          ZR     X1,RWF5     IF NO REWIND 
  
          SX1    B1 
 RWF5     SX6    B1 
          BX6    X6-X1
          SA2    CVFY 
          SA3    CCPY 
          BX6    X6+X2
          BX6    X6+X3
          ZR     X6,RWFX     IF V AND C NOT SET AND R SET 
          REWIND OLD,R
          REWIND NEW,R
          EQ     RWFX        RETURN 
          SPACE  4
**        RWS - REWIND SEQUENTIAL FILES.
* 
*         REWIND SEQUENTIAL CORRECTION FILES THAT HAVE REWIND SELECTED. 
* 
*         USES   X - 0, 1, 2, 3, 6, 7.
*                A - 1, 2, 3, 6.
*                B - 6, 7.
* 
*         MACROS REWIND, SEARCH.
  
  
 RWS      SUBR               ENTRY/EXIT 
          SX6    B0 
          SA6    RWSA 
 RWS1     SA1    P.FNT
          SA2    L.FNT
          SA3    RWSA 
          SB6    X1 
          SB7    B6+X2
          SB6    B6+X3
          SX6    X3+B1
          EQ     B6,B7,RWSX  IF END OF FNT
          SA6    A3 
          SA1    B6          READ FILE NAME 
          MX0    42 
          BX6    -X0*X1 
          ZR     X6,RWS1     IF FILE IS RANDOM
          SEARCH RFT,B6,(=77777777777777000000B)
          ZR     X6,RWS1     IF FILE IS NOT IN RFT
          SA1    P.FNT       REWIND FILE
          SA3    RWSA 
          IX2    X1+X3
          MX0    42 
          SA2    X2-1 
          BX6    X0*X2
          SX7    B1 
          IX6    X6+X7
          SA6    A2 
          SA6    LGO
          REWIND A6,R 
          EQ     RWS1 
  
  
 RWSA     DATA   0           FNT INDEX
          SPACE  4
**        SMT - SEARCH MANAGED TABLE. 
* 
*         ENTRY  (B2) = ADDRESS OF TABLE POINTER. 
*                (B3) = ADDRESS OF ENTRY. 
*                (B4) = ADDRESS OF MASK.
*                (B5) = INDEX INTO TABLE. 
*         EXIT   (B6) = ADDRESS OF ADDRESS OF ENTRY IF FOUND. 
*                (B6) = ADDRESS OF 0 IF NOT FOUND.
*                (X6) = ADDRESS OF ENTRY IF FOUND 
*                (X6) = 0 IF NOT FOUND
* 
*         USES   A - 1, 2, 3, 4, 5, 6.
*                X - 1, 2, 3, 4, 5, 6.
*                B - 2, 3, 7. 
  
  
 SMT      SUBR               ENTRY/EXIT 
          SA1    B2          SET TABLE POINTER
          SA2    A1+B1       SET TABLE LENGTH 
          SA3    A2+B1       SET NUMBER OF WORDS/ENTRY
          SA4    B3          (X4) = ENTRY 
          SB2    X1          (B2) = FWA TABLE 
          SB7    X2+B2       (B7) = LWA TABLE 
          SB3    X3          (B3) = WORDS/ENTRY 
          SA5    B4          (X5) = MASK
 SMT1     EQ     B2,B7,SMT2  IF END OF TABLE
          SA1    B2+B5
          BX6    X4-X1
          BX6    X5*X6
          SB2    B2+B3
          NZ     X6,SMT1     IF NOT FOUND 
          SX6    B2-B3       SET ENTRY ADDRESS
          SA6    B6 
          EQ     SMTX        RETURN 
  
 SMT2     SX6    B0          SET NOT FOUND
          SA6    B6 
          EQ     SMTX        RETURN 
  
  
 SMTA     VFD    60/0 
          SPACE  4
**        STB - SET TITLE BUFFER. 
* 
*         ENTRY  (B2) = ADDRESS OF TITLE. 
*                (B6) = 0  IF TITLE.
*                     = 1  IF SUBTITLE. 
* 
*         USES   A - 1, 2, 6. 
*                X - 0, 1, 2, 6.
*                B - 2, 6, 7. 
  
  
 STB      SUBR               ENTRY/EXIT 
          NZ     B6,STB0     IF SUBTITLE
          SB6    TITA 
          SB7    TITB 
          EQ     STB1        SET TITLE BUFFER 
  
 STB0     SB6    TITE 
          SB7    TITF 
 STB1     SX1    1R 
          MX0    54 
          SX6    99999       FORCE PAGE EJECT 
          SA6    LINE 
          SA2    B2          COPY TITLE OR SUBTITLE 
          BX6    X2 
          BX7    -X0*X2 
          SB2    B2+B1
          ZR     X7,STB2     IF END OF TITLE
          SA6    B6 
          SB6    B6+B1
          NE     B6,B7,STB1  IF NOT END OF TITLE BUFFER 
          EQ     STBX        RETURN 
  
*         ADD TRAILING BLANKS.
  
 STB2     BX6    X6+X1
          LX1    6
          LX0    6
          BX7    -X0*X2 
          ZR     X7,STB2     LOOP 
          SA6    B6 
          SA1    =1H         BLANK FILL REMAINING WORDS 
          BX6    X1 
          SB6    B6+B1
 STB3     EQ     B6,B7,STBX  IF END OF BUFFER 
          SA6    B6 
          SB6    B6+B1
          EQ     STB3 
          SPACE  4
**        SUL - SKIP USER LIBRARY.
* 
*         ENTRY  (B2) = ADDRESS OF CURRENT PROGRAM TYPE.
*                (B3) = ADDRESS TO RETURN EOR INDICATOR.
* 
*         USES   A - 1, 2, 6, 7.
*                X - 1, 2, 5, 6, 7. 
*                B - 6, 7.
* 
*         CALLS  SRT. 
* 
*         MACROS READW. 
  
  
 SUL      SUBR               ENTRY/EXIT 
          SA1    B2          CHECK IF USER LIBRARY
          SX7    B3 
          SX6    X1-ULRT
          SA7    SULA 
          NZ     X6,SUL4     IF NOT USER LIBRARY
 SUL1     READW  P,WSA,WSAL 
          NG     X1,SUL5     IF EOF 
          SB6    WSA
          SB7    X1 
          EQ     B6,B7,SUL1  IF 0-LENGTH RECORD 
          BX5    X1 
          SA1    X2-LWP      LWA+1 OF DATA TRANSFERED 
          SX2    WSA
          RJ     SRT         SET RECORD TYPE
          SA6    SULB 
          SA1    SULA 
          BX7    X5          STORE EOR INDICATOR
          SA7    X1 
          NZ     X5,SUL3     IF EOR ON PREVIOUS READ
 SUL2     READW  OLD,WSA,WSAL 
 SUL3     ZR     X1,SUL2     IF NOT EOR 
          SA2    SULB 
          SB7    X2-ODRT
          NZ     B7,SUL1     LOOP TO END OF USER LIBRARY
 SUL4     READW  P,WSA,WSAL 
 SUL5     SA2    SULA        STORE EOR INDICATOR
          BX6    X1 
          SA6    X2 
          EQ     SULX        RETURN 
  
  
 SULA     DATA   0           ADDRESS TO RETURN EOR INDICATOR
 SULB     DATA   0           PROGRAM NAME 
 SUM      SPACE  4,10 
**        SUM - SET *ULIB* MODE.
* 
*         ENTRY  (CULB) = *ULIB* MODE FLAG. 
* 
*         EXIT   ROUTINE PRESET FOR CALLING *LIBGEN*. 
* 
*         USES   A - 1, 2, 3, 4, 6, 7.
*                X - 0, 1, 2, 3, 4, 6, 7. 
  
  
 SUM      SUBR               ENTRY/EXIT 
          SA4    CULB 
          ZR     X4,SUMX     IF *U* NOT SPECIFIED 
          MX0    42 
          SA1    CCPY 
          ZR     X1,SUM1     IF NO RECOPY 
          SA2    NEW
          BX6    X0*X2
          SA6    GULD        SET F=NEW
          SA2    OLD
          BX6    X0*X2
          SA6    GULF        SET P=OLD
          EQ     SUM2        SET N=CULB 
  
 SUM1     SA2    SUMA 
          SA3    NEW
          BX6    X2*X0
          BX7    X0*X3
          BX3    -X0*X3 
          BX6    X6+X3
          SA6    A3+         SET NEW FILE NAME
          SA7    GULF        SET P=NEW
 SUM2     BX6    X4*X0
          SA6    GULH        SET N=CULB 
          EQ     SUMX        RETURN 
  
  
 SUMA     VFD    42/7LZZZZZG2,18/0
 SUM      SPACE  4,10 
**        VFY - CALL VFYLIB TO VERIFY *OLD* AND *NEW*.
* 
*         ENTRY  (CVFY) = 1  VERIFY REQUESTED.
* 
*         EXIT   TO *VFYLIB*. 
* 
*         MACROS MESSAGE, OVERLAY, RECALL, SETLOF.
  
  
 VFY      SUBR               ENTRY/EXIT 
          SA1    CVFY 
          ZR     X1,VFY      IF NO VERIFY 
          RECALL OUTPUT      WAIT FOR END OF OUTPUT 
          MESSAGE (=C* VFYLIB*),1 
          RECALL S
          RECALL OLD
          RECALL NEW
          SA1    OLD         SET *VFYLIB* PARAMETERS
          MX0    42 
          BX6    X0*X1
          SA6    2
          SA1    NEW
          BX6    X0*X1
          SA6    A6+B1
          SA1    OUTPUT 
          BX6    X0*X1
          SA6    A6+B1
          SX6    3           SET PARAMETER COUNT
          SA6    ACTR 
          SA2    FL 
          LX2    30 
          SA0    X2          SET (A0) = FL FOR *VFYLIB* 
          SETLOF =0          CLEAR LIST OF FILES POINTER
          OVERLAY VFYA,,SYSTEM
          PS     0
  
  
 VFYA     CON    0LVFYLIB 
          SPACE  4,15 
**        WPD - WRITE PROGRAM DIRECTORY.
* 
*         ENTRY  (X1) = OLD FILE EOI STATUS INDICATOR.
*                (B2) = ADDRESS OF OPL DIRECTORY NAME.
* 
*         USES   A - 1, 2, 5, 6, 7. 
*                X - 0, 1, 2, 5, 6, 7.
*                B - 2, 6, 7. 
* 
*         CALLS  CCM, EPN, ORW, OZR.
* 
*         MACROS ADDWRD, CALL, FILINFO, WRCW, WRITE,
*                WRITECW, WRITEF, WRITER, WRITEW. 
  
  
 WPD      SUBR               ENTRY/EXIT 
          SA5    NPLN 
          NZ     X5,WPD1     IF BUILD 
          SA5    FLST+/FLST/NEW  SET UP *FILINFO* BLOCK 
          MX0    42 
          BX5    X0*X5
          SX6    50001B 
          BX6    X5+X6
          SA6    WPDD 
          FILINFO  WPDD 
          SA2    WPDD+1      *FILINFO* STATUS WORD
          SA5    B2 
          LX2    59-24
          NG     X2,WPD0     IF NEW FILE IS ON MAGNETIC TAPE
          SX6    X5-ODRT
          ZR     X6,WPD1     IF LAST RECORD TYPE *OPLD* 
 WPD0     SB7    B0 
          SX6    X1+2        CHECK FOR EOI ON OLD FILE
          MX7    4
          BX5    X5-X5       CLEAR DIRECTORY TEXT 
          ZR     X6,WPD1     IF EOI ON OLD FILE 
          LX7    4+48 
          SA7    WDAA+1      SET LEVEL 17 EOR 
          WRCW   N,B0,B7
          SX7    0
          SA7    WDAA+1      RESET CONTROL WORD 
          CALL   OZR,(=1H ),OLD,(=7H**EOF**)
 WPD1     WRITECW N,R 
          ZR     X5,WPD      IF NO DIRECTORY
          MX0    42 
          BX6    X0*X5       STORE NAME IN 7700 TABLE 
          SA6    WPDA+1 
          SX7    ODRT 
          BX7    X6+X7
          SB2    WPDC 
          SA7    B2 
          SA1    DATE.
          BX6    X1 
          SA6    A6+B1
          CALL   EPN,B2 
          ADDWRD NPT,NIND 
          SA1    L.NPT       SET 7000 TABLE LENGTH
          MX6    3
          BX6    X6+X1
          SA6    WPDB 
          WRITE  N,*
          CALL   CCM,WPDA,WPDC
          SB6    X6          WRITE 7000 TABLE 
          SB7    WPDB+1 
          WRITEW NEW,B6,B7-B6 
          SA1    P.NPT
          SA2    L.NPT
          WRITEW NEW,X1,X2
          WRITER NEW
          WRITEF X2 
          CALL   ORW,(=5HADDED),(=5H*****)
          CALL   OZR,(=1H ),OLD,(=7H**EOF**)
          EQ     WPDX        RETURN 
  
  
 WPDA     DATA   77000016000000000000B
          BSSZ   16B
 WPDB     DATA   70000000000000000000B
  
 WPDC     VFD    42/,18/     42/PROGRAM,18/TYPE 
          BSS    1
  
 WPDD     BSS    5           *FILINFO* PARAMETER BLOCK
          SPACE  4
          TITLE  BUFFERS. 
**        DATA AND FILE ENVIRONMENT TABLES. 
  
*         INDEX TAGS FOR WORDS PRECEEDING EACH FET. 
  
 LWP      EQU    3           LWA+1 OF DATA TRANSFERED.
 WRB      EQU    2           WORDS REMAINING IN BLOCK.
 ERF      EQU    1           EOR FLAG.
  
  
 CW       CON    1           CONTROL WORD READ FLAG 
 SC       CON    1           SECTOR COUNT 
  
          CON    0           LWA+1 OF DATA TRANSFERED 
          CON    -0          WORDS REMAINING IN BLOCK (OLD) 
          CON    0           EOR FLAG 
 P        BSS    0
 OLD      FILEB  OLDB,OLDL,(FET=10),(WSA=WSA,WSAL)
          ORG    P+11B
          VFD    36/,6/ODEBL,18/PODEB POINTER TO *OD* EXT. BUFFER 
          ORG    P+10 
  
          CON    0           LWA+1 OF DATA TRANSFERED 
          CON    -0          WORDS REMAINING IN BLOCK (NEW) 
          CON    0           EOR FLAG 
 N        BSS    0
 NEW      RFILEB NEWB,NEWL,(FET=10) 
          ORG    N+11B
          VFD    36/,6/ODEBL,18/NODEB POINTER TO *OD* EXT. BUFFER 
          ORG    N+10 
  
          CON    0           LWA+1 OF DATA TRANSFERED 
          CON    -0 
          CON    0
 S        BSS    0
 ZZZZZG1  RFILEB SBUF,SBUFL 
  
          CON    0           LWA+1 OF DATA TRANSFERED 
          CON    -0 
          CON    0
 LGO      RFILEB LGOB,LGOL,(WSA=WSB,WSBL) 
  
 O        BSS    0
 OUTPUT   FILEC  OUTB,OUTL,(WSA=OUTPUTB,DCBL+1),(FET=10)
  
 I        BSS    0
 INPUT    FILEC  INPB,INPL,(WSA=DCB,DCBL),(FET=10)
  
 TTYOUT   BSS    0
 ZZZZZG0  FILEC  TTYB,TTYL,(FET=10) 
  
  
*         OPTICAL DISK EXTENSION BUFFERS. 
  
 PODEB    BSSZ   ODEBL       *OLD*
 NODEB    BSSZ   ODEBL       *NEW*
*         FILE LIST.
  
 FLST     CON    FLSTL
  
          LOC    1
          QUAL   FLST 
  
 TTYOUT   VFD    42/0LZZZZZG0,18///TTYOUT 
 INPUT    VFD    42/0LINPUT,18///INPUT
 OUTPUT   VFD    42/0LOUTPUT,18///OUTPUT
 OLD      VFD    42/0LOLD,18///OLD
 NEW      VFD    42/0LNEW,18///NEW
 LGO      VFD    42/0LLGO,18///LGO
  
          QUAL   *
          LOC    *O 
          CON    0
 FLSTL    EQU    *-FLST 
  
 DATE.    DATA   0           CURRENT DATE 
  
 LGO.     DATA   0LLGO       CORRECTION FILE NAME 
  
 LIST     VFD    56/0        LIST OPTIONS 
          VFD    1/1         FULL LIST
          VFD    1/1         LIST DIRECTIVES
          VFD    1/1         LIST MODIFICATIONS MADE
          VFD    1/1         LIST ERRORS
  
 BRFM     DATA   0           BRIEF MODE FLAG
  
 CADD     DATA   0           NO INSERT AT EOF FLAG
  
 CREW     DATA   0           NO REWIND FLAG 
  
 CVFY     DATA   0           VERIFY FLAG
  
 CCPY     DATA   0           COPY FLAG
  
 CDOP     DATA   0           IGNORE ERROR FLAG
  
 CZOP     DATA   0           *Z* OPTION FLAG
  
 CULB     DATA   0           USER LIBRARY OPTION
  
 FL       DATA   0           FIELD LENGTH 
  
 TTYI     DATA   1           NON-TTY INPUT FLAG 
  
 TTYO     DATA   1           NON-TTY OUTPUT FLAG
  
 SBP      VFD    60/DSB      STRING BUFFER POINTER
  
 LINE     CON    99999       LINE COUNT 
  
 LL       CON    0           PAGE LINE LIMIT
  
 PD       CON    0           PRINT DENSITY FORMAT CONTROL 
 PDFLG    CON    1           FORMAT CONTROL NOT WRITTEN FLAG
  
 PAGE     DATA   0           PAGE NUMBER COUNT
  
 NIND     VFD    42/,18/     42/PROGRAM,18/TYPE 
          CON    0           RANDOM ADDRESS 
  
 NPLN     DATA   0           NEW PROGRAM LIBRARY NAME 
  
 TITA     DATA   H*      LIBEDIT DIRECTIVES.               *
          DATA   H*                    *
 TITAL    EQU    *-TITA 
 TITB     DATA   H* 01/20/69.*
 TITC     DATA   H* 00.00.00.*
          DATA   H*          *
 TITD     DATA   H*PAGE      *
  
 TITE     DATA   H*                                        *
          DATA   H*                                        *
          DATA   H*                    *
 TITEL    EQU    *-TITE 
 TITF     BSS    0
          SPACE  4
**        TABLE POINTERS. 
  
  
 TABLE    BSS    0
          TABLE  CDT,8       COMMENT/DATE TABLE 
          TABLE  DPT,2       DELETE PROGRAM TABLE 
          TABLE  FNT         FILE NAME TABLE
          TABLE  IDT,2       IMPLIED DELETE TABLE 
          TABLE  IPT,4       INSERT PROGRAM TABLE 
          TABLE  NPT,2,40B   NEW PROGRAM TABLE
          TABLE  NRT         NO REPLACE TABLE 
          TABLE  PIT,3       PROGRAM IGNORE TABLE 
          TABLE  PNT,3,40B   PROGRAM NAME TABLE 
          TABLE  RFT         REWIND FILE TABLE
          TABLE  RNT,2       RENAME TABLE 
          TABLE  BUF         UNUSED STORAGE TABLE 
 RDA      SPACE  4
**        RDA - READ DATA.
* 
*         PROCESSES CALLS TO READ WORDS (RDW=). 
*         DEBLOCKS DATA IF CONTROL WORD READS.
* 
*         ENTRY  (X2) = FET ADDRESS.
*                (B6) = FWA OF WORKING STORAGE BUFFER.
*                (B7) = LENGTH OF TRANSFER REQUESTED. 
* 
*         EXIT   (X1) = STATUS RETURNED FROM RDW=.
*                (X2-LWP) = LWA+1 OF DATA TRANSFERED. 
*                (B6) = LWA+1 OF DATA TRANSFERED. 
* 
*         USES   A - 1, 3, 6, 7.
*                X - 1, 3, 4, 6, 7. 
*                B - 5, 6, 7. 
* 
*         CALLS  RDW=.
  
  
 RDA5     SX6    B5-B7       UPDATE WORDS REMAINING 
          SA6    A1 
  
 RDA6     RJ     RDW=        READ WORDS 
  
 RDA7     SX6    B6          LWA+1 OF DATA TRANSFERED 
          SA6    X2-LWP 
  
 RDA      SUBR               ENTRY/EXIT 
          SA1    CW          CHECK IF CONTROL WORDS LEGAL 
          ZR     X1,RDA6     IF CONTROL WORD READS NOT LEGAL
 RDA1     SA1    X2-WRB      GET NUMBER OF WORDS BEFORE CONTROL WORD
          SB5    X1+
          PL     X1,RDA2     IF NOT FIRST READ
          SX7    B7+         SET WORDS NEEDED 
          SA7    RDAA 
          JP     RDA4 
  
 RDA2     GE     B5,B7,RDA5  IF ENOUGH DATA TO FILL BUFFER
          SA3    X2-ERF      CHECK EOR FLAG 
          PL     X3,RDA3     IF NOT EOR ON FILE 
          MX6    1           SET NEW READ FLAG
          SB7    B5+B1       SET WORDS TO READ
          SA6    A3 
          SA6    A1 
          RJ     RDW=        READ WORDS 
          SX1    B6-B1       SET EOR INDICATION 
          SB6    B6-B1       BACK UP LWA TO ALLOW FOR CONTROL WORD
          JP     RDA7        RETURN 
  
 RDA3     SX6    B7-B5       SAVE ADDITIONAL WORDS NEEDED 
          SA6    RDAA 
          SB7    B5+B1       SET WORDS TO TRANSFER
          RJ     RDW=        READ WORDS 
          SB6    B6-1        BACK UP OVER LAST CONTROL WORD 
 RDA4     SB7    B1          READ CONTROL WORD
          RJ     RDW= 
          NG     X1,RDA7     IF EOF/EOI 
          SB6    B6-B1       BACK UP WORKING BUFFER 
          SA1    B6          CONTROL WORD 
          SX7    5
          SX4    X1+4        ROUND UP 
          AX1    36          EXTRACT BLOCK SIZE 
          SX3    X1 
          IX7    X4/X7       WORDS IN BLOCK 
          IX6    X7-X3       SAVE EOR FLAG
          SA7    X2-WRB      WORD COUNT 
          SA6    X2-ERF      EOR FLAG 
          SA1    RDAA        RESET WORDS NEEDED 
          SB7    X1 
          JP     RDA1        LOOP 
  
  
 RDAA     CON    0
 WDA      SPACE  4
**        WDA - WRITE DATA WITH CONTROL WORDS.
* 
*         ENTRY  (B6) = FWA OF WORKING STORAGE. 
*                (B7) = WORD COUNT. 
*                (X2) = FET ADDRESS.
* 
*         EXIT   (B7) = 0 IF FULL PRU WRITTEN.
* 
*         USES   A - 1, 3, 4, 5, 6, 7.
*                B - 4, 6, 7. 
*                X - 1, 3, 4, 5, 6, 7.
* 
*         MACROS WRITER, WRITEW.
  
  
 WDA3     SA3    SC 
          SA1    X2-1 
          SX7    B1+         UPDATE SECTOR COUNT
          IX7    X3+X7
          SB4    X1 
          SA7    A3          STORE RANDOM ADDRESS 
          BX6    X1 
          ZR     B7,WDA2     IF ZERO LENGTH RECORD
          SX3    5
          SX7    B7-B4
          PL     X7,WDA4     IF \ ONE PRU 
          SX1    B7 
 WDA4     IX4    X1*X3       FORM PRU BYTE COUNT
          SA7    WDAA 
          LX6    36          POSITION BLOCK SIZE
          SA5    X1+B6
          BX6    X6+X4       FORM HEADER CONTROL WORD 
          SX7    B0 
          SA6    B6-B1
          SA7    A5          STORE TRAILER CONTROL WORD 
          WRITEW X2,A6,X1+2 
          SB6    A5          SET ADDRESS OF NEXT BLOCK
          SA3    WDAA 
          BX6    X5          RESTORE CELL DESTROYED BY CONTROL WORD 
          SB7    X3 
          SA6    A5 
          GE     B7,B1,WDA3  IF AT LEAST ONE MORE WORD IN BUFFER
  
 WDA      SUBR               ENTRY/EXIT 
          SA4    X2-2 
          NG     X4,WDA3     IF CONTROL WORD WRITE ENABLED
          ZR     B7,WDA1     IF ZERO LENGTH RECORD
          WRITEW X2,B6,B7 
          SB7    B0+
          JP     WDA
  
 WDA1     WRITER X2,R        FLUSH BUFFER 
          SB7    1
          JP     WDA
  
 WDA2     LX6    36          POSITION BLOCK SIZE
          SA6    WDAA 
          WRITEW X2,A6,2     WRITE ZERO LENGTH RECORD 
          SB7    1
          JP     WDA
  
  
 WDAA     CON    0
          CON    0
 RCW      SPACE  4
**        RCW - RESTORE CONTROL WORD WRITE. 
* 
*         ENTRY  NONE.
* 
*         EXIT   NONE.
* 
*         USES   A - 1, 6, 7. 
*                B - NONE.
*                X - 1, 6, 7. 
* 
*         MACROS RECALL, WRITECW, WRITER. 
  
  
 RCW      SUBR               ENTRY/EXIT 
          RECALL N
          SA1    N+2         CHECK BUFFER EMPTY 
          SA3    A1+B1
          IX3    X3-X1
          ZR     X3,RCW1     IF BUFFER EMPTY
          WRITER X2,R        FLUSH BUFFER 
 RCW1     WRITECW X2,*       SET FILE STATUS
          SA1    N+6
          MX7    60 
          AX1    30 
          SA7    N-2         ENABLE CONTROL WORD WRITE
          BX6    X1 
          SA6    SC          RESET SECTOR COUNT 
          EQ     RCWX        RETURN 
 CVD      SPACE  4
**        CVD - CHECK DEVICE TYPE.
* 
*         ENTRY  (X1) = (FET+1).
* 
*         EXIT   (X7) = 0 IF CONTROL WORD READ/WRITE NOT SUPPORTED ON 
*                       DEVICE. 
* 
*         USES   X - 0,1,2,6,7. 
*                A - 2. 
*                B - NONE.
* 
*         CALLS  NONE.
  
  
 CVD2     LX1    12          CHECK *TT* 
          BX6    -X0*X1 
          SX7    X6-2RTT
  
 CVD      SUBR               ENTRY/EXIT 
          MX0    -12
          PL     X1,CVD2     IF ALLOCATABLE 
          LX1    12 
          SA2    CVDA        SEARCH DEVICE TABLE
          SX7    0           ASSUME NO FIND 
 CVD1     ZR     X2,CVDX     IF NOT FOUND 
          BX6    X1-X2
          AX2    12 
          BX6    X2*X6
          SA2    A2+B1
          NZ     X6,CVD1     IF NOT MATCH 
          SX7    1           INDICATE CONTROL WORD POSSIBLE 
          EQ     CVDX        RETURN 
  
  
 CVDA     VFD    36/,12/7703B,12/4002B
          VFD    36/,12/7703B,12/4102B
          VFD    36/,12/7777B,12/2RMT+4000B 
          VFD    36/,12/7777B,12/2RNT+4000B 
          VFD    36/,12/7777B,12/2RCT+4000B 
          VFD    36/,12/7777B,12/2RAT+4000B 
          CON    0
          SPACE  4,10 
**        COMMON DECKS. 
  
  
*CALL     COMCCDD 
 WRIF$    EQU    1           SELECT *REISSUE CURRENT WRITE* 
*CALL     COMCCIO 
*CALL     COMCCPM 
*CALL     COMCCPT 
*CALL     COMCDXB 
*CALL     COMCLFM 
*CALL     COMCOVL 
*CALL     COMCRDH 
*CALL     COMCRDW 
*CALL     COMCSFN 
*CALL     COMCSRT 
*CALL     COMCSYS 
*CALL     COMCWTC 
*CALL     COMCWTH 
*CALL     COMCWTW 
 BUFFERS  SPACE  4,10 
**        BUFFERS.
  
  
          USE    BUFFERS
  
 OUTPUTB  BSS    0           OUTPUT WORKING BUFFER
 DCB      EQU    OUTPUTB+1   DIRECTIVE COMMAND BUFFER 
 DSB      EQU    DCB+DCBL    DIRECTIVE STRING BUFFER
 WSA      EQU    DSB+10*DCBL+2  WORKING STORAGE (OLD) 
 WSAL     EQU    4000B
 WSB      EQU    WSA+WSAL+1  WORKING STORAGE (LGO/NEW)
 WSBL     EQU    4000B
 INPB     EQU    WSB+WSBL    INPUT BUFFER 
 OUTB     EQU    INPB+INPL   OUTPUT BUFFER
 TTYB     EQU    OUTB+OUTL
 OLDB     EQU    TTYB+TTYL   OLD BUFFER 
 NEWB     EQU    OLDB+OLDL   NEW BUFFER 
 LGOB     EQU    NEWB+NEWL   LGO BUFFER 
 SBUF     EQU    LGOB+LGOL   SCRATCH BUFFER 
 BUF      EQU    SBUF+SBUFL  START OF MANAGED TABLES
 MFL=     EQU    200000B+BUF+BUFL+5  MINIMUM FIELD LENGTH 
 PRS      TITLE  LIBEDIT - PRESET.
***       PRS - PRESET PROGRAM. 
* 
*         ENTRY  (A0) = FIELD LENGTH. 
*                (ARGR) = ARGUMENT LIST.
*                (ACTR) = ARGUMENT COUNT. 
* 
*         EXIT   (FL) = A0. 
*                (DATE.) = CURRENT DATE.
*                (TITC) = CURRENT TIME. 
*                (FLST) = UPDATED FILE LIST.
*                (LL) = LINE LIMIT. 
*                (PD) = PRINT DENSITY.
*                ALL COMMAND PARAMETERS PROCESSED.
  
  
 PRS      SUBR               ENTRY/EXIT 
          DATE   DATE.       SET CURRENT DATE 
          SB5    6
          SA3    DATE.
          LX6    B5,X3
          SA6    TITB 
          SA6    A3 
          CLOCK  TITC        GET CURRENT TIME 
          SA3    TITC 
          LX6    B5,X3
          SA6    A3 
          MEMORY CM,FL,R     SET AVAILABLE TABLE SPACE
          SA1    FL 
          LX1    30 
          SX6    X1-BUF 
          SA6    L.BUF
  
*         PROCESS COMMAND PARAMETERS. 
  
          SA1    ACTR        ARGUMENT COUNT 
          SB5    ARGA        ARGUMENT TABLE 
          SA4    ARGR        FIRST ARGUMENT 
          SB4    X1+
          RJ     ARG         PROCESS COMMAND PARAMETERS 
          SX7    =C* LIBEDIT ARGUMENT ERROR(S).*
          NZ     X1,PRS13    IF ERROR IN PARAMETERS 
  
*         SET FILE NAMES IN LIST AND FET-S. 
  
          SB5    B0+
          SB6    FLSTL-2
 PRS1     SA1    PAR+B5 
          ZR     X1,PRS2     IF NOT SPECIFIED 
          BX6    X1 
          SA1    FLST+/FLST/INPUT+B5
          RJ     RFN         REPLACE FILE NAME
 PRS2     SB5    B5+B1
          LT     B5,B6,PRS1  IF NOT FINISHED
  
*         CHECK FILE NAME CONFLICT. 
  
          SA1    FLST+/FLST/TTYOUT
          MX0    42 
          BX3    X1*X0
          ZR     X3,PRS5     IF NO FILE NAME
          SA2    A1+1 
          SX7    =C* FILE NAME CONFLICT.* 
 PRS3     ZR     X2,PRS5     IF END OF LIST 
          BX4    X2*X0
          ZR     X4,PRS4     IF NO FILE NAME
          BX5    X4-X3
          ZR     X5,PRS13    IF FILE NAME CONFLICT
 PRS4     SA2    A2+B1       NEXT FILE NAME 
          EQ     PRS3        LOOP FOR ALL FILES 
  
 PRS5     SA1    A1+1 
          NZ     X1,PRS3     IF NOT YET END OF LIST 
  
*         PROCESS REQUIRED FILES. 
  
          SETLOF PRSB        SET LIST OF FILES
          SA1    FLST+/FLST/NEW 
          BX6    X0*X1
          SX7    =C* NO NEW FILE.*
          ZR     X6,PRS13    IF NO NEW FILE 
          SA6    GULF        SET INPUT FILE FOR *LIBGEN*
  
*         DETERMINE ASSIGNMENT OF INPUT AND OUTPUT. 
  
          SX2    I           CHECK FOR TERMINAL INPUT FILE
          RJ     STF
          SA6    TTYI 
          NZ     X6,PRS6     IF NOT TTY INPUT 
          RETURN TTYOUT,R    ASSIGN *TTYOUT* TO TERMINAL
          SA1    =2LTT
          MX7    -12
          SA2    TTYOUT+1 
          BX6    -X7*X2 
          BX6    X6+X1
          SA6    A2+
          REQUEST  TTYOUT,U 
          WRITE  TTYOUT,* 
 PRS6     SX2    O           CHECK FOR TTY OUTPUT FILE
          RJ     STF
          SA6    TTYO 
  
*         PROCESS *LO* AND SET LIST OPTIONS.
  
          SA1    FLST+/FLST/OUTPUT
          BX4    X0*X1
          NZ     X4,PRS7     IF LIST FILE DEFINED 
          BX7    X7-X7       CLEAR LIST OPTIONS 
          SA7    LIST 
 PRS7     NZ     X6,PRS8     IF NOT TTY OUTPUT
  
*         CHECK TERMINAL TABLE FOR *BRIEF* MODE.
  
          TSTATUS  PRSA 
          SA1    PRSA+1 
          SX6    40B
          BX6    X6*X1
          SA6    BRFM 
  
*         CHECK LIST OPTIONS. 
  
 PRS8     SA1    LIST 
          BX1    X0*X1
          ZR     X1,PRS9     IF NO LIST OPTIONS SPECIFIED 
          RJ     ILO         INTERPRET LIST OPTIONS 
          SX7    =C* LIST OPTION ERROR.*
          NZ     X1,PRS13    IF LIST OPTION ERROR 
          EQ     PRS10       PROCESS *Z*
  
 PRS9     SA1    TTYO 
          NZ     X1,PRS10    IF NOT TTY OUTPUT
          SX7    3           SET TTY *LO* DEFAULT OPTIONS 
          SA7    LIST 
 PRS10    SA1    CZOP 
          ZR     X1,PRS11    IF *Z* PARAMETER NOT SELECTED
          BX6    X1 
          SA6    TTYI 
          SX2    INPUT       INPUT FILE FET 
          RJ     ZAP         *Z* ARGUMENT PROCESSOR 
 PRS11    SA1    LGO         SET CORRECTION FILE NAME 
          MX0    42 
          BX6    X0*X1
          SA6    LGO. 
          ZR     X6,PRS12    IF NO CORRECTION FILE
          ADDWRD FNT,A6 
 PRS12    OPEN   NEW,WRITE,R  INITIALIZE *NEW* FILE 
          WRITE  OUTPUT,*    PRESET *WRITE* FUNCTION IN FET 
          GETPP  SBUF,LL,PD  GET PAGE SIZE PARAMETERS 
          EQ     PRSX        RETURN 
  
 PRS13    MESSAGE  X7,3      ISSUE ERROR MESSAGE
          RJ     ABT         ABORT PROGRAM
  
  
 PRSA     BSS    2           *TLX* (TSTATUS) RESPONSE BLOCK 
  
 PRSB     VFD    12/0,18/FLST,30/0  FILE LIST POINTER FOR *SETLOF*
  
*         ARGUMENT TABLE. 
  
 ARGA     BSS    0
 I        ARG    FLST+/FLST/INPUT,PAR,400B
 L        ARG    FLST+/FLST/OUTPUT,PAR+1,400B 
 P        ARG    FLST+/FLST/OLD,PAR+2,400B
 N        ARG    FLST+/FLST/NEW,PAR+3,400B
 B        ARG    FLST+/FLST/LGO,PAR+4,400B
 LO       ARG    ARGB,LIST,400B 
 C        ARG    -*,CCPY     RECOPY 
 D        ARG    -*,CDOP     NO ABORT (DEBUG), EQUIVALENT TO *NA* 
 V        ARG    -*,CVFY     VFYLIB 
 Z        ARG    -*,CZOP     INPUT DIRECTIVES ON COMMAND
 NA       ARG    -*,CDOP     NO ABORT (DEBUG) 
 NI       ARG    -*,CADD     NO INSERT AT EOF 
 NR       ARG    -*,CREW     NO REWIND
 U        ARG    LIBGA,CULB  USER LIBRARY OPTION
 NX       ARG    ARGC,GULJ,400B  NO CROSSREF ULIB 
          CON    0
  
  
 ARGB     CON    1LF         FULL LISTING 
 ARGC     CON    1L1         NO CROSS REFERENCE ULIB
  
  
 PAR      BSSZ   FLSTL-2     PARAMETER BUFFER 
          SPACE  4,10 
**        PRESET COMMON DECKS.
  
  
*CALL     COMCARG 
*CALL     COMCSTF 
*CALL     COMCUSB 
*CALL     COMCWTS 
*CALL     COMCZAP 
  
          SPACE  4,10 
          END    LIBEDIT
