Retro1.org codex

          IDENT  GTR,FET 
          ABS
          ENTRY  GTR
          ENTRY  COPYRF
          ENTRY  MFL=
          SYSCOM B1          DEFINE B1=1
*COMMENT  GTR - GET SELECTED RECORDS.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
 GTR      TITLE  GTR - GET SELECTED RECORDS.
          SPACE  4,10
***       GET SELECTED RECORDS.
*         D. A. CAHLANDER.  69/08/30.
          SPACE  4
***       GTR SEARCHES FOR SELECTED RECORDS ON A LIBRARY FILE.  THE
*         SELECTED RECORDS ARE COPIED TO THE NEW FILE.
          SPACE  4
***       CONTROL CARD CALL -
*
*         POSITIONAL PARAMETER FORMAT.
*
*         GTR(OLD,LGO,DF,NR,S,NA,T)*SELECTION DIRECTIVES*
*
*                OLD = OLD PROGRAM FILE.
*                LGO = NEW FILE.
*                DF = DIRECTORY FLAG.
*                     *D* = BUILD DIRECTORY FOR NEW FILE, AND
*                           INCLUDE USER LIBRARY DIRECTORIES.
*                     *U* = COPY USER LIBRARY HEADER AND *OPLD* ONLY.
*                NR = NO REWIND FLAG.
*                S = SEQUENTIAL FILE PROCESSING.
*                NA = NO ABORT FLAG.
*                T = REMOVE RECORD NAME FROM SELECTED TEXT RECORDS.
*
*         POSITION-INDEPENDENT PARAMETER FORMAT.
*
*         GTR(OLD,LGO/P1,...,PN)*SELECTION DIRECTIVES*
*
*                OLD = OLD PROGRAM FILE (POSITIONAL).
*                LGO = NEW FILE (POSITIONAL).
*                P1 - PN = OPTIONAL PARAMETERS IN ANY ORDER.
*                          *D* = BUILD DIRECTORY FOR NEW FILE, AND
*                                INCLUDE USER LIBRARY DIRECTORIES.
*                          *U* = COPY USER LIBRARY HEADER AND *OPLD*.
*                          *NR* = DO NOT REWIND NEW FILE.
*                          *S* = SEQUENTIAL FILE PROCESSING.
*                          *NA* = DO NOT ABORT ON ERRORS.
*                          *T* = REMOVE RECORD NAME FROM
*                                SELECTED TEXT RECORDS.
*
*                SELECTION DIRECTIVES -
*
*                LIB/PN
*                COPY PROGRAM *PN* (TYPE *LIB*) FROM *OLD* TO *LGO*.
*
*                PN
*                COPY PROGRAM *PN* (TYPE *TEXT* OR PREVIOUS *LIB*)
*                FROM *OLD* TO *LGO*.
*
*                *
*                COPY ALL PROGRAM OF TYPE *LIB* FROM *OLD* TO *LGO*.
*
*                0
*                INSERT 0-LENGTH RECORD ON FILE *LGO*.
*
*                LIB/PN1-PN2
*                COPY PROGRAM *PN1* THROUGH *PN2* FROM *OLD* TO *LGO*.
 COPYRF   SPACE  4
***       COPYRF COPIES RECORDS FROM MEDIUM TO MEDIUM AND ADDS
*         A RANDOM INDEX ON THE END.
 COPYRF   SPACE  4
***       CONTROL CARD CALL.
*
*
*         COPYRF(IFILE,OFILE)
*                IFILE       NAME OF INPUT FILE.
*                OFILE       NAME OF OUTPUT FILE.
*
*         ASSUMED PARAMETERS.
*                IFILE = *OLD*
*                OFILE = *LGO*
          SPACE  4,10
***       DAYFILE MESSAGES.
*
*
*         * FILENAME CONFLICT.*
*                THE FIRST TWO PARAMETERS OF THE *GTR* COMMAND
*                ARE IDENTICAL.
*
*         * FORMAT ERROR.*
*                INDICATES ONE OF THE FOLLOWING:
*                     1.  THE *GTR* COMMAND FORMAT WAS INCORRECT.
*                     2.  AN INCORRECT LIBRARY TYPE WAS SPECIFIED.
*                     3.  A RECORD NAME LONGER THAN SEVEN CHARACTERS
*                         WAS SPECIFIED.
*
*         * GTR ERRORS.*
*                THERE ARE ERRORS ON THE *GTR* COMMAND.
*
*         * INCORRECT PARAMETER. *
*                A KEYWORD FORMAT COMMAND PARAMETER CONTAINED A VALUE
*                OTHER THAN ONE OF THE RECOGNIZED KEYWORDS.
*
*         * MASS STORAGE DIRECTORY NOT WRITTEN.*
*                A REQUEST WAS MADE TO WRITE A MASS STORAGE
*                DIRECTORY ON A NON-MASS STORAGE FILE.
*
*         * TABLE OVERFLOW.*
*                THE JOB FIELD LENGTH IS TOO SMALL TO HOLD THE
*                TABLES FOR PROCESSING THE *GTR* COMMAND.
*
*         * TOO MANY PARAMETERS.*
*                MORE PARAMETERS WERE ENTERED (INCLUDING NULL
*                PARAMETERS) THAN ARE ALLOWED FOR THE COMMAND.
*
*         * UNUSUAL END-OF-FILE ENCOUNTERED.*
*                *GTR* DETECTED AN EOF NOT PRECEDED BY AN EOR.
          SPACE  4
****      ASSEMBLY CONSTANTS.
 
 
 PBUFL    EQU    20041B      *OLD* BUFFER LENGTH
 BBUFL    EQU    10021B      *LGO* BUFFER LENGTH
 WSAL     EQU    1000B       WORKING BUFFER LENGTH
 BUFL     EQU    14000B      NOMINAL TABLE SPACE REQUIRED
 ODEBL    EQU    20B         OPTICAL DISK EXTENSION BUFFER LENGTH
****
 COMMON   SPACE  4,10
*         COMMON DECKS.
 
 
*CALL     COMCMAC
*CALL     COMSSRT
 ADDWORD  TITLE  SUBROUTINES.
**        ADDWORD - ADDWORD TO MANAGED TABLE.
*
*         ADDWORD TABNAM
*         ENTRY  (TABNAM) = MANAGED TABLE NAME.
 
 
 ADDWORD  MACRO  TABNAM
          R=     A0,TABNAM
          RJ     ADW
          ENDM
 ALLOC    SPACE  4,5
