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