IDENT LIBEDIT,LIBEDIT,LIBEDIT
ABS
ENTRY LIBEDIT
ENTRY SSM=
ENTRY MFL=
SYSCOM B1
*COMMENT LIBEDIT - LIBRARY EDITING PROGRAM.
COMMENT COPYRIGHT CONTROL DATA SYSTEMS INC. 1992.
TITLE LIBEDIT - LIBRARY EDITING PROGRAM.
SPACE 4
*** LIBEDIT - LIBRARY EDITING PROGRAM.
* D. A. CAHLANDER. 69/02/13.
* P. D. HAAS. 73/07/29.
SPACE 4,10
*** LIBEDIT PROVIDES EDITING AND REPLACEMENT OF RECORDS ON
* A BINARY FILE BY RECORDS FROM ONE OR MORE SECONDARY FILES.
SPACE 4
*** COMMAND CALL -
*
* LIBEDIT(P1,P2,P3,P4,.....,PN)
*
* WHERE PARAMETER KEYWORDS ARE ORDER INDEPENDENT,
* AND ARE ONE OR MORE OF THE FOLLOWING -
*
* I OMITTED, USE *INPUT* FOR INPUT DIRECTIVES FILE.
* I , USE *INPUT* FOR INPUT DIRECTIVES FILE.
* I=0 , NO INPUT DIRECTIVE FILE IS TO BE USED.
* I=FN , USE *FN* FOR INPUT DIRECTIVES FILE.
*
* P OMITTED, USE *OLD* FOR OLD FILE.
* P , USE *OLD* FOR OLD FILE.
* P=0 , NO OLD FILE TO BE USED.
* P=FN , USE *FN* FOR OLD FILE.
*
* N OMITTED, USE *NEW* FOR NEW FILE.
* N , USE *NEW* FOR NEW FILE.
* N=FN , USE *FN* FOR NEW FILE.
*
* B OMITTED, USE *LGO* FOR CORRECTION FILE.
* B , USE *LGO* FOR CORRECTION FILE.
* B=0 , NO CORRECTION FILE TO BE USED.
* B=FN , USE *FN* FOR CORRECTION FILE.
*
* L OMITTED, USE *OUTPUT* FOR LISTING FILE.
* L , USE *OUTPUT* FOR LISTING FILE.
* L=0 , NO LISTING FILE TO BE WRITTEN.
* L=FN , USE *FN* FOR LISTING FILE.
*
* LO=E , LIST PROCESSING ERRORS.
* LO=C , LIST INPUT DIRECTIVES.
* LO=M , LIST MODIFICATIONS MADE.
* LO=N , LIST RECORDS WRITTEN TO NEW FILE.
* LO=F , FULL LIST INCLUDING PROCESSING ERRORS, INPUT
* DIRECTIVES, MODIFICATIONS MADE AND RECORDS
* WRITTEN TO NEW FILE.
* (NOTE - ANY COMBINATION MAY BE SPECIFIED FOR *LO*.)
*
* LO OMITTED ---
* LO=EM , TIME SHARING JOB, LISTING FILE ASSIGNED
* TO EQUIPMENT *TT*.
* LO=ECF , ALL OTHER CASES.
*
* U OMITTED, NO USER LIBRARY TO BE GENERATED.
* U , GENERATE USER LIBRARY *ULIB* ON FILE *NEW*.
* U=0 , NO USER LIBRARY TO BE GENERATED.
* U=LN , GENERATE USER LIBRARY *LN* ON FILE *NEW*.
* (NOTE - *LIBGEN* IS CALLED TO GENERATE USER LIBRARY.)
*
* NX OMITTED, PASS *NX=0* TO *LIBGEN*.
* NX , PASS *NX=1* TO *LIBGEN*.
* NX=0 , PASS *NX=0* TO *LIBGEN*.
* NX=N , PASS *NX=N* TO *LIBGEN*.
*
* C OMITTED, DO NOT RECOPY NEW FILE TO OLD FILE.
* C , RECOPY NEW FILE TO OLD FILE AFTER EDITING.
*
* D , SAME AS *NA* (INCLUDED FOR UPWARD COMPATABILITY).
*
* V OMITTED, DO NOT VERIFY OLD FILE AGAINST NEW FILE.
* V , VERIFY NEW FILE AGAINST NEW FILE.
* (NOTE - *VFYLIB* IS CALLED TO PERFORM THE VERIFY.)
*
* NA OMITTED, ABORT ON DIRECTIVE ERRORS.
* NA , DO NOT ABORT ON DIRECTIVE ERRORS.
* (NOTE - TIME SHARING JOBS WITH DIRECTIVE INPUT FILE
* ASSIGNED TO *TT* SET *NA* AUTOMATICALLY.)
*
* NI OMITTED, INSERT NEW RECORDS FROM CORRECTION FILE AT EOF.
* NI , DO NOT INSERT NEW RECORDS AT EOF.
* (NOTE - ONLY THOSE RECORDS NOT RERERENCED BY ANY DIRECTIVE
* ARE ADDED AT EOF. ANY DIRECTIVE SUCH AS *INSERT
* *NOREP, OR *IGNORE TAKES PRECEDENCE.
*
* NR OMITTED, REWIND *OLD* AND *NEW* BEFORE AND AFTER EDITING.
* NR , DO NOT REWIND *OLD* OR *NEW* FILES.
*
* Z OMITTED, NO DIRECTIVE INPUT ON COMMAND.
* Z , GET DIRECTIVE INPUT FROM COMMAND.
* (NOTE - *Z* PARAMETER WILL OVERRIDE *I* PARAMETER.)
*
*
* SINCE THE *U* AND *V* OPTIONS ARE PERFORMED BY LOADING
* DIFFERENT UTILITIES, IF BOTH ARE SPECIFIED, *U* WILL
* TAKE PRECEDENCE.
SPACE 4,10
*** DAYFILE MESSAGES.
*
* * DIRECTIVE ERRORS.* = A *LIBEDIT* DIRECTIVE HAS INCORRECT
* SYNTAX.
*
* * EDITING COMPLETE.* = INFORMATIVE MESSAGE INDICATING THAT
* THE LIBRARY EDITING HAS COMPLETED.
*
* * FILE NAME CONFLICT.* = THE SAME FILE NAME HAS BEEN
* SPECIFIED FOR MORE THAN ONE PARAMETER.
*
* * FILENAM NOT DECLARED NRANDOM.* = AN EOF WAS ENCOUNTERED
* ON THE NONRANDOM FILE, FILENAM.
*
* * INCORRECT DEVICE TYPE - LFN.* = A NON-MASS STORAGE FILE WAS
* INCORRECTLY SPECIFIED AS EITHER THE OLD FILE OR THE
* CORRECTION FILE.
*
* * LIBEDIT ARGUMENT ERROR(S).* = THE *LIBEDIT* COMMAND
* CONTAINS AN INCORRECT PARAMETER.
*
* * LIST OPTION ERROR.* = AN INCORRECT OPTION WAS SPECIFIED
* FOR THE *LO* PARAMETER.
*
* * N DIRECTIVE ERRORS.* = *LIBEDIT* COULD NOT INTERPRET
* N NUMBER OF DIRECTIVES.
*
* * N RECORDS NOT REPLACED.* = AN INFORMATIVE MESSAGE.
* *LIBEDIT* ENCOUNTERED N NUMBER OF RECORDS ON A
* REPLACEMENT FILE THAT WERE NOT NAMED IN THE DIRECTIVES
* AND DID NOT REPLACE OLD FILE RECORDS.
*
* * NO NEW FILE.* = N=0 WAS INCORRECTLY SPECIFIED FOR THE
* *N* PARAMETER.
*
* * OVERLAPPING INSERT OR DELETE.* = *LIBEDIT* ENCOUNTERED AN
* OVERLAP IN THE RECORD NAMES SPECIFIED IN THE
* DIRECTIVES.
*
* * RENAME NOT ALLOWED FOR PROC OR TEXT RECORD.* = ATTEMPT TO
* RENAME A PROC OR TEXT TYPE RECORD WAS NOT ALLOWED.
*
* * REQUIRED FL EXCEEDS VALIDATED LIMIT.* = THE JOB FIELD
* LENGTH REQUIRED FOR *LIBEDIT* IS GREATER THAN THE
* MAXIMUM FOR WHICH THE USER IS VALIDATED.
*
SPACE 4
**** ASSEMBLY CONSTANTS.
BUFL EQU 4020B MINIMUM BUFFER REQUIRED
DCBL EQU 16 DIRECTIVE BUFFER LENGTH
INPL EQU 2010B *INPUT* *CIO* BUFFER LENGTH
LGOL EQU 10021B *LGO* *CIO* BUFFER LENGTH
NEWL EQU 20041B *NEW* *CIO* BUFFER LENGTH
OLDL EQU 20041B *OLD* *CIO* BUFFER LENGTH
OUTL EQU 4020B *OUTPUT* *CIO* BUFFER LENGTH
SBUFL EQU 4020B *SCR* BUFFER LENGTH
TTYL EQU 301B *TTYOUT* *CIO* BUFFER LENGTH
TWIDE EQU 80+1 WIDTH LIMIT FOR TERMINAL OUTPUT
ODEBL EQU 16
****
* SPECIAL ENTRY POINT.
SSM= EQU 0 SUPPRESS DUMPS OF FIELD LENGTH
TITLE INPUT DIRECTIVES.
*** INPUT DIRECTIVES.
*
* ON ALL DIRECTIVE DESCRIPTIONS, THE PARAMETERS ARE -
* FN FILE NAME.
* NAME RECORD NAME.
* N NUMERIC PARAMETER.
* ABCD ALPHANUMERIC PARAMETER.
* TYPE LIBRARY TYPE - (MAY BE ONE OF THE FOLLOWING)
* *ABS* ABSOLUTE PROGRAM.
* *CAP* FAST DYNAMIC LOAD CAPSULES.
* *OPL* OLD PROGRAM LIBRARY.
* *OPLC* OLD PROGRAM LIBRARY COMMON DECK.
* *OPLD* OPL DIRECTORY.
* *OVL* SCOPE CPU OVERLAY PROGRAM.
* *PP* PERIPHERAL PROCESSOR PROGRAM.
* *PPL* 16-BIT PERIPHERAL PROCESSOR PROGRAM.
* *PPU* 7600 PPU PROGRAM.
* *PROC* PROCEDURE TYPE RECORD.
* *REL* RELOCATABLE CPU PROGRAM.
* *TEXT* UNRECOGNIZED AS A PROGRAM.
* *ULIB* USER LIBRARY.
*
*
* FOR THOSE DIRECTIVES REQUIRING RECORD NAME(S), THE
* FOLLOWING CONVENTIONS ARE USED -
*
* RID RECORD IDENTIFIER
* TYPE/NAME RECORD *NAME* OF TYPE *TYPE*.
* NAME RECORD *NAME*, USING DEFAULT TYPE.
* * EOF (USED ONLY WITH *BEFORE).
*
* GID RECORD GROUP IDENTIFIER
* TYPE/NAME RECORD *NAME* OF TYPE *TYPE*.
* NAME RECORD *NAME*, USING DEFAULT TYPE.
* TYPE1/NAME1- GROUP OF RECORDS STARTING WITH
* TYPE2/NAME2 *RID1* AND ENDING WITH *RID2*.
* TYPE/NAME1- GROUP OF *TYPE* RECORDS STARTING WITH
* NAME2 *NAME1* AND ENDING WITH *NAME2*.
* NAME1-NAME2 GROUP OF DEFAULT TYPE RECORDS STARTING
* WITH *NAME1* AND ENDING WITH *NAME2*.
* TYPE/NAME-* ALL *TYPE* RECORDS STARTING WITH *NAME*
* NAME-* ALL DEFAULT TYPE RECORDS STARTING
* WITH *NAME*.
* TYPE/* ALL RECORDS OF THE SPECIFIED *TYPE*.
* * ALL DEFAULT TYPE RECORDS.
* 0 ZERO LENGTH RECORD (USED ONLY
* WITH *INSERT).
*
*
* DIRECTIVES -
*
* *AFTER RID,GID1,GID2,....GIDN
* *A RID,GID1,GID2,...,GIDN
* *INSERT RID,GID1,GID2,...,GIDN
* *I RID,GID1,GID2,...,GIDN
* INSERT *GID1* THROUGH *GID2* FROM CURRENT CORRECTION
* FILE AFTER *RID* ON FILE *NEW*.
* (NOTE - ANY RECORDS ON *OLD* WITH SAME NAME ARE DELETED.)
*
* *BEFORE RID,GID1,GID2,...,GIDN
* *B RID,GID1,GID2,...,GIDN
* INSERT *GID1* THROUGH *GID2* FROM CURRENT CORRECTION
* FILE BEFORE *RID* ON FILE *NEW*.
* (NOTE - ANY RECORDS ON *OLD* WITH SAME NAME ARE DELETED.)
*
* *DELETE GID1,GID2,...,GIDN
* *D GID1,GID2,...,GIDN
* DELETE *GID1* THROUGH *GIDN*.
*
* *NAME TYPE
* *TYPE TYPE
* CHANGE DEFAULT RECORD TYPE TO *TYPE*.
*
* *ADD LIB,GID1,GID2,...,GIDN.
* ADD *GID1* THROUGH *GIDN* AT END OF LIBRARY *LIB*.
* *LIB* CAN BE ANY OF THE FOLLOWING -
* 1. *DDS* DEADSTART LIBRARY.
* 2. *MOV* MONITOR OVERLAY.
* 3. *RPL* RESIDENT PERIPHERAL OVERLAY.
* 4. *RSL* RESIDENT *SCOPE* LIBRARY.
* 5. *SLD* *SCOPE* LIBRARY DIRECTORY.
* 6. ANY NAME FROM *LIB1* TO *LIB9999*.
* (A LIBRARY IS DEFINED AS A GROUP OF RECORDS
* TERMINATED BY A ZERO-LENGTH RECORD.)
*
* *IGNORE GID1,GID2,...,GIDN
* IGNORE *GID1* THROUGH *GIDN* WHEN READING CORRECTION
* FILE(S). THESE RECORDS ARE NOT REPLACED.
*
* *RENAME RID1,RID2
* CHANGE THE NAME OF *RID1* TO *RID2*.
*
* *REPLACE GID1,GID2,...GIDN
* REPLACE ONLY *GID1* THROUGH *GIDN* WHEN READING CORRECTION
* FILE. THE REST OF THE RECORDS ARE IGNORED.
*
* *LIBGEN UN
* CALL *LIBGEN* AT END OF EDITING TO GENERATE USER LIBRARY
* *UN* ON FILE *NEW*. IF *UN* IS OMITTED,
* USE *UN* = *ULIB*.
* (OVERRIDES *U* PARAMETER IF *UN* IS SPECIFIED).
*
* *OLD FN
* USE *FN* AS OLD FILE (OVERRIDES *P* PARAMETER).
*
* *NEW FN
* USE *FN* AS NEW FILE (OVERRIDES *N* PARAMETER).
*
* *LGO FN1,FN2,...,FNN
* *FILE FN1,FN2,...,FNN
* ADD *FN1* THROUGH *FNN* TO LIST OF CORRECTION FILES.
*
* *NOREP FN1,FN2,...,FNN
* DO NOT REPLACE RECORDS FROM FILES *FN1* THROUGH *FNN*.
*
* *REWIND FN1,FN2,...,FNN
* REWIND *FN1* THROUGH *FN2* BEFORE AND AFTER EDITING.
*
* *BUILD ABCD
* BUILD AN *OPLD* INDEX AT THE END OF FILE *NEW*.
* THE NAME GIVEN TO THIS RECORD IS *ABCD*.
*
* *COMMENT RID,ABCD
* ADDS 70 CHARACTER COMMENT *ABCD* TO THE 7700
* TABLE OF *RID* FROM *OLD* OR CORRECTION FILE.
*
* *DATE RID,ABCD
* ADDS THE CURRENT DATE AND 70 CHARACTER COMMENT *ABCD*
* TO THE 7700 TABLE OF *RID* FROM *OLD* OR CORRECTION FILE.
*
* *LIST FN,ABCD
* CHANGES LISTING FILE TO *FN*, AND LIST OPTIONS TO *ABCD*
* (SEE *LO* PARAMETER). IF EITHER PARAMETER IS OMITTED,
* IT IS NOT CHANGED (OVERRIDES *L* AND *LO* PARAMETERS).
*
* *COPY
* COPY *NEW* TO *OLD* AFTER EDITING
* (EQUIVALENT TO *C* COMMAND PARAMETER).
*
* *DEBUG
* IGNORE SUBSEQUENT DIRECTIVE ERRORS (EQUIVALENT TO
* *NA* PARAMETER, SET AUTOMATICALLY IF OUTPUT ASSIGNED
* TO EQUIPMENT *TT*.
*
* *NOINS
* DO NOT INSERT UNREPLACEABLE RECORDS AT EOF.
* (EQUIVALENT TO *NI* PARAMETER.)
*
* *NOREW
* DO NOT REWIND *OLD* OR *NEW * FILES.
* (EQUIVALENT TO *NR* PARAMETER)
*
* *VERIFY
* *VFYLIB
* VERIFY *NEW* AGAINST *OLD* AFTER EDITING.
* (EQUIVALENT TO *V* PARAMETER, USES *VFYLIB*.)
*
* */ TEXT
* COMMENT CARD, *TEXT* IS COPIED TO LISTING FILE.
*
*
*
* CARDS WITHOUT AN *** IN COLUMN 1 ARE TREATED AS A CONTINUATION
* OF THE PREVIOUS CARD. IF NO CARD PRECEEDS THIS CARD,
* (*BEFORE *,LIB/PN) IS ASSUMED.
TITLE TABLE STRUCTURE.
** TABLE STRUCTURE.
* ALL TABLES ARE VARIABLE LENGTH, MANAGED TABLES. POINTERS
* TO THE TABLE ABC ARE
* P.ABC = FWA OF TABLE ABC.
* L.ABC = LENGTH OF TABLE ABC.
* N.ABC = NUMBER OF WORDS/ENTRY.
* D.ABC = NUMBER OF WORDS THE LENGTH OF TABLE IS
* INCREASED IF TABLE IS FULL.
*
* FNT - NAME TABLE.
* 42/FILE,18/RANDOM
* 1. FILE = FILE NAME LEFT JUSTIFIED
* 2. RANDOM = 0 IF FILE IS RANDOM.
* RANDOM = CURRENT POSITION IF FILE IS NON RANDOM.
*
* PNT - PROGRAM NAME TABLE.
*
* 42/PROGRAM,18/TYPE
* 42/FILE,18/0
* 60/POSITION
* 1. PROGRAM = PROGRAM NAME LEFT JUSTIFIED.
* 2. TYPE = PROGRAM TYPE.
* 0 = *TEXT*
* 1 = *PP*
* 3 = *REL* RELOCATABLE
* 4 = *OVL* OVERLAY
* 5 = *ULIB* USER LIBRARY
* 6 = *OPL* OLD PROGRAM LIBRARY
* 7 = *OPLC* OLD PROGRAM LIBRARY COMMON DECK
* 8 = *OPLD* OPL DIRECTORY
* 9 = *ABS* ABSOLUTE PROGRAM
* 10 = *PPU* 7600 PPU PROGRAM
* 14 = *CAP* FAST DYNAMIC LOAD CAPSULE
* 16 = *PROC* PROCEDURE TYPE RECORD
* 20 = *PPL* 16-BIT PP PROGRAM
* 3. FILE = CORRECTION FILE NAME.
* 4. POSITION = RANDOM INDEX.
*
* DPT - DELETE PROGRAM TABLE.
*
* 42/PROGRAM1,6/IP,12/TYPE
* 42/PROGRAM2,6/0,12/TYPE
* 1. PROGRAM1 = START OF DELETE.
* 2. PROGRAM2 = END OF DELETE.
* 3. IP = 0, IF DELETE NOT IN PROGRESS.
* = 1, IF DELETE IN PROGRESS.
*
* IDT - IMPLIED DELETE TABLE.
*
* 42/PROGRAM, 18/TYPE
* 42/FILE,18/0
* 1. PROGRAM = PROGRAM DELETED IF PRESENT.
* 2. TYPE = PROGRAM TYPE.
* 3. FILE = CORRECTION FILE NAME.
*
* PIT - PROGRAM IGNORE TABLE.
*
* 42/FILE,18/0
* 42/PROGRAM1,18/TYPE1
* 42/PROGRAM2,18/TYPE2
* 1. FILE = FILE NAME LEFT JUSTIFIED.
* 2. PROGRAM1 = START OF IGNORE.
* 3. PROGRAM2 = END OF IGNORE.
*
*
* RFT - REWIND FILE TABLE.
*
* 42/FILE,18/0
* 1. FILE = FILE NAME LEFT JUSTIFIED.
*
*
* IPT - INSERT PROGRAM TABLE.
*
* 42/PROG1,1/BEFORE,17/TYPE1
* 42/FILE,18/0
* 42/PROG2,18/TYPE2
* 42/PROG3,18/TYPE3
* 1. PROG1 = PROGRAM NAME ON FILE *OLD*.
* PROG1 = LIBRARY NUMBER OF FILE *OLD*.
* 2. BEFORE = 0 IF INSERT AFTER PROG1.
* BEFORE = 1 IF INSERT BEFORE PROG1.
* 3. FILE = CORRECTION FILE NAME.
* 4. PROG2 = PROGRAM NAME FOR START OF INSERT.
* 5. PROG3 = PROGRAM NAME FOR END OF INSERT.
*
*
* CDT - COMMENT AND DATE TABLE.
*
* 42/PROGRAM,1/DATE,17/TYPE
* 60/COMMENT TEXT
* 60/COMMENT TEXT
* 60/COMMENT TEXT
* 60/COMMENT TEXT
* 60/COMMENT TEXT
* 60/COMMENT TEXT
* 60/COMMENT TEXT
* 1. PROGRAM = PROGRAM NAME ON FILE *NEW*.
* 2. DATE = 1 IF DATE IS INSERTED IN 7700 TABLE.
* 3. COMMENT TEXT = 70-CHARACTERS OF TEXT.
*
*
* NRT - NO REPLACE TABLE.
*
* 42/FILE,18/0
* 1. FILE = FILE NAME LEFT JUSTIFIED.
*
*
* NPT - NEW PROGRAM TABLE.
*
* 42/PROGRAM,18/TYPE
* 60/POSITION
* 1. PROGRAM = PROGRAM NAME.
* 2. TYPE = PROGRAM TYPE.
* 3. POSITION = RANDOM FILE INDEX.
*
*
* RNT - RENAME TABLE.
*
* 42/PROG1,18/TYPE1
* 42/PROG2,18/TYPE2
* 1. PROG1 = OLD PROGRAM NAME.
* 2. PROG2 = NEW PROGRAM NAME.
TITLE MACRO DEFINITIONS.
* MACROS.
*CALL COMCMAC
*CALL COMCCMD
*CALL COMSSRT
*CALL COMSTCM
SPACE 4
** CALL - SUBROUTINE CALL.
* THIS MACRO SETS UP A STANDARD CALLING SEQUENCE.
* CALL SUB,P1,P2,P3,P4,P5,P6
* ENTRY SUB = SUBROUTINE NAME.
* PI = ADDRESS OF I-TH PARAMETER.
* PARAMETER ADDRESSES ARE PASSED IN B-REGISTERS (AS IN FORTRAN)
* WITH THE FIRST PARAMETER ADDRESS IN B2, SECOND IN B3, ETC.
CALL MACRO SUB,P1,P2,P3,P4,P5,P6
IFC NE,$P1$$,1
R= B2,P1
IFC NE,$P2$$,1
R= B3,P2
IFC NE,$P3$$,1
R= B4,P3
IFC NE,$P4$$,1
R= B5,P4
IFC NE,$P5$$,1
R= B6,P5
IFC NE,$P6$$,1
R= B7,P6
ENDIF
RJ SUB
ENDM
SPACE 4
** ADDWRD - ADD WORD TO MANAGED TABLE.
* THIS MACRO SETS UP A CALL TO ADD AN ENTRY TO A MANAGED TABLE:
* ADDWRD TABLE,ENTRY
* ENTRY TABLE = NAME OF MANAGED TABLE.
* ENTRY = ADDRESS OF ENTRY.
ADDWRD MACRO TABLE,ENTRY
CALL ADD,P.TABLE,ENTRY
ENDM
SPACE 4
** TABLE - DEFINE MANAGED TABLE POINTERS.
* MANAGED TABLES HAVE 4 POINTERS ASSOCIATED WITH THEM:
* (P.NAME) = FWA OF MANAGED TABLE.
* (L.NAME) = LENGTH OF MANAGED TABLE.
* (N.NAME) = NUMBER OF WORDS IN AN ENTRY.
* (D.NAME) = NUMBER OF WORDS TABLE LENGTH IS INCREASED AT
* A TIME.
* TABLE NAME,WORD,DELTA
* ENTRY NAME = NAME OF TABLE.
* WORD = NUMBER OF WORDS/ENTRY.
* DELTA = SIZE OF TABLE INCREASE (NUMBER OF ENTRIES).
TABLE MACRO NAME,WORD,DELTA
LOCAL NW,DW
NW SET WORD 1
DW SET DELTA 4
P.NAME VFD 42D/0L_NAME,18D/BUF
L.NAME VFD 60D/0
N.NAME VFD 60D/NW
D.NAME VFD 60D/NW*DW
ENDM
SPACE 4
** SEARCH - SEARCH FOR ENTRY IN MANAGED TABLE.
* THIS MACRO SETS UP A CALL TO SEARCH FOR AN ENTRY
* IN A MANAGED TABLE
* SEARCH TABLE,ENTRY,MASK,INDEX,RETURN
* ENTRY TABLE = NAME OF MANAGED TABLE.
* ENTRY = ADDRESS OF ENTRY.
* MASK = ADDRESS OF SEARCH MASK.
* INDEX = INDEX INTO TABLE.
* RETURN = ADDRESS OF RETURN PARAMETER.
SEARCH MACRO TABLE,ENTRY,MASK,INDEX,RETURN
SB2 P.TABLE
SB3 ENTRY
SB4 MASK =77777777777777777777B
SB5 INDEX B0
SB6 RETURN SMTA
RJ SMT
ENDM
READW SPACE 4
** READW - REDEFINE READ WORDS MACRO TO USE CONTROL WORDS.
PURGMAC READW
READW MACRO F,S,N
R= B6,S
R= B7,N
R= X2,F
RJ RDA
ENDM
WRCW SPACE 4
** WRCW - WRITE WORKING STORAGE WITH CONTROL WORDS.
WRCW MACRO F,S,N,E
R= B6,S
R= B7,N
R= X2,F
RJ WDA
IFC NE,*E**,2
+ NZ B7,*+1
- RJ WDA
ENDM
TITLE
** LIBEDIT - LIBRARY EDITING PROGRAM.
*
* 1. FILE INPUT IS READ TO DETERMINE DIRECTIVES.
* 2. ALL FILES WITH REWIND SELECTED ARE REWOUND.
* 3. ALL CORRECTION FILES ARE READ TO DETERMINE PROGRAM
* NAMES AND BUILD AN INDEX.
* 4. CORRECTION FILES WITH REWIND SELECTED ARE REWOUND.
* 5. FILE OLD IS READ.
* 6. INSERT BEFORE IS CHECKED.
* 7. IMPLIED DELETE IS CHECKED.
* 8. REPLACEMENT IS CHECKED.
* 9. INSERT AFTER IS CHECKED.
* 10. FILE NEW IS WRITTEN.
* 11. REPEAT STEPS 5.-11.
* 12. COPY ADDED PROGRAMS ONTO *NEW*, IF APPLICABLE.
* 13. REWIND ALL FILES WITH REWIND SELECTED.
* 14. CALL *VFYLIB* IF VERIFY REQUESTED.
* 15. CALL *LIBGEN* IF USER LIBRARY REQUESTED.
ORG 104B
LIBEDIT BSS 0 ENTRY
SB1 1 (B1) = CONSTANT ONE
RJ PRS PRESET
RJ RDC READ DIRECTIVES
CALL RWF REWIND ALL FILES
CALL RCF READ ALL CORRECTION FILES
CALL RWS REWIND SEQUENTIAL CORRECTION FILES
CALL BID BUILD IMPLIED DELETE TABLE
SA2 CCPY
SA1 P SET *OLD* IN HEADER
NZ X2,LIB0 IF *C* OPTION
SA2 CULB
SA1 N SET *NEW* IN HEADER
ZR X2,LIB0 IF NO *U* OPTION
SA1 GULF SET *NEW* IN HEADER
LIB0 MX0 42
BX6 X0*X1
SA6 LIBF+3
SB6 B0+
CALL STB,LIBF SET TITLE OF PAGE
SB6 B1
CALL STB,LIBG
WRITECW N,* SET FILE STATUS
SA4 N+4
AX4 18
SX6 X4 SET SECTOR WORD COUNT
SA1 OLD
SA6 N-1
ZR X1,LIB19 IF NO FILE *OLD*
OPEN A1,READNR,R
SA1 P+1 CHECK DEVICE TYPE
RJ CVD
ZR X7,IDT IF INCORRECT DEVICE
READCW P,17B
LIB1 READW P,WSA,WSAL
BX6 X1 SET EOR INDICATOR
SA6 LIBA
PL X1,LIB2 IF NOT EOF ON FILE *OLD*
SB5 WSA
EQ B5,B6,LIB19 IF NO DATA READ
EQ LIB2.1 PROCESS DATA
LIB2 SA1 LIBA CHECK EOR INDICATOR
NG X1,LIB19 IF EOF ON FILE OLD
LIB2.1 SB6 WSA
SB7 X1+
EQ B6,B7,LIB17 IF 0-LENGTH RECORD
SA1 P-LWP LWA+1 OF DATA TRANSFERED FROM OLD FILE
SX2 WSA
RJ SRT SET RECORD TYPE
SA6 LIBB
SA6 LIBH
MX0 -18 CREATE -TYPE/*- PSEUDO-ENTRY
SX7 1R*
BX6 -X0*X6 EXTRACT RECORD TYPE
LX7 54
BX7 X7+X6 MERGE TYPE AND -*-
SA7 LIBB+2
SX3 X6-ODRT
SA2 CULB
BX4 X3+X2
ZR X4,LIB19 IF OPLD AND NOT *ULIB* MODE
ZR X2,LIB2.3 IF NOT *ULIB* MODE
SA1 LIBA
ZR X3,LIB2.2 IF OPLD
SX4 X6-ULRT
NZ X4,LIB2.3 IF NOT *ULIB* RECORD
LIB2.2 NZ X1,LIB1 IF END OF RECORD
READW P,WSA,WSAL
EQ LIB2.2 SKIP RECORD
* CHECK INSERT BEFORE.
LIB2.3 SA1 LIBB SET SEARCH NAME
MX6 1
LX6 18
BX6 X6+X1
SA6 A1+B1
LIB3 SEARCH IPT,(LIBB+1)
ZR X6,LIB4 IF NO MORE INSERT BEFORE
SA1 P.IPT SET IPT INDEX
SX1 X1
IX6 X6-X1
* INSERT PROGRAMS BEFORE SPECIFIED PROGRAM.
CALL CPP,X6
EQ LIB3 CHECK FOR ANOTHER INSERT
* CHECK FOR DELETE.
LIB4 SEARCH DPT,LIBN,LIBP SEARCH FOR DELETE IN PROGRESS
NZ X6,LIB6 IF DELETE IN PROGRESS
SEARCH DPT,LIBB
NZ X6,LIB5 IF START OF DELETE
SEARCH DPT,LIBB+2 CHECK FOR -TYPE/*-
SX7 X6
BX6 X6-X6
NZ X7,LIB6 IF DELETING ALL OF THIS TYPE
SEARCH IDT,LIBB
ZR X6,LIB9 IF PROGRAM IS NOT INSERTED
SX6 B0
EQ LIB6 ISSUE OUTPUT MESSAGE
LIB5 SA1 X6+B1 CHECK FOR /*DELETE NAME-*/ FORM
SA2 LIBB+2
BX7 X1-X2
NZ X7,LIB5.1 IF NORMAL DELETE RANGE
BX7 X1
SA7 X6 UPDATE *DPT*
BX6 X6-X6
EQ LIB6 CONTINUE PROCESSING
LIB5.1 SA1 LIBP SET START OF DELETE
SA2 X6
BX7 -X1*X2
SA3 LIBN
BX7 X3+X7
SA7 X6
LIB6 SA6 LIBC SET DPT ADDRESS
CALL ODP,LIBB OUTPUT DELETED PROGRAM
* SKIP RECORD FROM FILE *OLD*.
CALL DIS,LIBB,(=H*SKIPPING *)
SA1 LIBA
LIB7 NZ X1,LIB8 IF EOR OR EOF
READW OLD,WSA,WSAL
EQ LIB7 LOOP TO END OF RECORD
LIB8 CALL SUL,LIBB,LIBA
SA1 LIBC CHECK FOR END OF DELETE
ZR X1,LIB16 IF IMPLIED DELETE
SA2 X1+B1
SA3 LIBB
BX6 X2-X3
NZ X6,LIB16 IF NOT END OF DELETE
SX6 7777B DELETE FLAG
SA6 X1 CLEAR DPT ENTRY
SA6 X1+B1
EQ LIB16 CHECK INSERT AFTER
* CHECK FOR REPLACEMENT.
LIB9 SEARCH PNT,LIBB
ZR X6,LIB12 IF NO REPLACEMENT
SA1 P.PNT
SX1 X1
IX6 X6-X1
SA6 LIBE
CALL CNR,X6 CHECK FOR NO REPLACE
NZ X6,LIB9 IF NO REPLACE
CALL DIS,LIBB,(=H*REPLACING *)
SA1 LIBE
CALL CPY,X1 COPY REPLACEMENT RECORD
CALL ORW,(=8HREPLACED),LGO
SA1 LIBA
NZ X1,LIB11 IF EOR ON PREVIOUS READ
LIB10 READW OLD,WSA,WSAL SKIP RECORD ON *OLD*
LIB11 ZR X1,LIB10 IF NOT EOR
CALL SUL,LIBB,LIBA
EQ LIB16 CHECK INSERT AFTER
* COPY FROM *OLD* TO *NEW*.
LIB12 CALL DIS,LIBB,(=H*COPYING *)
CALL CCM,WSA,LIBB
SB6 X6
SA1 LIBA CHECK FOR EOR
NZ X1,LIB14 IF EOR/EOF/EOI
LIB13 SB7 WSA+WSAL
WRCW N,B6,B7-B6
READW OLD,WSA,WSAL
SB6 WSA
ZR X1,LIB13 IF NOT EOR/EOF/EOI
LIB14 SA1 P-LWP LWA + 1 OF DATA TRANSFERED
SB7 X1
WRCW N,B6,B7-B6,R WRITE LAST PORTION OF RECORD
SA1 N-2
NG X1,LIB15 IF *WRITECW* NOT DISABLED
RJ RCW
LIB15 ADDWRD NPT,NIND
CALL ORW,(=1H ),OLD
CALL CPL,LIBB,LIBA
* CHECK INSERT AFTER.
LIB16 SEARCH IPT,LIBB
ZR X6,LIB2 IF NO INSERT
SA1 P.IPT SET IPT INDEX
SX1 X1
IX6 X6-X1
* INSERT PROGRAMS AFTER SPECIFIED PROGRAM.
CALL CPP,X6
EQ LIB16 LOOP
* PROCESS ZERO LENGTH RECORD.
LIB17 SEARCH IPT,LIBI
ZR X6,LIB18 IF NO ADD
SA1 P.IPT SET IPT INDEX
SX1 X1
IX6 X6-X1
CALL CPP,X6
EQ LIB17 LOOP
LIB18 SB2 =0 ENTER ZERO LENGTH RECORD NAME AND TYPE
RJ EPN
ADDWRD NPT,NIND
WRCW N,B0,B0 WRITE ZERO LENGTH RECORD
SA1 LIBI INCREMENT LIBRARY NUMBER
SX6 B1
LX6 42
IX6 X6+X1
SA6 A1
CALL OZR,(=1H ),OLD,(=2H00)
JP LIB1 READ NEXT RECORD
* CHECK INSERT BEFORE EOF.
LIB19 SEARCH IPT,LIBD,(=77777777777777400000B)
ZR X6,LIB20 IF NO INSERT
SA1 P.IPT SET IPT INDEX
SX1 X1
IX6 X6-X1
* INSERT PROGRAM(S) BEFORE EOF.
CALL CPP,X6
EQ LIB19 CHECK FOR ANOTHER INSERT
* PROCESS EOF ON FILE OLD.
LIB20 RJ CAP COPY ADDED PROGRAMS
SB2 LIBH
SA1 LIBA GET EOR INDICATOR
RJ WPD WRITE PROGRAM DIRECTORY
CALL RWF REWIND FILES
CALL CRR CHECK RECORDS REPLACED
CALL CNO COPY NEW TO OLD
MESSAGE (=C* EDITING COMPLETE.*),,R
RETURN S RETURN SCRATCH FILE
SA1 OUTPUT+2 CLOSE OUT FILE *OUTPUT*
SA2 A1+B1
BX6 X1-X2
ZR X6,LIB21 IF NO OUTPUT
WRITER OUTPUT,R
LIB21 RJ GUL GENERATE USER LIBRARY
RJ VFY VERIFY *OLD* AND *NEW*
ENDRUN
LIBA DATA 0 EOR INDICATOR
LIBB DATA 0 PROGRAM NAME
DATA 0 PROGRAM NAME WITH INSERT BEFORE SET
BSSZ 1 TYPE/* PSUEDO-ENTRY
LIBC DATA 0 ADDRESS OF DPT ENTRY
LIBD VFD 42/1L*,1/1,17/
LIBE DATA 0 PROGRAM NAME TABLE INDEX
LIBF DATA C* RECORDS WRITTEN ON FILE XXX*
LIBG DATA H* RECORD TYPE FILE *
DATA C* DATE COMMENT*
LIBH DATA 0 OPL DIRECTORY NAME
LIBI DATA 1S42 LIBRARY NUMBER
LIBN VFD 42/0,6/1,12/0 DELETE IN PROGRESS FLAG
LIBP VFD 42/0,6/77B,12/0 DELETE IN PROGRESS MASK
TITLE DIRECTIVE CARD PROCESSING.
** RDC - READ DIRECTIVES.
RDC SUBR ENTRY/EXIT
SA1 INPUT CHECK FOR NO INPUT FILE
SA2 CZOP CHECK FOR *Z* OPTION
NZ X2,RDC1 IF *Z* OPTION SELECTED
ZR X1,RDC12 IF NO INPUT FILE
SA1 TTYI
NZ X1,RDC0.1 IF NOT TTY INPUT
WRITEC TTYOUT,(=C*ENTER DIRECTIVES -*)
RDC0.1 READ I
RDC1 READH I,DCB,DCBL
SB2 DCB UNPACK DIRECTIVE COMMAND BUFFER
SB3 DCB+DCBL
SB4 DSB
MX0 54
NZ X1,RDC12 IF END-OF-RECORD
RDC2 SB5 B4+10
SA1 B2
RDC3 LX1 6
BX6 -X0*X1
SA6 B4
SB4 B4+B1
NE B4,B5,RDC3 LOOP FOR 10 CHARACTERS
SB2 B2+B1
SX6 B0
NE B2,B3,RDC2 LOOP FOR END OF BUFFER
SB4 DSB SUPPRESS TRAILING BLANKS
RDC4 SA6 B5
EQ B4,B5,RDC5 IF START OF BUFFER
SB5 B5-B1
SA1 B5
SX6 X1-1R
ZR X6,RDC4 IF CHARACTER IS * *
* ASSEMBLE DIRECTIVE AND GO TO DIRECTIVE PROCESSOR.
RDC5 SX6 DSB SET COLUMN POINTER AT COLUMN 1
SA6 RDCA
SA1 X6 CHECK COLUMN 1
SA3 A1+B1 CHECK COLUMN 2
SX2 X1-1R*
NZ X2,RDC11 IF NOT *** IN COLUMN 1
SX6 X3-1R/
ZR X6,LST IF COMMENT TEXT
CALL AFN,RDCA,RDCB
SA1 RDCA IGNORE TRAILING BLANKS
SA2 X1
+ SA2 A2+B1
SX6 X2-1R
ZR X6,*-1 LOOP
SX6 A2-B1
SA6 B2
SA1 RDCC SEARCH FOR LEGAL DIRECTIVE
SA2 RDCB
RDC6 ZR X1,RDC14 IF DIRECTIVE INCORRECT
MX0 42
BX6 X1-X2
BX6 X0*X6
SX7 X1
LX7 30
SA1 A1+B1
NZ X6,RDC6 LOOP
SA7 SDA SET DIRECTIVE ADDRESS
LX7 30
SX6 X7+COPY
ZR X6,COPY IF *COPY DIRECTIVE
SX6 X7+DEBUG
ZR X6,DEBUG IF *DEBUG DIRECTIVE
SX6 X7+VFYLIB
ZR X6,VFYLIB IF *VFYLIB DIRECTIVE
SX6 X7+LSTDR
ZR X6,LSTDR IF *LIST DIRECTIVE
SX6 X7+NOREW
ZR X6,NOREW IF *NOREW DIRECTIVE
SX6 X7+NOINS
ZR X6,NOINS IF *NOINS DIRECTIVE
SX6 X7+LIBGEN
ZR X6,LIBGEN IF *LIBGEN DIRECTIVE
** PROCESS DIRECTIVE.
RDC7 SA1 RDCA CHECK SERARATOR CHARACTER
SA2 X1
SB5 X2+B1
SA1 =20000000000005000000B
LX7 X1,B5
NG X7,ERR9 IF CHARACTER = EOL */* *-*
SA3 SDA
RDC8 PL X3,RDC9 IF LIBRARY/PROGRAM TO BE ASSEMBLED
CALL AFN,RDCA,RDCD
SA3 SDA
BX3 -X3
AX3 30
SB7 X3
EQ RDC10 CHECK FILE NAME
RDC9 CALL APN,RDCA,RDCD
SA3 SDA
AX3 30
SB7 X3
RDC10 MX0 42 CHECK FILE NAME
SA1 RDCD
BX1 X0*X1
SX7 =C* REQUIRED PARAMETER(S) NOT SPECIFIED.*
ZR X1,ERR IF FILE NAME = 0
SA1 RDCA
SA2 X1+ (X2) = CHARACTER
SB5 X2-1R, (B5) = CHARACTER - *,*
JP B7 GO TO DIRECTIVE PROCESSOR.
* PROCESS DIRECTIVE CONTINUATION.
RDC11 SX6 DSB-1 SET STRING BUFFER POINTER
SA6 RDCA
SA3 SDA
EQ RDC8 CHECK DIRECTIVE FORMAT
* END OF DIRECTIVES. CHECK FOR ERRORS.
RDC12 RETURN TTYOUT
RJ SUM SET *ULIB* MODE
SA1 TTYI
SA2 RDCF
ZR X1,RDCX IF TTY INPUT
ZR X2,RDCX IF NO DIRECTIVE ERRORS
MESSAGE (=C* DIRECTIVE ERRORS.*),3
SA1 CDOP
NZ X1,RDCX IF DEBUG OPTION ON
RJ ABT ABORT
RDC14 SX7 =C* UNRECOGNIZED KEYWORD IN DIRECTIVE.*
EQ ERR LIST ERROR MESSAGE
SPACE 4
** SET NEW DIRECTIVE ADDRESS.
* RJ SDA TO SET NEW ADDRESS. LIBRARY/PROGRAM WILL
* BE ASSEMBLED.
SDA EQ INS5 PROCESS NEXT FIELD
SPACE 4
** RET - RETURN FOR PROCESSING DUPLICATE FIELD.
RET SA1 RDCA CHECK SEPARATOR CHARACTER
SA2 X1
ZR X2,LST IF END-OF-LINE
SB5 X2-1R
ZR B5,LST IF CHARACTER = * *
EQ RDC7 IF MORE PARAMETERS
RDCA VFD 60/DSB DIRECTIVE STRING BUFFER POINTER
RDCB DATA 0 DIRECTIVE
RDCC VFD 42/0LAFTER,18/INSERT
VFD 42/0LA,18/INSERT
VFD 42/0LADD,18/-ADP
VFD 42/0LBEFORE,18/BEFORE
VFD 42/0LB,18/BEFORE
VFD 42/0LBUILD,18/BUILD
VFD 42/0LCOMMENT,18/COMMENT
VFD 42/0LCOPY,18/-COPY
VFD 42/0LDATE,18/DATE
VFD 42/0LDEBUG,18/-DEBUG
VFD 42/0LDELETE,18/DELETE
VFD 42/0LD,18/DELETE
VFD 42/0LFILE,18/-FILE
VFD 42/0LIGNORE,18/IGNORE
VFD 42/0LINSERT,18/INSERT
VFD 42/0LI,18/INSERT
VFD 42/0LLIBGEN,18/-LIBGEN
VFD 42/0LLIST,18/-LSTDR
VFD 42/0LLGO,18/-FILE
VFD 42/0LNAME,18/-NAME
VFD 42/0LNEW,18/-NEWF
VFD 42/0LNOINS,18/-NOINS
VFD 42/0LNOREP,18/-NOREP
VFD 42/0LNOREW,18/-NOREW
VFD 42/0LOLD,18/-OLDF
VFD 42/0LRENAME,18/RENAME
VFD 42/0LREPLACE,18/REPLACE
VFD 42/0LREWIND,18/-REWIND
VFD 42/0LTYPE,18/-NAME
VFD 42/0LVERIFY,18/-VFYLIB
VFD 42/0LVFYLIB,18/-VFYLIB
VFD 60/0
RDCD DATA 0 ASSEMBLED NAME
RDCE DATA 0LTEXT DEFAULT RECORD TYPE
RDCF DATA 0 DIRECTIVE ERROR COUNT
SPACE 4
** ERR - ERROR DETECTED IN DIRECTIVE SCAN.
*
* ENTRY (X7) = 0 IF NO EXTRA ERROR MESSAGE TO BE ISSUED.
* (X7) = ADDRESS OF EXPLANATORY ERROR MESSAGE.
ERR SA1 TTYI
SA7 ERRB SAVE ERROR MESSAGE ADDRESS
ZR X1,ERR2 IF TTY INPUT
SA1 =10H ERROR*
BX6 X1
SA6 OUTPUTB
CALL LOL LIST ONE LINE
WRITEC OUTPUT,(=C* *)
SA1 RDCF INCREMENT ERROR COUNT
SX6 X1+B1
SA6 A1
SA1 ERRB
ERR1 ZR X1,RDC1 IF NO ERROR MESSAGE TO BE ISSUED
WRITEC OUTPUT,X1
EQ RDC1 READ NEXT DIRECTIVE
ERR2 SX2 1R BLANK FILL LINE
SB6 OUTPUTB+1
SB7 OUTPUTB+DCBL+1
SA1 B6
MX0 54
ERR3 BX6 X1
SA6 A1
EQ B6,B7,ERR5 IF END OF LINE
SA1 B6
SB6 B6+B1
SB5 10D
ERR4 ZR B5,ERR3 IF END OF WORD
LX0 6
LX2 6
BX6 -X0*X1
SB5 B5-B1
NZ X6,ERR4 IF CHARACTER .NE. 00
BX1 X1+X2
EQ ERR4 LOOP
ERR5 WRITEW TTYOUT,ERRA,ERRAL
WRITEH TTYOUT,OUTPUTB+1,DCBL
SA1 ERRB
ZR X1,ERR1 IF NO EXPLANATORY MESSAGE
WRITEC TTYOUT,X1
WRITEC TTYOUT,ERRC
SA1 TTYO
ZR X1,RDC1 IF TTY OUTPUT
SA1 ERRB
EQ ERR1 ISSUE EXPLANATION
ERR9 SX7 =C* -- UNRECOGNIZED SEPARATOR CHARACTER.*
EQ ERR ISSUE ERROR MESSAGE
ERRA DATA 22HINCORRECT DIRECTIVE -
ERRAL EQU *-ERRA
ERRB CON 0
ERRC DATA C* (CORRECTED DIRECTIVE MAY BE RE-ENTERED...)*
SPACE 4
** LST - LIST DIRECTIVE.
*
* USES A - 1, 6.
* X - 1, 2, 6.
LST SA1 =10H
BX6 X1
SA6 OUTPUTB
SA1 LIST
SX2 4B
BX1 X1*X2
ZR X1,RDC1 IF DIRECTIVE LIST OPTION OFF
CALL LOL LIST ONE LINE
EQ RDC1 LOOP TO READ NEXT DIRECTIVE
SPACE 4
** *ADD LIB,LIB1/PN1
*
* ADD PROGRAM(S) AT END OF SPECIFIED LIBRARY.
* ENTRY (X2) = SEPARATOR CHARACTER.
ADP SA1 RDCD CHECK LIBRARY NAME
SA3 ADPA
MX0 42
ADP1 BX3 X3-X1
BX6 -X0*X3
ZR X6,ADP3 IF NO MATCH ON LIBRARY NAME
BX7 X0*X3
SA3 A3+B1
NZ X7,ADP1 IF NOT FOUND
ADP2 LX6 42 SET LIBRARY NUMBER
SA6 A1
EQ INSERT PROCESS INSERT
ADP3 MX0 18
BX7 X0*X3
NZ X7,ADP4 IF NOT *LIBN..N*
BX5 -X0*X1
LX5 18
SB7 B1+ SET DECIMAL BASE
RJ DXB CONVERT DECIMAL TO BINARY
SA2 RDCA RESTORE SEPARATOR CHARACTER
SA2 X2+ (X2) = CHARACTER
ZR X4,ADP2 IF CORRECT CONVERSION
ADP4 SX7 =C* UNRECOGNIZED LIBRARY NAME.*
EQ ERR ISSUE ERROR MESSAGE
ADPA BSS 0
CON 0LDDS+1
CON 0LIDS+2
CON 0LMOV+3
CON 0LRPL+4
CON 0LRSL+5
CON 0LSLD+6
ADPB CON 0LLIB
SPACE 4
** *BEFORE LIB1/PN1,LIB2/PN2-LIB3/PN3,LIB4/PN4
*
* INSERT PROGRAM(S) BEFORE SPECIFIED PROGRAM.
* ENTRY (X2) = SEPARATOR CHARACTER.
BEFORE MX6 1 SET INSERT BEFORE FLAG
LX6 18
EQ INS1
SPACE 4
** *BUILD PN
*
* BUILD A DIRECTORY OF FILE *NEW* WITH NAME *PN*.
BUILD SA1 RDCD
BX6 X1
SA6 NPLN
EQ LST
SPACE 4
** *COMMENT LIB/PN COMMENT
*
* ADD A 70-CHARACTER COMMENT TO THE 7700 TABLE OF THE
* SPECIFIED RECORD.
COMMENT SX6 B0
COM1 SA1 RDCD SET PROGRAM NAME
SB5 X2-1R CHECK SEPARATOR
ZR B5,COM2 IF CHARACTER = * *
SB5 X2-1R,
ZR B5,COM2 IF CHARACTER = *,*
NZ X2,ERR9 IF NOT EOL
COM2 BX6 X6+X1
SA1 RDCA
SA2 X1+B1
SA6 COMA
SB2 COMA
SB3 COMA+7
COM3 SX6 B0 ASSEMBLE COMMENT
SB7 60
SB2 B2+B1
COM4 SB7 B7-6
LX6 6
BX6 X6+X2
ZR X2,COM6 IF END-OF-LINE
LX6 6
SA2 A2+B1
SB7 B7-6
NZ X2,COM5 IF NOT END-OF-LINE
SX2 1R
COM5 BX6 X6+X2
SA2 A2+B1
NZ B7,COM4 LOOP FOR 1 WORD
COM6 LX6 X6,B7 STORE 10-CHARACTERS OF COMMENT
SA6 B2
NE B2,B3,COM3 LOOP FOR 7 WORDS
ADDWRD CDT,COMA
EQ LST LIST DIRECTIVE
COMA VFD 42/,1/,17/ 42/PROGRAM,1/DATE,17/TYPE
DATA 0 420/COMMENT
DATA 0
DATA 0
DATA 0
DATA 0
DATA 0
DATA 0
SPACE 4
** *COPY
*
* COPY FILE *NEW* TO FILE *OLD* AFTER EDITING.
COPY SX6 B1 SET COPY FLAG
SA6 CCPY
EQ LST
SPACE 4
** *DATE LIB/PN COMMENT
*
* ADD A 70-CHARACTER COMMENT AND THE DATE TO THE 7700
* TABLE OF THE SPECIFIED PROGRAM.
DATE MX6 1 SET DATE FLAG
LX6 18
EQ COM1 GO ASSEMBLE COMMENT
DEBUG SPACE 4,10
** *DEBUG
*
* IGNORE SUBSEQUENT DIRECTIVE ERRORS.
DEBUG SX6 B1+ SET DEBUG FLAG
SA6 CDOP
EQ LST LIST DIRECTIVE
SPACE 4
** *DELETE LIB1/PN1,LIB2/PN2-LIB3/PN3
*
* DELETE SELECTED PROGRAM(S) FROM FILE *OLD*.
* ENTRY (X2) = SEPARATOR CHARACTER.
DELETE SB5 X2-1R-
SA1 RDCD SET DELETE START AND STOP
BX6 X1
SA6 DELA
SA6 A6+B1
NZ B5,DEL1 IF NO CONTINUATION FIELD
* ASSEMBLE SECOND FIELD
CALL APN,RDCA,(DELA+1)
DEL1 ADDWRD DPT,DELA
EQ RET RETURN
DELA VFD 42/,6/,12/ 42/PROGRAM,6/IP,12/TYPE
VFD 42/,6/,12/ 42/PROGRAM,6/0,12/TYPE
SPACE 4
** *FILE FN,FN,FN
*
* DECLARE ADDITIONAL CORRECTION FILES.
FILE SA1 RDCD
BX6 X1
SA6 LGO.
SEARCH FNT,RDCD,FILA
NZ X6,RET IF FILE IN FNT
ADDWRD FNT,RDCD
EQ RET RETURN
FILA DATA 77777777777777000000B
SPACE 4
** *IGNORE LIB/PN
* *IGNORE LIB1/PN1-LIB2/PN2
*
* IGNORE PROGRAM(S) WHEN CORRECTION FILE IS READ.
* ENTRY (X2) = SEPARATOR CHARACTER.
IGNORE SA1 LGO. SET CORRECTION FILE NAME
SA3 RDCD SET PROGRAM NAME
BX6 X1
LX7 X3
SA6 IGNA
SA7 A6+B1
SA7 A7+B1
SB5 X2-1R- CHECK FOR CONTINUATION FIELD
NZ B5,IGN1 IF NO CONTINUATION FIELD
* ASSEMBLE SECOND FIELD.
CALL APN,RDCA,(IGNA+2)
IGN1 ADDWRD PIT,IGNA
EQ RET RETURN
IGNA VFD 42/,18/ 42/FILE,18/
VFD 42/,18/ 42/PROGRAM,18/TYPE
VFD 42/,18/ 42/PROGRAM,18/TYPE
SPACE 4
** *INSERT LIB1/PN1,LIB2/PN2,LIB3/PN3
*
* INSERT PROGRAMS AFTER SPECIFIED PROGRAM.
* ENTRY (X2) = SEPARATOR CHARACTER.
INSERT SX6 B0 SET INSERT AFTER FLAG
INS1 SB5 X2-1R,
ZR B5,INS2 IF SEPARATOR = *,*
SB5 X2-1R
NZ B5,ERR9 IF SEPARATOR NOT * * OR *,*
INS2 SA1 RDCA CHECK FOR SECOND FIELD
SA3 X1+1
SX7 =C* RECORD(S) TO BE INSERTED NOT SPECIFIED.*
ZR X3,ERR IF NO SECOND FIELD
SA3 RDCD SET INSERT POINT
BX6 X6+X3
SA6 INSA
* ASSEMBLE PROGRAM NAME OF START.
CALL APN,RDCA,(INSA+2)
INS3 SB5 X2-1R-
SA1 INSA+2
SA4 LGO. SET FILE NAME
LX7 X4
SA7 A1-B1
BX6 X1
SA6 A1+B1
NZ B5,INS4 IF NO CONTINUATION FIELD
* PROCESS CONTINUATION FIELD
CALL APN,RDCA,(INSA+3)
INS4 ADDWRD IPT,INSA
RJ SDA SET DIRECTIVE ADDRESS AND READ NEXT FIELD
* PROCESS NEXT FIELD.
INS5 SA3 RDCD
BX6 X3
SA6 INSA+2
EQ INS3 LOOP TO END OF CARD
INSA VFD 42/1L*,1/1,17/ 42/PROG1,1/BEFORE,17/TYPE1
VFD 42/,18/ 42/FILE,18/
VFD 42/,18/ 42/PROG2,18/TYPE2
VFD 42/,18/ 42/PROG3,18/TYPE3
LIBGEN SPACE 4,10
** *LIBGEN UN
*
* SET *ULIB* MODE, CALLING *LIBGEN* AFTER EDITING
* TO GENERATE A USER LIBRARY *UN* ON FILE *NEW*.
* IF *UN* IS OMITTED, *UN* = *ULIB* IS USED.
LIBGEN SA1 RDCA
SA2 X1+
ZR X2,LIBG2 IF EOL
SB5 X2+1
SA2 =20000000000005000000B
LX7 X2,B5
NG X7,ERR9 IF ERROR
SB2 RDCA
SB3 RDCD
RJ AFN ASSEMBLE *UN* NAME
SA1 RDCD
MX0 42
BX6 X0*X1
ZR X1,LIBG2 IF NULL *UN* NAME
LIBG1 SA6 CULB
EQ LST LIST DIRECTIVE
LIBG2 SA1 LIBGA
BX6 X1
EQ LIBG1 LIST DIRECTIVE
LIBGA VFD 24/4LULIB,36/0 DEFAULT USER LIBRARY NAME
LSTDR SPACE 4,10
** *LIST LFN,OPT
*
* DECLARE LISTING FILE AND LIST OPTIONS.
LSTDR SA1 RDCA CHECK SEPARATOR CHARACTER
SA2 X1
SB5 X2+B1
SA2 =20000000000005000000B
LX7 X2,B5
NG X7,ERR9 IF ERROR
SB2 RDCA
SB3 RDCD
RJ AFN ASSEMBLE LIST FILE NAME
MX0 42
SA1 RDCD
BX6 X1*X0
ZR X6,LSTDR1 IF FILE NAME NULL
SA1 FLST+/FLST/OUTPUT
RJ RFN REPLACE FILE NAME
LSTDR1 SA1 RDCA
SA2 X1+
ZR X2,LST IF EOL
SB2 RDCA
SB3 RDCD
RJ AFN ASSEMBLE LIST OPTIONS
SA2 RDCD
SA1 LIST
MX0 42
BX1 X2*X0
ZR X1,LST IF LIST OPTIONS NULL
RJ ILO INTERPRET LIST OPTIONS
SX7 =C* UNRECOGNIZED LIST OPTION(S).*
NZ X1,ERR IF ERRORS
EQ LST LIST DIRECTIVE
SPACE 4
** *NAME LIB
*
* SET DEFAULT LIBRARY NAME.
NAME SA1 RDCD CHECK LIBRARY NAME
SA2 NAMA
NAM1 ZR X2,NAM2 IF INCORRECT LIBRARY
BX6 X1-X2
SA2 A2+B1
NZ X6,NAM1 IF NOT FOUND
BX6 X1
SA6 RDCE
EQ LST LIST LINE
NAM2 SX7 =C* UNRECOGNIZED RECORD TYPE.*
EQ ERR ISSUE ERROR MESSAGE
NAMA BSS 0
.E ECHO ,RT=("RTMIC")
.A IFC NE,/RT//
DATA L/RT/
.A ELSE
DATA 1
.A ENDIF
.E ENDD
DATA 0
NEWF SPACE 4,10
** *NEW FN
*
* CHANGE/SPECIFY NAME OF *NEW* FILE.
NEWF SA1 FLST+/FLST/NEW
NEW1 SA2 RDCD GET FILE NAME
BX6 X2
RJ RFN REPLACE FILE NAME
EQ LST LIST DIRECTIVE
NOINS SPACE 4,10
** *NOINS
*
* SET NO INSERT OF NEW RECORDS.
NOINS SX6 B1+
SA6 CADD SET NO INSERT AT EOF
EQ LST LIST DIRECTIVE
NOREP SPACE 4,10
** *NOREP FN,FN,FN
*
* DO NOT REPLACE RECORDS FROM FILE *FN*.
NOREP SEARCH NRT,RDCD
NZ X6,RET IF FILE IN NRT
ADDWRD NRT,RDCD
EQ RET RETURN
NOREW SPACE 4,10
** *NOREW
*
* SET NO REWIND OF FILES.
NOREW SX6 B1+
SA6 CREW SET NO REWIND FLAG
EQ LST LIST DIRECTIVE
OLDF SPACE 4,10
** *OLD FN
*
* CHANGE/SPECIFY NAME OF OLD FILE.
OLDF SA1 FLST+/FLST/OLD
EQ NEW1 PROCESS FILE NAME
SPACE 4
** *RENAME LIB1/PN1,PN2
*
* CHANGE THE NAME OF PROGRAM *PN1* TO *PN2*.
* ENTRY (B5) = (SEPARATOR CHARACTER - *,*).
RENAME SA3 RDCD SET REPLACE NAME
BX6 X3
SA6 RENA
ZR B5,REN1 IF SEPARATOR = *,*
SB5 X2-1R
NZ B5,ERR9 IF SEPARATOR NOT *,* OR * *
REN1 SEARCH RNT,A6
SX7 =C* RECORD ALREADY RENAMED.*
NZ X6,ERR IF NAME IN RNT
CALL AFN,RDCA,(RENA+1)
MX0 42
SA3 RENA
SA4 A3+B1
BX6 -X0*X3
BX6 X4+X6
SA6 A4
ADDWRD RNT,RENA
EQ LST LIST LINE
RENA VFD 42/,18/ 42/PRG1,18/LIB1
VFD 42/,18/ 42/PRG1,18/LIB1
SPACE 4
** *REPLACE LIB1/PN1,LIB2/PN2-LIB3/PN3
*
* REPLACE PROGRAM(S) FROM FILE *OLD* WITH PROGRAMS FROM
* THE CURRENT CORRECTION FILE.
* ENTRY (X2) = SEPARATOR CHARACTER.
REPLACE SA3 RDCD SET REPLACE NAME
BX6 X3
SA6 INSA
SEARCH NRT,(LGO.)
NZ X6,REP1 IF FILE IN NRT
SB3 LGO.
ADDWRD NRT,B3
REP1 SA1 RDCA
SA2 X1
EQ INS5 ASSEMBLE AS INSERT
SPACE 4
** *REWIND FN,FN,FN
*
* REWIND FN BEFORE AND AFTER EDITING.
REWIND SEARCH RFT,RDCD
NZ X6,RET IF IN RFT TABLE
ADDWRD RFT,RDCD
EQ RET
VFYLIB SPACE 4,10
** *VFYLIB
*
* CALL *VFYLIB* AFTER EDITING.
VFYLIB SX6 B1+ SET *VFYLIB* FLAG
SA6 CVFY
EQ LST LIST DIRECTIVE
TITLE SUBROUTINES.
** ABT - ABORT JOB.
ABT SUBR ENTRY/EXIT
SA1 OUTPUT+2 CLOSE OUT FILE *OUTPUT*
SA2 A1+B1
BX6 X1-X2
ZR X6,ABT1 IF NO OUTPUT
WRITER OUTPUT,R
ABT1 ABORT
SPACE 4
** ADD - ADD WORD(S) TO MANAGED TABLE.
*
* ENTRY (B2) = ADDRESS OF TABLE POINTER.
* (B3) = FWA OF ENTRY.
ADD SUBR ENTRY/EXIT
ADD1 SA1 B2 SET TABLE ADDRESS
SA2 B2+B1
SA3 A2+B1
SA4 A3+B1
SA5 A4+B1
IX7 X2-X5
SB6 X1
SX6 B6+X7
SB7 X4 (B7) = NUMBER OF WORDS TO MOVE
ZR X6,ADD3 IF NO ROOM FOR ENTRY
SA1 B3 STORE ENTRY
ADD2 BX7 X1
SA7 B6+X2
SX2 X2+B1
SA1 A1+B1
SX3 X3-1
NZ X3,ADD2 LOOP FOR ENTIRE ENTRY
BX7 X2
SA7 A2
EQ ADDX RETURN
* NO ROOM FOR ENTRY. MOVE OTHER TABLES UP TO MAKE ROOM FOR
* ENTRY.
ADD3 SA1 P.BUF
SA2 L.BUF
IX6 X2-X4
PL X6,ADD4 IF ENOUGH FL
SX6 B0 CLEAR STATUS WORD
SA6 ADDA
MX6 29
SA6 A6+B1
MEMORY CM,ADDA,R
MEMORY CM,ADDB,R
SA1 ADDA GET PRESENT FL
AX1 30
SA2 A1+B1 GET MAXIMUM FL
AX2 30
SX6 X1+1000B ADD INCREMENT
IX2 X2-X6
PL X2,ADD3.1 IF NOT BEYOND MAXIMUM FL
MESSAGE (=C* REQUIRED FL EXCEEDS VALIDATED LIMIT.*)
CALL ABT ABORT JOB
ADD3.1 LX6 30 BUILD STATUS WORD
SA6 FL
MEMORY CM,FL,R REQUEST ADDITIONAL FL
SA2 L.BUF UPDATE SPARE BUFFER LENGTH
SX6 X2+1000B
SA6 A2
EQ ADD3 TRY AGAIN
ADD4 SB5 X1 (B5) = LWA OF MOVE
SB6 X5 (B6) = FWA OF MOVE
SA6 A2
SB4 A1
ADD5 SA1 B4 INCREMENT TABLE POINTERS
SB4 B4-4
IX7 X1+X4
SA7 A1
NE B4,B2,ADD5 LOOP
SA2 B5
EQ B5,B6,ADD1 JUMP IF NO DATA TO MOVE
+ SA1 A2-B1 MOVE TABLES
SA2 A1-B1
SB5 B5-2
BX6 X1
LX7 X2
SA6 A1+B7
SA7 A2+B7
NE B5,B6,*-2
SX7 B0 CLEAR NEW AREA
SB7 B6+B7
+ SA7 B6
SB6 B6+B1
NE B6,B7,*
EQ ADD1 MAKE ENTRY
ADDA CON 0
ADDB VFD 30/-1,30/0
ERRNZ ADDB-ADDA-1
AFN SPACE 4,14
** AFN - ASSEMBLE FILE NAME.
*
* CHARACTER MASK:
* EOL = 2000 0000 0000 0000 0000
* *-* = 0000 0000 0000 0400 0000
* */* = 0000 0000 0000 0100 0000
* * * = 0000 0000 0000 0002 0000
* *,* = 0000 0000 0000 0001 0000
* ENTRY (B2) = ADDRESS OF STRING BUFFER POINTER.
* (B3) = ADDRESS TO STORE FILE NAME.
* EXIT (B2) = ADDRESS OF UPDATED STRING BUFFER POINTER.
*
* USES A - 1, 2, 6.
* X - 0, 1, 2, 6, 7.
* B - 4, 5, 7.
AFN SUBR ENTRY/EXIT
SA1 B2
SB4 X1+B1
SB7 60
SX6 B0
AFN1 SA1 B4 READ CHARACTER
SB5 X1+B1
SA2 =20000000000005030000B
LX2 X2,B5
NG X2,AFN2 IF CHARACTER = EOL */* *,* *-*
LX6 6
BX6 X6+X1
SB4 B4+B1
SB7 B7-6
EQ AFN1 LOOP FOR NEXT CHARACTER
AFN2 LX2 X6,B7 STORE FILE NAME
MX0 42
BX6 X0*X2
BX2 -X0*X2
SX7 =C* FILE NAME TOO LONG.*
NZ X2,ERR IF FILE NAME, DIRECTIVE .GT. 7 CHARACTERS
SA6 B3
AX6 42 CHECK FOR FILE NAME (*)
SX6 X6-1L*
NZ X6,AFN3 IF NOT MAIN CORRECTION FILE
SA1 LGO
BX6 X0*X1
SA6 A6
AFN3 SX6 B4 STORE STRING POINTER
SA6 B2
EQ AFNX RETURN
APN SPACE 4,10
** APN - ASSEMBLE PROGRAM NAME.
*
* ASSEMBLE ENTRY OF TYPE *LIB/PN,*
* ENTRY (B2) = ADDRESS OF STRING BUFFER POINTER.
* (B3) = ADDRESS TO RETURN ENTRY.
* EXIT (X2) = SEPARATOR CHARACTER
*
* USES A - 1, 2, 6, 7.
* X - 0, 1, 2, 6, 7.
* B - 4, 5, 7.
APN SUBR ENTRY/EXIT
SA1 B2
SB4 X1+B1 (B4) = STRING BUFFER POINTER
SA1 RDCE SET DEFAULT LIBRARY
BX7 X1
SA7 APNA
SX6 B0
SB7 60
* ASSEMBLE FIRST ENTRY.
APN1 SA2 B4
SB5 X2-1R/
ZR B5,APN2 IF CHARACTER = */*
SA1 =20000000000004030000B
SB5 X2+B1
LX1 X1,B5
NG X1,APN4 IF CHARACTER = EOL *-* * * *,*
LX6 6
SB7 B7-6
IX6 X6+X2
SB4 B4+B1
EQ APN1 LOOP
* CHARACTER = */* SET LIBRARY NAME. ASSEMBLE PROGRAM NAME.
APN2 LX6 X6,B7
SA6 APNA
SX6 B0
SB7 60
SB4 B4+B1
APN3 SA2 B4
SB5 X2-1R/
ZR B5,ERR9 IF CHARACTER = */*
SA1 =20000000000004030000B
SB5 X2+B1
LX1 X1,B5
NG X1,APN4 IF CHARACTER = EOL *-* * * *,*
LX6 6
IX6 X6+X2
SB7 B7-6
SB4 B4+B1
EQ APN3 LOOP
* CHARACTER = EOL *-* * * *,*. STORE PROGRAM NAME.
APN4 SA1 APNA CHECK LIBRARY TYPE
SA2 NAMA
APN5 ZR X2,NAM2 IF INCORRECT LIBRARY
BX7 X1-X2
SA2 A2+B1
NZ X7,APN5 IF NOT FOUND
BX7 X1 SET DEFAULT TYPE
SA7 RDCE
MX0 42 SET PROGRAM AND LIBRARY NAMES
LX2 X6,B7
BX6 X0*X2
BX2 -X0*X2
SX7 =C* FILE NAME TOO LONG.*
NZ X2,ERR IF FILE NAME .GT. 7 CHARACTERS
SX7 A2-NAMA-1
BX7 X6+X7
SA7 B3
SA2 B4
SX6 B4
SA6 B2
SX6 X2
EQ APNX RETURN
APNA DATA 0 LIBRARY NAME
SPACE 4
** BID - BUILD IMPLIED DELETE TABLE.
*
* THE INSERT PROGRAM TABLE IS SCANNED TO DETERMINE WHICH
* PROGRAMS ARE TO BE INSERTED. EACH PROGRAM TO BE INSERTED
* IS ADDED TO THE IMPLIED DELETE TABLE.
BID SUBR ENTRY/EXIT
CALL LIT LIST IGNORE TABLE
SA6 BIDE SET ERROR COUNT
SX6 B0 SET IPT INDEX
SA6 BIDA
BID1 SA1 P.IPT
SA2 L.IPT
SA3 BIDA
BX6 X2-X3
ZR X6,BID8 IF END OF INSERT PROGRAM TABLE
SB6 X1
SB6 B6+X3 (B6) = IPT ADDRESS
SA4 B6+B1 SET IPT ENTRY
SA5 A4+B1
BX6 X4
LX7 X5
SA6 BIDB
SA7 A6+B1
AX7 42
SX7 X7-1L0
ZR X7,BID6 IF ZERO-LENGTH RECORD INSERT
SA4 A5+B1
BX6 X4
SA6 A7+B1
SB7 B0 SEARCH PNT FOR START OF INSERT
SA1 P.PNT
SA2 L.PNT
SB5 X1
SB6 X2
SA5 BIDB
MX0 42
BID2 EQ B6,B7,BID5 IF END OF PNT
SB7 B7+B1
SA1 B5+B7 CHECK FILE NAME
SB7 B7+2
BX6 X1-X5
BX6 X0*X6
NZ X6,BID2 IF FILE NAME NOT FOUND
SA4 BIDB+1 CHECK PROGRAM NAME
BX6 X4
AX6 42
SX1 X6-1L*
SB7 B7-3
ZR X1,BID7 IF ENTIRE FILE INSERT
BID3 EQ B6,B7,BID5 IF END OF PNT
SA1 B5+B7
SA2 A1+B1
BX6 X2-X5
BX6 X0*X6
NZ X6,BID5 IF END OF FILE
SB7 B7+3
BX6 X1-X4
NZ X6,BID3 IF FIRST PROGRAM NOT FOUND
* FIRST PROGRAM FOUND, MAKE ENTRIES IN IMPLIED DELETE TABLE.
SX6 B7-3
BID4 SA6 BIDC
SA1 P.PNT
SB5 X1
SA2 B5+X6
SA3 A2+B1
BX6 X2
LX7 X3
SA6 BIDD
SA7 A6+B1
ADDWRD IDT,A6
SA1 P.PNT
SA2 L.PNT
SA3 BIDC
SB5 X1
SB6 X2
SB7 X3
SA5 BIDB CHECK FILE
SA4 BIDB+2 CHECK FOR LAST PROGRAM
MX0 42
SA1 B5+B7
BX6 X1-X4
ZR X6,BID6 IF LAST PROGRAM FOUND
SB7 B7+3
BX6 X4
AX6 42
SX1 X6-1L*
ZR X1,BID7 IF ADD FULL FILE
SB4 B5+B7 CHECK FILE OF NEXT ENTRY IN THE PNT
SA1 B4+B1
EQ B6,B7,BID5 IF END OF PNT
BX6 X1-X5
BX7 X0*X6
SX6 B7
ZR X7,BID4 IF FILE CONTINUES
* AN ERROR HAS BEEN DETECTED. OUTPUT INCORRECT DIRECTIVE.
BID5 CALL OIC,BIDA
SA1 BIDE INCREMENT ERROR COUNT
SX6 X1+B1
SA6 A1
* END OF INSERT SCAN. LOOP FOR NEXT INSERT CARD.
BID6 SA1 BIDA
SX6 X1+4
SA6 A1
EQ BID1 LOOP
* ADD ENTIRE FILE TO IDT.
BID7 EQ B6,B7,BID6 IF END OF PNT
SA1 B5+B7 SET IDT ENTRY
SA2 A1+B1
SA5 BIDB
SA4 A5+B1
BX6 X1
LX7 X2
SA6 BIDD
SA7 A6+B1
MX0 42
BX6 X5-X2
BX6 X0*X6
NZ X6,BID6 IF END OF FILE
BX6 X4-X1
BX6 -X0*X6
SB7 B7+3
NZ X6,BID7 IF NOT CORRECT PROGRAM TYPE
SX7 B7
SA7 BIDC
ADDWRD IDT,A6 ADD ENTRY TO IDT
SA1 P.PNT
SA2 L.PNT
SA3 BIDC
SB5 X1
SB6 X2
SB7 X3
EQ BID7 LOOP
* CHECK ERROR COUNT.
BID8 SA1 BIDE
ZR X1,BIDX IF NO ERRORS
SA1 TTYI
ZR X1,BIDX IF TTY INPUT
CALL C6S,BIDE,BIDF
CALL MSG,BIDF,(=C* DIRECTIVE ERROR(S).*)
SA1 CDOP CHECK *NA* OPTION
NZ X1,BIDX IF NO ABORT
CALL ABT ABORT JOB
*
BIDA DATA 0 INSERT PROGRAM TABLE INDEX
BIDB VFD 42/,18/ IPT ENTRY - 42/FILE,18/0
VFD 42/,18/ 42/PROG1,18/LIB1
VFD 42/,18/ 42/PROG2,18/LIB2
BIDC DATA 0 PROGRAM NAME TABLE INDEX
BIDD VFD 42/,18/ IDT ENTRY - 42/PROG,18/LIB
VFD 42/,18/ 42/FILE,18/POSITION
BIDE DATA 0 ERROR COUNT
BIDF DATA 0 ERROR COUNT (DISPLAY CODE)
CAP SPACE 4,10
** CAP - COPY ADDED PROGRAMS.
*
* COPY NEW RECORDS (THOSE NOT ON FILE *OLD*) ONTO
* THE END OF FILE *NEW* (JUST BEFORE EOF).
*
* ENTRY (CADD) = 0 IF RECORDS TO BE INSERTED AT EOF.
*
* EXIT RECORDS WRITTEN TO FILE *NEW*.
*
* USES A - 1, 2, 3, 4, 6.
* X - 1, 2, 3, 4, 6.
* B - 2, 3, 6, 7.
*
* CALLS CPY, DIS, ORW.
*
* MACROS SEARCH.
CAP SUBR ENTRY/EXIT
SA1 CADD
NZ X1,CAPX IF NO INSERT AT EOF
SX6 B0+
SA6 CAPA
CAP1 SA1 P.PNT
SA2 L.PNT
SA3 CAPA
SB6 X2
SB7 X3
CAP2 EQ B6,B7,CAPX IF END OF ADD
SA4 X1+B7 CHECK PNT ENTRY
SB7 B7+3
ZR X4,CAP2 IF RECORD REPLACED
SX6 B7
SA6 A3
BX6 X4
SA1 A4+B1
SA6 CAPB
BX6 X1
SA6 A6+B1
SEARCH NRT,(A4+B1),(=77777777777777000000B)
NZ X6,CAP1 IF FILE A NO REPLACE FILE
SB2 CAPB
SB3 =H* ADDING*
RJ DIS
SA1 CAPA
SB2 X1-3
RJ CPY COPY NEW RECORD
SB2 =5HADDED
SB3 CAPB+1
RJ ORW
EQ CAP1 GET NEXT RECORD
CAPA BSS 1 PNT INDEX
CAPB BSS 2 PNT ENTRY
SPACE 4
** CCM - COPY COMMENT ONTO FILE *NEW*.
*
* ENTRY (B2) = ADDRESS OF WORKING STORAGE.
* (B3) = ADDRESS OF PROGRAM NAME.
*
* EXIT (X6) = ADDRESS OF TEXT FWA.
*
* USES X - 0, 1, 2, 3, 5, 6, 7.
* A - 1, 2, 3, 5, 6, 7.
* B - 2, 3, 4, 5, 6, 7.
*
* CALLS COB, CPT, EPN, RNP.
*
* MACROS CALL, SEARCH, WRITE, WRITECW.
CCM SUBR ENTRY/EXIT
SX6 B2 SAVE WORKING STORAGE ADDRESS
SA6 CCMA
SA1 B3 SET PROGRAM NAME
BX6 X1
SA6 CCMC
CALL COB CLEAR OUTPUT BUFFER
SA1 CCMC
MX0 42
BX6 X0*X1
SA6 OUTPUTB+1
SA2 X1+NAMA
BX6 X2
SA6 A6+B1
SX6 B0 CLEAR COMMENT/DATE BUFFER
SA6 OUTPUTB+4
SB7 7
CCM1 SA6 A6+B1
SB7 B7-B1
NZ B7,CCM1 IF NOT END OF BUFFER
SEARCH CDT,B3,(=77777777777777377777B)
SA1 CCMA
ZR X6,CCM14 IF NO COMMENT OR DATE
SA2 CCMC CHECK RECORD TYPE
SB3 X2
ERRNZ TXRT CODE ASSUMES VALUE
SB2 X2-PRRT+TXRT CHECK FOR TYPE *PROC*
ZR B3,CCM14 IF TYPE *TEXT*
ZR B2,CCM14 IF TYPE *PROC*
SB6 X1
SB5 X6
SB3 5 COPY WORDS 3 - 7 OF 7700 TABLE
SB2 2
CCM2 SB2 B2+B1
SA1 B6+B2
BX6 X1
SA6 CCMB+B2
SB3 B3-B1
NZ B3,CCM2 IF MORE WORDS TO COPY
SA1 B5+B1 COPY COMMENT
SX2 -7
CCM3 BX6 X1
SA6 A6+B1
MX7 -12
BX7 -X7*X1
ZR X7,CCM4 IF END OF DATA
SA1 A1+B1
SX2 X2+B1
NZ X2,CCM3 IF NOT END OF TABLE
CCM4 BX6 X6-X6 SET TO CLEAR COMMENT FIELD
SB3 CCMB+CCMBL-1 LWA OF COMMENT FIELD
CCM5 SB2 A6 CHECK FOR END OF COMMENT FIELD
GE B2,B3,CCM6 IF AT END OF COMMENT FIELD
SA6 A6+B1
EQ CCM5 LOOP TO END OF PREFIX TABLE
CCM6 SA1 DATE. COPY DATE
BX6 X1
SA6 CCMB+2
SA1 B6 CHECK FOR 7700 TABLE
MX0 6
BX1 X1-X0
AX1 36
SB3 X1+B1 SET 7700 TABLE LENGTH
SB4 X1
AX1 12
NZ X1,CCM7 IF NO 7700 TABLE
SB6 B6+B3 SET TEXT ADDRESS
SA2 A1+B1 SET PROGRAM NAME
SA1 B5
LX1 42
NG X1,CCM7 IF DATE FLAG SET
SA1 A2+B1 SET OLD DATE
SX6 B0
SA6 CCMB+2
BX6 X1
LE B4,B1,CCM7 IF 1 WORD 7700 TABLE
SA6 A6+
CCM7 SX6 B6+ SAVE TEXT FWA
SA6 CCMA
SB7 X4-OPRT CHECK FOR OPL/OPLC RECORD TYPE
ZR B7,CCM8 IF OPL
NE B7,B1,CCM9 IF NOT OPLC
ERRNZ OPRT+1-OCRT CODE ASSUMES VALUE
CCM8 SA1 B6-B1
BX6 X1
SA6 CCMB+16B
CCM9 SX6 B0
SX6 B0 CLEAR COMMENT
SA6 B5
SB7 7
CCM10 SA6 A6+B1
SB7 B7-B1
NZ B7,CCM10 IF NOT END OF COMMENT FIELD
CALL RNP,CCMC,(CCMB+1)
MX0 42 SET NAME IN 7700 TABLE
BX6 X0*X6
SA6 CCMB+1
CALL EPN,CCMC ENTER PROGRAM NAME
WRITECW N,R
WRITE X2,*
SA1 SC
BX6 X6-X6
LX1 30
SA6 N-2 DISABLE CONTROL WORD WRITE
BX7 X1
SA7 N+6 STORE SECTOR COUNT
WRITEW NEW,CCMB,CCMBL WRITE 17-WORD 7700 TABLE
SB6 CCMB+10B COPY COMMENT TO OUTPUT
SA1 CCMB+2 COPY DATE FIRST
MX2 -12
SB7 CCMB+16B
SB5 OUTPUTB+4
CCM11 BX6 X1
SA1 B6
SB6 B6+B1
SA6 B5
BX3 -X2*X6
ZR X3,CCM12 IF END OF DATA
SB5 B5+B1
NE B6,B7,CCM11 IF NOT END OF DATA
CCM12 EQ B6,B7,CCM13 IF END OF BUFFER
SX6 B0
SB5 B5+B1
SA6 B5
SB6 B6+B1
EQ CCM12 CONTINUE TO END OF BUFFER
CCM13 SA1 CCMA
SX6 X1
EQ CCMX RETURN
CCM14 SA1 CCMA
SA2 X1 CHECK FOR 7700 TABLE
MX0 6
BX2 X2-X0
AX2 48
NZ X2,CCM15 IF NO 7700 TABLE
CALL RNP,CCMC CHECK FOR RENAME
SA5 CCMA
SB2 CCMC
BX6 X0*X6 STORE NAME IN PREFIX TABLE
SA6 X5+B1
RJ EPN ENTER PROGRAM NAME
SA3 OUTPUTB+3
BX6 X3 SET (A6) FOR *CPT* CALL
SA1 X5
SA6 A3
RJ CPT COPY PREFIX TABLE
BX6 X5
EQ CCMX RETURN
CCM15 SB2 CCMC
RJ RNP CHECK FOR RENAME
SA2 CCMC
SA5 CCMA
SB2 X2
ERRNZ TXRT CODE ASSUMES VALUE
NE B2,B1,CCM16 IF NOT TYPE *PP*
ERRNZ TXRT+1-PPRT CODE ASSUMES VALUE
MX0 18
CCM16 SB4 B2+TXRT-PRRT CHECK FOR TYPE *PROC*
ZR B2,CCM17 IF TYPE *TEXT*
ZR B4,CCM17 IF TYPE *PROC*
SA3 X5
BX6 X0*X6
BX3 -X0*X3
BX6 X3+X6
SA6 X5
CCM17 SB2 A2
RJ EPN ENTER PROGRAM NAME
BX6 X5
EQ CCMX RETURN
CCMA DATA 0 ADDRESS OF WORKING STORAGE
CCMB DATA 77000016000000000000B
BSSZ 16B
CCMBL EQU *-CCMB
CCMC DATA 0 PROGRAM NAME AND TYPE
CFN SPACE 4,10
** CFN - CONVERT FILE NAME.
*
* CONVERT LEFT JUSTIFIED FILE NAME INTO A STRING IN
* THE STRING BUFFER.
* ENTRY (B2) = ADDRESS OF FILE NAME.
*
* USES A - 1, 2, 6.
* X - 0, 1, 2, 5, 6.
* B - 6.
CFN SUBR ENTRY/EXIT
SA1 B2
MX0 42
SA2 SBP
BX5 X0*X1
NZ X5,CFN1 IF NOT ZERO FILE NAME
SX5 3R(0)
BX5 -X0*X5
LX5 -18
CFN1 SB6 X2
MX0 54
+ LX5 6
BX6 -X0*X5
SA6 B6
SB6 B6+B1
NZ X6,*-1
SX6 B6-B1
SA6 A2
EQ CFNX RETURN
CIT SPACE 4,15
** CIT - CHECK IGNORE TABLE.
*
* SEARCH THE PROGRAM IGNORE TABLE FOR CURRENT FILE.
* CHECK FOR IGNORING, START OF IGNORE, OR END OF IGNORE.
* DELETE ENTRY IN IGNORE TABLE ON END OF IGNORE.
* ENTRY (B2) = ADDRESS OF FILE NAME.
* (B3) = ADDRESS OF PROGRAM NAME.
* EXIT (X6) = 0 IF PROGRAM IS IGNORED.
*
* USES A - 1, 2, 3, 4, 5.
* X - 1, 2, 3, 4, 5, 6, 7.
* B - 6, 7.
CIT SUBR ENTRY/EXIT
SX6 B1 CLEAR IGNORE PROGRAM FLAG
SA1 P.PIT CHECK FILE NAME IN IGNORE TABLE
SA2 L.PIT
SB6 X1
SB7 X2+B6
SA4 B2 (X4) = FILE NAME
SA5 B3 (X5) = PROGRAM NAME
CIT1 EQ B6,B7,CITX IF END OF IGNORE TABLE
SA1 B6
BX7 X1-X4
SB6 B6+3
NZ X7,CIT1 LOOP IF FILE IS NOT CURRENT FILE
SA2 A1+B1 CHECK PROGRAM NAME
SA3 A2+B1
SX1 1R* BUILD TYPE/*
SX7 X5 PROPOGATE TYPE
LX1 54
BX1 X7+X1
ZR X2,CIT3 IF IGNORE-ALL IN PROGRESS
BX7 X5-X2
BX1 X2-X1
ZR X7,CIT4 IF TYPE/NAME MATCHES TABLE
ZR X1,CIT2 IF TABLE ENTRY IS THIS TYPE/*
AX1 18
NZ X1,CIT1 IF TABLE ENTRY NOT ANOTHER TYPE/*
BX7 X5-X3 CHECK END OF IGNORE GROUP
NZ X7,CIT1 IF NOT END
CIT2 SX6 B0 SET IGNORE PROGRAM FLAG
BX7 X5-X3
NZ X7,CIT1 IF NOT END OF IGNORE
SA7 A1 CLEAR IGNORE ENTRY
SA7 A7+1
SA7 A3
EQ CIT1 LOOP
* CHECK FOR IGNORING ALL RECORDS OF ANOTHER TYPE.
CIT3 BX7 X1-X3
ZR X7,CIT2 IF IGNORING ALL OF THIS TYPE
AX7 18
NZ X7,CIT2 IF NOT IGNORING ALL OF DIFFERENT TYPE
JP CIT1 LOOP
* SET IGNORE-ALL FLAG.
CIT4 SA7 A2
JP CIT2 GO IGNORE THIS RECORD
SPACE 4
** COB - CLEAR OUTPUT BUFFER.
*
* USES X - 1, 6.
* A - 1, 6.
* B - 6, 7.
COB SUBR ENTRY/EXIT
SA1 =1H
SB6 OUTPUTB
SB7 OUTPUTB+DCBL+1
BX6 X1
COB1 SA6 B6
SB6 B6+B1
NE B6,B7,COB1 LOOP TO END OF BUFFER
EQ COBX RETURN
CNO SPACE 4,15
** CNO - COPY *NEW* TO *OLD*.
*
* PERFORMS *C* OR *COPY OPTION.
*
* USES X - 1, 2, 3, 6, 7.
* A - 1, 3, 6, 7.
* B - 6, 7.
*
* CALLS DIS, SRT.
*
* MACROS READCW, READW, REWIND, WRCW, WRITECW.
CNO SUBR ENTRY/EXIT
SA1 CCPY CHECK COPY FLAG
ZR X1,CNO IF NO COPY
READCW N,17B
SA3 P+4
MX7 60
AX3 18
SA7 N-2 SET FIRST READ FLAG
SA7 P-2
SX6 X3 STORE PRU SIZE
SA6 A7+B1
WRITECW A6+B1,* SET FILE STATUS
CNO1 READW NEW,WSB,WSBL
NG X1,CNO4 IF EOF
SB6 WSB
SB7 X1
EQ B6,B7,CNO3 IF NO DATA
BX6 X1
SA6 CNOA
SA1 X2-LWP LWA+1 OF DATA TRANSFERED
SX2 WSB
RJ SRT SET RECORD TYPE
SA6 CNOB
CALL DIS,CNOB,(=H*RECOPYING *)
SA1 CNOA
NZ X1,CNO3 IF EOR
CN02 WRCW P,WSB,WSBL
READW NEW,WSB,WSBL
ZR X1,CN02 IF NOT EOR
NG X1,CNO4 IF EOF
CNO3 WRCW P,WSB,X1-WSB,R
EQ CNO1 LOOP TO EOF
CNO4 SX6 X1+2
ZR X6,CNO5 IF *EOI*
MX7 4
LX7 4+48
SA7 WDAA+1 SET LEVEL 17 EOR
WRCW P,0,0
CNO5 WRITECW P,R FLUSH BUFFER
REWIND OLD
REWIND NEW
EQ CNOX RETURN
CNOA DATA 0 EOR INDICATOR
CNOB DATA 0 PROGRAM NAME
SPACE 4
** CNR - CHECK NO REPLACE TABLE.
*
* ENTRY (B2) = PROGRAM NAME TABLE INDEX.
* EXIT (X6) " 0 IF PROGRAM IS IN A NO REPLACE FILE.
* (X6) = 0 IF PROGRAM IS NOT IN A NO REPLACE FILE.
*
* USES A - 1, 2, 6, 7.
* X - 1, 2, 6, 7.
* B - 4, 6.
CNR SUBR ENTRY/EXIT
SA1 P.PNT
SB4 B2+X1
SX6 B2
SA6 CNRA
SEARCH NRT,(B4+B1),(=77777777777777000000B)
ZR X6,CNRX IF NOT IN NO REPLACE TABLE
SA1 P.PNT DELETE PROGRAM FROM PNT
SA2 CNRA
SB6 X1
SX7 B0
SA7 B6+X2
EQ CNRX RETURN
CNRA DATA 0 PROGRAM NAME TABLE INDEX
SPACE 4,15
** CPL - COPY USER LIBRARY.
*
* ENTRY (B2) = ADDRESS OF PROGRAM TYPE.
* (B3) = ADDRESS TO RETURN STATUS OF NEXT READ.
* USES A - 1, 2, 6.
* X - 1, 2, 5, 6, 7.
* B - 6, 7.
*
* CALLS SRT.
*
* MACROS READW,WRCW.
CPL4 READW P,WSA,WSAL
CPL5 SA2 CPLA
BX6 X1 RETURN RECORD STATUS
SA6 X2
CPL SUBR ENTRY/EXIT
SA1 B2
SX6 B3
SX7 X1-ULRT
SA6 CPLA
NZ X7,CPL4 IF NOT *ULIB*
SX6 0
SA6 CPLB
CPL1 READW P,WSA,WSAL
NG X1,CPL5 IF EOF
SB6 WSA
SB7 X1
EQ B6,B7,CPL3 IF ZERO LENGTH RECORD
BX5 X1
SA1 X2-LWP LWA+1 OF DATA TRANSFERED
SX2 WSA
RJ SRT SET RECORD TYPE
SA6 CPLB
* COPY FROM *OLD* TO *NEW*.
BX7 X5
SA2 A6-B1
BX1 X5
SA7 X2
NZ X5,CPL3 IF EOR ON PREVIOUS READ
CPL2 WRCW N,WSA,WSAL
READW OLD,WSA,WSAL
ZR X1,CPL2 IF NOT EOR
CPL3 WRCW N,WSA,X1-WSA,R
SA2 CPLB
SB7 X2-ODRT
NZ B7,CPL1 LOOP TO END OF USER LIBRARY
EQ CPL4
CPLA BSSZ 2
CPLB EQU CPLA+1
SPACE 4
** CPP - COPY SPECIFIED PROGRAM(S).
*
* COPY RECORDS FROM FILE TO *NEW*.
* ENTRY (B2) = IPT INDEX.
*
* USES A - 1, 2, 3, 4, 5, 6, 7.
* X - ALL.
* B - 2, 3, 4, 5, 6, 7.
*
* CALLS CPY, DIS, OIC, ORW.
*
* MACROS CALL, MESSAGE, WRCW.
CPP SUBR ENTRY/EXIT
SA1 P.IPT
SX6 B2
SA6 CPPA
SX5 B2+X1
SA5 X5+B1 SET FILE NAME
SA2 A5+B1 SET FIRST PROGRAM
SA3 A2+B1 SET LAST PROGRAM
BX6 X5
LX7 X2
SA6 CPPB
SA7 A6+B1
BX6 X3
SA6 A7+B1
* CHECK FOR 0-LENGTH RECORD INSERT.
AX2 42
SX2 X2-1L0
ZR X2,CPP4 IF 0-LENGTH RECORD
* SEARCH PNT FOR START OF INSERT
SB7 B0
SA1 P.PNT
SA2 L.PNT
SB5 X1
ZR X2,CPP2 IF EMPTY PNT
SB6 X2
MX0 42
SB4 3
SB3 B5+B7
SA1 B3+B1 CHECK FILE NAME
+ EQ B6,B7,CPP2 IF END OF PNT
BX6 X1-X5
SB7 B7+B4
BX6 X0*X6
SA1 A1+B4
NZ X6,*-1 IF FILE NAME NOT FOUND
SB7 B7-B4
SA4 A5+B1 CHECK PROGRAM NAME
BX6 X4
AX6 42
SX1 X6-1L*
ZR X1,CPP3 IF ENTIRE FILE INSERT
+ EQ B6,B7,CPP2 IF END OF PNT
SA1 B5+B7
SA2 A1+B1
BX6 X2-X5
BX6 X0*X6
NZ X6,CPP2 IF END OF FILE
SB7 B7+B4
BX6 X1-X4
NZ X6,*-2 LOOP FOR FIRST PROGRAM
SX6 B7-B4 SET PNT INDEX
SA6 CPPC
* FIRST PROGRAM FOUND, START COPY.
CPP1 SA1 CPPC
SA2 P.PNT
IX3 X1+X2
CALL DIS,X3,(=H*INSERTING *)
SA1 CPPC
CALL CPY,X1
CALL ORW,(=8HINSERTED),CPPB
SA1 P.PNT CHECK FOR END OF COPY
SA2 L.PNT
SA3 CPPC
SB5 X1
SB6 X2
SB4 3
SA5 CPPB CHECK FILE
SA1 A5+B1 CHECK PROGRAM NAME
SA4 A1+B1
MX0 42
SB7 X3+B4
BX6 X1-X4
ZR X6,CPP5 IF LAST PROGRAM FOUND RETURN
BX6 X4
AX6 42
SX1 X6-1L*
ZR X1,CPP3 IF ADD FULL FILE
SB2 B5+B7 CHECK FILE OF NEXT ENTRY IN THE PNT
SA1 B2+B1
EQ B6,B7,CPP2 IF END OF PNT
BX6 X1-X5
SX7 B7
SA7 CPPC
SA1 B2 SET CURRENT PROGRAM NAME
BX7 X1
SA7 A5+B1
BX6 X0*X6
ZR X6,CPP1 IF FILE CONTINUES
* AN ERROR HAS BEEN DETECTED. SEND MESSAGE AND ABORT.
CPP2 CALL OIC,CPPA OUTPUT INSERT DIRECTIVE
SA1 TTYI
ZR X1,CPP5 IF TERMINAL INPUT
MESSAGE (=C*OVERLAPPING INSERT OR DELETE.*)
SA1 CDOP CHECK *NA* OPTION
NZ X1,CPP5 RETURN IF NO ABORT
CALL ABT ABORT JOB
* ADD ENTIRE FILE TO FILE NEW.
CPP3 EQ B6,B7,CPP5 RETURN IF END OF PNT
SX6 B7
SA2 B5+B7 CHECK PROGRAM TYPE
SA6 CPPC
SA5 CPPB CHECK FILE NAME
SA4 A5+B1
SA1 A2+B1
BX7 X1-X5
BX7 X0*X7
NZ X7,CPP5 RETURN IF END OF FILE
BX7 X2-X4
BX7 -X0*X7
SB7 B7+B4
NZ X7,CPP3 IF NOT CORRECT PROGRAM TYPE
ZR X2,CPP3 IF PROGRAM ALREADY INSERTED
SA1 P.PNT
IX3 X6+X1
CALL DIS,X3,(=H*INSERTING *)
SA1 CPPC
CALL CPY,X1 COPY RECORD
CALL ORW,(=8HINSERTED),CPPB
SA1 P.PNT
SA2 L.PNT
SA3 CPPC
SB5 X1
SB6 X2
SB4 3
MX0 42
SB7 X3+B4
EQ CPP3 LOOP
* WRITE 0-LENGTH RECORD.
CPP4 SB2 =0 ENTER ZERO LENGTH RECORD
RJ EPN
ADDWRD NPT,NIND
WRCW N,B0,B0 WRITE ZERO LENGTH RECORD
CALL OZR,(=8HINSERTED),(=1H ),(=2H00)
* CLEAR IPT ENTRY.
CPP5 SA1 P.IPT
SA2 CPPA
SB5 X1
SX6 B0
SA6 B5+X2
SA6 A6+B1
SA6 A6+B1
SA6 A6+B1
EQ CPPX RETURN
CPPA DATA 0 INSERT PROGRAM TABLE INDEX
CPPB VFD 42/,18/ FILE NAME
VFD 42/,18/ FIRST PROGRAM
VFD 42/,18/ LAST PROGRAM
CPPC DATA 0 PROGRAM NAME TABLE INDEX
SPACE 4
** CPY - COPY RECORD TO FILE NEW.
*
* ENTRY (B2) = PNT INDEX.
*
* USES A - 1, 2, 3, 4, 5, 6, 7.
* X - 1, 2, 3, 4, 5, 6, 7.
* B - 2, 4, 5, 6.
*
* CALLS ABT, CCM, COB, MSG, RCW, SFN.
*
* MACROS BKSP, CALL, READ, READCW, READW, RECALL, WRCW.
CPY SUBR ENTRY/EXIT
CALL COB CLEAR OUTPUT BUFFER
SX6 B2
SA1 P.PNT SET PROGRAM NAME
SA4 B2+X1
ZR X4,CPY IF PROGRAM ALREADY REPLACED
SA6 CPYA
SA5 A4+B1
BX6 X4
LX7 X5
SA6 CPYB
SA7 LGO
SA7 A6+B1
SA4 A5+B1 SET RANDOM ADDRESS
BX6 X4
SX7 B0
SA6 S+6
SA7 CW
* COPY RECORD.
READ S READ FILE *S*
READW S,WSB,WSBL
NG X1,CPY11 IF END OF FILE
SX6 X1
SA6 CPYD
CALL CCM,WSB,CPYB
SA1 CPYB
SB2 X1
ERRNZ TXRT CODE ASSUMES VALUE
NZ B2,CPY1 IF NOT TEXT
SA3 WSB CHECK FIRST WORD OF TEXT RECORD
MX7 6
BX7 X3-X7
AX7 48
ZR X7,CPY1 IF 7700 TABLE PRESENT
SA1 X6 REMOVE BLANKS FROM RECORD NAME
RJ SFN GENERATE MASK OF BLANKS
BX7 X7*X1 REMOVE BLANKS
SX6 A1 RESTORE X6
SA7 A1
CPY1 SA3 SC
SA1 CPYD
BX7 X3 SET RANDOM ADDRESS
SB6 X6
SA7 NIND+1
NZ X1,CPY3 IF EOR SENSED
SB7 WSB+WSBL
WRCW N,B6,B7-B6
CPY2 READW S,WSB,WSBL
SB6 WSB
NZ X1,CPY3 IF EOR SENSED
WRCW N,B6,WSBL
EQ CPY2 CONTINUE READ
CPY3 SB7 X1
WRCW N,B6,B7-B6,R
SA1 CPYB CHECK PROGRAM TYPE
SB4 X1-ULRT
NZ B4,CPY9 IF NOT USER LIBRARY
* COPY USER LIBRARY.
SX6 1
SA6 CW SET CONTROL WORD READ FLAG
READCW S,17B
CPY4 READW S,WSB,WSBL
PL X1,CPY5 IF NOT EOF
BKSP S,R
EQ CPY9 CLEAR PROGRAM NAME
CPY5 SB6 WSB
SB7 X1
EQ B6,B7,CPY8 IF 0-LENGTH RECORD
SX6 X1
SA6 CPYD
SA1 X2-LWP LWA+1 OF DATA TRANSFERED
SX2 WSB
RJ SRT SET RECORD TYPE
SA6 CPYB
SA1 CPYD
EQ CPY7 CHECK FOR EOR
CPY6 WRCW N,WSB,WSBL
READW S,WSB,WSBL
CPY7 ZR X1,CPY6 IF NOT EOR
CPY8 WRCW N,WSB,X1-WSB,R
SA2 CPYB
SX6 X2-ODRT
NZ X6,CPY4 IF NOT END OF USER LIBRARY
RECALL S
SA3 S+2
BX7 X3 SET BUFFER EMPTY
SA7 A3+B1
* CLEAR PROGRAM NAME.
CPY9 SA1 N-2
NG X1,CPY10 IF CONTROL WORD WRITE ENABLED
RJ RCW
CPY10 ADDWRD NPT,NIND WRITE NEW INDEX
SA1 P.PNT CLEAR PROGRAM NAME
SA2 CPYA
SB5 X1
SX6 B0
SA6 B5+X2
SX7 B1
SA7 CW
EQ CPYX RETURN
* END OF FILE DETECTED. ABORT JOB.
CPY11 CALL MSG,(CPYB+1),(=C* NOT DECLARED NRANDOM.*)
SA1 CDOP CHECK *NA* OPTION
NZ X1,CPY9 IF NO ABORT
CALL ABT
CPYA DATA 0 PNT INDEX
CPYB VFD 42/,18/ PROGRAM NAME
VFD 42/,18/ FILE AND POSITION
CPYD DATA 0 EOR INDICATION
CRR SPACE 4,10
** CRR - CHECK RECORDS REPLACED.
*
* USES A - ALL.
* X - ALL.
* B - 2, 3, 6, 7.
*
* CALLS ABT, CFN, COB, C6S, MST, LOL, OCC, OIC, OSB, STB.
*
* MACROS CALL, SEARCH.
CRR SUBR ENTRY/EXIT
CALL STB,CRRC SET TITLE BUFFER
SB6 B0+
CALL STB,CRRD
SB6 B1
SX6 B0
SA6 CRRA
CRR1 SA1 P.PNT CHECK PROGRAM NAME TABLE
SA2 L.PNT
SA3 CRRA
SB6 X2
SB7 X3
CRR2 EQ B6,B7,CRR3 IF END OF PNT
SA4 X1+B7 CHECK PNT ENTRY
SB7 B7+3
ZR X4,CRR2 IF PROGRAM REPLACED
SX6 B7
SA6 A3
SEARCH NRT,(A4+B1),(=77777777777777000000B)
NZ X6,CRR1 IF FILE IN NO REPLACE TABLE
SA1 CRRB INCREMENT ERROR COUNT
SX6 X1+B1
SA6 A1
CALL COB CLEAR OUTPUT BUFFER
SA1 CRRA OUTPUT RECORD, TYPE, AND FILE
SA2 P.PNT
SB6 X1-3
SA1 B6+X2
SA2 A1+B1
MX0 42
BX6 X0*X1
BX7 X0*X2
SA6 OUTPUTB+1
SA3 X1+NAMA
BX6 X3
SA6 A6+B1
SA7 A6+B1
CALL LOL LIST ONE LINE
EQ CRR1 LOOP TO END OF PNT
* CHECK DELETE PROGRAM TABLE.
CRR3 SB6 B0+ SET TITLE
CALL STB,CRRF
SB6 B1+
CALL STB,CRRG
SX6 B0
SA6 CRRA
* OUTPUT ERROR MESSAGE.
SA1 CRRB
BX6 X1
SA6 CRRB+2
ZR X1,CRR4 IF NO ERRORS
CALL C6S,CRRB,CRRA
CALL MSG,CRRA,(=C* RECORD(S) NOT REPLACED.*)
SX6 B0
SA6 CRRA
SA6 CRRB
CRR4 CALL COB CLEAR OUTPUT BUFFER
SA1 P.DPT
SA2 L.DPT
SA3 CRRA
SB6 X2
SB7 X3
SX0 7777B DELETE FLAG
CRR5 EQ B6,B7,CRR7 IF END OF DPT
SA4 X1+B7
BX5 X0-X4 COMPARE WITH DELETE FLAG
SB7 B7+2
ZR X5,CRR5 IF PROGRAM DELETED
MX5 -12 CHECK FOR -TYPE/*-
LX4 12
BX5 -X5*X4
LX4 -12
SX5 X5-1R**100B
ZR X5,CRR5 IF -TYPE/*- ENTRY
SA1 CRRB INCREMENT ERROR COUNT
SX6 X1+B1
SA6 A1
SA5 A4+B1 SET DELETE ENTRY
SA1 LIBP ISOLATE RECORD NAME
BX6 -X1*X4
MX0 -12 ISOLATE RECORD TYPE
BX4 -X0*X4
LX7 X5
SA6 CRRE
SA7 A6+B1
SX6 B7
SA6 A3
SA1 =10H*DELETE
BX7 X1
SA7 OUTPUTB+1
CALL CFN,(X4+OICD)
CALL CFN,CRRE OUTPUT PROGRAM NAME
SA1 CRRE CHECK FOR END OF DELETE
SA2 A1+B1
BX6 X1-X2
ZR X6,CRR6 IF FIRST PROGRAM = LAST PROGRAM
CALL CFN,(=1L-)
SA2 CRRE+1 OUTPUT LIBRARY NAME
CALL CFN,(X2+OICD)
CALL CFN,(CRRE+1)
CRR6 CALL OSB OUTPUT STRING BUFFER
EQ CRR4 LOOP TO END OF DPT
** CHECK INSERT PROGRAM TABLE.
CRR7 SA1 CRRB SAVE ERROR COUNT
SA2 A1+B1
IX6 X1+X2
SA6 A2
SX6 B0
SA6 A1
SA6 CRRA
CRR8 SA1 P.IPT
SA2 L.IPT
SA3 CRRA
SB6 X2
SB7 X3
CRR9 EQ B6,B7,CRR10 IF END OF INSERT PROGRAM TABLE
SA4 X1+B7
SB7 B7+4
ZR X4,CRR9 IF PROGRAMS INSERTED
SX6 B7
SA6 A3
SX6 X6-4
SA6 CRRH
CALL OIC,A6 OUTPUT INSERT DIRECIVE
SA2 CRRB INCREMENT ERROR COUNT
SX6 X2+B1
SA6 A2
EQ CRR8 LOOP TO END OF IPT
** CHECK COMMENT/DATE TABLE.
CRR10 SA1 CRRB SAVE ERROR COUNT
SA2 A1+B1
IX6 X1+X2
SA6 A2
SX6 B0
SA6 A1
SA6 CRRA
CRR11 SA1 P.CDT
SA2 L.CDT
SA3 CRRA
SB6 X2
SB7 X3
CRR12 EQ B6,B7,CRR13 IF END OF COMMENT/DATE TABLE
SA4 X1+B7 CHECK ENTRY
SB7 B7+8
ZR X4,CRR12 IF COMMENT PROCESSED
SX6 B7
SA6 A3
CALL OCC,(B7-8) OUTPUT COMMENT DIRECTIVE
SA2 CRRB
SX6 X2+B1
SA6 A2
EQ CRR11 LOOP TO END OF CDT
** OUTPUT ERROR MESSAGE.
CRR13 SA1 CRRB
SA2 A1+B1
IX6 X1+X2
SA6 A1
SA3 A2+B1
IX3 X6+X3
ZR X3,CRRX IF NO ERRORS
ZR X6,CRR14 IF ALL DIRECTIVES PROCESSED
SA1 TTYI
ZR X1,CRRX IF TTY INPUT
CALL C6S,CRRB,CRRA
CALL MSG,CRRA,(=C* DIRECTIVE ERROR(S).*)
CRR14 SA1 CDOP CHECK D OPTION
NZ X1,CRRX IF NO ABORT
CALL ABT ABORT JOB
CRRA DATA 0 TABLE INDEX
CRRB DATA 0 ERROR COUNT
DATA 0
DATA 0
CRRC DATA C* ERROR DIRECTORY - RECORDS NOT REPLACED.*
CRRD DATA C* RECORD TYPE FILE*
CRRE VFD 42/,18/ DPT ENTRY - 42/PROG1,18/LIB1
VFD 42/,18/ 42/PROG2,18/LIB2
CRRF DATA C* ERROR DIRECTORY - DIRECTIVES NOT PERFORMED.*
CRRG DATA C* *
CRRH DATA 0 INSERT PROGRAM TABLE INDEX
SPACE 4
** C6S - CONVERT 6 DIGITS WITH LEADING ZERO SUPPRESSION.
*
* ENTRY (B2) = ADDRESS OF RIGHT JUSTIFIED NUMBER.
* (B3) = ADDRESS TO STORE RESULT.
*
* USES X - 0, 1, 2, 3, 4, 5, 6.
* A - 1, 2, 3, 6.
* B - 2, 7.
C6S SUBR ENTRY/EXIT
SA2 =0.1000000001P48
SA3 =10.0P0
SA4 =1H
SB6 6
SB5 1R0-1R
SA1 B2
SB2 18
PX1 X1
BX6 X4
C6S1 DX4 X1*X2
FX1 X1*X2
SB7 X1
LX6 54
SB2 B2+B6
FX5 X4*X3 CALCULATE REMAINDER DIGIT
SX0 X5+B5
IX6 X0+X6
NZ B7,C6S1 IF NOT ENTIRE NUMBER
LX6 X6,B2 POSITION NUMBER
SA6 B3
EQ C6SX RETURN
SPACE 4
** DIS - DISPLAY MESSAGE.
*
* ENTRY (B2) = ADDRESS OF PROGRAM NAME.
* (B3) = ADDRESS OF MESSAGE.
*
* USES A - 1, 2, 6, 7.
* X - 0, 1, 2, 6, 7.
DIS SUBR ENTRY/EXIT
SA1 B2
SA2 B3
MX0 42
BX6 X2
BX7 X0*X1
SA6 DISA
SA7 A6+B1
MESSAGE A6,1
EQ DISX RETURN
DISA BSS 2
SPACE 4
** EPN - ENTER PROGRAM NAME IN NEW PROGRAM TABLE.
*
* ENTRY (B2) = ADDRESS OF PROGRAM NAME AND TYPE.
*
* USES A - 1, 6, 7.
* X - 1, 6, 7.
EPN SUBR ENTRY/EXIT
SA1 B2
BX6 X1
SA6 NIND
SA1 SC
LX7 X1 SET RELATIVE SECTOR ADDRESS
SA7 A6+B1
EQ EPNX RETURN
GUL SPACE 4,15
** GUL - GENERATE USER LIBRARY (*LIBGEN* CALL).
*
* SET UP CALLING PARAMETERS AND CALL *LIBGEN*
* PROGRAM (OVERLAYING PRESENT *LIBEDIT* ROUTINE)
* TO GENERATE USER LIBRARY.
*
* ENTRY (GULC) THRU (GULJ) SET UP FOR CALL.
*
* EXIT TO *LIBGEN*.
*
* MACROS MESSAGE, OVERLAY, RECALL, SETLOF.
GUL SUBR ENTRY/EXIT
SA1 CULB
ZR X1,GULX IF NO *U* OPTION
RECALL OUTPUT
MESSAGE (=C* LIBGEN*),1
RECALL S
RECALL OLD
RECALL NEW
SA1 GULC MOVE PARAMETERS TO ARGR
BX6 X1
SA6 ARGR
GUL2 ZR X6,GUL3 IF END OF MOVE
SA1 A1+B1
BX6 X1
SA6 A6+1
EQ GUL2 MOVE NEXT ARGUMENT
GUL3 SX7 A6-ARGR
SA2 FL
SA7 ACTR SET NUMBER OF PARAMETERS
LX2 30
SA0 X2+
SETLOF =0 CLEAR LIST OF FILES POINTER
OVERLAY GULA,,SYSTEM
PS
GULA VFD 36/6LLIBGEN,24/0
GULC VFD 42/0LF,18/1R=
GULD VFD 42/0LZZZZZG2,18/0
VFD 42/0LP,18/1R=
GULF VFD 42/0LNEW,18/0
VFD 42/0LN,18/1R=
GULH VFD 42/0LULIB,18/0
VFD 42/0LNX,18/1R=
GULJ VFD 42/0L0,18/0
CON 0 END OF ARGUMENTS FOR *LIBGEN*
ILO SPACE 4,10
** ILO - INTERPRET LIST OPTIONS.
*
* ENTRY (A1) = ADDRESS OF OPTION WORD.
* (X1) = LIST OPTIONS.
*
* EXIT ((A1)) = INTERPRETTED LIST OPTIONS.
* (X1) = 0 IF NO ERROR.
*
* USES X - 0, 1, 2, 3, 4, 6.
* A - 2, 6.
ILO4 SA6 A1+ SET LIST OPTIONS
ILO SUBR ENTRY/EXIT
SX6 B0+ INITIALIZE INTERPRETTED LIST OPTIONS
MX0 6
ILO1 SA2 ILOA-1
BX4 X0*X1
ILO2 SA2 A2+B1
ZR X2,ILO3 IF END OF OPTIONS
BX2 X4-X2
BX3 X0*X2
NZ X3,ILO2 IF NO MATCH
SX3 X2
BX6 X3+X6
BX1 -X0*X1
ZR X1,ILO4 IF ALL OPTIONS PROCESSED
LX1 6
EQ ILO1 PROCESS NEXT OPTION
ILO3 SX1 B1+ SET ERROR
EQ ILOX RETURN
ILOA CON 1LF+17B FULL
CON 1LC+4B DIRECTIVES
CON 1LM+2B SHORT
CON 1LE+1B ERRORS
CON 1LN+10B RECORDS WRITTEN
CON 0
LIT SPACE 4,15
** LIT - LIST IGNORE TABLE.
*
* EXIT (X6) = ERROR COUNT.
*
* USES A - 1, 2, 3, 6, 7.
* X - 1, 2, 3, 6, 7.
* B - 2.
*
* CALLS CFN, COB, LOL, OSB.
*
* MACROS CALL, WRITEC.
LIT SUBR ENTRY/EXIT
LIT1 SA1 P.PIT
SA2 L.PIT
SA3 LITA PIT INDEX
BX6 X2-X3
NZ X6,LIT2 IF NOT END OF TABLE
SA1 LITB ERROR COUNT
BX6 X1
EQ LITX RETURN
LIT2 IX1 X1+X3
SA2 X1
NZ X2,LIT4 IF ENTRY NOT PROCESSED
LIT3 SA3 LITA ADVANCE PIT INDEX
SX6 X3+3
SA6 LITA
EQ LIT1 LOOP
* LIST UNPROCESSED ENTRY.
LIT4 BX6 X2 COPY IPT ENTRY
SA1 A2+B1
SA6 LITC
BX7 X1
SA2 A1+B1
SA7 A6+B1
BX6 X2
SA6 A7+B1
SX1 1R*
LX1 54
ZR X7,LIT5 IF START OF IGNORE FOUND
BX6 X6-X1
AX6 18
NZ X6,LIT6 IF NOT IGNORE ALL OF TYPE
LIT5 BX7 X7-X1
AX7 18
ZR X7,LIT3 IF IGNORE TO END OF FILE
LIT6 CALL COB CLEAR OUTPUT BUFFER
WRITEC OUTPUT,(=C* *)
SA1 =H/ *ERROR* DIRECTIVE CANNOT BE PERFORMED./
SB2 4
BX6 X1
SA6 OUTPUTB
LIT7 SA1 A1+B1
SB2 B2-B1
BX6 X1
SA6 A6+B1
NZ B2,LIT7 IF NOT 4 WORDS
CALL LOL LIST ONE LINE
CALL COB CLEAR OUTPUT BUFFER
SA2 =5H*FILE LIST FILE NAME
BX6 X2
SA6 OUTPUTB+1
CALL CFN,LITC OUTPUT FILE NAME
CALL OSB OUTPUT STRING BUFFER
SA2 =7H*IGNORE OUTPUT IGNORE CARD
SA1 LITC+1
BX6 X2
SA6 OUTPUTB+1
NZ X1,LIT8 IF IGNORE NOT STARTED
CALL CFN,(=6LTEXT/,)
EQ LIT9 OUTPUT PROGRAM NAME
LIT8 CALL CFN,X1+OICD
CALL CFN,LITC+1 OUTPUT PROGRAM NAME
SA1 LITC+1 CHECK SINGLE IGNORE
SA2 A1+B1
BX6 X1-X2
ZR X6,LIT10 IF FIRST PROGRAM = LAST PROGRAM
LIT9 CALL CFN,(=1L-)
SA2 LITC+2 OUTPUT LIBRARY NAME
CALL CFN,X2+OICD
CALL CFN,LITC+2
LIT10 CALL OSB OUTPUT STRING BUFFER
SA1 LITB ADVANCE ERROR COUNT
SX6 X1+B1
SA6 A1
EQ LIT3 LOOP
LITA CON 0 PIT INDEX
LITB CON 0 ERROR COUNT
LITC VFD 42/,18/ PIT ETRY - 42/FILE,18/
VFD 42/,18/ 42/PROG1,18/LIB1
VFD 42/,18/ 42/PROG2,18/LIB2
LOL SPACE 4,20
** LOL - LIST ONE LINE.
*
* ENTRY (OUTPUTB) = LINE TO BE WRITTEN.
* (LINE) = LINE NUMBER.
* (BRFM) = 1 IF BRIEF MODE SET (NO TITLE).
* (PAGE) = PAGE NUMBER.
* (LL) = PAGE LINE LIMIT.
* (PD) = PRINT DENSITY FORMAT CONTROL.
* (PDFLG) = 1 IF FORMAT CONTROL NOT WRITTEN.
*
* EXIT LINE AND PAGE NUMBER UPDATED.
*
* USES A - 1, 2, 3, 6.
* X - 0, 1, 2, 3, 6.
* B - 2, 5, 6, 7.
*
* CALLS C6S.
*
* MACROS CALL, WRITEC, WRITEH.
LOL SUBR ENTRY/EXIT
SA1 LINE CHECK LINE NUMBER
SX6 X1+B1
SA6 A1
SA3 A1+B1 GET LINE LIMIT
ERRNZ LL-LINE-1 CODE DEPENDS ON CONSECUTIVE LOCATIONS
IX6 X6-X3
NG X6,LOL1 IF NOT END OF PAGE
SX6 B0 RESET LINE COUNT
SA6 A1
SA3 TTYO
NZ X3,LOL0 IF NOT TTY OUTPUT
SA1 BRFM
NZ X1,LOL1 IF BRIEF MODE SET
WRITEH OUTPUT,TITA,TITAL TITLE LINE
WRITEH OUTPUT,TITE,TITEL SUBTITLE
WRITEC OUTPUT,(=C* *)
EQ LOL1 CONTINUE
LOL0 SA2 PAGE
SX6 X2+B1
SA6 A2
CALL C6S,PAGE,LOLA
SA1 TITD INSERT PAGE NUMBER
LX6 36
MX0 24
BX1 X0*X1
BX6 -X0*X6
BX6 X6+X1
SA6 A1
SA3 PDFLG FLAG THAT FORMAT CONTROL WAS WRITTEN
BX7 X7-X7
SA7 A3
WRITEW O,A3-B1,X3 CONDITIONALLY WRITE FORMAT EFFECTOR
ERRNZ PDFLG-PD-1 CODE DEPENDS ON CONSECUTIVE LOCATIONS
WRITEC OUTPUT,(=C*1*)
WRITEH OUTPUT,TITA,TITE-TITA WRITE TITLE LINE
WRITEC OUTPUT,(=C* *)
WRITEH OUTPUT,TITE,TITF-TITE WRITE SUBTITLE LINE
WRITEC OUTPUT,(=C* *)
SX6 5 RESET LINE COUNT
SA6 LINE
LOL1 SX2 1R BLANK FILL LINE
SB6 OUTPUTB
SB7 OUTPUTB+DCBL+1
SA1 B6
MX0 54
LOL2 BX6 X1
SA6 A1
EQ B6,B7,LOL4 IF END-OF-LINE
SA1 B6
SB6 B6+B1
SB5 10
LOL3 ZR B5,LOL2 IF END-OF-WORD
LX0 6
LX2 6
BX6 -X0*X1
SB5 B5-B1
NZ X6,LOL3 IF CHARACTER .NE. 00
BX1 X1+X2
EQ LOL3 LOOP
LOL4 WRITEH OUTPUT,OUTPUTB,DCBL+1
EQ LOLX RETURN
LOLA VFD 60/ PAGE NUMBER (DISPLAY CODE)
MSG SPACE 4,10
** MSG - SEND DAYFILE MESSAGE.
*
* ENTRY (B2) = ADDRESS OF PROGRAM NAME.
* (B3) = ADDRESS OF MESSAGE.
*
* USES A - 1, 2, 6.
* X - 0, 1, 2, 3, 4, 6.
*
* MACROS MESSAGE.
MSG SUBR ENTRY/EXIT
MX0 42
SA1 B3
SA2 B2
BX3 X0*X2
BX1 -X0*X1
BX6 X3+X1
MX0 6
SA6 B3
SX4 1R
LX0 24
LX4 18
BX1 X0*X6
NZ X1,MSG2 IF NO BLANKS
MSG1 IX6 X6+X4 BLANK FILL FILE NAME
LX0 6
LX4 6
BX1 X0*X6
ZR X1,MSG1
SA6 B3
MSG2 MESSAGE B3,,R SEND MESSAGE TO DAYFILE
EQ MSGX RETURN
IDT SPACE 4
** IDT - ISSUE INCORRECT DEVICE MESSAGE.
*
* ENTRY (A1) = FET ADDRESS + 1.
* (X7) = 0.
*
* EXIT TO ABT.
*
* USES A - 1, 7.
* B - 4.
* X - 0, 1, 2, 3, 4, 6, 7.
*
* CALLS MSG=.
IDT MX0 42
SA1 A1-B1 READ FILE NAME
MX3 26+10
BX6 X0*X1
MX2 6
LX3 59 POSITION LEGAL CHARACTER MASK
BX1 X1-X1
MX0 -6
IDT1 LX7 6
BX7 X7+X1 ASSEMBLE FILE NAME
LX6 6
BX1 -X0*X6
SB4 X1 FIND END OF FILE NAME
LX4 B4,X3
NG X4,IDT1 IF NOT END OF NAME
LX7 6
SX1 1R. ADD *.* TO FILE NAME
BX7 X7+X1
+ LX7 6 LEFT JUSTIFY ASSEMBLY
BX6 X2*X7
ZR X6,* IF NOT LEFT JUSTIFIED
SA7 IDTB
MESSAGE IDTA
CALL ABT
IDTA DATA 30H UNKNOWN DEVICE TYPE -- LFN =
IDTB CON 0
SPACE 4
** OCC - OUTPUT COMMENT DIRECTIVE.
*
* ENTRY (B2) = INDEX IN COMMENT/DATE TABLE.
* USES A - 1, 5, 6.
* X - 0, 1, 5, 6, 7.
* B - 4, 6, 7.
*
* CALLS CFN, OSB.
*
* MACROS CALL.
OCC SUBR ENTRY/EXIT
SA1 P.CDT
SX6 X1+B2
SA6 OCCA
SA2 =1H
BX6 X2
SA6 OUTPUTB
SA1 X1+B2 SET *DATE OR *COMMENT
LX1 60-17
SX7 B1
BX6 X7*X1
SA2 OCCB+X6
BX6 X2
SA6 A6+B1
AX1 -17+60 OUTPUT LIBRARY NAME
CALL CFN,(X1+OICD)
SA1 OCCA OUTPUT PROGRAM NAME
CALL CFN,X1
CALL CFN,(=1L ) OUTPUT BLANK
SA1 OCCA OUTPUT COMMENT
SB6 X1
MX0 54
SB7 B6+8
SA1 SBP SET STRING BUFFER POINTER
SB4 X1
OCC1 SB6 B6+B1 DISASSEMBLE COMMENT INTO STRING BUFFER
EQ B6,B7,OCC3 IF END OF COMMENT
SA5 B6
SB5 B4+10
OCC2 EQ B4,B5,OCC1 IF END OF WORD
LX5 6
BX6 -X0*X5
SA6 B4
SB4 B4+B1
NZ X6,OCC2 IF NOT END OF COMMENT
OCC3 SX6 B0 SET END OF BUFFER
SA6 B4
SX7 B4
SA7 A1
CALL OSB OUTPUT STRING BUFFER
EQ OCCX RETURN
OCCA VFD 60/ COMMENT ADDRESS
OCCB DATA 10H*COMMENT
DATA 10H*DATE
SPACE 4
** ODP - OUTPUT DELETED PROGRAM.
*
* ENTRY (B2) = ADDRESS OF PROGRAM NAME.
*
* USES A - 1, 2, 6, 7.
* X - 0, 1, 2, 3, 6, 7.
* B - 2.
*
* CALLS COB, ORW.
*
* MACROS CALL.
ODP SUBR ENTRY/EXIT
CALL COB CLEAR OUTPUT BUFFER
MX0 42
SA1 B2 SET PROGRAM NAME
SA2 X1+NAMA
BX1 X0*X1
SX3 1R) ADD *)* AT END OF NAME
MX0 54
+ LX3 54
LX0 54
BX7 -X0*X1
BX6 X1+X3
NZ X7,*-1 LOOP FOR END OF NAME
SA6 OUTPUTB+1
LX7 X2
SA7 A6+B1
SB2 =9HDELETED-(
CALL ORW,B2,OLD
EQ ODPX RETURN
OIC SPACE 4,15
ODPL BSS 0
SPACE 4
** OIC - OUTPUT INSERT DIRECTIVE.
*
* OUTPUT AN INSERT DIRECTIVE THAT CAN NOT BE FOLLOWED.
*
* ENTRY (B2) = ADDRESS OF INSERT PROGRAM TABLE INDEX.
*
* USES A - 1, 2, 3, 4, 5, 6, 7.
* X - ALL.
* B - 2, 5, 6, 7.
*
* CALLS CFN, LOL.
*
* MACROS CALL.
OIC SUBR ENTRY/EXIT
SA2 B2
SA1 P.IPT
SB6 X1
SA4 B6+X2
SA5 A4+B1
BX6 X4
LX7 X5
SA6 OICA
SA7 A6+B1
SA4 A5+B1
SA5 A4+B1
BX6 X4
LX7 X5
SA6 A7+B1
SB6 OICB *DIRECTIVE CAN NOT BE PERFORMED.*
SB7 OICB+OICBL
SB5 OUTPUTB
SA7 A6+B1
SB5 B6-B5
+ SA1 B6
BX6 X1
SA6 B6-B5
SB6 B6+B1
NE B6,B7,*-1
CALL LOL LIST ONE LINE
SA1 =10H
BX6 X1
SA6 OUTPUTB
SA1 =10H*FILE
BX6 X1
SA6 A6+B1
SB2 OICA+1 CONVERT FILE NAME
CALL CFN,B2
CALL OSB OUTPUT STRING BUFFER
SA1 OICA CHECK FOR *REPLACE* *INSERT* OR *BEFORE*
SA3 OICA+2
BX7 X1-X3
SA2 =10H*REPLACE
SX6 B1
BX3 X1
LX1 60-17
ZR X7,OIC1 IF *REPLACE*
BX6 X6*X1
SA2 OICC+X6
MX0 6
BX6 X0*X3
NZ X6,OIC1 IF *INSERT* OR *BEFORE*
SA2 =10H*ADD
BX6 X2
SA6 OUTPUTB+1
CALL CFN,ADPB OUTPUT *LIB* PREFIX
BX1 X3 CONVERT LIBRARY NAME
AX1 42
RJ CDD CONVERT LIBRARY NUMBER TO DISPLAY
SB2 B2-B1 OUTPUT CONVERTED LIBRARY NUMBER
MX6 1
AX6 B2
BX6 X6*X4
SA6 OICE
CALL CFN,OICE
EQ OIC2
OIC1 BX6 X2
SA6 OUTPUTB+1
AX1 -17+60 OUTPUT LIBRARY NAME
CALL CFN,(X1+OICD)
CALL CFN,OICA OUTPUT PROGRAM NAME
OIC2 CALL CFN,(=1L,)
SA1 OICA+2 OUTPUT FIRST PROGRAM NAME
CALL CFN,(X1+OICD)
CALL CFN,(OICA+2)
SA1 OICA+2 OUTPUT LAST PROGRAM NAME
SA2 A1+B1
BX6 X1-X2
ZR X6,OIC3 IF FIRST PROGRAM = LAST PROGRAM
CALL CFN,(=1L-)
SA2 OICA+3
CALL CFN,(X2+OICD)
CALL CFN,(OICA+3)
OIC3 CALL OSB OUTPUT STRING BUFFER
EQ OICX RETURN
OICA VFD 42/,1/,17/ IPT ENTRY - 42/PROG1,1/BEFORE,17/LIB1
VFD 42/,18/ 42/FILE,18/0
VFD 42/,18/ 42/PROG2,18/LIB2
VFD 42/,18/ 42/PROG3,18/LIB3
OICB DATA H/ *ERROR* - *DIRECTIVE CAN NOT BE PERFORMED./
OICBL EQU *-OICB
OICC DATA 0H*INSERT
DATA 0H*BEFORE
OICD BSS 0
.E ECHO ,RT=("RTMIC")
.A IFC NE,/RT//
DATA L.RT/.
.A ELSE
DATA 0
.A ENDIF
.E ENDD
OICE BSS 1
SPACE 4
** ORW - OUTPUT RECORDS WRITTEN ON FILE *NEW*.
*
* ENTRY (B2) = ADDRESS OF *INSERT*, *DELETED*, *REPLACED*,
* OR * *.
* (B3) = ADDRESS OF FILE NAME.
*
* USES A - 1, 2, 3, 6, 7.
* X - 0, 1, 2, 3, 6, 7.
* B - 2.
*
* CALLS LOL.
ORW SUBR ENTRY/EXIT
SA1 LIST
SX2 10B+2B
BX1 X2*X1
ZR X1,ORWX IF LIST OPTION IS OFF
SA2 B2 SET STATUS AND FILE NAME
SX6 10B
BX1 X6*X1
NZ X1,ORW1 IF FULL LIST OPTION ON
SA3 =1H
BX6 X2-X3
NZ X6,ORW1 IF COMMENT MESSAGE
SA3 OUTPUTB+1 CHECK FOR RENAME
MX0 60-12
BX6 -X0*X3
SX7 X6-2R*
NZ X7,ORWX IF NO RENAME
ORW1 SA3 B3
BX6 X2
MX0 42
LX6 54
BX7 X0*X3
SA6 OUTPUTB
SA7 OUTPUTB+3
SA1 TTYO
NZ X1,ORW3 IF NOT TTY OUTPUT
BX6 X6-X6
SB2 DCBL-5
SA6 OUTPUTB+5
ORW2 SA6 A6+B1 CLEAR COMMENT FIELD
SB2 B2-B1
NZ B2,ORW2 IF NOT END OF BUFFER
ORW3 RJ LOL LIST ONE LINE
EQ ORWX RETURN
SPACE 4
** OSB - OUTPUT STRING BUFFER.
*
* ENTRY (OUTPUTB) = STRING BUFFER.
*
* USES X - 1, 6.
* A - 1, 6.
* B - 4, 5, 6, 7.
*
* CALLS LOL.
*
* MACROS CALL.
OSB SUBR ENTRY/EXIT
SX6 DSB RESET STRING BUFFER POINTER
SA6 SBP
SB6 OUTPUTB+2
SB7 OUTPUTB+DCBL
SA1 DSB
SB4 10
SX6 B0
SB5 B4
EQ OSB2
OSB1 SA6 B6 STORE WORD
SB6 B6+B1
SB5 B4
SX6 B0
OSB2 ZR B5,OSB1 IF END OF WORD
LX6 6
BX6 X6+X1
SA1 A1+B1
SB5 B5-B1
NZ X1,OSB2 IF NOT END OF STRING BUFFER
SA1 A1-B1
SX1 1R
NZ B5,OSB2 IF NOT END OF WORD
SA1 =10H
SA6 B6
BX6 X1
OSB3 SB6 B6+B1 BLANK FILL WORKING STORAGE
SA6 B6
NE B6,B7,OSB3
CALL LOL
EQ OSBX RETURN
OZR SPACE 4,15
** OZR - OUTPUT ZERO LENGTH RECORD.
*
* ENTRY (B2) = ADDRESS OF STATUS.
* (B3) = ADDRESS OF FILE NAME.
* (B4) = ADDRESS OF PROGRAM NAME.
*
* USES A - 1, 6.
* X - 1, 2, 6.
*
* CALLS COB, LOL, ORW.
*
* MACROS CALL.
OZR SUBR ENTRY/EXIT
CALL COB CLEAR OUTPUT BUFFER
SA1 B4
BX6 X1 SET PROGRAM NAME
SA6 OUTPUTB+1
CALL ORW,B2,B3 OUTPUT RECORD WRITTEN
CALL COB CLEAR OUTPUT BUFFER
SA1 LIST CHECK LIST OPTION
SX2 10B
BX1 X2*X1
ZR X1,OZR IF FULL LIST OPTION OFF
CALL LOL LIST ONE LINE
EQ OZRX RETURN
SPACE 4
** RCF - READ ALL CORRECTION FILES.
*
* READ CORRECTION FILES, IGNORING RECORDS IN THE IGNORE TABLE.
* MAKE ENTRYS IN THE PROGRAM NAME TABLE.
*
* USES A - 1, 2, 3, 4, 6, 7.
* X - 0, 1, 2, 3, 4, 6, 7.
* B - 2, 3, 6, 7.
*
* CALLS CIT, CVD, DIS, SRT.
*
* MACROS ADDWRD, BKSP, CALL, OPEN, READCW, READW, REWIND, WRCW,
* WRITECW.
RCF11 WRITECW S,R FLUSH BUFFER
REWIND X2,R
SX7 1 INITIALIZE SECTOR COUNT
SA7 SC
RCF SUBR ENTRY/EXIT
OPEN S,WRITE,R
WRITECW S,* SET FILE STATUS
SA3 S+4
BX6 X6-X6
AX3 18 EXTRACT PRU SIZE
SA6 RCFA
SX7 X3+
SA7 S-1
RCF1 SX6 B0 CLEAR PROGRAM TYPE
SA6 RCFE
SA1 P.FNT DO LOOP TO READ CORRECTION FILE
SA2 L.FNT
SA3 RCFA
SB2 X2
SB3 X3
EQ B2,B3,RCF11 IF END OF TABLE
SA4 X1+B3 READ FILE NAME
MX0 42
BX6 X4
SA6 RCFC+1
BX6 X0*X4
SX7 17B SET NAME IN FET
BX7 X6+X7
SA6 RCFB
SA7 LGO
OPEN A7,READ,R
SA1 LGO+1 CHECK VALID DEVICE
RJ CVD
ZR X7,IDT IF CONTROL WORD I/O NOT SUPPORTED
READCW LGO,17B
RCF2 SA1 SC
BX7 X1 STORE RANDOM ADDRESS
SA7 RCFC+2
READW LGO,WSB,WSBL READ 1 SECTOR
PL X1,RCF4 IF NOT EOF
RCF3 BKSP LGO,R
SA1 RCFA INCREMENT FILE INDEX
SX6 X1+B1
SA6 A1
EQ RCF1 LOOP TO READ NEXT FILE
RCF4 BX6 X1 SET EOR INDICATOR
SA6 RCFD
SB7 X1
SB6 WSB
EQ B6,B7,RCF2 IF 0-LENGTH RECORD
* CHECK PROGRAM TYPE, CHECK IGNORE TABLE, AND MAKE
* ENTRY INTO THE PROGRAM NAME TABLE.
SA1 X2-LWP LWA+1 OF DATA TRANSFERED
SX2 WSB FWA OF BUFFER
RJ SRT SET RECORD TYPE
SA6 RCFC
CALL DIS,RCFC,(=H*READING *)
* COPY REST OF RECORD.
SA1 RCFD
NZ X1,RCF6 IF EOR READ
RCF5 WRCW S,WSB,WSBL
READW LGO,WSB,WSBL
ZR X1,RCF5 IF NOT EOR READ
SA1 LGO-LWP LWA + 1 OF DATA TRANSFERED
RCF6 WRCW S,WSB,X1-WSB,R
CALL CIT,RCFB,RCFC
SA1 RCFC GET RECORD TYPE
NZ X6,RCF7 IF NOT IGNORED
SB7 X1-ULRT
ZR B7,RCF8 IF TYPE *ULIB*
JP RCF2 READ NEXT RECORD
RCF7 SX6 X1-ODRT
ZR X6,RCF2 IF RECORD IS *OPLD*
SA2 CULB
ZR X2,RCF7.1 IF NOT *ULIB* MODE
SX6 X1-ULRT
ZR X6,RCF2 IF *ULIB* SKIP RECORD
RCF7.1 ADDWRD PNT,RCFC
SA1 RCFC CHECK PROGRAM TYPE
SB7 X1-ULRT
NZ B7,RCF2 IF NOT TYPE *ULIB*
* COPY USER LIBRARY.
RCF8 READW LGO,WSB,WSBL
NG X1,RCF3 IF EOF
SB6 WSB
SB7 X1
EQ B6,B7,RCF10 IF 0-LENGTH RECORD
BX6 X1 SET EOR INDICATOR
SA6 RCFD
SA1 X2-LWP LWA+1 OF DATA TRANSFERED
SX2 WSB
RJ SRT SET RECORD TYPE
SA6 RCFE
SA1 RCFD
NZ X1,RCF10 IF EOR
RCF9 WRCW S,WSB,WSBL
READW LGO,WSB,WSBL
ZR X1,RCF9 IF NOT EOR
RCF10 WRCW S,WSB,X1-WSB,R
SA2 RCFE
SX6 X2-ODRT
NZ X6,RCF8 IF NOT OPLD
EQ RCF2 READ NEXT RECORD
RCFA DATA 0 INDEX IN FNT
RCFB VFD 42/,18/ CURRENT FILE NAME
RCFC VFD 42/,18/ 42/PROGRAM,18/TYPE
VFD 42/,18/ 42/FILE,18/ADDRESS
VFD 60/ 60/POSITION
RCFD DATA 0 EOR INDICATOR
RCFE DATA 0 USER LIBRARY RECORD NAME
RFN SPACE 4,10
** RFN - REPLACE FILE NAME.
*
* ENTRY (A1) = ADDRESS OF ENTRY IN LIST OF FILES.
* (X1) = CONTENTS OF ENTRY IN LIST OF FILES.
* (X6) = NEW FILE NAME.
*
* EXIT FILE NAME CHANGED.
*
* USES A - 3, 6.
* X - 0, 1, 2, 3, 6.
RFN SUBR ENTRY/EXIT
MX0 -18
BX1 -X0*X1 EXTRACT ADDRESS OF FET
SA3 X1 READ FET+0
BX2 X0*X6
SX6 1R0
LX6 -6
BX6 X6-X2
ZR X6,RFN1 IF FILE NAME = *0*
BX6 X2
ZR X6,RFN1 IF NO NEW FILE NAME
BX3 -X0*X3
BX6 X3+X6
RFN1 SA6 A3
BX6 X0*X6
BX6 X6+X1
SA6 A1
EQ RFNX RETURN
RNP SPACE 4,10
** RNP - RENAME PROGRAM.
* ENTRY (B2) = ADDRESS OF PROGRAM NAME.
* EXIT (X6) = NEW PROGRAM NAME AND TYPE.
*
* USES A - 1, 2, 3, 6.
* X - 0, 1, 2, 3, 6.
* B - 2, 3, 4.
*
* MACROS MESSAGE, SEARCH.
RNP SUBR ENTRY/EXIT
SX6 B2 SAVE PROGRAM NAME ADDRESS
MX0 42
SA6 RNPA
SEARCH RNT,X6
SA1 RNPA
SB2 X6
SA2 X1
BX6 X2
ZR B2,RNPX IF NO RENAME
SA2 RNPA CHECK RECORD TYPE
SA3 X2
SB3 X3
ERRNZ TXRT CODE ASSUMES VALUE
SB4 B3+TXRT-PRRT CHECK FOR TYPE *PROC*
ZR B3,RNP1 IF TYPE *TEXT*
NZ B4,RNP2 IF NOT TYPE *PROC*
RNP1 MESSAGE (=C* RENAME NOT ALLOWED FOR PROC OR TEXT RECORD.*)
EQ RNPX RETURN
RNP2 SA2 B2+B1
BX6 X0*X2
SX3 2R*
BX6 X6+X3
SA6 OUTPUTB+1
BX6 X2
SA6 X1
EQ RNPX RETURN
RNPA DATA 0 ADDRESS OF PROGRAM NAME
SPACE 4
** RWF - REWIND ALL FILES.
*
* REWIND ALL RANDOM FILES ALONG WITH THE FILES IN THE RFT.
*
* USES X - 0, 1, 2, 3, 6.
* A - 1, 2, 3, 6.
* B - 6, 7.
*
* MACROS EVICT, REWIND.
RWF SUBR ENTRY/EXIT
EVICT S,R
SA1 P.FNT
SA2 L.FNT
SB6 X1
SB7 X2+B6
RWF1 EQ B6,B7,RWF2 IF END OF TABLE
SA1 B6 CHECK IF FILE IS RANDOM
MX0 42
SX6 3
BX2 -X0*X1
BX1 X0*X1
SB6 B6+B1
BX6 X6+X1
NZ X2,RWF1 LOOP IF FILE IS NON-RANDOM
SA6 LGO
REWIND A6,R
EQ RWF1
RWF2 SA1 P.RFT REWIND FILES IN THE REWIND FILE TABLE
SA2 L.RFT
SB6 X1
SB7 X2+B6
RWF3 EQ B6,B7,RWF4 IF END OF TABLE
SA1 B6
SX6 3
SB6 B6+B1
BX6 X6+X1
SA6 LGO
REWIND A6,R
EQ RWF3 LOOP
RWF4 SA1 CREW CHECK FOR NO REWIND OPTION
ZR X1,RWF5 IF NO REWIND
SX1 B1
RWF5 SX6 B1
BX6 X6-X1
SA2 CVFY
SA3 CCPY
BX6 X6+X2
BX6 X6+X3
ZR X6,RWFX IF V AND C NOT SET AND R SET
REWIND OLD,R
REWIND NEW,R
EQ RWFX RETURN
SPACE 4
** RWS - REWIND SEQUENTIAL FILES.
*
* REWIND SEQUENTIAL CORRECTION FILES THAT HAVE REWIND SELECTED.
*
* USES X - 0, 1, 2, 3, 6, 7.
* A - 1, 2, 3, 6.
* B - 6, 7.
*
* MACROS REWIND, SEARCH.
RWS SUBR ENTRY/EXIT
SX6 B0
SA6 RWSA
RWS1 SA1 P.FNT
SA2 L.FNT
SA3 RWSA
SB6 X1
SB7 B6+X2
SB6 B6+X3
SX6 X3+B1
EQ B6,B7,RWSX IF END OF FNT
SA6 A3
SA1 B6 READ FILE NAME
MX0 42
BX6 -X0*X1
ZR X6,RWS1 IF FILE IS RANDOM
SEARCH RFT,B6,(=77777777777777000000B)
ZR X6,RWS1 IF FILE IS NOT IN RFT
SA1 P.FNT REWIND FILE
SA3 RWSA
IX2 X1+X3
MX0 42
SA2 X2-1
BX6 X0*X2
SX7 B1
IX6 X6+X7
SA6 A2
SA6 LGO
REWIND A6,R
EQ RWS1
RWSA DATA 0 FNT INDEX
SPACE 4
** SMT - SEARCH MANAGED TABLE.
*
* ENTRY (B2) = ADDRESS OF TABLE POINTER.
* (B3) = ADDRESS OF ENTRY.
* (B4) = ADDRESS OF MASK.
* (B5) = INDEX INTO TABLE.
* EXIT (B6) = ADDRESS OF ADDRESS OF ENTRY IF FOUND.
* (B6) = ADDRESS OF 0 IF NOT FOUND.
* (X6) = ADDRESS OF ENTRY IF FOUND
* (X6) = 0 IF NOT FOUND
*
* USES A - 1, 2, 3, 4, 5, 6.
* X - 1, 2, 3, 4, 5, 6.
* B - 2, 3, 7.
SMT SUBR ENTRY/EXIT
SA1 B2 SET TABLE POINTER
SA2 A1+B1 SET TABLE LENGTH
SA3 A2+B1 SET NUMBER OF WORDS/ENTRY
SA4 B3 (X4) = ENTRY
SB2 X1 (B2) = FWA TABLE
SB7 X2+B2 (B7) = LWA TABLE
SB3 X3 (B3) = WORDS/ENTRY
SA5 B4 (X5) = MASK
SMT1 EQ B2,B7,SMT2 IF END OF TABLE
SA1 B2+B5
BX6 X4-X1
BX6 X5*X6
SB2 B2+B3
NZ X6,SMT1 IF NOT FOUND
SX6 B2-B3 SET ENTRY ADDRESS
SA6 B6
EQ SMTX RETURN
SMT2 SX6 B0 SET NOT FOUND
SA6 B6
EQ SMTX RETURN
SMTA VFD 60/0
SPACE 4
** STB - SET TITLE BUFFER.
*
* ENTRY (B2) = ADDRESS OF TITLE.
* (B6) = 0 IF TITLE.
* = 1 IF SUBTITLE.
*
* USES A - 1, 2, 6.
* X - 0, 1, 2, 6.
* B - 2, 6, 7.
STB SUBR ENTRY/EXIT
NZ B6,STB0 IF SUBTITLE
SB6 TITA
SB7 TITB
EQ STB1 SET TITLE BUFFER
STB0 SB6 TITE
SB7 TITF
STB1 SX1 1R
MX0 54
SX6 99999 FORCE PAGE EJECT
SA6 LINE
SA2 B2 COPY TITLE OR SUBTITLE
BX6 X2
BX7 -X0*X2
SB2 B2+B1
ZR X7,STB2 IF END OF TITLE
SA6 B6
SB6 B6+B1
NE B6,B7,STB1 IF NOT END OF TITLE BUFFER
EQ STBX RETURN
* ADD TRAILING BLANKS.
STB2 BX6 X6+X1
LX1 6
LX0 6
BX7 -X0*X2
ZR X7,STB2 LOOP
SA6 B6
SA1 =1H BLANK FILL REMAINING WORDS
BX6 X1
SB6 B6+B1
STB3 EQ B6,B7,STBX IF END OF BUFFER
SA6 B6
SB6 B6+B1
EQ STB3
SPACE 4
** SUL - SKIP USER LIBRARY.
*
* ENTRY (B2) = ADDRESS OF CURRENT PROGRAM TYPE.
* (B3) = ADDRESS TO RETURN EOR INDICATOR.
*
* USES A - 1, 2, 6, 7.
* X - 1, 2, 5, 6, 7.
* B - 6, 7.
*
* CALLS SRT.
*
* MACROS READW.
SUL SUBR ENTRY/EXIT
SA1 B2 CHECK IF USER LIBRARY
SX7 B3
SX6 X1-ULRT
SA7 SULA
NZ X6,SUL4 IF NOT USER LIBRARY
SUL1 READW P,WSA,WSAL
NG X1,SUL5 IF EOF
SB6 WSA
SB7 X1
EQ B6,B7,SUL1 IF 0-LENGTH RECORD
BX5 X1
SA1 X2-LWP LWA+1 OF DATA TRANSFERED
SX2 WSA
RJ SRT SET RECORD TYPE
SA6 SULB
SA1 SULA
BX7 X5 STORE EOR INDICATOR
SA7 X1
NZ X5,SUL3 IF EOR ON PREVIOUS READ
SUL2 READW OLD,WSA,WSAL
SUL3 ZR X1,SUL2 IF NOT EOR
SA2 SULB
SB7 X2-ODRT
NZ B7,SUL1 LOOP TO END OF USER LIBRARY
SUL4 READW P,WSA,WSAL
SUL5 SA2 SULA STORE EOR INDICATOR
BX6 X1
SA6 X2
EQ SULX RETURN
SULA DATA 0 ADDRESS TO RETURN EOR INDICATOR
SULB DATA 0 PROGRAM NAME
SUM SPACE 4,10
** SUM - SET *ULIB* MODE.
*
* ENTRY (CULB) = *ULIB* MODE FLAG.
*
* EXIT ROUTINE PRESET FOR CALLING *LIBGEN*.
*
* USES A - 1, 2, 3, 4, 6, 7.
* X - 0, 1, 2, 3, 4, 6, 7.
SUM SUBR ENTRY/EXIT
SA4 CULB
ZR X4,SUMX IF *U* NOT SPECIFIED
MX0 42
SA1 CCPY
ZR X1,SUM1 IF NO RECOPY
SA2 NEW
BX6 X0*X2
SA6 GULD SET F=NEW
SA2 OLD
BX6 X0*X2
SA6 GULF SET P=OLD
EQ SUM2 SET N=CULB
SUM1 SA2 SUMA
SA3 NEW
BX6 X2*X0
BX7 X0*X3
BX3 -X0*X3
BX6 X6+X3
SA6 A3+ SET NEW FILE NAME
SA7 GULF SET P=NEW
SUM2 BX6 X4*X0
SA6 GULH SET N=CULB
EQ SUMX RETURN
SUMA VFD 42/7LZZZZZG2,18/0
SUM SPACE 4,10
** VFY - CALL VFYLIB TO VERIFY *OLD* AND *NEW*.
*
* ENTRY (CVFY) = 1 VERIFY REQUESTED.
*
* EXIT TO *VFYLIB*.
*
* MACROS MESSAGE, OVERLAY, RECALL, SETLOF.
VFY SUBR ENTRY/EXIT
SA1 CVFY
ZR X1,VFY IF NO VERIFY
RECALL OUTPUT WAIT FOR END OF OUTPUT
MESSAGE (=C* VFYLIB*),1
RECALL S
RECALL OLD
RECALL NEW
SA1 OLD SET *VFYLIB* PARAMETERS
MX0 42
BX6 X0*X1
SA6 2
SA1 NEW
BX6 X0*X1
SA6 A6+B1
SA1 OUTPUT
BX6 X0*X1
SA6 A6+B1
SX6 3 SET PARAMETER COUNT
SA6 ACTR
SA2 FL
LX2 30
SA0 X2 SET (A0) = FL FOR *VFYLIB*
SETLOF =0 CLEAR LIST OF FILES POINTER
OVERLAY VFYA,,SYSTEM
PS 0
VFYA CON 0LVFYLIB
SPACE 4,15
** WPD - WRITE PROGRAM DIRECTORY.
*
* ENTRY (X1) = OLD FILE EOI STATUS INDICATOR.
* (B2) = ADDRESS OF OPL DIRECTORY NAME.
*
* USES A - 1, 2, 5, 6, 7.
* X - 0, 1, 2, 5, 6, 7.
* B - 2, 6, 7.
*
* CALLS CCM, EPN, ORW, OZR.
*
* MACROS ADDWRD, CALL, FILINFO, WRCW, WRITE,
* WRITECW, WRITEF, WRITER, WRITEW.
WPD SUBR ENTRY/EXIT
SA5 NPLN
NZ X5,WPD1 IF BUILD
SA5 FLST+/FLST/NEW SET UP *FILINFO* BLOCK
MX0 42
BX5 X0*X5
SX6 50001B
BX6 X5+X6
SA6 WPDD
FILINFO WPDD
SA2 WPDD+1 *FILINFO* STATUS WORD
SA5 B2
LX2 59-24
NG X2,WPD0 IF NEW FILE IS ON MAGNETIC TAPE
SX6 X5-ODRT
ZR X6,WPD1 IF LAST RECORD TYPE *OPLD*
WPD0 SB7 B0
SX6 X1+2 CHECK FOR EOI ON OLD FILE
MX7 4
BX5 X5-X5 CLEAR DIRECTORY TEXT
ZR X6,WPD1 IF EOI ON OLD FILE
LX7 4+48
SA7 WDAA+1 SET LEVEL 17 EOR
WRCW N,B0,B7
SX7 0
SA7 WDAA+1 RESET CONTROL WORD
CALL OZR,(=1H ),OLD,(=7H**EOF**)
WPD1 WRITECW N,R
ZR X5,WPD IF NO DIRECTORY
MX0 42
BX6 X0*X5 STORE NAME IN 7700 TABLE
SA6 WPDA+1
SX7 ODRT
BX7 X6+X7
SB2 WPDC
SA7 B2
SA1 DATE.
BX6 X1
SA6 A6+B1
CALL EPN,B2
ADDWRD NPT,NIND
SA1 L.NPT SET 7000 TABLE LENGTH
MX6 3
BX6 X6+X1
SA6 WPDB
WRITE N,*
CALL CCM,WPDA,WPDC
SB6 X6 WRITE 7000 TABLE
SB7 WPDB+1
WRITEW NEW,B6,B7-B6
SA1 P.NPT
SA2 L.NPT
WRITEW NEW,X1,X2
WRITER NEW
WRITEF X2
CALL ORW,(=5HADDED),(=5H*****)
CALL OZR,(=1H ),OLD,(=7H**EOF**)
EQ WPDX RETURN
WPDA DATA 77000016000000000000B
BSSZ 16B
WPDB DATA 70000000000000000000B
WPDC VFD 42/,18/ 42/PROGRAM,18/TYPE
BSS 1
WPDD BSS 5 *FILINFO* PARAMETER BLOCK
SPACE 4
TITLE BUFFERS.
** DATA AND FILE ENVIRONMENT TABLES.
* INDEX TAGS FOR WORDS PRECEEDING EACH FET.
LWP EQU 3 LWA+1 OF DATA TRANSFERED.
WRB EQU 2 WORDS REMAINING IN BLOCK.
ERF EQU 1 EOR FLAG.
CW CON 1 CONTROL WORD READ FLAG
SC CON 1 SECTOR COUNT
CON 0 LWA+1 OF DATA TRANSFERED
CON -0 WORDS REMAINING IN BLOCK (OLD)
CON 0 EOR FLAG
P BSS 0
OLD FILEB OLDB,OLDL,(FET=10),(WSA=WSA,WSAL)
ORG P+11B
VFD 36/,6/ODEBL,18/PODEB POINTER TO *OD* EXT. BUFFER
ORG P+10
CON 0 LWA+1 OF DATA TRANSFERED
CON -0 WORDS REMAINING IN BLOCK (NEW)
CON 0 EOR FLAG
N BSS 0
NEW RFILEB NEWB,NEWL,(FET=10)
ORG N+11B
VFD 36/,6/ODEBL,18/NODEB POINTER TO *OD* EXT. BUFFER
ORG N+10
CON 0 LWA+1 OF DATA TRANSFERED
CON -0
CON 0
S BSS 0
ZZZZZG1 RFILEB SBUF,SBUFL
CON 0 LWA+1 OF DATA TRANSFERED
CON -0
CON 0
LGO RFILEB LGOB,LGOL,(WSA=WSB,WSBL)
O BSS 0
OUTPUT FILEC OUTB,OUTL,(WSA=OUTPUTB,DCBL+1),(FET=10)
I BSS 0
INPUT FILEC INPB,INPL,(WSA=DCB,DCBL),(FET=10)
TTYOUT BSS 0
ZZZZZG0 FILEC TTYB,TTYL,(FET=10)
* OPTICAL DISK EXTENSION BUFFERS.
PODEB BSSZ ODEBL *OLD*
NODEB BSSZ ODEBL *NEW*
* FILE LIST.
FLST CON FLSTL
LOC 1
QUAL FLST
TTYOUT VFD 42/0LZZZZZG0,18///TTYOUT
INPUT VFD 42/0LINPUT,18///INPUT
OUTPUT VFD 42/0LOUTPUT,18///OUTPUT
OLD VFD 42/0LOLD,18///OLD
NEW VFD 42/0LNEW,18///NEW
LGO VFD 42/0LLGO,18///LGO
QUAL *
LOC *O
CON 0
FLSTL EQU *-FLST
DATE. DATA 0 CURRENT DATE
LGO. DATA 0LLGO CORRECTION FILE NAME
LIST VFD 56/0 LIST OPTIONS
VFD 1/1 FULL LIST
VFD 1/1 LIST DIRECTIVES
VFD 1/1 LIST MODIFICATIONS MADE
VFD 1/1 LIST ERRORS
BRFM DATA 0 BRIEF MODE FLAG
CADD DATA 0 NO INSERT AT EOF FLAG
CREW DATA 0 NO REWIND FLAG
CVFY DATA 0 VERIFY FLAG
CCPY DATA 0 COPY FLAG
CDOP DATA 0 IGNORE ERROR FLAG
CZOP DATA 0 *Z* OPTION FLAG
CULB DATA 0 USER LIBRARY OPTION
FL DATA 0 FIELD LENGTH
TTYI DATA 1 NON-TTY INPUT FLAG
TTYO DATA 1 NON-TTY OUTPUT FLAG
SBP VFD 60/DSB STRING BUFFER POINTER
LINE CON 99999 LINE COUNT
LL CON 0 PAGE LINE LIMIT
PD CON 0 PRINT DENSITY FORMAT CONTROL
PDFLG CON 1 FORMAT CONTROL NOT WRITTEN FLAG
PAGE DATA 0 PAGE NUMBER COUNT
NIND VFD 42/,18/ 42/PROGRAM,18/TYPE
CON 0 RANDOM ADDRESS
NPLN DATA 0 NEW PROGRAM LIBRARY NAME
TITA DATA H* LIBEDIT DIRECTIVES. *
DATA H* *
TITAL EQU *-TITA
TITB DATA H* 01/20/69.*
TITC DATA H* 00.00.00.*
DATA H* *
TITD DATA H*PAGE *
TITE DATA H* *
DATA H* *
DATA H* *
TITEL EQU *-TITE
TITF BSS 0
SPACE 4
** TABLE POINTERS.
TABLE BSS 0
TABLE CDT,8 COMMENT/DATE TABLE
TABLE DPT,2 DELETE PROGRAM TABLE
TABLE FNT FILE NAME TABLE
TABLE IDT,2 IMPLIED DELETE TABLE
TABLE IPT,4 INSERT PROGRAM TABLE
TABLE NPT,2,40B NEW PROGRAM TABLE
TABLE NRT NO REPLACE TABLE
TABLE PIT,3 PROGRAM IGNORE TABLE
TABLE PNT,3,40B PROGRAM NAME TABLE
TABLE RFT REWIND FILE TABLE
TABLE RNT,2 RENAME TABLE
TABLE BUF UNUSED STORAGE TABLE
RDA SPACE 4
** RDA - READ DATA.
*
* PROCESSES CALLS TO READ WORDS (RDW=).
* DEBLOCKS DATA IF CONTROL WORD READS.
*
* ENTRY (X2) = FET ADDRESS.
* (B6) = FWA OF WORKING STORAGE BUFFER.
* (B7) = LENGTH OF TRANSFER REQUESTED.
*
* EXIT (X1) = STATUS RETURNED FROM RDW=.
* (X2-LWP) = LWA+1 OF DATA TRANSFERED.
* (B6) = LWA+1 OF DATA TRANSFERED.
*
* USES A - 1, 3, 6, 7.
* X - 1, 3, 4, 6, 7.
* B - 5, 6, 7.
*
* CALLS RDW=.
RDA5 SX6 B5-B7 UPDATE WORDS REMAINING
SA6 A1
RDA6 RJ RDW= READ WORDS
RDA7 SX6 B6 LWA+1 OF DATA TRANSFERED
SA6 X2-LWP
RDA SUBR ENTRY/EXIT
SA1 CW CHECK IF CONTROL WORDS LEGAL
ZR X1,RDA6 IF CONTROL WORD READS NOT LEGAL
RDA1 SA1 X2-WRB GET NUMBER OF WORDS BEFORE CONTROL WORD
SB5 X1+
PL X1,RDA2 IF NOT FIRST READ
SX7 B7+ SET WORDS NEEDED
SA7 RDAA
JP RDA4
RDA2 GE B5,B7,RDA5 IF ENOUGH DATA TO FILL BUFFER
SA3 X2-ERF CHECK EOR FLAG
PL X3,RDA3 IF NOT EOR ON FILE
MX6 1 SET NEW READ FLAG
SB7 B5+B1 SET WORDS TO READ
SA6 A3
SA6 A1
RJ RDW= READ WORDS
SX1 B6-B1 SET EOR INDICATION
SB6 B6-B1 BACK UP LWA TO ALLOW FOR CONTROL WORD
JP RDA7 RETURN
RDA3 SX6 B7-B5 SAVE ADDITIONAL WORDS NEEDED
SA6 RDAA
SB7 B5+B1 SET WORDS TO TRANSFER
RJ RDW= READ WORDS
SB6 B6-1 BACK UP OVER LAST CONTROL WORD
RDA4 SB7 B1 READ CONTROL WORD
RJ RDW=
NG X1,RDA7 IF EOF/EOI
SB6 B6-B1 BACK UP WORKING BUFFER
SA1 B6 CONTROL WORD
SX7 5
SX4 X1+4 ROUND UP
AX1 36 EXTRACT BLOCK SIZE
SX3 X1
IX7 X4/X7 WORDS IN BLOCK
IX6 X7-X3 SAVE EOR FLAG
SA7 X2-WRB WORD COUNT
SA6 X2-ERF EOR FLAG
SA1 RDAA RESET WORDS NEEDED
SB7 X1
JP RDA1 LOOP
RDAA CON 0
WDA SPACE 4
** WDA - WRITE DATA WITH CONTROL WORDS.
*
* ENTRY (B6) = FWA OF WORKING STORAGE.
* (B7) = WORD COUNT.
* (X2) = FET ADDRESS.
*
* EXIT (B7) = 0 IF FULL PRU WRITTEN.
*
* USES A - 1, 3, 4, 5, 6, 7.
* B - 4, 6, 7.
* X - 1, 3, 4, 5, 6, 7.
*
* MACROS WRITER, WRITEW.
WDA3 SA3 SC
SA1 X2-1
SX7 B1+ UPDATE SECTOR COUNT
IX7 X3+X7
SB4 X1
SA7 A3 STORE RANDOM ADDRESS
BX6 X1
ZR B7,WDA2 IF ZERO LENGTH RECORD
SX3 5
SX7 B7-B4
PL X7,WDA4 IF \ ONE PRU
SX1 B7
WDA4 IX4 X1*X3 FORM PRU BYTE COUNT
SA7 WDAA
LX6 36 POSITION BLOCK SIZE
SA5 X1+B6
BX6 X6+X4 FORM HEADER CONTROL WORD
SX7 B0
SA6 B6-B1
SA7 A5 STORE TRAILER CONTROL WORD
WRITEW X2,A6,X1+2
SB6 A5 SET ADDRESS OF NEXT BLOCK
SA3 WDAA
BX6 X5 RESTORE CELL DESTROYED BY CONTROL WORD
SB7 X3
SA6 A5
GE B7,B1,WDA3 IF AT LEAST ONE MORE WORD IN BUFFER
WDA SUBR ENTRY/EXIT
SA4 X2-2
NG X4,WDA3 IF CONTROL WORD WRITE ENABLED
ZR B7,WDA1 IF ZERO LENGTH RECORD
WRITEW X2,B6,B7
SB7 B0+
JP WDA
WDA1 WRITER X2,R FLUSH BUFFER
SB7 1
JP WDA
WDA2 LX6 36 POSITION BLOCK SIZE
SA6 WDAA
WRITEW X2,A6,2 WRITE ZERO LENGTH RECORD
SB7 1
JP WDA
WDAA CON 0
CON 0
RCW SPACE 4
** RCW - RESTORE CONTROL WORD WRITE.
*
* ENTRY NONE.
*
* EXIT NONE.
*
* USES A - 1, 6, 7.
* B - NONE.
* X - 1, 6, 7.
*
* MACROS RECALL, WRITECW, WRITER.
RCW SUBR ENTRY/EXIT
RECALL N
SA1 N+2 CHECK BUFFER EMPTY
SA3 A1+B1
IX3 X3-X1
ZR X3,RCW1 IF BUFFER EMPTY
WRITER X2,R FLUSH BUFFER
RCW1 WRITECW X2,* SET FILE STATUS
SA1 N+6
MX7 60
AX1 30
SA7 N-2 ENABLE CONTROL WORD WRITE
BX6 X1
SA6 SC RESET SECTOR COUNT
EQ RCWX RETURN
CVD SPACE 4
** CVD - CHECK DEVICE TYPE.
*
* ENTRY (X1) = (FET+1).
*
* EXIT (X7) = 0 IF CONTROL WORD READ/WRITE NOT SUPPORTED ON
* DEVICE.
*
* USES X - 0,1,2,6,7.
* A - 2.
* B - NONE.
*
* CALLS NONE.
CVD2 LX1 12 CHECK *TT*
BX6 -X0*X1
SX7 X6-2RTT
CVD SUBR ENTRY/EXIT
MX0 -12
PL X1,CVD2 IF ALLOCATABLE
LX1 12
SA2 CVDA SEARCH DEVICE TABLE
SX7 0 ASSUME NO FIND
CVD1 ZR X2,CVDX IF NOT FOUND
BX6 X1-X2
AX2 12
BX6 X2*X6
SA2 A2+B1
NZ X6,CVD1 IF NOT MATCH
SX7 1 INDICATE CONTROL WORD POSSIBLE
EQ CVDX RETURN
CVDA VFD 36/,12/7703B,12/4002B
VFD 36/,12/7703B,12/4102B
VFD 36/,12/7777B,12/2RMT+4000B
VFD 36/,12/7777B,12/2RNT+4000B
VFD 36/,12/7777B,12/2RCT+4000B
VFD 36/,12/7777B,12/2RAT+4000B
CON 0
SPACE 4,10
** COMMON DECKS.
*CALL COMCCDD
WRIF$ EQU 1 SELECT *REISSUE CURRENT WRITE*
*CALL COMCCIO
*CALL COMCCPM
*CALL COMCCPT
*CALL COMCDXB
*CALL COMCLFM
*CALL COMCOVL
*CALL COMCRDH
*CALL COMCRDW
*CALL COMCSFN
*CALL COMCSRT
*CALL COMCSYS
*CALL COMCWTC
*CALL COMCWTH
*CALL COMCWTW
BUFFERS SPACE 4,10
** BUFFERS.
USE BUFFERS
OUTPUTB BSS 0 OUTPUT WORKING BUFFER
DCB EQU OUTPUTB+1 DIRECTIVE COMMAND BUFFER
DSB EQU DCB+DCBL DIRECTIVE STRING BUFFER
WSA EQU DSB+10*DCBL+2 WORKING STORAGE (OLD)
WSAL EQU 4000B
WSB EQU WSA+WSAL+1 WORKING STORAGE (LGO/NEW)
WSBL EQU 4000B
INPB EQU WSB+WSBL INPUT BUFFER
OUTB EQU INPB+INPL OUTPUT BUFFER
TTYB EQU OUTB+OUTL
OLDB EQU TTYB+TTYL OLD BUFFER
NEWB EQU OLDB+OLDL NEW BUFFER
LGOB EQU NEWB+NEWL LGO BUFFER
SBUF EQU LGOB+LGOL SCRATCH BUFFER
BUF EQU SBUF+SBUFL START OF MANAGED TABLES
MFL= EQU 200000B+BUF+BUFL+5 MINIMUM FIELD LENGTH
PRS TITLE LIBEDIT - PRESET.
*** PRS - PRESET PROGRAM.
*
* ENTRY (A0) = FIELD LENGTH.
* (ARGR) = ARGUMENT LIST.
* (ACTR) = ARGUMENT COUNT.
*
* EXIT (FL) = A0.
* (DATE.) = CURRENT DATE.
* (TITC) = CURRENT TIME.
* (FLST) = UPDATED FILE LIST.
* (LL) = LINE LIMIT.
* (PD) = PRINT DENSITY.
* ALL COMMAND PARAMETERS PROCESSED.
PRS SUBR ENTRY/EXIT
DATE DATE. SET CURRENT DATE
SB5 6
SA3 DATE.
LX6 B5,X3
SA6 TITB
SA6 A3
CLOCK TITC GET CURRENT TIME
SA3 TITC
LX6 B5,X3
SA6 A3
MEMORY CM,FL,R SET AVAILABLE TABLE SPACE
SA1 FL
LX1 30
SX6 X1-BUF
SA6 L.BUF
* PROCESS COMMAND PARAMETERS.
SA1 ACTR ARGUMENT COUNT
SB5 ARGA ARGUMENT TABLE
SA4 ARGR FIRST ARGUMENT
SB4 X1+
RJ ARG PROCESS COMMAND PARAMETERS
SX7 =C* LIBEDIT ARGUMENT ERROR(S).*
NZ X1,PRS13 IF ERROR IN PARAMETERS
* SET FILE NAMES IN LIST AND FET-S.
SB5 B0+
SB6 FLSTL-2
PRS1 SA1 PAR+B5
ZR X1,PRS2 IF NOT SPECIFIED
BX6 X1
SA1 FLST+/FLST/INPUT+B5
RJ RFN REPLACE FILE NAME
PRS2 SB5 B5+B1
LT B5,B6,PRS1 IF NOT FINISHED
* CHECK FILE NAME CONFLICT.
SA1 FLST+/FLST/TTYOUT
MX0 42
BX3 X1*X0
ZR X3,PRS5 IF NO FILE NAME
SA2 A1+1
SX7 =C* FILE NAME CONFLICT.*
PRS3 ZR X2,PRS5 IF END OF LIST
BX4 X2*X0
ZR X4,PRS4 IF NO FILE NAME
BX5 X4-X3
ZR X5,PRS13 IF FILE NAME CONFLICT
PRS4 SA2 A2+B1 NEXT FILE NAME
EQ PRS3 LOOP FOR ALL FILES
PRS5 SA1 A1+1
NZ X1,PRS3 IF NOT YET END OF LIST
* PROCESS REQUIRED FILES.
SETLOF PRSB SET LIST OF FILES
SA1 FLST+/FLST/NEW
BX6 X0*X1
SX7 =C* NO NEW FILE.*
ZR X6,PRS13 IF NO NEW FILE
SA6 GULF SET INPUT FILE FOR *LIBGEN*
* DETERMINE ASSIGNMENT OF INPUT AND OUTPUT.
SX2 I CHECK FOR TERMINAL INPUT FILE
RJ STF
SA6 TTYI
NZ X6,PRS6 IF NOT TTY INPUT
RETURN TTYOUT,R ASSIGN *TTYOUT* TO TERMINAL
SA1 =2LTT
MX7 -12
SA2 TTYOUT+1
BX6 -X7*X2
BX6 X6+X1
SA6 A2+
REQUEST TTYOUT,U
WRITE TTYOUT,*
PRS6 SX2 O CHECK FOR TTY OUTPUT FILE
RJ STF
SA6 TTYO
* PROCESS *LO* AND SET LIST OPTIONS.
SA1 FLST+/FLST/OUTPUT
BX4 X0*X1
NZ X4,PRS7 IF LIST FILE DEFINED
BX7 X7-X7 CLEAR LIST OPTIONS
SA7 LIST
PRS7 NZ X6,PRS8 IF NOT TTY OUTPUT
* CHECK TERMINAL TABLE FOR *BRIEF* MODE.
TSTATUS PRSA
SA1 PRSA+1
SX6 40B
BX6 X6*X1
SA6 BRFM
* CHECK LIST OPTIONS.
PRS8 SA1 LIST
BX1 X0*X1
ZR X1,PRS9 IF NO LIST OPTIONS SPECIFIED
RJ ILO INTERPRET LIST OPTIONS
SX7 =C* LIST OPTION ERROR.*
NZ X1,PRS13 IF LIST OPTION ERROR
EQ PRS10 PROCESS *Z*
PRS9 SA1 TTYO
NZ X1,PRS10 IF NOT TTY OUTPUT
SX7 3 SET TTY *LO* DEFAULT OPTIONS
SA7 LIST
PRS10 SA1 CZOP
ZR X1,PRS11 IF *Z* PARAMETER NOT SELECTED
BX6 X1
SA6 TTYI
SX2 INPUT INPUT FILE FET
RJ ZAP *Z* ARGUMENT PROCESSOR
PRS11 SA1 LGO SET CORRECTION FILE NAME
MX0 42
BX6 X0*X1
SA6 LGO.
ZR X6,PRS12 IF NO CORRECTION FILE
ADDWRD FNT,A6
PRS12 OPEN NEW,WRITE,R INITIALIZE *NEW* FILE
WRITE OUTPUT,* PRESET *WRITE* FUNCTION IN FET
GETPP SBUF,LL,PD GET PAGE SIZE PARAMETERS
EQ PRSX RETURN
PRS13 MESSAGE X7,3 ISSUE ERROR MESSAGE
RJ ABT ABORT PROGRAM
PRSA BSS 2 *TLX* (TSTATUS) RESPONSE BLOCK
PRSB VFD 12/0,18/FLST,30/0 FILE LIST POINTER FOR *SETLOF*
* ARGUMENT TABLE.
ARGA BSS 0
I ARG FLST+/FLST/INPUT,PAR,400B
L ARG FLST+/FLST/OUTPUT,PAR+1,400B
P ARG FLST+/FLST/OLD,PAR+2,400B
N ARG FLST+/FLST/NEW,PAR+3,400B
B ARG FLST+/FLST/LGO,PAR+4,400B
LO ARG ARGB,LIST,400B
C ARG -*,CCPY RECOPY
D ARG -*,CDOP NO ABORT (DEBUG), EQUIVALENT TO *NA*
V ARG -*,CVFY VFYLIB
Z ARG -*,CZOP INPUT DIRECTIVES ON COMMAND
NA ARG -*,CDOP NO ABORT (DEBUG)
NI ARG -*,CADD NO INSERT AT EOF
NR ARG -*,CREW NO REWIND
U ARG LIBGA,CULB USER LIBRARY OPTION
NX ARG ARGC,GULJ,400B NO CROSSREF ULIB
CON 0
ARGB CON 1LF FULL LISTING
ARGC CON 1L1 NO CROSS REFERENCE ULIB
PAR BSSZ FLSTL-2 PARAMETER BUFFER
SPACE 4,10
** PRESET COMMON DECKS.
*CALL COMCARG
*CALL COMCSTF
*CALL COMCUSB
*CALL COMCWTS
*CALL COMCZAP
SPACE 4,10
END LIBEDIT
- LIST ONE LINE.