**        ALLOC - ALLOCATE MEMORY.
*
*         ALLOC  TABLE,INCR
*         ENTRY  (TABLE) = TABLE NAME.
*                (INCR) = TABLE LENGTH INCREMENT.
 
 
 ALLOC    MACRO  TABLE,INCR
          R=     A0,TABLE
          R=     X3,INCR
          RJ     ATS
          ENDM
 SEARCH   SPACE  4,10
**        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
*         ENTRY  (TABLE) = NAME OF MANAGED TABLE.
*                (ENTRY) = ADDRESS OF ENTRY.
*                (MASK) = ADDRESS OF SEARCH MASK.
 
 
 SEARCH   MACRO  TABLE,ENTRY,MASK
          R=     A2,ENTRY
          IFC    EQ,*MASK**
          MX3    60
          ELSE   1
          SA3    MASK
          SA1    O.TABLE
          RJ     SMT
          ENDM
 TABLE    SPACE  4,6
**        TABLE - CREATE MANAGED TABLE.
*
*         TABLE  TNAM
*         ENTRY  (TNAM) = TABLE NAME.
 
 
          MACRO  TABLE,TNAM
 TNAM     EQU    *-TAB
 O.TNAM   CON    BUF
          RMT
 L.TNAM   EQU    TNAM+TAB+TABL
          RMT
          ENDM
 FET      TITLE  CONTROL CELLS.
**        FET - FILE ENVIORNMENT TABLES.
 
 
          ORG    110B
 FET      BSS    0
 P        BSS    0           PROGRAM LIBRARY
 OLD      RFILEB PBUF,PBUFL,FET=10
          ORG    P+11B
          VFD    36/,6/ODEBL,18/PODEB POINTER TO *OD* EXT. BUFFER
          ORG    P+10
 
 
 B        BSS    0           NEW FILE
 LGO      RFILEB BBUF,BBUFL,FET=10
          ORG    B+11B
          VFD    36/,6/ODEBL,18/BODEB POINTER TO *OD* EXT. BUFFER
          ORG    B+10
 
*         OPTICAL DISK EXTENSION BUFFERS.
 
 PODEB    BSSZ   ODEBL       *OLD*
 BODEB    BSSZ   ODEBL       *LGO*
 FLAGS    SPACE  4,3
**        CONTROL FLAGS.
 
 
 CP       CON    0           CARD POINTER
 ID       CON    77000016000000000000B
          CON    0LNAME
          BSSZ   15B
          CON    70000000000000000000B
 FL       CON    0           FIELD LENGTH
 ND       CON    0           NO DIRECTORY FLAG
 NR       CON    0           NO REWIND FLAG
 SQ       CON    0           SEQUENTIAL FILE FLAG
 NABT     CON    0           NO ABORT FLAG
 TU       CON    0           REMOVE RECORD NAMES FLAG
 RN       CON    0           RECORD NAME
 MFL      CON    0           MAXIMUM MEMORY
 T1       CON    0           TEMPORARY
 T2       CON    0           TEMPORARY
 T3       CON    0           TEMPORARY
 ZR       CON    1           ZERO RECORD INSERT FLAG
 CPRF     CON    0           COPYRF FLAG
 ERRF     CON    0           ERROR FLAG
 RCWF     CON    0           RECORDS WRITTEN FLAG
 BUFFER   SPACE  4,3
**        BUFFER SPACE.
 
 
          USE    //
 WSA      BSS    WSAL        WORKING STORAGE
 PBUF     BSS    PBUFL       PROGRAM LIBRARY BUFFER
 BBUF     BSS    BBUFL       CORRECTION FILE BUFFER
 BUF      BSS    0           MANAGED TABLE SPACE
          USE    *
 TABLE    TITLE  MANAGED TABLES.
**        MANAGED TABLES.
*         TABLES ARE VARIABLE LENGTH MANAGED TABLES.  POINTERS TO
*         TABLE *ABC* ARE -
*                O.ABC = FWA OF TABLE *ABC*.
*                L.ABC = LENGTH OF TABLE *ABC*.
 TABLE    SPACE  4,11
**        IPT - INSERT PROGRAM TABLE.
*
*                42/PROG1,18/TYPE1
*                42/PROG2,18/TYPE2
*                  1. PROG1 = PROGRAM NAME FOR START OF INSERT.
*                  2. PROG2 = PROGRAM NAME FOR END OF INSERT.
*                  3. TYPE = PROGRAM TYPE.
 
 
 TAB      BSS    0
 IPT      TABLE
 TABLE    SPACE  4,10
**        PNT - PROGRAM NAME TABLE.
*
*                42/PROGRAM,18/TYPE
*                60/POSITION
*                  1. PROGRAM = PROGRAM NAME LEFT JUSTIFIED.
*                  2. POSITION = RNADOM INDEX.
*                  3. TYPE = PROGRAM TYPE.
 
 
 PNT      TABLE
 TABLE    SPACE  4,10
**        NPT - NEW PROGRAM TABLE.
*
*                42/PROGRAM,18/TYPE
*                60/POSITION
*                  1. PROGRAM = PROGRAM NAME LEFT JUSTIFIED.
*                  2. POSITION = RNADOM INDEX.
*                  3. TYPE = PROGRAM TYPE.
 
 
 NPT      TABLE
 END      TABLE
 TABL     EQU    *-TAB
 
          BSS    TABL        TABLE LENGTHS
 GTR      TITLE  MAIN PROGRAM.
***       GTR - GET SELECTED RECORDS.
 
 
 GTR      SB1    1           (B1) = 1
          RJ     PRS         PRESET TABLE LENGTHS
          RJ     ARG         PROCESS CONTROL CARD
          RJ     RCD         READ CORRECTION DIRECTIVES
          OPEN   P,READNR,R
          SA1    NR
          NZ     X1,GTR1     IF NO REWIND
          REWIND B
 GTR1     SA1    P+1
          SA2    SQ
          NZ     X2,GTR3     IF SEQUENTIAL PROCESSING REQUESTED
 
          NG     X1,GTR3     IF FILE NON-RANDOM
          RJ     RDD         READ DIRECTORY
          ZR     X1,GTR3     IF NO DIRECTORY
          RJ     CPP         COPY PROGRAMS
 GTR2     RJ     WND         WRITE NEW DIRECTORY
          SA2    ERRF
          NZ     X2,GTR8     IF ERRORS
          MESSAGE (=C* EDITING COMPLETE.*)
 GTR2.1   ENDRUN
 
