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