GTR 
          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 