*         PROCESS NON-RANDOM FILE.
 
 GTR3     SA1    NR
          NZ     X1,GTR4     IF NO REWIND
          REWIND P
 GTR4     RJ     CFE         CHECK FOR END OF INSERTS
          ZR     X1,GTR2     IF END
 GTR5     RJ     RFR         READ FIRST RECORD
          NG     X1,GTR7     IF EOF
          RJ     CFI         CHECK FOR INSERTS
          ZR     X7,GTR6     IF INSERT FOUND
          RJ     SKR         SKIP RECORD
          EQ     GTR5        LOOP
 
 GTR6     RJ     WNR         WRITE NEXT RECORD
          SA5    ZR
          NZ     X5,GTR4     IF NO ZERO RECORD INSERT
          WRITER B           WRITE ZERO RECORD
          SX7    B1
          SA7    A5
          EQ     GTR4        LOOP
 
 GTR7     RJ     DMP         DISPLAY MISSING PROGRAMS
          EQ     GTR2
 
*         ERROR EXIT.
 
 ERR      MESSAGE (=C* FORMAT ERROR.*)
 
 GTR8     SA2    CPRF
          NZ     X2,GTR9     IF COPYRF
          MESSAGE (=C* GTR ERRORS.*)
          SA2    NABT
          NZ     X2,GTR2.1   IF NO ABORT FLAG SET
 GTR9     ABORT
 COPYRF   TITLE  MAIN PROGRAM.
**        COPYRF - MAIN PROGRAM.
 
 
 COPYRF   SB1    1           (B1) = 1
          SX6    B1          SET COPYRF FLAG
          SA6    CPRF
          RJ     PRS         PRESET TABLE LENGTHS
          RJ     ARG         PROCESS CONTROL CARD
          OPEN   P,READNR,R
          OPEN   B,WRITENR,R
          SA1    =10H COPYING
          BX7    X1
          SX6    B1+B1       SELECT DIRECTORY OPTION
          SA7    WNRA
          SA6    ND
          SA6    NR          SELECT NO REWIND
          SA1    B+1
          AX1    48
          SX3    X1-2ROD
          ZR     X3,CRF1     IF OPTICAL DISK FILE
          EVICT  B,R
 CRF1     RJ     RFR         READ FIRST RECORD
          NG     X1,CRF2     IF EOF
          RECALL B
          SA1    RN
          ADDWORD NPT
          IX6    X3+X4       SET RANDOM RETURN ADDRESS
          SX6    X6-1
          SA6    B+6
          SA1    T1
          RJ     WNR         WRITE NEXT RECORD
          EQ     CRF1        LOOP
 
 CRF2     RJ     WND         WRITE NEW DIRECTORY
          MESSAGE (=C* CONVERSION COMPLETE.*),1
          ENDRUN
 ADW      TITLE  SUBROUTINES.
**        ADW - ADD WORD TO MANAGED TABLE.
*         ENTRY  (A0) = TABLE INDEX.
*                (X1) = ENTRY WORD 1.
*                (X2) = ENTRY WORD 2.
 
 
 ADW      PS                 RETURN EXIT
          ALLOC  A0,2
          LX7    X2          STORE ENTRY
          IX6    X3+X4
          SA7    X6-1
          BX6    X1
          SA6    A7-B1
          EQ     ADW         RETURN
 ATS      SPACE  4,7
**        ATS - ALLOCATE TABLE SPACE.
*
*         ALLOCATE TABLE SPACE, REQUESTING MEMORY IF NECESSARY.
*
*         ENTRY  (A0) = TABLE INDEX.
*                (X3) = INCREMENT.
*
*         EXIT   (X1) = ENTRY VALUE RESTORED.
*                (X3) = FWA OF TABLE.
*                (X4) = LENGTH OF TABLE.
*
*         ERROR  TO *GTR8*.
*
*         USES   X - 1, 3, 4, 6, 7.
*                A - 1, 3, 4, 6, 7.
*                B - 2, 3.
*
*         MACROS MEMORY, MESSAGE.
 
 
 ATS5     SA3    A0+TAB
          SA4    A0+TAB+TABL
 
 ATS      PS                 RETURN EXIT
          SA4    A0+TAB+TABL INCREMENT TABLE LENGTH
          IX6    X4+X3
          SA6    A4
          SB2    A0+1        INCREMENT TABLE ORIGINS
          SB3    TABL
 ATS1     SA4    B2+TAB
          IX6    X4+X3
          SA6    A4
          SB2    B2+1
          NE     B2,B3,ATS1  LOOP TO END OF TABLES
          SA4    A6+TABL     DECREMENT SPACE AVAILABLE
          IX7    X4-X3
          SA7    A4
          PL     X7,ATS5     IF NO OVERFLOW
          BX7    -X7
          BX6    X1          PRESERVE (X1) ENTRY VALUE
          SA6    ATSA
          SX7    X7+77B      ROUND TO NEXT EVEN 100B
          AX7    6
          LX7    6
          SA7    ATSC        MINIMUM ADDITIONAL WORDS REQUIRED
          SX4    1000B       MINIMUM DESIRABLE REQUEST
          SA1    FL
          IX6    X4-X7
          PL     X6,ATS2     IF REQUIRED .LT. DESIRABLE
          BX4    X7
 ATS2     SA3    MFL         MAXIMUM MEMORY
          IX6    X1+X4
          IX7    X6-X3
          NG     X7,ATS3     IF MAXIMUM IS SUFFICIENT
          SA4    ATSC        MINIMUM WORDS REQUIRED
          IX6    X1+X4
          IX1    X6-X3
          PL     X1,ATS4     IF MAXIMUM IS INSUFFICIENT
 ATS3     SA6    FL          NEW FL
          SA1    L.END       SPACE AVAILABLE
          LX6    30
          SA6    ATSB        MEMORY REQUEST STATUS WORD
          IX6    X1+X4
          SA6    A1+         NEW SPACE AVAILABLE
          MEMORY CM,ATSB,R,,NA
          SA4    ATSB
          SA1    FL
          AX4    30
          IX3    X4-X1
          SA1    ATSA        RESTORE (X1)
          PL     X3,ATS5     IF FL OBTAINED
 ATS4     MESSAGE (=C* TABLE OVERFLOW.*)
          EQ     GTR8        ERROR EXIT
 
 
 ATSA     CON    0           STORAGE FOR (X1)
 ATSB     CON    0           MEMORY REQUEST STATUS WORD
 ATSC     CON    0           MINIMUM MEMORY REQUIRED
 CDT      SPACE  4,5
