Retro1.org codex

          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