**        CDT - CHECK DEVICE TYPE.
*
*         EXIT   (ND) = 0, IF DIRECTORY REQUESTED ON NON MASS
*                            STORAGE FILE.
*
*         USES   X - 1, 5, 6.
*                A - 1, 6.
 
 
 CDT      PS                 ENTRY/EXIT
          SA1    B+1         SET USER ERROR PROCESSING
          SX5    B1
          LX5    44
          BX6    X1+X5
          SA6    A1
          SA1    B+5         SAVE FET+5, FET+6
          BX6    X1
          SA1    A1+B1
          SA6    CDTA
          BX6    X1
          SA6    A6+B1
          STATUS B,P         DETERMINE DEVICE TYPE
          SA1    CDTA        RESTORE FET+5, FET+6
          BX6    X1
          SA1    A1+B1
          SA6    B+5
          BX6    X1
          SA6    A6+B1
          SA1    B+1         CLEAR ERROR PROCESSING
          BX6    X1-X5
          SA6    A1
          PL     X1,CDT      IF MASS STORAGE
          SX5    =C* MASS STORAGE DIRECTORY NOT WRITTEN.*
          MESSAGE X5
          BX6    X6-X6       SET NO DIRECTORY
          SA6    ND
          EQ     CDT
 
 
 CDTA     BSS    2           SCRATCH
 CFE      SPACE  4,4
**        CFE - CHECK FOR END OF INSERTS.
*         EXIT   (X1) = 0 IF END OF INSERTS.
 
 
 CFE      PS                 RETURN EXIT
          SA2    O.IPT
          SA1    L.IPT
          ZR     X1,CFE      IF NO INSERTS
          SB7    X1
          SA1    X2
          SB4    B1+B1
 CFE1     NZ     X1,CFE      IF MORE INSERTS
          SB7    B7-B4
          SA1    A1+B4
          NZ     B7,CFE1     LOOP
          MX1    0
          EQ     CFE         RETURN
 CFI      SPACE  4,7
**        CFI - CHECK FOR INSERT.
*         ENTRY  (X1) = EOR INDICATOR.
*         EXIT   (X7) = 0 IF RECORD TO BE COPIED.
*                (X1) = EOR INDICATOR.
 
 
 CFI      PS                 RETURN EXIT
          BX7    X1
          SA7    T1
          RECALL B
          SEARCH IPT,(=1L,)
          ZR     X7,CFI1     IF INSERTING
          SA1    RN
          SA2    =1L*
          SX1    X1
          BX2    X1+X2
          SEARCH IPT,A2
          ZR     X7,CFI2     IF INSERTING FULL FILE
          SEARCH IPT,RN
          SA1    RN
          NZ     X1,CFI0     IF NOT ZERO RECORD
          SX7    B1
 CFI0     NZ     X7,CFI      IF RECORD NOT INSERTED
 CFI1     SA1    O.IPT       CHECK FOR END OF INSERT
          IX0    X1+X6
          SA2    X0+B1
          SA3    =1L*        CHECK FOR NEXT PARAMETER BEING +*+
          BX1    X2-X3
          BX3    X2
          MX6    42          MASK OFF RECORD TYPE
          BX1    X6*X1
          ZR     X1,CFI1.1   IF INSERT FULL FILE FROM NOW ON
          SA1    RN
          SA3    =1L,        SET INSERTING FLAG
 CFI1.1   BX6    X3
          SA6    X0
          BX6    X1-X2
          NZ     X6,CFI2     IF NOT END OF INSERT
          SA6    X0          CLEAR IPT ENTRY
          SA6    X0+B1
          SA1    A6+B1       CHECK FOR ZERO RECORD INSERT
          AX1    42
          SX1    X1-1L0
          NZ     X1,CFI2     IF NO ZERO RECORD
          SA6    ZR
 CFI2     SA1    RN
          BX2    X2-X2
          ADDWORD NPT
          IX6    X3+X4       SET RANDOM RETURN ADDRESS
          SX6    X6-1
          SA6    B+6
          MX7    0
          SA1    T1
          EQ     CFI         RETURN
 CIT      SPACE  4,5
**        CIT - CHECK INSERT TABLE.
*         THE INSERT TABLE IS CHECKED AGAINST THE PNT TO DETERMINE
*         IF ALL INSERTS ARE LEGAL.
 
 
 CIT      PS                 RETURN EXIT
          SX6    B0          SET IPT INDEX
          SA6    T1
 CIT1     SA1    O.IPT
          SA2    L.IPT
          SA3    T1
          BX6    X3-X2
          ZR     X6,CIT4     IF END OF IPT
          IX1    X1+X3
          SA2    X1
          BX6    X2
          AX6    42
          SX7    X6-1L0
          ZR     X7,CIT3     IF 0-LENGTH RECORD INSERT
          SX7    X6-1L*
          ZR     X7,CIT3     IF FULL FILE ADD
          SEARCH PNT,A2
          NZ     X7,CIT2     IF RECORD NOT FOUND
          SA6    T2
          SA1    O.IPT
          SA2    T1
          IX1    X1+X2
          SA2    X1+B1
          BX6    X2
          AX6    42
          SX7    X6-1L*
          ZR     X7,CIT3     IF FULL FILE ADD
          SEARCH PNT,A2
          NZ     X7,CIT2     IF RECORD NOT FOUND
          SA1    T2
          IX7    X6-X1
          PL     X7,CIT3     IF LEGAL INSERT
 
*         BAD INSERT.
 
 CIT2     RJ     DPN         DISPLAY PROGRAM NAME
          SA1    CITA        INCREMENT ERROR COUNT
          SX6    X1+B1
          SA6    A1
 
*         ADVANCE TO NEXT ENTRY.
 
 CIT3     SA1    T1
          SX6    X1+2
          SA6    A1
          EQ     CIT1        LOOP
 
*         CHECK ERROR COUNT.
 
 CIT4     SA1    CITA
          ZR     X1,CIT      IF NO ERRORS
          SX6    B1          SET ERROR FLAG
          SA6    ERRF
          SA2    NABT
          NZ     X2,CIT      IF NO ABORT FLAG SET
          EQ     GTR8        ERROR EXIT
 
 CITA     CON    0           ERROR COUNT
 COMMON   SPACE  4
**        COMMON DECKS.
 
 
*CALL     COMCLFM
*CALL     COMCSYS
*CALL     COMCCIO
*CALL     COMCCPM
*CALL     COMCRDW
*CALL     COMCWTW
*CALL     COMCSRT
 CPP      SPACE  4,3
**        CPP - COPY PROGRAMS.
 
 
 CPP      PS                 RETURN EXIT
          RJ     CIT         CHECK INSERT TABLE
 CPP1     SA1    O.IPT
          SA2    L.IPT
          ZR     X2,CPP      IF END OF INSERTS
 
*         CHECK FOR 0-LENGTH RECORD INSERT.
 
          SA2    X1
          AX2    42
          SX6    X2-1L0
          NZ     X6,CPP2     IF NOT 0-LENGTH RECORD
          BX1    X1-X1       MAKE *OPLD* ENTRY
          BX2    X2-X2
          ADDWORD  NPT
          RECALL B
          SA1    O.NPT       SET RANDOM RETURN ADDRESS
          SA2    L.NPT
          IX6    X1+X2
          SX6    X6-1
          SA6    B+6
          WRITER B
          EQ     CPP7
 
*         CHECK FOR ENTIRE FILE INSERT.
 
 CPP2     SX6    X2-1L*
          NZ     X6,CPP5     IF NOT ENTIRE FILE INSERT
          SA6    T1          SET PNT INDEX
 CPP3     SA1    O.PNT
          SA2    L.PNT
          SA3    T1
          SB5    X1
          SB6    X2
          SB4    B1+B1
          MX0    42
          SB7    X3
 CPP4     EQ     B6,B7,CPP7  IF END OF PNT
          SA2    B5+B7       CHECK PROGRAM TYPE
          SA4    O.IPT
          SA4    X4
          BX7    X4-X2
          BX7    -X0*X7
          SB7    B7+B4
          NZ     X7,CPP4     IF NOT CORRECT PROGRAM TYPE
          SX6    B7
          SA6    T1
          SB2    B7-B4       COPY RECORD
          RJ     CPY
          EQ     CPP3        LOOP
 
*         SEARCH PNT FOR START OF INSERT.
 
 CPP5     SA2    X1
          SEARCH PNT,A2
          NZ     X7,CPP7     IF RECORD NOT FOUND
          SA6    T1
 
*         FIRST PROGRAM FOUND, START COPY.
 
 CPP6     SA1    T1
          SB2    X1
          RJ     CPY
          SA1    O.IPT
          SA2    X1
          SA4    X1+B1
          BX6    X2-X4
          ZR     X6,CPP7     IF LAST PROGRAM FOUND
          BX6    X4
          AX6    42
          SX6    X6-1L*
          SA3    T1          INCREMENT PNT INDEX
          SX7    X3+2
          SA7    A3
          ZR     X6,CPP3     IF ADD FULL FILE
          SA1    L.PNT
          BX2    X1-X7
          ZR     X2,CPP7     IF END OF PNT
          SA1    O.PNT
          SB5    X1
          SA1    B5+X7       SET CURRENT PROGRAM NAME
          BX7    X1
          SA2    O.IPT
          SA7    X2
          EQ     CPP6        LOOP
 
*         ADVANCE TO NEXT IPT ENTRY.
 
 CPP7     SA1    O.IPT
          SA2    L.IPT
          SX6    X1+2
          SX7    X2-2
          SA6    A1
          SA7    A2
          EQ     CPP1        LOOP
 CPY      SPACE  4,4
**        CPY - COPY RECORD TO FILE *LGO*.
*         ENTRY  (B2) = PNT INDEX.
 
 
 CPY      PS                 RETURN EXIT
          SX6    B1          SET RECORDS WRITTEN FLAG
          SA6    RCWF
          SA1    O.PNT
          SA1    X1+B2
          SA2    A1+B1       SET RANDOM ADDRESS
          BX6    X2
          SA6    P+6
          BX6    X1
          SA6    RN          SAVE RECORD NAME
          BX2    X2-X2
          ADDWORD NPT
          READ   P
          RECALL B
          SA3    O.NPT       SET RANDOM RETURN ADDRESS
          SA4    L.NPT
          IX6    X3+X4
          SA1    X6-2
          SX6    X6-1
          SA6    B+6
          SA2    WNRA
          RJ     MSG
          SA1    RN          CHECK TYPE
          SB7    X1-ULRT
          ZR     B7,CPY4     IF *ULIB*
          SB7    X1-TXRT
          NZ     B7,CPY1     IF NOT A TEXT RECORD
          SA1    TU
          ZR     X1,CPY1     IF NOT REMOVING RECORD NAMES
          MX0    -12
 CPY0     READW  P,WSA,1     SKIP RECORD NAME LINE
          NG     X1,CPY3     IF EOF/EOI ENCOUNTERED
          NZ     X1,CPY2.1   IF EOR ENCOUNTERED
          SA1    WSA
          BX1    -X0*X1
          NZ     X1,CPY0     IF NOT END OF LINE
 CPY1     READW  P,WSA,WSAL  COPY RECORD
          NZ     X1,CPY2     IF EOR
          WRITEW B,WSA,WSAL
          EQ     CPY1
 
 CPY2     NG     X1,CPY3     IF EOF
          WRITEW B,WSA,X1-WSA
 CPY2.1   WRITER B
          EQ     CPY         RETURN
 
 CPY3     MESSAGE (=C* UNUSUAL END-OF-FILE ENCOUNTERED.*)
          EQ     GTR8        ERROR EXIT
 
 CPY4     SA1    ND
          ZR     X1,CPY7     IF DIRECTORY NOT REQUESTED
 CPY5     READW  P,WSA,WSAL  COPY DIRECTORY RECORD
          NZ     X1,CPY6     IF EOR
          WRITEW B,WSA,WSAL
          EQ     CPY5        LOOP ON COPY
 
 CPY6     NG     X1,CPY3     IF EOF/EOI
          WRITEW B,WSA,X1-WSA
          WRITER B
 CPY7     RJ     SKR         SKIP RECORD
          SA1    RN
          SA2    WNRA
          RJ     MSG
          RJ     CUL         COPY USER LIBRARY
          EQ     CPY         RETURN
 CUL      SPACE  4
**        CUL - COPY USER LIBRARY.
*         ENTRY  (RN) = CURRENT RECORD NAME.
 
 
 CUL      PS                 RETURN EXIT
 CUL1     READ   P
          RECALL B
          READW  P,WSA,WSAL
          NG     X1,CPY3     IF EOF
          BX6    X1
          SX1    B6          LWA+1 OF DATA READ
          SA6    T2          SAVE EOR INDICATOR
          SX2    WSA
          RJ     SRT         SET RECORD TYPE
          SA6    RN
          SA1    T2
          NZ     X1,CUL3     IF EOR
 CUL2     WRITEW B,WSA,WSAL  COPY RECORD
          READW  P,WSA,WSAL
          ZR     X1,CUL2     IF NOT EOR
          NG     X1,CPY2     IF EOF/EOI
 CUL3     WRITEW B,WSA,X1-WSA
          WRITER B
          SA1    RN          CHECK TYPE
          SB7    X1-ODRT
          NZ     B7,CUL1     LOOP TO END OF ULIB
          EQ     CUL         RETURN
 DMP      SPACE  4,3
**        DMP - DISPLAY MISSING PROGRAMS.
 
 
 DMP      PS                 RETURN EXIT
          SX6    B0
          SA6    T1
 DMP1     SA1    O.IPT
          SA2    L.IPT
          ZR     X2,DMP4     IF END OF IPT
          SA2    X1          READ ENTRY
          BX6    X2
          AX6    42
          ZR     X2,DMP3     IF NO ENTRY
          SX7    X6-1L0
          ZR     X7,DMP3     IF ADD 0-LENGTH RECORD
          SX7    X6-1L*
          ZR     X7,DMP3     IF FULL FILE ADD
          SX7    X6-1L,
          NZ     X7,DMP2     IF INSERT NOT STARTED
          SA2    A2+B1
 DMP2     SA1    T1          INCREMENT ERROR COUNT
          SX6    X1+B1
          SA6    A1
          RJ     DPN         DISPLAY PROGRAM NAME
 DMP3     SA1    O.IPT       ADVANCE TO NEXT INSERT
          SA2    L.IPT
          SX6    X1+2
          SX7    X2-2
          SA6    A1
          SA7    A2
          EQ     DMP1        LOOP
 
 DMP4     SA1    T1
          ZR     X1,DMP      IF NO ERRORS
          SX6    B1          SET ERROR FLAG
          SA6    ERRF
          EQ     DMP         RETURN
 DPN      SPACE  4,4
**        DPN - DISPLAY PROGRAM NAME.
*         ENTRY  (X2) = 42/PROGRAM NAME LEFT JUSTIFIED, 18/RECORD TYPE.
 
 
 DPN      PS                 RETURN EXIT
          MX0    30
          SA1    DPNB+X2
          LX6    X1
          LX2    30
          BX1    -X0*X2
          MX7    12
          BX7    X7*X2
          IX6    X6+X1
          SA6    DPNA+1
          SA7    A6+B1
          MESSAGE A6-B1,,R
          EQ     DPN         RETURN
 
 DPNA     DATA   22C  MISSING
 DPNB     BSS    0
 .E       ECHO   ,RT=("RTMIC")
 .A       IFC    NE,/RT//
          VFD    24/0A_RT,36/1L/
 .A       ELSE
          DATA   0
 .A       ENDIF
 .E       ENDD
 MSG      SPACE  4,5
**        MSG - SEND CONSOLE MESSAGE.
*         ENTRY  (X1) = PROGRAM NAME LEFT JUSTIFIED.
*                (X2) = CONSOLE MESSAGE.
 
 
 MSG      PS                 RETURN EXIT
          MX0    42
          LX6    X2
          BX7    X0*X1
          SA6    MSGA
          SA7    A6+B1
          MESSAGE A6,1
          EQ     MSG         RETURN
 
 MSGA     DATA   17C GETTING
 RDD      SPACE  4,4
**        RDD - READ DIRECTORY.
*         EXIT   (X1) = 0 IF DIRECTORY NOT FOUND.
 
 
 RDD      PS                 RETURN EXIT
          SKIPEI P
          SKIPB  P,2
          READ   P
          READW  P,T1,1
          NZ     X1,RDD1     IF EOR OR EOF
          SA1    T1
          LX1    18
          SX6    X1-770000B
          NZ     X6,RDD1     IF NO 7700 TABLE
          LX1    6
          READW  P,WSA,X1
          SA1    WSA
          BX6    X1
          SA6    ID+1
          READW  P,T1,1
          SA2    T1
          LX2    18
          BX3    X2
          SX6    X2-700000B
          LX3    18
          SX3    X3
          NZ     X3,RDD1     IF NOT OPLD
          NZ     X6,RDD1     IF NOT OPLD
          LX2    -18
          ALLOC  PNT,X2
          READW  P,X3,X4
          NZ     X1,RDD1     IF EOR
          READW  P,WSA,3
          NZ     X1,RDD      RETURN IF EOR
 RDD1     REWIND P
          MX1    0
          EQ     RDD         RETURN
 RFR      SPACE  4,5
**        RFR - READ FIRST RECORD.
*         EXIT   (X1) = EOR INDICATOR.
*                (RN) = RECORD NAME AND TYPE.
 
 
 RFR      PS                 RETURN EXIT
 RFR1     READ   P
          READW  P,WSA,WSAL
          NG     X1,RFR      EXIT IF EOF
          BX6    X1
          SX1    B6          LWA+1 OF DATA READ
          SA6    T1
          SX2    WSA
          RJ     SRT         SET RECORD TYPE
          SA6    RN
          SA1    T1
          SX7    X6-ODRT
          NZ     X7,RFR      IF NOT OPLD
          NZ     X1,RFR1     IF EOR
 RFR2     READW  P,WSA,WSAL
          ZR     X1,RFR2     LOOP TO EOR
          PL     X1,RFR1     IF EOR
          EQ     RFR
 SKR      SPACE  4,3
**        SKR - SKIP RECORD.
 
 
 SKR      PS                 RETURN EXIT
          SA1    RN
          SA2    =10H SKIPPING
          RJ     MSG
 SKR1     READW  P,WSA,WSAL
          ZR     X1,SKR1     IF NOT EOR
          EQ     SKR         RETURN
 SMT      SPACE  4,10
**        SMT - SEARCH MANAGED TABLE.
*         ENTRY  (A1) = ADDRESS OF TABLE ORIGIN.
*                (X1) = TABLE ORIGIN.
*                (X2) = ENTRY.
*                (X3) = MASK.
*         EXIT   (X2) = ENTRY.
*                (X6) = TABLE INDEX.
*                (X7) = 0 IF FOUND.
 
 
 SMT      PS                 RETURN EXIT
          SB2    X1
          SA4    A1+TABL
          SB7    X4+B2
          MX7    1
          SB3    B2
          SB4    B1+B1
 SMT1     EQ     B3,B7,SMT   IF END OF TABLE
          SA1    B3
          BX7    X1-X2
          BX7    X3*X7
          SB3    B3+B4
          NZ     X7,SMT1     IF NOT FOUND
          SX6    A1-B2
          EQ     SMT         RETURN
 WND      SPACE  4,3
**        WND - WRITE NEW DIRECTORY.
 
 
 WND      PS                 RETURN EXIT
          RECALL B
          RJ     CDT         CHECK DEVICE TYPE
          SA1    ND
          ZR     X1,WND1     IF NO DIRECTORY
          SX1    X1-1
          ZR     X1,WND1     IF *U* OPTION SELECTED
          SA1    RCWF        CHECK RECORDS WRITTEN FLAG
          ZR     X1,WND1     IF NO RECORDS WRITTEN
          SA1    ID+1        ADD *NPT* ENTRY FOR NEW OPLD
          SX3    8
          SA2    B+6
          IX1    X1+X3
          AX2    30
          ADDWORD  NPT
          SA1    L.NPT
          MX6    3
          BX6    X6+X1
          SA6    ID+17B
          WRITEW B,ID,20B
          SA1    O.NPT
          SA2    L.NPT
          WRITEW B,X1,X2
          WRITER B
          WRITEF B
          SA1    B+1
          AX1    48
          SX3    X1-2ROD
          ZR     X3,WND2     IF OPTICAL DISK FILE
          BKSP   B,R
 WND1     SA1    NR
          NZ     X1,WND      IF NO REWIND
 WND2     REWIND B
          REWIND P
          EQ     WND         RETURN
 WNR      SPACE  4,4
**        WNR - WRITE NEXT RECORD.
*         ENTRY  (X1) = EOR INDICATOR.
 
 
 WNR      PS                 RETURN EXIT
          SX6    B1          SET RECORDS WRITTEN FLAG
          SA6    RCWF
          BX6    X1
          SA6    T1
          SA1    RN
          SA2    WNRA
          RJ     MSG
          SA2    RN          CHECK TYPE
          SA1    T1
          SB7    X2-ULRT
          ZR     B7,WNR3     IF *ULIB*
          SB7    X2-TXRT
          NZ     B7,WNR0.2   IF NOT A TEXT RECORD
          SA2    TU
          ZR     X2,WNR0.2   IF NOT REMOVING RECORD NAMES
          SA2    WSA
          SB7    WSAL
          MX0    -12
          ZR     X1,WNR0.1   IF NOT AT EOR
          SB7    X1-WSA
          ZR     B7,WNR2.1   IF EMPTY RECORD
 WNR0.1   SB7    B7-B1
          ZR     B7,WNR2.1   IF EMPTY RECORD
          BX6    -X0*X2
          SA2    A2+B1
          NZ     X6,WNR0.1   IF NOT AT END OF LINE
          BX0    X1
          WRITEW B,A2,B7
          NZ     X0,WNR2.1   IF AT EOR
          READW  P,WSA,WSAL
 WNR0.2   NZ     X1,WNR2     IF AT EOR
 WNR1     WRITEW B,WSA,WSAL
          READW  P,WSA,WSAL
          ZR     X1,WNR1     IF NOT EOR
          NG     X1,WNR      IF EOF/EOI
 WNR2     WRITEW B,WSA,X1-WSA
 WNR2.1   WRITER B
          EQ     WNR         RETURN
 
 WNR3     SA2    ND
          ZR     X2,WNR6     IF DIRECTORY NOT REQUESTED
          NZ     X1,WNR5     IF EOR
 WNR4     WRITEW B,WSA,WSAL
          READW  P,WSA,WSAL
          ZR     X1,WNR4     IF NOT EOR
          NG     X1,WNR      IF EOF/EOI - RETURN
 WNR5     WRITEW B,WSA,X1-WSA
          WRITER B
 WNR6     RJ     SKR         SKIP RECORD
          SA1    RN
          SA2    WNRA
          RJ     MSG
          RJ     CUL         COPY USER LIBRARY
          EQ     WNR         RETURN
 
 WNRA     DATA   10H GETTING
 ENDS     BSS    0           END OF SUBROUTINES
 APN      TITLE  CONTROL CARD PROCESSING - OVERLAID CODE.
**        APN - ASSEMBLE PROGRAM NAME.
*         ASSEMBLE ENTRY OF TYPE *LIB/PN,*
*         EXIT   (X2) = SEPARATOR CHARACTER
*                (X6) = PROGRAM NAME AND TYPE.
 
 
          ORG    WSA
          SEG
 APN      PS                 RETURN EXIT
          SA1    CP
          SB4    X1+B1       (B4) = STRING BUFFER POINTER
          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,ERR      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    APNB
 APN5     ZR     X2,ERR      IF ILLEGAL LIBRARY
          BX7    X1-X2
          SA2    A2+B1
          NZ     X7,APN5     IF NOT FOUND
          SX7    A2-APNB-1
          MX0    -18         SET PROGRAM AND LIBRARY NAMES
          LX6    X6,B7
          BX2    -X0*X6
          NZ     X2,ERR      IF NAME MORE THAN 7 CHARACTERS
          BX6    X0*X6
          BX6    X6+X7
          SA2    B4
          SX7    B4
          SA7    CP
          EQ     APN         RETURN
 
 
 APNA     CON    0LTEXT      LIBRARY NAME
 APNB     BSS    0
 .E       ECHO   ,RT=("RTMIC")
 .A       IFC    NE,/RT//
          DATA   L/RT/
 .A       ELSE
          DATA   1
 .A       ENDIF
 .E       ENDD
          CON    0
 ARG      SPACE  4,3
**        ARG - PROCESS ARGUMENTS ON COMMAND.
*
*         ARG SETS FILE NAMES AND FLAGS BASED ON COMMAND PARAMETERS.
*
*         ENTRY  COMMAND PARAMETERS ARE IN JOB COMMUNICATION AREA.
*
*         EXIT   FILE NAMES AND SELECTED OPTION FLAGS ARE SET UP.
*
*         ERROR  TO *GTR8* IF FILE NAME CONFLICT, TOO MANY PARAMETERS,
*                          OR INCORRECT PARAMETER.
*
*         USES   X - 0, 1, 2, 3, 6, 7.
*                A - 1, 2, 3, 6, 7.
*                B - 6, 7.
*
*         MACROS MESSAGE.
 
 
 ARG3     SA1    P
          SA2    B
          BX6    X0*X2       SET NEW LFN AS NEW DIRECTORY NAME
          SA6    ID+1
          BX2    X2-X1
          BX1    X0*X2
          NZ     X1,ARG4     IF FILE NAMES DIFFERENT
          MESSAGE  (=C* FILENAME CONFLICT.*)
          EQ     GTR8        ERROR EXIT
 
 ARG4     SA1    ND          READ NO DIRECTORY FLAG
          ZR     X1,ARG      IF NO DIRECTORY OPTION SELECTED
          SX2    1RU
          LX1    5-59
          IX6    X2-X1
          ZR     X6,ARG5     IF *U* OPTION SELECTED
          SX6    B1+
 ARG5     SX7    X6+1        SET OPTION AND RETURN
          SA7    A1+
 
 ARG      PS                 RETURN EXIT
          SA1    ACTR        SET ARGUMENT COUNT
          SA2    CPRF
          SB6    B1+B1       COPYRF MAXIMUM NUMBER OF ARGUMENTS
          SB7    X1
          ZR     X2,ARG0     IF NOT COPYRF
          LE     B7,B6,ARG0  IF 2 OR LESS ARGUMENTS
          MESSAGE (=C* TOO MANY PARAMETERS.*)
          EQ     GTR8        ERROR EXIT
 
 ARG0     MX0    42
          SA1    B6          FIRST ARGUMENT
          SA2    ARGA        SET LIST OF OPTIONS
 ARG1     ZR     B7,ARG3     IF END OF ARGUMENTS
          BX6    X0*X1
          SA3    X2
          SB7    B7-B1
          BX3    -X0*X3
          ZR     X6,ARG2     IF NULL PARAMETER
          BX6    X6+X3
          SA6    X2
 ARG2     SX3    X1-3        CHECK FOR */* SEPARATOR
          SX6    X1-1R/
          SA1    A1+B1       READ NEXT PARAMETER
          SA2    A2+B1
          ZR     X3,ARG2.1   IF NON-POSITIONAL PARAMETERS FOLLOW
          ZR     X6,ARG2.1   IF NON-POSITIONAL PARAMETERS FOLLOW
          NZ     X2,ARG1     IF MORE PARAMETERS TO PROCESS
          EQ     ARG3        RETURN
 
 ARG2.1   ZR     B7,ARG3     IF END OF PARAMETERS
          BX6    X0*X1
          ZR     X6,ARG2.3   IF NULL PARAMETER
          SA2    ARGB-1
 ARG2.2   SA2    A2+B1
          ZR     X2,ARG2.4   IF NO MATCH IN ARGUMENT TABLE
          BX1    X0*X2
          BX1    X1-X6
          NZ     X1,ARG2.2   IF NOT THIS ARGUMENT
          SA6    X2
 ARG2.3   SB7    B7-B1
          SA1    A1+B1
          EQ     ARG2.1      PROCESS NEXT PARAMETER
 
 ARG2.4   MESSAGE (=C* INCORRECT PARAMETER.*)
          EQ     GTR8        ERROR EXIT
 
 
*         POSITIONAL PARAMETER ARGUMENT TABLE.
 
 ARGA     CON    P
          CON    B
          CON    ND
          CON    NR
          CON    SQ
          CON    NABT
          CON    TU
          CON    0
 
 
*         POSITION-INDEPENDENT PARAMETER ARGUMENT TABLE.
 
 ARGB     VFD    42/0LD,18/ND
          VFD    42/0LU,18/ND
          VFD    42/0LNR,18/NR
          VFD    42/0LS,18/SQ
          VFD    42/0LNA,18/NABT
          VFD    42/0LT,18/TU
          CON    0
 PRS      SPACE  4,4
**        PRS - PRESET TABLE LENGTHS.
*         ENTRY  (A0) = FIELD LENGTH.
 
 
 PRS      PS                 RETURN EXIT
          DATE   ID+2
          SA1    ID+2        POSITION DATE
          SX6    TAB         SET TABLE POINTER
          BX7    X1
          SA6    B0
          LX7    6
          SX6    A0
          SA7    A1
          SA6    FL
          SX6    A0-BUF-10B  SET BUFFER LENGTH
          SA6    L.END
          GETFLC MFL         GET MAXIMUM MEMORY AND OTHER DATA
          SA1    MFL
          MX6    12
          BX6    X6*X1       ISOLATE AND SAVE MAXIMUM MEMORY
          LX6    17-59
          SA6    A1
          EQ     PRS         RETURN
 
 MFL=     EQU    BUF+BUFL+200000B
 RCD      SPACE  4,5
**        RCD - READ CORRECTION DIRECTIVES.
*         ENTRY (CCDR) = CONTROL CARD.
*         EXIT   (X1) < 0 IF FILE IS NON-RANDOM.
 
 
 RCD      PS                 RETURN EXIT
          SB2    CCDR        UNPACK CONTROL CARD
          SB3    CCDR+10B
          SB4    CBUF
          MX0    -6
 RCD1     SB5    B4+10
          SA1    B2
          SB2    B2+B1
 RCD2     LX1    6
          BX6    -X0*X1
          SA6    B4
          SB4    B4+B1
          NZ     X1,RCD2.1   IF NON-ZERO BYTES LEFT IN WORD
          NE     B4,B5,RCD3  IF MULTIPLE ZERO BYTES AT END OF WORD
          EQ     B2,B3,RCD3  IF END OF COMMAND LINE
          SA2    B2+         CHECK NEXT WORD
          ZR     X2,RCD3     IF END OF COMMAND
 RCD2.1   BX1    X1-X6
          NE     B4,B5,RCD2  LOOP FOR 10-CHARACTERS
          SX6    B0+
          NE     B2,B3,RCD1  LOOP FOR END OF BUFFER
 RCD3     SA6    B4          SUPPRESS TRAILING BLANKS
          SB4    B4-B1
          SA1    B4
          SX6    X1-1R
          ZR     X6,RCD3     IF CHARACTER IS * *
 
*         SKIP OVER GTR CALL.
 
          SA1    CBUF
 RCD4     SX6    X1-1R.
          ZR     X6,RCD5     IF *.* TERMINATOR
          SX6    X1-1R)
          ZR     X6,RCD5     IF *)* TERMINATOR
          SA1    A1+B1
          EQ     RCD4        LOOP
 
 RCD5     SX6    A1          SET CHARACTER POINTER
          SA6    CP
 
*         BUILD INSERT PROGRAM TABLE.
 
 RCD6     RJ     APN
          ZR     X6,ERR      IF NO NAME
          SA6    T1
          SB5    X2-1R-
          SA6    A6+B1
          NZ     B5,RCD7     IF NO SECOND FIELD
          RJ     APN
          SA6    T2
 RCD7     SA1    T1
          SA2    A1+B1
          ADDWORD IPT
 
*         PROCESS NEXT FIELD.
 
          SA1    CP
          SA2    X1
          SX6    X2-1R
          ZR     X6,RCD      RETURN IF * *
          NZ     X2,RCD6     IF NOT END-OF-LINE
          EQ     RCD         RETURN
 CBUF     SPACE  4,3
**        CBUF - CARD BUFFER.
 
 
 CBUF     BSS    80
          SPACE  4
          END    GTR         GET SELECTED RECORDS