IDENT OPLEDIT,FETS,OPLEDIT
ABS
ENTRY OPLEDIT
ENTRY MFL=
SYSCOM B1
OPLEDIT TITLE OPLEDIT - OPL EDITING PROGRAM.
*COMMENT OPLEDIT - OPL EDITING PROGRAM.
COMMENT COPYRIGHT CONTROL DATA SYSTEMS INC. 1992.
SPACE 4
*** OPLEDIT - OPL EDITING PROGRAM.
* G. R. MANSFIELD. 69/06/29.
* A. D. FORET. 74/10/01.
OPLEDIT SPACE 4
*** OPLEDIT PROVIDES ADDITIONAL PL EDITING CAPABILITIES
* SUCH AS *PURGE* AND *PULLMOD*, TO COMPLEMENT THE *MODIFY*
* PROGRAM.
CARD SPACE 4,25
*** THE COMMAND.
*
* OPLEDIT(P1,P2,P3,,,PN)
*
* WHERE *PI* MAY BE ANY OF THE FOLLOWING -
*
* I DIRECTIVE INPUT FILE NAME, DEFAULT IS *INPUT*.
*
* P OLD PROGRAM LIBRARY FILE NAME, DEFAULT IS *OPL*.
*
* N NEW PROGRAM LIBRARY FILE NAME, DEFAULT IS *NPL*.
*
* L OUTPUT FILE NAME, DEFAULT IS *OUTPUT*.
*
* M FILE TO RECEIVE MODSETS, DEFAULT IS *MODSETS*.
*
* LO LIST OPTIONS. DEFAULT IS *E* IF LIST OUTPUT FILE IS
* ASSIGNED TO AN INTERACTIVE TERMINAL, OTHERWISE
* DEFAULT IS *ECMDS*.
*
* OPTION DESCRIPTION
*
* E ERRORS.
* C INPUT DIRECTIVES.
* M MODIFICATIONS MADE.
* D DECK STATUS.
* S DIRECTORY LISTS.
*
* F MODIFY ALL DECKS, DEFAULT IS NOT SELECTED.
*
* D IGNORE ERRORS, DEFAULT NOT SET.
*
* Z PROCESS DIRECTIVES FROM COMMAND.
* FORMAT IS- OPLEDIT(Z)SDDDSDDDSDDD
* WHERE *S* IS ANY SEPARATOR AND *D* IS ANY
* VALID DIRECTIVE.
*
* U DETERMINES WHAT *EDIT DIRECTIVES ARE GENERATED
* ON *MODSETS*.
* U OMITTED = *EDIT DIRECTIVES ARE GENERATED
* FOR COMMON DECKS.
* U SPECIFIED = *EDIT DIRECTIVES ARE GENERATED
* FOR ALL DECKS.
* U=0 = NO *EDIT-S ARE GENERATED.
DAYFILE SPACE 4,20
*** DAYFILE MESSAGES.
*
* * CSET - UNKNOWN CHARACTER SET.* - THE CHARACTER SET
* ON THE *CSET* DIRECTIVE IS UNKNOWN.
*
* * ERROR IN ARGUMENTS.* - AN INCORRECT ARGUMENT WAS
* ENCOUNTERED. THIS IS A FATAL ERROR.
*
* * DIRECTIVE ERRORS.* - AN INCORRECT DIRECTIVE
* WAS ENCOUNTERED.
*
* * MEMORY OVERFLOW.* - NOT ENOUGH STORAGE WAS
* ALLOWED FOR THE OPLEDIT RUN. THIS IS A FATAL ERROR.
*
* * PL ERROR IN DECK DNAME* - ERROR ENCOUNTERED IN
* PROCESSING DECK *DNAME*. THIS IS A FATAL ERROR.
*
* * ERROR IN DIRECTORY.* - PROGRAM LIBRARY DOES NOT
* HAVE OR HAS AN INCORRECTLY FORMATTED
* DIRECTORY RECORD. THIS IS A FATAL ERROR.
*
* * PROGRAM LIBRARY EMPTY.* - THE OLD PROGRAM LIBRARY
* CONTAINED NO DATA. THIS IS A FATAL ERROR.
*
* * NO DIRECTIVES.* - DIRECTIVE FILE WAS EMPTY. THIS IS
* A FATAL ERROR.
*
* * OPLEDIT ERRORS.* - ERRORS ENCOUNTERED DURING
* THE OPLEDIT RUN.
*
* * OPLEDIT COMPLETE.* - NORMAL OPLEDIT COMPLETION
* MESSAGE.
*
* * FILE NAME CONFLICT.* - TWO FILES HAVE THE SAME NAME.
* THIS IS A FATAL ERROR.
*
* * DECKNAM - INCORRECT CS, 63 ASSUMED.* - DECK *DECKNAM*
* HAD AN INCORRECT CHARACTER SET DESIGNATION. OPLEDIT
* ASSUMES IT TO BE A 63 CHARACTER SET RECORD AND
* MAKES IT SUCH ON A NEW PROGRAM LIBRARY IF ONE
* IS BEING GENERATED.
*
* * MIXED CHARACTER SET OPL.* - RECORDS OF BOTH 63 AND
* 64 CHARACTER SET WERE FOUND ON THE PROGRAM
* LIBRARY. THIS IS A FATAL ERROR.
TITLE ASSEMBLY CONSTANTS AND MACRO DEFINITIONS.
ASSEMBLY SPACE 4,10
**** ASSEMBLY CONSTANTS.
OBUFL EQU 1001B LENGTH OF O-BUFFER (OUTPUT)
SBUFL EQU 1001B LENGTH OF S-BUFFER (SOURCE)
MBUFL EQU 1001B LENGTH OF M-BUFFER (MODSETS)
PBUFL EQU 2001B LENGTH OF P-BUFFER (OPL)
NBUFL EQU 2001B LENGTH OF N-BUFFER (NPL)
MTBSL EQU 10000B NOMINAL TABLE LENGTH
MXCCL EQU 37B MAXIMUM LENGTH OF COMPRESSED LINE IMAGE
LIST EQU 153B DEFAULT LIST OPTIONS (ALL OPTIONS SET)
****
COMMON SPACE 4,10
* COMMON DECKS.
*CALL COMCMAC
*CALL COMCCMD
*CALL COMSSRT
MACROS SPACE 4,10
* MACRO DEFINITIONS.
READK SPACE 4,15
** READK - READ CODED LINE TO CHARACTER BUFFER.
*
* READK FILE,BUF,N
*
* WORDS ARE UNPACKED AND STORED IN THE WORKING BUFFER 1 6/12
* CHARACTER/WORD UNTIL THE END OF LINE (0000) BYTE IS SENSED.
* CHARACTERS STORED ARE OF THE TYPE 6 BIT DISPLAY OR 6/12 BIT
* DISPLAY BASED ASCII.
* IF THE CODED LINE TERMINATES BEFORE *N* CHARACTERS ARE
* STORED, THE WORKING BUFFER IS FILLED WITH SPACE CODES.
*
* CALLS SSR.
PURGMAC READK
READK MACRO F,S,N
MACREF READK
R= B6,S
R= B7,N
R= X2,F
RJ =XSSR
ENDM
WRITEK SPACE 4,10
** WRITEK - WRITE CODED LINE FROM CHARACTER BUFFER.
*
* WRITEK FILE,BUF,N
*
* CHARACTERS ARE PACKED FROM THE WORKING BUFFER.
* TRAILING CODES ARE DELETED BEFORE CHARACTERS ARE PACKED.
*
* CALLS SSW.
PURGMAC WRITEK
WRITEK MACRO F,S,N
MACREF WRITEK
R= B6,S
R= B7,N
R= X2,F
RJ =XSSW
ENDM
ADDWRD SPACE 4
** ADDWRD - ADD A WORD TO A TABLE.
*
* ADDWRD TNAM,WORD
*
* TNAM TABLE NAME.
* WORD WORD TO ADD.
*
* CALLS ADW.
ADDWRD MACRO TNAM,WORD
IFC NE,$X1$WORD$,1
BX1 WORD
R= A0,TNAM
RJ ADW
ENDM
CARD SPACE 4,10
** CARD - GENERATE LIST AND CALL FOR DIRECTIVE TRANSLATION.
*
* CARD NAME,ADDR
*
* NAME DIRECTIVE NAME.
* ADDR ADDRESS TO BEGIN EXECUTION.
* IF *ADDR* IS NOT SPECIFIED, BEGIN EXECUTION AT *NAME*.
*
* CALLS CKC.
NOREF .X
CARD MACRO NAM,ADR
LOCAL A,B,C
IF DEF,.X,1
.1 IFNE .X,*
RMT
DATA 0
A BSS 0
RMT
SA0 A
RJ CKC
B BSS 0
.X SET B
.1 ENDIF
RMT
C SET ADR NAM
VFD 42/0L_NAM,18/C
RMT
ENDM
ALLOC SPACE 4,10
** ALLOC - ALLOCATE SPACE TO TABLE.
*
* ALLOC TNAM,WORDS
*
* TNAM TABLE NAME.
* WORDS NUMBER OF WORDS TO ALLOCATE.
*
* CALLS ATS.
ALLOC MACRO TNAM,N
R= X1,N
R= A0,TNAM
RJ ATS
ENDM
LISTOP SPACE 4,15
** LISTOP - CHECK LIST OPTION.
*
* LISTOP TYPE,ADDR,INS,REG
*
* ENTRY TYPE - OPTION LETTER.
* ADDR - ADDRESS TO JUMP TO.
* INS - ALTERNATE INSTRUCTION TO EXECUTE, DEFAULT IS
* *PL*.
* REG - ALTERNATE REGISTER TO USE, DEFAULT IS *X1*.
*
* EXIT CONTROL IS TRANSFERRED TO SPECIFIED ADDRESS IF THE
* SPECIFIED OPTION LETTER WAS SELECTED ON THE CONTROL
* COMMAND.
PURGMAC LISTOP
LISTOP MACRO T,A,I,R
.INS MICRO 1,2,*I_PL*
.REG MICRO 1,1,*R_1*
SA".REG" LO
LX".REG" 59-LO.T
".INS" X".REG",A
LISTOP ENDM
OPTION SPACE 4,15
** OPTION - DEFINE BIT VALUE OF OPTION.
*
* OPTION TYPE
*
* ENTRY TYPE - OPTION LETTER.
*
* EXIT THE SYMBOL LO.X IS GENERATED, WHERE X IS THE OPTION
* BIT CORRESPONDING TO THE LETTER *X*.
.OPT SET 0
NOREF .OPT
PURGMAC OPTION
OPTION MACRO T
LO.T EQU .OPT
.OPT SET .OPT+1
OPTION RMT
CON 0R_T
OPTION RMT
LO.T DECMIC LO.T
OPTION ENDM
PRINT SPACE 4,10
** PRINT - PRINT LINE.
*
* PRINT FWA,N
*
* FWA LINE FWA.
* N IF *FWA* .GE. 0, N IS IGNORED. IF *FWA* .LT. 0, N IS
* THE CHARACTER COUNT. IF N IS OMITTED, *B0* IS USED.
*
* CALLS WOF.
PRINT MACRO FWA,N
SX1 FWA
R= X2,N
RJ WOF
ENDM
SEARCH SPACE 4,10
** SEARCH - SEARCH TABLE.
*
* SEARCH TNAM,WORD,BITS
*
* TNAM TABLE NAME TO BE SEARCHED.
* WORD WORD TO FIND.
* BITS ADDITIONAL BITS (0-16) TO COMPARE ON.
*
* CALLS STB.
SEARCH MACRO TNAM,ENTRY,BITS
R= A0,TNAM
IFC NE,$X6$ENTRY$,1
BX6 ENTRY
MX1 42
IFC NE,*BITS**,2
R= X2,BITS
BX1 X1+X2
RJ STB
ENDM
TABLE SPACE 4,10
** TABLE - GENERATE MANAGED TABLE.
*
* TNAM TABLE N
*
* TNAM NAME OF TABLE TO BE GENERATED.
* N NUMBER OF WORDS TO BE ALLOCATED WHEN TABLE IS FULL.
*
* GENERATES TABLE POINTERS FOR TABLE *TNAM*.
* *F.TNAM* NAME OF A WORD CONTAINING TABLE FWA.
* *L.TNAM* NAME OF A WORD CONTAINING TABLE LENGTH.
MACRO TABLE,TNAM,N
TNAM EQU *
VFD 60/MTBS
F.TNAM EQU FTAB+TNAM
RMT
L.TNAM EQU LTAB+TNAM
ORG L.TNAM
DATA 0
ORG NTAB+TNAM
VFD 60/N
RMT
ENDM
TITLE FETS AND TEMPORARY STORAGE.
FETS SPACE 4
** FETS.
ORG 110B
FETS BSS 0
I BSS 0 DIRECTIVES FILE FET
INPUT FILEC SBUF,SBUFL,FET=8
O BSS 0 OUTPUT FILE FET
OUTPUT FILEC OBUF,OBUFL,FET=8
M BSS 0 MODSET OUTPUT FILE FET
MODSETS FILEC MBUF,MBUFL,FET=8
ORG M+7
CON 0LMODSETS+1
N BSS 0 NEW PROGRAM LIBRARY FET
NPL RFILEB NBUF,NBUFL,FET=8
ORG N
CON 0
ORG N+8
P BSS 0 OLD PROGRAM LIBRARY FET
OPL RFILEB PBUF,PBUFL,FET=8
ORG P+7
CON 0LOPL+3
FETSL BSS 0
TITLE MANAGED TABLES.
** MANAGED TABLES ARE REFERENCED BY THE TABLE NUMBER *TNAM*.
* THE FWA OF A TABLE IS CONTAINED IN *F.TNAM*.
* THE LENGTH OF A TABLE IS CONTAINED IN *L.TNAM*.
* THESE SYMBOLS ARE GENERATED BY THE *TABLE* MACRO.
FTAB BSS 0
LOC 0
SPACE 4
** TDKN - TABLE OF DECK NAMES.
* ENTRY = 2 WORDS.
*
* WORD 1 -
* BITS 18 - 59 = DECK NAME LEFT JUSTIFIED
*
* WORD 2 -
* BITS 00 - 35 = RANDOM ADDRESS ON PROGRAM LIBRARY
TDKN TABLE 10 DECK NAMES
SPACE 4
** TPRG - TABLE OF MODIFIERS TO BE PURGED.
* ENTRY = 1 WORD.
TPRG TABLE 10 MODIFIERS TO BE PURGED
TDKI SPACE 4
** TDKI - TABLE OF DECK IDENTIFIERS.
* ENTRY = 1 WORD.
* BITS 18 - 59 = IDENTIFIER LEFT JUSTIFIED
* BIT 16 = YANK FLAG
* BITS 00 - 15 = MODIFIER EQUIVALENCE
TDKI TABLE 10 DECK IDENTIFIERS
SPACE 4
** TEDT - TABLE OF DECKS FOR WHICH EDITING IS REQUESTED.
* ENTRY = 1 WORD.
* BITS 18 - 59 = DECK NAME LEFT JUSTIFIED
* BITS 00 - 17 = ADDRESS OF DECK IN DECK NAME TABLE.
TEDT TABLE 10 DECKS REQUESTED FOR EDITING
TPAT SPACE 4,13
** TPAT - TABLE OF PULLALL IDENTS.
* ENTRY = 1 WORD.
* BITS 18 - 59 = IDENTIFIER LEFT JUSTIFIED.
TPAT TABLE 10 PULLALL IDENTIFIERS
SPACE 4
** TPMI - TABLE OF PULLMOD IDENTS.
TPMI TABLE 10
SPACE 4
** TNDK - TABLE OF NEW DECKS.
* SAME FORMAT AS *TDKN*.
TNDK TABLE 10 NEW DECK NAMES
TCED SPACE 4,10
** TCED - TABLE OF CHARACTER SETS OF EDITED DECKS.
* ENTRY = 1 WORD.
* BITS 18 - 59 = DECK NAME LEFT JUSTIFIED.
* BITS 00 - 17 = CHARACTER SET OF DECK.
* 1 = ASCII 0 = DISPLAY.
TCED TABLE 10 CHARACTER SETS OF EDITED DECKS
SPACE 4
* REMAINDER OF MANAGED TABLE VALUES.
FTABL BSS 0
LOC *O
VFD 60/MTBS LWA+1 ALL TABLES
LTAB BSS 0
NTAB EQU LTAB+FTABL
HERE
OPTION SPACE 4,10
** OPTION - LIST OPTION TABLE.
OPTION E ERRORS
OPTION C OTHER INPUT DIRECTIVES
OPTION M MODIFICATIONS
OPTION D DECK STATUS
OPTION S DIRECTORY LISTS
TITLE STORAGE ASSIGNMENTS.
* COMMON DATA.
T1 DATA 0 TEMPORARY STORAGE
T2 DATA 0
FL DATA 0 FIELD LENGTH
CH DATA 0 CHARACTER POINTER
PL DATA 0LOPL PROGRAM LIBRARY NAME
SPACE 4
* MODIFICATION CONTROLS.
ACTIVE DATA 0 DIRECTIVE IN PROGRESS FLAG
DF DATA 0 DELETE IN PROGRESS FLAG
DL DATA 0 *DIRECTIVE LAST* FLAG
IF DATA 0 INSERT IN PROGRESS FLAG
RF DATA 0 RESTORE IN PROGRESS FLAG
II DATA -0 IDENT INDEX
IN DATA 0 IDENT NAME
IP DATA 0 IDENT PRESENT FLAG
PA DATA 0 *PULL ALL* FLAG
DATA 0 *PULLALL,IDENT* IDENT FLAG
PI DATA 0 *PULLMOD* INDEX
EI DATA 0 EDIT TABLE INDEX
MD DATA 0 MODIFICATION FLAG
DN DATA 0 CURRENT DECK NAME
DA DATA 0 CURRENT DECK ADDRESS
EC DATA 0 DECK ERROR COUNTER
CC DATA 0 INACTIVE CARD COUNTER
DATA 0 ACTIVE CARD COUNTER
DATA 0 INSERTED CARD COUNTER
SPACE 4
* LIST CONTROLS.
LC CON 99999,0 LINE COUNT
LL EQU LC+1 LINE LIMIT
LO CON 0 LIST OPTION
PN DATA 1 PAGE NUMBER
TL CON CCDR ADDRESS OF TITLE TEXT
TO DATA 0 TERMINAL OUTPUT FORMAT FLAG
TCST SPACE 4,10
** TCST - TABLE OF SYMBOLIC NAMES OF CHARACTER SETS.
*
*T TCST 42/ CS NAME,18/ CS ORDINAL
*
TCST BSS 0
CON 0LDISPLAY+.DIS DISPLAY
CON 0LASCII+.AS612 ASCII (6/12)
CON 0 MAXIMUM CHARACTER SETS
CSD SPACE 4,20
* CHARACTER SET DEFINITIONS.
.DIS EQU 0 DISPLAY CODE 63/64
.AS612 EQU 1 DISPLAY CODE BASED 6/12 ASCII (63/64)
SPACE 4
* FLAGS.
CSM DATA -1 OPL CHARACTER SET FLAG
CSC CON .DIS OPL 6 OR 6/12 CHARACTER SET FLAG
EF DATA 0 ERROR (TOTAL ERRORS DURING MODIFICATION)
CD DATA 0 COMMON DECK
IGNORE DATA 0 SET ON MULTIPLE MODSET PULLMODS
LF CON 0 SET IF DATA TRANSMITTED TO LIST FILE
SETC CON -1 0 = CSET DISPLAY 1 = CSET ASCII
* FLAGS SET BY COMMAND PARAMETERS.
CL DATA 0 CARD LISTED
DB DATA 0 DEBUG
FM DATA 0 -F- MODE
UM DATA -1 -1=COMMON, +1=ALL, 0=NO *EDIT-S
** MODIFY DIRECTIVE TEMPLATES.
DCKD DATA 17C*DECK DNAME
DELD DATA 03L*D,
EDTD DATA 17C*EDIT DNAME
IDND DATA 17C*IDENT MNAME
INSD DATA 03L*I,
RESD DATA 09L*RESTORE,
** TABLE OF DIRECTIVE TEMPLATE ADDRESSES.
TDTA CON DCKD *DECK
CON DELD *D
CON EDTD *EDIT
CON IDND *IDENT
CON INSD *I
CON RESD *RESTORE
CON 0
SPACE 4,10
** BLOCK STORAGE.
USE BUFFERS
* TITLE LINE.
TITL DATA 20H OPLEDIT - VER 1.2
DATE DATA 1H
TIME DATA 1H
DATA 4APAGE
PAGE DATA 1H
TITLL EQU *-TITL
* TERMINAL TITLE LINE.
TERL DATA 50H OPLEDIT - VER 1.2
TERDT CON 1H
TERTM CON 1H
TERLL EQU *-TERL
* SUBTITLE LINE
SBTL DATA 30H
DATA 0
DATA 2L
SBTLL EQU *-SBTL
* IDENT TABLE.
TIDT VFD 12/7700B,12/TIDTL-1,36/0
BSS 16B
TIDTL EQU *-TIDT
* PROGRAM LIBRARY CARD PROCESSING BUFFERS.
* THE ORDER OF THE FOLLOWING MUST BE MAINTAINED.
CDAC DATA 1S59 CARD ACTIVITY
CDWC DATA 0 WORD COUNT OF COMPRESSED CARD
CDID DATA 1 CARD ID
CDTX BSS MXCCL TEXT OF COMPRESSED LINE
NMHB DATA 1 NUMBER OF MODIFICATION HISTORY BYTES
TMHB DATA 1S16 MODIFICATION HISTORY BYTE TABLE
BSS 199
USE *
OPLEDIT TITLE OPLEDIT - MAIN PROGRAM.
** OPLEDIT - MAIN PROGRAM.
OPLEDIT SB1 1 (B1) = 1
RJ PRS PRESET PROGRAM
RJ PDC PROCESS DIRECTIVE CARDS
SX6 B1 SET WORDS/ENTRY
SA6 LTBA
RJ BNI BEGIN FIRST IDENT
EQ OPL3 BEGIN FIRST DECK
* PROCESS MODIFICATIONS.
OPL1 MX6 0 CLEAR CARD LIST
SX7 B0 CLEAR CARD ACTIVITY
SA6 CL
SA7 CDAC
RJ RPF READ CARD FROM PROGRAM LIBRARY
NZ X1,OPL2 IF EOR
RJ PPM
RJ SCS SET CARD STATUS
SA1 NMHB
ZR X1,OPL1 IF CARD REMOVED
RJ WNF WRITE NEW PROGRAM LIBRARY
EQ OPL1 LOOP
* COMPLETE PROCESSING.
OPL2 RJ CDK COMPLETE DECK
OPL3 RJ BDK BEGIN NEXT DECK
NZ X7,OPL1 IF DECK TO BE PROCESSED
RJ WDR WRITE DIRECTORY
RJ LST LIST STATISTICS
SA1 EF
SA2 DB
ZR X1,OPL4 IF NO ERRORS
NZ X2,OPL4 IF DEBUG SET
SA0 =C* OPLEDIT ERRORS.*
EQ ABT
OPL4 RJ CMF COMPLETE FILES
MESSAGE (=C* OPLEDIT COMPLETE.*)
ENDRUN
BDK SPACE 4,20
** BDK - BEGIN DECK.
*
* EXIT (X7) - .NE. 0 IF DECK READY FOR PROCESSING.
*
* USES ALL.
*
* CALLS CDC, LDS, RMT, SFI, SFN, WMT.
BDK PS 0 ENTRY/EXIT
BDK0 RJ CDC COMPLETE DIRECTIVE CARD
SX6 B0
SA6 DL CLEAR DL
RECALL P
SA1 P+1
SX6 X1 *REWIND* OPL FET
SA6 A1+B1
SA6 A6+B1
SA1 EI CHECK EDIT TABLE
SA2 L.TEDT
IX7 X2-X1
SX6 X1+B1 ADVANCE EDIT INDEX
ZR X7,BDK1 IF END OF TABLE
SA3 F.TEDT LOOK UP EDIT TABLE ENTRY
SB2 X1
SA2 X3+B2
SA6 A1
MX0 42 MASK DECK NAME
BX6 X0*X2
SX7 X2 SET DECK ADDRESS
SA6 DN SET DECK NAME
SA6 ID1 SET TO DECK.0
SA6 ID3 SET LAST ORIGINAL CARD ID
SA6 EDTD+1 IN EDIT MESSAGE
SA7 DA
BX1 X6
RJ SFN SPACE FILL NAME
SA6 SBTL+2
SA6 BDKA+1 ENTER NAME IN MESSAGE
MX7 0 CLEAR DECK IDENTIFIER TABLE LENGTH
SA7 L.TDKI
RJ RMT READ MODIFIER TABLE
RJ SFI SEARCH FOR IDENT IN THIS DECK
SA1 PA+1
NZ X1,BDK0.0 IF *PULLMOD,IDENT*
SA1 A1-B1
NZ X1,BDK0.1 IF *SUMMARY MODE*
BDK0.0 SA1 IP
NZ X1,BDK0.1 IF FOUND
SA1 IGNORE
NZ X1,BDK0 IF NOT *NORMAL* MODE
BDK0.1 MESSAGE BDKA,1
RJ LDS LIST DECK STATUS
RJ WMT WRITE MODIFIER TABLE
SX6 B0 CLEAR CARD COUNTS
SX7 B1
SA6 CC
SA6 A6+B1
SA6 A6+B1
SA6 MD CLEAR MODIFICATION FLAG
EQ BDK
BDK1 SA1 PA
MX7 0
SA7 A1 CLEAR PA
SA7 A1+B1
ZR X1,BDK2 IF NOT PULL ALL MOD
WRITER M,R
BDK2 RJ BNI BEGIN NEXT IDENT
ZR X7,BDK IF EXHAUSTED
SX6 B1
SA6 IGNORE SET *MODSETS ONLY* MODE
MX6 0
SA6 EI RESET EDIT INDEX
EQ BDK0 PROCESS FIRST DECK AGAIN
BDKA DATA 10H EDITING
DATA 0
DATA 10H PULLING
BDKB DATA 10C * NONE *
BNI SPACE 4,20
** BNI - BEGIN NEXT IDENT.
*
* USES X - 1, 2, 3, 4, 6, 7.
* A - 1, 2, 3, 4, 6, 7.
* B - ALL.
*
* CALLS WTW=.
BNI PS 0
SA1 PA
NZ X1,BNI2 IF *SUMMARY* MODE
SA1 PI
SA2 L.TPMI
IX7 X2-X1
SX6 X1+B1
ZR X7,BNI IF NO NEXT IDENT
SA3 F.TPMI
SB2 X1
SA2 X3+B2 LOOK UP ENTRY
SA6 A1
MX0 42
BX6 X0*X2
SA6 IN STORE IDENT NAME
SA6 IDND+1 STORE IN IDENT HEADER LINE
SA6 BDKB ENTER INTO MESSAGE
SA1 PI EOR IF NOT NEW
SX1 X1-1
ZR X1,BNI1 IF FILE NEVER WRITTEN
WRITER M,R
BNI1 WRITEW M,IDND+1,1 WRITE HEADER
WRITEW M,IDND,2
SX7 B1
EQ BNI EXIT
BNI2 SA1 =C+*******+ SET PSEUDO-IDENT FOR SUMMARY
BX6 X1
SA6 IDND+1
SA6 BDKB INTO MESSAGE
MX7 0
SA7 II
EQ BNI1 TO FINISH
CDK SPACE 4,20
** CDK - COMPLETE DECK.
*
* ISSUE ERROR MESSAGE IF APPROPRIATE, COMPLETE DECK
* ON NEW PROGRAM LIBRARY IF SELECTED AND RESET
* MISCELLANEOUS FLAGS.
*
* USES X - 1, 2, 6, 7.
* A - 1, 2, 6, 7.
* B - 7.
*
* CALLS CDD.
*
* MACROS LISTOP, MESSAGE, PRINT, WRITER, WRITEW.
CDK SUBR ENTRY/EXIT
SA1 IP
ZR X1,CDK.2 IF IDENT NOT IN DECK
SA1 UM
ZR X1,CDK.2 IF *NONE* SELECTED
PL X1,CDK.1 IF *ALL* SELECTED
SA1 CD
ZR X1,CDK.2 IF *COMMON* SELECTED BUT NOT COMMON
CDK.1 WRITEW M,EDTD,2
CDK.2 SA2 IGNORE
NZ X2,CDKX IF *MODSETS ONLY* MODE
SA2 EF PROPAGATE ERRORS
SA1 EC
MX7 0 CLEAR ERROR COUNT
IX6 X2+X1
SA7 A1
SA6 A2
ZR X1,CDK3 IF NO ERRORS
SA2 SBTL+2
SB7 X1
BX6 X2
SA2 =10H ERRORS IN
NE B7,B1,CDK2 IF MORE THAN 1
SA2 =10H ERROR IN
LX6 6 SHIFT NAME
CDK2 BX7 X2
LX6 60-6
SA7 CDKA+1
SA6 A7+B1
SX1 B7 CONVERT COUNT
RJ CDD
SA6 A7-B1
MESSAGE A6,3,R
CDK3 WRITER N
LISTOP D,CDKX,,2 IF NO LIST FOR DECK STATUS - RETURN
PRINT (=C* *)
SA1 CC CONVERT INACTIVE CARD COUNT
RJ CDD
SA6 CDKC
SA1 A1+B1 CONVERT ACTIVE CARD COUNT
RJ CDD
SA6 CDKB+1
SA1 A1+B1 CONVERT INSERTED CARD COUNT
RJ CDD
SA6 CDKD
PRINT CDKB
SA1 MD
ZR X1,CDKX IF NO MODIFICATIONS - RETURN
SX6 99999 FORCE PAGE EJECT
SA6 LC
EQ CDKX RETURN
CDKA DATA 10H
DATA 10HERRORS IN
DATA 10H
DATA 0
CDKB DATA 10H
DATA 10H
DATA 20H ACTIVE CARD(S).
CDKC DATA 10H
DATA 20H INACTIVE CARD(S).
CDKD DATA 10H
DATA 20H INSERTED CARD(S).
DATA 0
SCS SPACE 4,20
** SCS - SET CARD STATUS.
*
* SET CARD ACTIVITY ACCORDING TO LAST MHB AND YANK
* STATUS. LIST MODIFICATION TO CARD.
*
* USES X - ALL.
* A - 1, 2, 3, 6, 7.
* B - 2, 3, 4.
*
* CALLS ECD, LCS.
*
* MACROS LISTOP.
SCS SUBR ENTRY/EXIT
SA1 IGNORE
NZ X1,SCSX IF *MODSETS ONLY* MODE
SA1 NMHB (B2) = MHB COUNT
SA2 F.TDKI (B3) = FWA DECK IDENTIFIER TABLE
MX0 60-16 MHB INDEX MASK
SB2 X1
SB3 X2
MX7 0 CLEAR STATUS
SB4 B0 CLEAR NEW MHB COUNT
SA2 A1+B1 FIRST MHB
BX3 -X0*X2
ZR X3,SCS1 IF ORIGINAL CARD
SA2 CC+2 ADVANCE INSERTED CARD COUNT
SX6 X2+B1
SA6 A2
SCS1 SA1 A1+B1 NEXT MHB
BX3 -X0*X1 SET MODIFIER INDEX
SB2 B2-B1 COUNT MHB
SA2 X3+B3
BX1 X1*X0
BX6 -X0*X2
BX6 X6+X1 STORE MHB
LX2 59-16 CHECK YANK
SA6 TMHB+B4
LX5 X2,B1 CHECK PURGE
NG X5,SCS2 IF PURGED
SB4 B4+B1 COUNT NEW MHB
NG X2,SCS2 IF YANKED
BX7 X1 STATUS = MHB STATUS
SCS2 NZ B2,SCS1 IF NOT END OF MHB-S
SX6 B4 SET NEW MHB COUNT
SA6 NMHB
SA3 CDAC COMPARE STATUS
LX7 59-16
BX6 X7-X3
SA7 A3 SET NEW STATUS
SX1 B1
LX7 1
BX2 X1*X7
SA3 CC+X2 COUNT CARD
SX7 X3+B1
SA7 A3
PL X6,SCSX IF UNCHANGED - RETURN
LISTOP M,SCSX IF NO LIST FOR MODIFICATIONS - RETURN
RJ ECD EXPAND CARD
SA3 CDAC CHECK STATUS
SX6 1RA
SX7 1R
NG X3,SCS3 IF ACTIVE
SX6 1R
SX7 1RD
SCS3 SA6 CHSP+5
SA7 A6+B1
RJ LCS LIST CARD STATUS
EQ SCSX RETURN
TITLE SUBROUTINES.
ABT SPACE 4,10
** ABT - ABORT OPLEDIT.
*
* ENTRY (A0) - ADDRESS OF MESSAGE.
*
* CALLS CMF.
ABT RJ CMF COMPLETE FILES
ABT1 MESSAGE A0
ABORT
ADW SPACE 4,20
** ADW - ADD ENTRY TO A TABLE.
*
* ENTRY (A0) - TABLE POINTER ADDRESS.
* (X1) - ENTRY.
*
* EXIT (X6) - ENTRY.
* (A6) - ADDRESS OF ENTRY.
* (X3) - INDEX OF ENTRY.
*
* USES X - 1, 2, 3, 4, 6, 7.
* A - 1, 2, 3, 4, 6, 7.
* B - 2.
*
* CALLS ATS.
ADW1 BX6 X1 ENTER WORD
SX7 X3+B1 ADVANCE LENGTH
SA6 X2+B2
SA7 A3
ADW PS 0 ENTRY/EXIT
SA2 FTAB+A0 CHECK TABLE ROOM
SA3 LTAB+A0
SA4 A2+B1
IX6 X2+X3
SB2 X3
IX7 X4-X6
NZ X7,ADW1 IF ROOM FOR WORD
SA2 NTAB+A0 ALLOCATE TABLE
BX6 X1 SAVE WORD
SA6 ADWA
ALLOC A0,X2
SA4 NTAB+A0 RESET LAST LENGTH
SA1 ADWA RESTORE WORD
IX3 X3-X4
SB2 X3
EQ ADW1 ENTER WORD
ADWA CON 0
ASN SPACE 4,20
** ASN - ASSEMBLE NAME.
*
* ASSEMBLE UP TO 7 CHARACTER NAME TO A SEPARATOR.
* THE CHARACTER STRING BUFFER CAN CONTAIN EITHER
* 6 OR 6/12 CHARACTERS.
*
*
* ENTRY (CHAR) - CHARACTER STRING BUFFER.
* (CH) - CHARACTER POINTER.
*
* EXIT (X6) - NAME LEFT JUSTIFIED ZERO FILL.
* (X6) = 0 IF SEPARATOR FOUND, OR MORE THAN
* 7 CHARACTERS ASSEMBLED.
*
* USES X - 1, 2, 6, 7.
* A - 1, 2, 7.
* B - 2.
*
ASN3 LX6 6
BX2 X1*X6
ZR X2,ASN3 IF NAME NOT LEFT JUSTIFIED
SA7 A1 UPDATE CHARACTER POINTER
MX1 42
BX7 -X1*X6
ZR X7,ASN IF @ 7 CHARACTERS
SX6 B0 RETURN WITH BLANK NAME
ASN PS 0 ENTRY/EXIT
SA1 CH CHECK FIRST CHARACTER
MX7 -6
SA2 X1
MX6 0 CLEAR ASSEMBLY
BX2 -X7*X2 USE LOWER 6 BIT ONLY
SB2 X2-1R
ZR X2,ASN IF SEPARATOR
NG B2,ASN1 IF NOT SEPARATOR
* CHECK POSSIBLE 6/12 ESCAPE CODE.
SB2 X2-76B
NZ B2,ASN IF SEPARATOR
SA2 A2+B1 LOWER PORTION OF 6/12 CHARACTER
BX2 -X7*X2
SB2 X2-1RZ-1
ZR X2,ASN IF SEPARATOR
PL B2,ASN IF SEPARATOR
ASN1 LX6 6 SHIFT ASSEMBLY
BX6 X6+X2 MERGE NEW CHARACTER
SA2 A2+B1 NEXT CHARACTER
BX2 -X7*X2
SB2 X2-1R
NG B2,ASN1 IF NOT SEPARATOR
* CHECK POSSIBLE 6/12 ESCAPE CODE.
SB2 X2-76B
NZ B2,ASN2 IF NOT ESCAPE CODE, THEN SEPARATOR
SA2 A2+B1 LOWER PORTION OF 6/12 CHARACTER
BX2 -X7*X2
SB2 X2-1RZ-1
ZR X2,ASN2 IF SEPARATOR
NG B2,ASN1 IF NOT SEPARATOR
ASN2 MX1 6
SX7 A2
EQ ASN3 LEFT JUSTIFY NAME
ATS SPACE 4,20
** ATS - ALLOCATE TABLE SPACE.
*
* ENTRY (A0) - TABLE NUMBER.
*
* EXIT (X2) - TABLE FWA.
* (X3) - TABLE LANGTH.
*
* USES X - 1, 2, 3, 4, 6, 7.
* A - 0, 1, 2, 3, 4, 6, 7.
* B - ALL.
*
* CALLS ABT, WTW=.
ATSX SA2 FTAB+A0 SET RESPONSE
SA3 LTAB+A0
ATS PS 0 ENTRY/EXIT
SA2 FTAB+A0 CHECK TABLE SPACE
SA3 LTAB+A0
IX7 X3+X1 ADVANCE LENGTH
SA4 A2+B1
IX6 X2+X7
SA7 A3
IX4 X4-X6
NG X4,ATS1 IF NO ROOM FOR CHANGE
BX3 X7
EQ ATS RETURN
* CHECK AVAILABLE STORAGE.
ATS1 SA2 FTAB+FTABL CHECK STORAGE
SA3 FL
IX6 X2+X1
IX7 X3-X6
NG X7,ATS4 IF NO ROOM FOR INCREASE
SA6 A2 UPDATE LWA+1 OF ALL TABLES
SB2 A0+B1
SB3 FTABL
BX4 X2
EQ B2,B3,ATSX RETURN IF LAST TABLE
* MOVE HIGHER TABLE UP.
ATS2 SA2 A2-B1 ADVANCE FWA OF HIGHER TABLES
IX6 X2+X1
SA6 A2
SB2 B2+B1
NE B2,B3,ATS2
IX3 X4-X2 (B2) = WORD COUNT
SB3 X1 (B3) = MOVE INCREMENT
ZR X3,ATSX IF NO MOVE NEEDED
SB2 X3
SA1 X4-1 BEGIN AT LWA
ATS3 BX6 X1 MOVE TABLE UP
SA6 A1+B3
SB2 B2-B1
SA1 A1-B1
NZ B2,ATS3 LOOP TO END OF MOVE
EQ ATSX RETURN
ATS4 SA0 =C* MEMORY OVERFLOW.*
EQ ABT
CKC SPACE 4,20
** CKC - CHECK CARD.
*
* ENTRY (A0) - ADDRESS OF FLAG LIST WORD.
* (00-17) - ADDRESS OF PROCESSOR.
* (18-59) - FLAG NAME.
*
* USES X - 0, 1, 2, 3, 6, 7.
* A - 1, 2, 7.
* B - 2, 3, 5.
*
* CALLS ASN.
CKC PS 0 ENTRY/EXIT
SA1 CHAR CHECK FIRST CHARACTER
SX2 -1R* CHECK PREFIX CHARACTER
SX7 A1+B1
BX6 X1+X2
NZ X6,CKC RETURN IF FIRST CHARACTER " PREFIX
SA7 CH SET SECOND CHARACTER
RJ ASN ASSEMBLE NAME
MX0 42
SA1 A0
SB3 64
NZ X6,CKC1 IF NOT BLANK NAME
SA2 CHAR+1 SET SECOND CHARACTER
BX6 X2
LX6 54
CKC1 ZR X1,CKC RETURN IF END OF LIST
IX7 X1-X6 COMPARE NAMES
SB5 X1 SET PROCESSOR ADDRESS
BX3 X0*X7
SA1 A1+B1 NEXT LIST ENTRY
NZ X3,CKC1 IF NO MATCH
SA1 CH CHECK NEXT CHARACTER
SA2 X1+B1
CKC2 SB2 X2-1R
NZ B2,CKC3 IF NOT * *
SA2 A2+B1 NEXT CHARACTER
SB3 B3-B1
PL B3,CKC2 LOOP TO END OF CARD
CKC3 SX7 A2 SET NEXT CHARACTER ADDRESS
SA7 A1
JP B5 PROCESS SPECIAL CARD
CMF SPACE 4,20
** CMF - COMPLETE FILES.
*
* COMPLETE *MODSETS* FILE, ENSURE EVEN PAGE COUNT, AND
* COMPLETE *OUTPUT* FILE IF USED.
*
* USES X - 1, 2, 3.
* A - 1, 2, 3.
*
* MACROS REWIND, WRITER, WRITEW.
CMF SUBR ENTRY/EXIT
WRITER M,R
REWIND M
SA1 O
SA2 LF
ZR X1,CMFX IF NO OUTPUT FILE - RETURN
SA3 PN
ZR X2,CMFX IF NOTHING LISTED TO OUTPUT - RETURN
LX3 59
NG X3,CMF1 IF PAGE NUMBER EVEN
SA3 TO
ZR X3,CMF1 IF TERMINAL OUTPUT
WRITEW O,(=2L1 ),1 EJECT
CMF1 WRITER O,R
EQ CMFX RETURN
ECD SPACE 4,20
** ECD - EXPAND CARD.
*
* ENTRY (CDTX) - TEXT OF COMPRESSED CARD.
*
* EXIT (CHAR) - EXPANDED CARD CHARACTER STRING.
*
* USES X - 0, 1, 2, 3, 4, 6, 7.
* A - 1, 2, 3, 4, 6, 7.
* B - ALL.
*
* CALLS CDD.
ECD PS 0 ENTRY/EXIT
SA1 CSC SET CHARACTER SET
SB6 X1
SX1 300 SET LAST COLUMN
SX6 1R (X6) = * *
SB7 X1+B1
SA6 CHAR PRESET (A6)
MX0 60-6 (X0) = CHARACTER MASK
SB2 -B7
SB5 10 (B5) = 10
SB4 B5
ECD1 SB7 B7-B1 CLEAR CARD
SA6 A6+B1
PL B7,ECD1
SB3 CHAR+1+X1
SA1 CDTX
EQ ECD3
* EXPAND CARD TEXT.
ECD1.1 SX2 X7-76B
SX4 X7-74B
ZR X2,ECD1.2 IF 76B ESCAPE CODE
NZ X4,ECD2 IF NO ESCAPE CODES
BX3 X1
LX3 6
BX2 -X0*X3
SX4 X2-1
SX3 X2-2
ZR X4,ECD1.3 IF 7401B UNPACK AT SIGN
ZR X3,ECD1.3 IF 7402B UNPACK CIRCUMFLEX
SX4 X2-4
SX3 X2-7
ZR X4,ECD1.3 IF 7404B UNPACK COLON (64) OR PERCENT (63)
ZR X3,ECD1.3 IF 7407B UNPACK GRAVE ACCENT
EQ ECD2 OTHERWISE UNPACK 6 BIT CHARACTERS
ECD1.2 BX4 X1 76B PREFIX FOUND
LX4 6
BX3 -X0*X4
SX4 X3-37B
PL X4,ECD2 IF .GT. 7636B UNPACK 6 BIT CHARACTERS
ECD1.3 LX7 6 12 BIT CHARACTER
SB4 B4-B1
LX1 6
BX2 -X0*X1
BX7 X7+X2
NZ B4,ECD2 IF NOT END OF WORD
SA1 A1+B1
SB4 B5
ECD2 PL B2,ECD6 IF CARD LIMIT REACHED
SA7 B2+B3 STORE CHARACTER
SB2 B2+B1
ECD3 SB4 B4-B1 SHIFT TO NEXT CHARACTER
LX1 6
BX7 -X0*X1
NZ B4,ECD4 IF NOT END OF WORD
SA1 A1+B1 SET NEXT WORD
SB4 B5
ECD4 ZR X7,ECD4.1 IF *00* CHARACTER
NZ B6,ECD1.1 IF 6/12 ASCII CHARACTER SET
EQ ECD2 IF DISPLAY CHARACTER SET
ECD4.1 SB4 B4-B1
LX1 6 EXTRACT SPACE COUNT
BX7 -X0*X1
ECDA BSS 0
NZ B4,ECD5 IF NOT END OF WORD
SA1 A1+B1 SET NEXT WORD
SB4 B5 RESET CHARACTER COUNT
* NZ B4,ECD5.1 * 63 *
* SA1 A1+B1 * CHARACTER *
* SB4 B5 * SET *
ECDB BSS 0
ECD5 SB7 X7
NE B7,B1,ECD5.1 IF NOT *0001*
BX7 X7-X7
* EQ ECD5.1 * 63 CHARACTER SET *
EQ ECD2
ECD5.1 SX4 X7+B1 SET COMPRESSION COUNT
SB2 X4+B2 SET BLANKS IN BUFFER
NZ X7,ECD3 IF NOT END OF WORD
* ENTER IDENTIFIER NAME.
ECD6 SA2 CDID GET CARD IDENTIFICATION
SB2 7
MX3 60-16
LX2 6
ECD7 BX7 -X0*X2 NEXT CHARACTER
SB2 B2-B1
LX2 6
NZ X7,ECD8 IF NOT 00
BX7 X6 SUBSTITUTE * *
ECD8 SA7 B3-B1
SB3 B3+B1
NZ B2,ECD7 LOOP TO END OF NAME
* ENTER CARD NUMBER.
LX2 12 CONVERT CARD NUMBER
BX1 -X3*X2
RJ CDD
SB2 9
LX6 24
MX0 60-6
ECD9 BX7 -X0*X6 ENTER SEQUENCE NUMBER
SB2 B2-B1
SA7 A7+B1
LX6 6
NZ B2,ECD9
SB3 A7+B1 RETURN WITH NEXT CHARACTER POSITION
EQ ECD
PLE SPACE 4,20
** PLE - PROCESS LIBRARY ERROR.
*
* ISSUES LIBRARY ERROR MESSAGE AND ABORTS JOB.
*
* CALLS ABT.
PLE SA1 DN SET DECK NAME IN MESSAGE
BX6 X1
SA6 PLEB
SA0 PLEA ABORT JOB
EQ ABT
PLEA DATA 20H PL ERROR IN DECK
PLEB DATA 0
POC SPACE 4,15
** POC - PROCESS OPL CHARACTER SET.
*
* CHECK AND/OR INITIALIZE *OPLEDIT* FOR 63/64 CHARACTER
* AND 6/12 CHARACTER SET OPL PROCESSING.
*
* ENTRY (TIDT - TIDT+16B) - IDENT TABLE FOR DECK.
*
* EXIT IF INITIAL ENTRY.
* (ECDA) INITIALIZED.
* (ECDB) INITIALIZED.
*
* USES X - 1, 2, 3, 4, 5, 6, 7.
* A - 0, 1, 2, 6, 7.
POC SUBR ENTRY/EXIT
SA5 TIDT+16B CHECK OPL CHARACTER SET
MX1 -6
BX5 -X1*X5
* VERIFY OPL CHARACTER SET.
SX3 X5-64B CHECK FOR 64 CHARACTER SET PL
ZR X3,POC1 IF 64 CHARACTER SET
ZR X5,POC1 IF 63 CHARACTER SET (*00*)
SA1 TIDT+1 SET NAME OF DECK WITH INVALID CHARACTER SET
RJ SFN SPACE FILL DECK NAME
SX2 1R &1R- FORM MESSAGE
BX5 X5-X5 SET 63 CHARACTER SET
LX6 -6
BX6 X6-X2
SA6 POCB SET MESSAGE
SA1 TIDT+16B CORRECT CHARACTER SET IN RECORD HEADER
MX2 54
BX7 X2*X1
SA7 A1
MESSAGE A6,3 * DECKNAM - INCORRECT CS, 63 ASSUMED.*
* CHECK FOR MIXED PL,S.
POC1 SA2 CSM PREVIOUS CHARACTER SET
SA5 A5 REREAD CHARACTER SET INDICATORS
MX1 -6 EXCLUDE 6/12 FLAG FROM MASK
BX5 -X1*X5
BX4 X2-X5 COMPARE CHARACTER SETS
MI X2,POC2 IF INITIAL ENTRY
* COMPARE AGAINST PREVIOUS RECORD.
ZR X4,POCX IF CHARACTER SET SAME AS PREVIOUS RECORD
SA0 =C* MIXED CHARACTER SET OPL.*
EQ ABT1
* ON INITIAL ENTRY SET CHARACTER SET AND PRESET INSTRUCTIONS.
POC2 BX6 X5
SA6 A2 SET CHARACTER SET
ZR X3,POC3 IF 64 CHARACTER SET DECK
SA1 POCA SET INSTRUCTIONS
SA2 A1+B1
BX6 X1
LX7 X2
SA6 ECDA
SA7 ECDB
POC3 MX3 -6 MASK FOR 0 = DISPLAY, 1 = 6/12
SA5 A5
AX5 6
BX7 -X3*X5
SA7 CSC STORE CURRENT CHARACTER SET
EQ POCX RETURN
POCA NZ B4,ECD5.1 IF NOT END OF WORD
SA1 A1+B1
SB4 B5
+ EQ ECD5.1
POCB DATA C* DECKNAM - INCORRECT CS, 63 ASSUMED.*
RMT SPACE 4,25
** RMT - READ MODIFIER TABLE.
*
* ENTRY (DN) - DECK NAME.
* (MA) - MODIFICATION TABLE ADDRESS.
*
* USES ALL.
*
* CALLS AMD, ATS, POC.
RMT PS 0 ENTRY/EXIT
SA1 DA GET DECK TABLE ENTRY
SA3 X1+B1 SET RANDOM ADDRESS
LX7 X3
SA7 P+6
READ P INITIATE NEW READ
READW X2,TIDT,TIDTL READ IDENT TABLE
NZ X1,PLE IF EOR
SA1 TIDT
LX1 12
SB2 X1-7700B
NZ B2,PLE IF NO IDENT TABLE
SA1 TIDT+1 CHECK DECK NAME
SA2 DN
BX3 X1-X2
NZ X3,PLE IF NO MATCH
ADDWRD TDKI,X1 ADD DECK NAME TO DECK IDENTIFIER TABLE
RJ POC PROCESS OPL CHARACTER SET
READW P,T1,1 READ MODIFIER TABLE LENGTH
NZ X1,PLE IF EOR
SA1 T1 CHECK TABLE
SX6 B0
LX1 18
SB2 X1-700100B
SB3 X1-700200B
ZR B2,RMT1 IF NORMAL DECK
NZ B3,PLE IF NOT COMMON DECK
SX6 B1
RMT1 SA6 CD SET DECK STATUS
LX1 42 SET TABLE LENGTH
SB7 X1
ZR B7,RMT RETURN IF NO MODIFIERS
ALLOC TDKI,B7 ALLOCATE FOR MODIFIERS
READW P,X2+B1,B7 READ MODIFIERS
SA1 L.TDKI MODIFIER LENGTH
SA2 F.TDKI
SB7 X1-1
SA5 X2+B1
SX0 B1
RMT2 SEARCH TPRG,X5 SEARCH FOR PURGE
ZR X2,RMT4 IF NOT FOUND
RMT3 SX0 X0-1 DECREMENT POINTER
SX3 1S15 SET PURGE FLAG
BX5 X5+X3
SA1 MD COUNT MODIFICATIONS
SX6 X1+B1
SA6 A1
RMT4 BX6 X5+X0
SA6 A5
SB2 X2
SB7 B7-B1
SX0 X0+B1
SA5 A5+B1
ZR B7,RMT RETURN IF END OF TABLE
ZR B2,RMT2 IF NOT ALL AFTER
EQ RMT3 LOOP
RPF SPACE 4,25
** RPF - READ CARD FROM PROGRAM LIBRARY.
*
* EXIT (X1) .NE. 0, IF EOR READ.
* (CDAC) - CARD ACTIVITY.
* (CDID) - CARD IDENTIFICATION.
* (CDWC) - WORD COUNT OF COMPRESSED CARD.
* (CDTX) - TEXT OF COMPRESSED CARD.
* (NMHB) - NUMBER OF MHB,S.
* (THMB) - MHB,S.
*
* USES ALL.
*
* CALLS RDC=.
RPF PS 0 ENTRY/EXIT
READC P,BUF,BUFL READ MHBS
NZ X1,RPF RETURN IF EOR
SA1 BUF SHIFT TO FIRST MHB
LX1 24
SX6 -B1 CLEAR MHB COUNT
MX0 60-18
SB2 B1 2 MHB-S ON FIRST PASS
RPF1 LX1 18 SHIFT TO NEXT MHB
BX7 -X0*X1
SB2 B2-B1
SX6 X6+B1
ZR X7,RPF2 IF END OF MHB LIST
SA7 TMHB+X6 STORE MHB
PL B2,RPF1 LOOP TO END OF WORD
SA1 A1+B1 NEXT WORD
SB2 B1+B1 RESET MHB COUNT
LX1 6
EQ RPF1 LOOP
* READ COMPRESSED CARD.
RPF2 SA5 BUF SET CARD ACTIVITY
MX0 60-16 SET IDENTIFIER INDEX MASK
BX7 X5
SA6 NMHB
SA7 CDAC
READC P,CDTX,MXCCL READ COMPRESSED IMAGE
NZ X1,PLE IF EOR
SX7 B6-CDTX SET WORD COUNT OF CARD
LX5 60-18 EXTRACT IDENTIFIER INDEX
SA7 CDWC
BX4 -X0*X5
SA2 F.TDKI
SB2 X4
AX5 18 SET CARD NUMBER
SA2 X2+B2 SET CARD IDENTIFIER
SX3 X5
BX6 X0*X2
IX7 X6+X3
SA7 CDID
NZ B2,RPF IF NOT ORIGINAL CARD
SA3 CDAC CHECK CARD ACTIVITY
PL X3,RPF IF ORIGINAL CARD ACTIVE
SA7 ID3 LAST ORIGINAL ACTIVE CARD SEQUENCE NUMBER
EQ RPF RETURN
SSR SPACE 4,15
** SSR - SELECT *S* READ FUNCTION.
*
* SELECT *RDS=* OR *RDA=* DEPENDING ON CHARACTER SET.
*
* ENTRY (CSC) = CURRENT CHARACTER SET.
*
* USES X - 3.
* A - 3.
* B - 3.
*
* CALLS RDA=, RDS=.
SSR SUBR ENTRY/EXIT
SA3 CSC GET CURRENT CHARACTER SET
LX3 1 TWO INSTRUCTION WORDS PER ENTRY
SB3 X3
JP B3+SSR1 GO TO PROPER PROCESSOR
SSR1 RJ =XRDS= DISPLAY CODE
EQ SSRX RETURN
RJ =XRDA= 6/12 DISPLAY BASED ASCII
EQ SSRX RETURN
SSW SPACE 4,15
** SSW - SELECT *S* WRITE FUNCTION.
*
* SELECT *WTS=* OR *WTA=* DEPENDING ON CHARACTER SET.
*
* ENTRY (CSC) = CURRENT CHARACTER SET.
*
* USES X - 3.
* A - 3.
* B - 3.
*
* CALLS WTA=, WTS=.
SSW SUBR ENTRY/EXIT
SA3 CSC GET CURRENT CHARACTER SET
LX3 1 TWO INSTRUCTION WORDS PER ENTRY
SB3 X3
JP B3+SSW1 GO TO PROPER PROCESSOR
SSW1 RJ =XWTS= DISPLAY CODE
EQ SSWX RETURN
RJ =XWTA= 6/12 DISPLAY BASED ASCII
EQ SSWX RETURN
STB SPACE 4,20
** STB - SEARCH TABLE FOR ENTRY WITH MASK.
*
* ENTRY (A0) - TABLE NUMBER.
* (X1) - MASK.
* (X6) - ENTRY.
*
* EXIT (X2) - 0, IF ENTRY NOT FOUND.
* (X2) .NE. 0, ENTRY IF FOUND.
* (A2) - ADDRESS OF ENTRY.
* (X3) - INDEX OF ENTRY.
*
* USES X - 2, 3.
* A - 2, 3.
* B - 2, 3.
STB2 SA2 A2-B1 RESTORE ENTRY
SX3 A2-B3 SET INDEX
STB PS 0 ENTRY/EXIT
SA3 FTAB+A0
SA2 LTAB+A0
ZR X2,STB RETURN IF TABLE EMPTY
SB2 X2
SB3 X3
SA2 X3
STB1 BX3 X6-X2 CHECK ENTRY
SB2 B2-B1
BX3 X1*X3
SA2 A2+B1
ZR X3,STB2 IF REQUESTED ENTRY FOUND
NZ B2,STB1 LOOP TO END OF TABLE
MX2 0 RESPOND WITH 0
EQ STB
UPN SPACE 4,20
** UPN - UNPACK NAME.
*
* ENTRY (X6) - NAME LEFT JUSTIFIED.
* (B3) - CHARACTER ADDRESS.
*
* EXIT (B3) - UPDATED CHARACTER ADDRESS.
*
* USES X - 1, 6, 7.
* A - 7.
* B - 2.
UPN PS 0 ENTRY/EXIT
MX1 60-6
LX6 6
SB2 B3+10
UPN1 BX7 -X1*X6
ZR X7,UPN2 IF END OF NAME
SA7 B3
SB3 B3+B1
LX6 6
NE B3,B2,UPN1
UPN2 SX7 1R SET TERMINAL * *
SA7 B3
EQ UPN
WDR SPACE 4,25
** WDR - WRITE DIRECTORY TO PROGRAM LIBRARY.
*
* SET DATE IN IDENT TABLE AND WRITE TO *NPL*.
*
* USES X - 1, 2, 3, 4, 5, 6, 7.
* A - 1, 2, 3, 4, 5, 6, 7.
* B - ALL.
*
* CALLS WTW=.
WDR PS 0 ENTRY/EXIT
SA1 N
SA2 L.TNDK
ZR X1,WDR RETURN IF NO NEW PROGRAM LIBRARY
ZR X2,WDR RETURN IF NO NEW DECKS
RECALL N
SA1 PL ENTER PROGRAM LIBRARY NAME
SA2 DATE ENTER DATE IN IDENT TABLE
BX6 X1
LX7 X2
SA6 TIDT+1
SA7 A6+B1
MX7 0 CLEAR MODIFICATION DATE
SA7 A7+B1
WRITEW N,TIDT,TIDTL
SA5 L.TNDK MERGE DECK COUNT AND DIRECTORY ID
SA2 WDRA
BX6 X5+X2
SA6 T1
WRITEW N,T1,1
SA1 F.TNDK REMOVE FILE NAME POINTERS
SB2 B1+B1
SB3 X5
MX4 24
SA2 X1+B1
BX6 -X4*X2
WDR1 SA6 A2
SB3 B3-B2
SA2 A2+B2
BX6 -X4*X2
NZ B3,WDR1
WRITEW N,X1,X5 WRITE DECK NAME TABLE
WRITEF X2,R
EQ WDR RETURN
WDRA DATA 7000BS48 DIRECTORY ID
WMT SPACE 4,20
** WMT - WRITE MODIFIER TABLE.
*
* ADD DECK TO NEW DECK NAME TABLE. WRITE MODIFIER TABLE
* TO *NPL*.
*
* USES ALL.
*
* CALLS ADW, WTW=.
WMT PS 0 ENTRY/EXIT
SA1 IGNORE
NZ X1,WMT IF *MODSETS ONLY* MODE
RECALL N
SA1 MD
SA2 DN ENTER DECK NAME IN IDENT TABLE
ZR X1,WMT1 IF NO MODIFICATIONS
SA1 DATE ENTER NEW DATE
LX7 X1
SA7 TIDT+3
WMT1 SA1 CD
SX3 X1+6
LX6 X2
SA6 TIDT+1
ADDWRD TNDK,X2+X3 ENTER DECK NAME
ADDWRD A0,X6-X6
SX2 A6 SET RANDOM RETURN ADDRESS
SX3 A6
LX2 30
BX6 X2+X3
SA6 N+6
SA5 DN DECK NAME
SEARCH TCED,X5 CHECK FOR CHARACTER SET CHANGE
ZR X2,WMT1.1 IF NO CHANGE OF CHARACTER SET
SA1 TIDT+16B CHARACTER SET WORD
MX4 -6
LX2 6 POSITION NEW CHARACTER SET
LX4 6
BX5 -X4*X2 NEW CHARACTER SET
BX6 X4*X1
BX6 X5+X6 ADD TO 63 - 64 CHARACTER SET INDICATOR
SA6 A1+
WMT1.1 WRITEW N,TIDT,TIDTL WRITE IDENT TABLE
SA1 L.TDKI CHECK MODIFIERS
SA2 F.TDKI
SX6 -B1
SB3 X1
SA3 X2
WMT2 LX3 59-15
NG X3,WMT3 IF PURGED
SX6 X6+B1
WMT3 SB3 B3-B1
SA3 A3+B1
NZ B3,WMT2
SA1 CD
SA2 WMTA
ZR X1,WMT4 IF NOT COMMON DECK
SA2 WMTB
WMT4 BX6 X2+X6 MERGE MODIFIER COUNT AND TABLE ID
SA6 T1
WRITEW N,T1,1 WRITE MODIFIER ID
SA5 L.TDKI WRITE ACTIVE MODIFIERS
SA1 F.TDKI WRITE DECK MODIFIERS
MX0 60-16
SX5 X5-1
SA0 X1+B1
WMT5 ZR X5,WMT RETURN IF END OF MODIFIERS
SA1 A0 SET MODIFIER
BX6 X0*X1
LX1 59-15
NG X1,WMT6 IF PURGED
SA6 T1
WRITEW X2,T1,1
WMT6 SA0 A0+B1
SX5 X5-1
EQ WMT5 LOOP
WMTA DATA 7001BS48 MODIFIER TABLE ID
WMTB DATA 7002BS48 MODIFIER TABLE ID FOR COMMON DECK
WNF SPACE 4,25
** WNF - WRITE CARD TO NEW PROGRAM LIBRARY.
*
* ENTRY (CDAC) - CARD ACTIVITY.
* (CDID) - CARD IDENTIFICATION.
* (CDWC) - WORD COUNT OF COMPRESSED CARD.
* (CDTX) - TEXT OF COMPRESSED CARD.
* (NMHB) - NUMBER OF MHB,S.
* (TMHB) - MHB,S.
*
* USES ALL.
*
* CALLS WTW=.
WNF PS 0 ENTRY/EXIT
SA2 IGNORE
NZ X2,WNF IF *MODSETS ONLY* MODE
SA2 N
ZR X2,WNF RETURN IF NO NEW PROGRAM LIBRARY
SA1 CDAC ACTIVITY TO BIT 59
SA5 NMHB STORE MHB TERMINATORS
MX3 1
SA2 A1+B1 WORD COUNT OF CARD TO BITS 54 - 58
SX6 B0
BX1 X3*X1
SA6 TMHB+X5
LX1 24
SA3 A2+B1 CARD NUMBER TO BITS 36 - 53
MX0 60-16
SA6 A6+B1
LX2 18
SB3 X5 MHB COUNT
BX3 -X0*X3
SA6 A6+B1
BX1 X1+X2
SA5 A5+B1 FIRST MHB
SB2 B1 2 MHB-S ON FIRST PASS
IX7 X1+X3
SA7 BUF
* PACK AND WRITE MHB TABLE.
WNF1 LX7 18 PACK MHB-S
SB3 B3-B1
BX7 X5+X7
SB2 B2-B1
SA5 A5+B1 NEXT MHB
PL B2,WNF1 LOOP FOR 1 WORD OF MHB-S
SA7 A7+B1 STORE WORD
SB2 B1+B1
MX7 0
PL B3,WNF1 LOOP FOR ALL MHB-S
WRITEW N,BUF+1,A7-BUF
SA5 CDWC WRITE COMPRESSED CARD
WRITEW X2,CDTX,X5
EQ WNF RETURN
WOF SPACE 4,20
** WOF - WRITE OUTPUT FILE.
*
* ENTRY (X1) - FWA OF LINE.
* .LT. 0, LINE IS IN *S* FORMAT.
* (X2) - 0, IF LINE IS IN *C* FORMAT.
*
* USES X - 1, 2, 3, 4, 6, 7.
* A - 1, 2, 3, 4, 6, 7.
*
* CALLS CDD.
*
* MACROS WRITEC, WRITEK, WRITEW.
WOF SUBR ENTRY/EXIT
SX6 B1+
SA3 LC ADVANCE LINE COUNT
SA6 LF
SX6 X3+B1
SA6 A3
SA4 A3+B1
IX7 X6-X4
NG X7,WOF3 IF BOTTOM OF PAGE NOT REACHED
BX6 X1 SAVE REQUEST
LX7 X2
SA6 WOFA
SA7 A6+B1
SA1 PN ADVANCE PAGE NUMBER
SX7 X1+B1
SX6 3 RESET LINE COUNT
SA6 A3
SA7 A1
RJ CDD CONVERT PAGE NUMBER
MX1 60-12
LX6 4*6 STORE PAGE NUMBER
BX6 X1*X6
SA6 PAGE
SX2 O
SA1 TO
ZR X1,WOF1 IF TERMINAL OUTPUT
WRITEW X2,(=1H1),1
SA1 TL
WRITEW X2,X1,4
WRITEW X2,TITL,TITLL
WRITEW X2,SBTL,SBTLL
EQ WOF2 CONTINUE PROCESSING
WOF1 SA3 PN
SX3 X3-2
NZ X3,WOF2 IF NOT FIRST TIME
WRITEW X2,TERL,TERLL
WRITEW X2,(=C* *),1 WRITE END OF LINE
WOF2 SA1 WOFA RESTORE REQUEST
SA2 A1+B1
WOF3 NG X1,WOF4 IF *S* FORMAT
WRITEC O,X1
EQ WOFX RETURN
WOF4 BX1 -X1
WRITEK O,X1,X2
EQ WOFX RETURN
WOFA DATA 0,0
LCS SPACE 4,15
** LCS - LIST CARD STATUS.
*
* USES X - 0, 1, 2, 3, 6.
* A - 1, 2, 3, 6.
* B - 2, 3, 4, 5.
*
* CALLS CDD, UPN.
LCS PS 0 ENTRY/EXIT
SA1 IGNORE
NZ X1,LCS IF *MODSETS ONLY* MODE
SA1 CL
NZ X1,LCS RETURN IF CARD LISTED
SA1 TMHB
SX2 80
MX0 60-16
BX6 -X0*X1
SB5 CHAR+15+X2
ZR X6,LCS1 IF DECK CARD
SA2 F.TDKI ADD CURRENT DECK NUMBER
SA3 X2
BX1 -X0*X3
RJ CDD
LX6 6*4
SB3 B5
RJ UPN
LCS1 PRINT -CHSP,B3+X1
SX6 1R CLEAR STATUS
SA6 CHSP+4
SA6 A6+B1
SA6 A6+B1
SA6 CL SET CARD LISTED
EQ LCS RETURN
LDS SPACE 4,15
** LDS - LIST DECK STATUS.
*
* USES X - 0, 1, 2, 3, 5, 6.
* A - 1, 2, 3, 6.
*
* CALLS LTB, SFN.
*
* MACROS LISTOP, PRINT.
LDS SUBR ENTRY/EXIT
SA2 IGNORE
NZ X2,LDSX IF *MODSETS ONLY* MODE
LISTOP D,LDSX,,2 IF NO LIST FOR DECK STATUS - RETURN
SA1 DN SPACE FILL DECK NAME
RJ SFN
SA2 F.TDKI
LX6 60-12
SX4 X2+B1
SA6 BUF
SA3 L.TDKI
SX0 =C*MODIFIERS.*
SX5 X3-1
RJ LTB
PRINT (=C* *)
EQ LDSX RETURN
LER SPACE 4,20
** LER - LIST ERROR MESSAGE.
*
* ENTRY (X0) = ERROR MESSAGE ADDRESS.
*
* EXIT (CHSP) CLEARED.
* (EC) ADVANCED.
*
* USES X - 1, 2, 6, 7.
* A - 1, 2, 6, 7.
* B - 2.
*
* MACROS LISTOP, WRITEC, WRITEW.
LER SUBR ENTRY/EXIT
SA2 O
LISTOP E,LER1 IF NO ERROR LIST
ZR X2,LER1 IF NO OUTPUT FILE
WRITEW O,(=8A******* ),1
WRITEC X2,X0
SA2 LC ADVANCE LINE COUNT
SX7 X2+B1
SA7 A2
LER1 SB2 9 CLEAR CHARACTER SPACING
SX6 1R
LER2 SA6 CHSP+B2
SB2 B2-B1
PL B2,LER2
SA1 EC ADVANCE ERROR COUNT
SX6 X1+B1
SA6 A1
EQ LERX RETURN
LST SPACE 4,20
** LST - LIST STATISTICS.
*
* LIST DECKS ON PROGRAM LIBRARY. LIST DECKS ON *NPL*.
*
* USES X - 0, 1, 4, 5, 6, 7.
* A - 1, 4, 5, 6, 7.
*
* CALLS LTB.
*
* MACROS LISTOP.
LST SUBR ENTRY/EXIT
LISTOP S,LSTX IF NO LIST FOR STATISTICS - RETURN
SX6 =40HSTATISTICS.
SX7 99999 FORCE PAGE EJECT
SA6 TL
SA7 LC
SA1 =1H CLEAR FIRST WORD OF BUFFER
SX7 B1+B1 RESET WORDS/ENTRY
BX6 X1
SA6 BUF
SA7 LTBA
SA6 SBTL+1 CLEAR SUBTITLE
SA6 A6+B1
* LIST DECKS ON PROGRAM LIBRARY.
SX0 =C*DECKS ON PROGRAM LIBRARY.*
SA4 F.TDKN
SA5 L.TDKN
RJ LTB
* LIST DECKS ON NEW PROGRAM LIBRARY.
SA1 N
ZR X1,LSTX IF NO NEW PROGRAM LIBRARY - RETURN
SX0 =C*DECKS ON NEW PROGRAM LIBRARY.*
SA4 F.TNDK
SA5 L.TNDK
RJ LTB
EQ LSTX RETURN
LTB SPACE 4,20
** LTB - LIST TABLE.
*
* LIST SPECIFIED TABLE ON OUTPUT FILE.
*
* ENTRY (X0) - MESSAGE.
* (X4) - TABLE.
* (X5) = TABLE LENGTH.
*
* USES ALL.
*
* CALLS SFN, WOF.
LTB6 MX6 0
SA6 A6+B1
PRINT BUF
LTB PS 0 ENTRY/EXIT
SA1 LC CHECK LINE COUNT
SA0 X4 (A0) = TABLE ADDRESS
SA2 A1+B1
SX6 X1+4
IX7 X6-X2
PL X7,LTB1 IF NOT ROOM FOR FIRST LINE OF TABLE
PRINT (=C* *)
SA1 LC
BX6 X1
LTB1 SA6 A1 UPDATE LINE COUNT
MX3 60-12 COPY MESSAGE TO BUFFER
SA2 X0
LX6 X2
SB2 BUF+1
LTB2 SA6 B2
BX7 -X3*X2
SB2 B2+B1
SA2 A2+B1
LX6 X2
NZ X7,LTB2
PRINT BUF
SA1 =1H CLEAR FIRST WORD OF BUFFER
BX6 X1
MX0 42
SA6 BUF
PRINT (=C* *)
NZ X5,LTB3 IF TABLE NOT EMPTY
PRINT (=C+ * NONE * +)
EQ LTB RETURN
LTB3 SB6 -12
ZR X5,LTB RETURN IF END OF TABLE
LTB4 ZR X5,LTB6 IF END OF TABLE
SA1 A0 SPACE FILL NAME
BX7 -X0*X1
BX1 X0*X1
RJ SFN
SA4 LTBA TABLE WORD COUNT
LX7 59-16
PL X7,LTB5 IF CLEAR
SA2 A4+B1 ADD ()
IX6 X6+X2
LTB5 LX6 60-6 STORE NAME
SA6 BUF+13+B6
SB6 B6+B1
SB2 X4 ADVANCE TABLE
IX5 X5-X4
SA0 A0+B2
NG B6,LTB4 LOOP TO END OF LINE
MX6 0
SA6 A6+B1
PRINT BUF
EQ LTB3 LOOP
LTBA DATA 2 WORDS/TABLE ENTRY
VFD 60/10H ) (-1H
PPM SPACE 4,20
** PPM - PROCESS PULLED MODS.
*
* USES ALL.
*
* CALLS CDC, ECD.
*
* MACROS WRITEK.
PPM PS 0
SA1 IP
ZR X1,PPM IF NOT IN DECK
SA1 II
SA2 NMHB
SB6 X2 NUMBER OF MHB-S
SB5 X2
MX2 -16D MASK FOR IDENT INDEX
SA3 TMHB GET FIRST MHB
SA4 PA
NZ X4,PPM10 IF *SUMMARY* MODE
BX4 -X2*X3
IX5 X1-X4
NG X5,PPM IF CARD INSERTED *LATER* THAN THIS IDENT
PPM1 BX4 -X2*X3
IX5 X4-X1
ZR X5,PPM2 IF MATCH
SB6 B6-B1
SA3 A3+B1
NZ B6,PPM1 IF MORE MHB-S
SA3 PA
NZ X3,PPM9 IF NON-ORIGINAL IN *SUMMARY* MODE
PPM1.1 SX6 B0
SA6 DL CLEAR DL
RJ CDC COMPLETE DIRECTIVE CARD
SA1 CDID
BX6 X1
SA6 ID1 SET FIRST IDENTIFIER
EQ PPM
* DETERMINE *I *D OR *RESTORE
PPM2 SA1 PA
NZ X1,PPM8 IF *SUMMARY* MODE
BX2 X2*X3
ZR X2,PPM3 IF PROCESS *D
EQ B5,B6,PPM4 IF PROCESS *I
* PROCESS *RESTORE
PPM2.1 SA1 RF
NZ X1,PPM6 IF (STILL) RESTORING
RJ CDC COMPLETE DIRECTIVE CARD
SX6 B1
SA6 RF INDICATE RESTORING
SA6 DL SET DL
EQ PPM5 SET ACTIVE AND EXIT
* PROCESS *D
PPM3 SA1 DF
NZ X1,PPM6 IF (STILL) DELETING
RJ CDC COMPLETE DIRECTIVE CARD
SX6 B1
SA6 DF INDICATE DELETING
SA6 DL SET DL
EQ PPM5 SET ACTIVE AND EXIT
* PROCESS *I
PPM4 SA1 IF
NZ X1,PPM7 IF (STILL) INSERTING
RJ CDC COMPLETE DIRECTIVE CARD
SX6 B1
SA6 IF INDICATE INSERTING
SA1 DL
NZ X1,PPM7 IF DIRECTIVE LAST, OMIT *I
SA6 ACTIVE
RJ CDC FLUSH INSERT IMMEDIATELY
SX6 B1 TURN IF BACK ON
SA6 IF
EQ PPM7 AND THE FIRST INSERT
* SET ACTIVE AND EXIT
PPM5 SA6 ACTIVE
SA1 CDID
BX6 X1
SA6 ID1
EQ PPM EXIT
PPM6 SA1 CDID
BX6 X1 STORE ID2
SA6 ID2
EQ PPM EXIT
PPM7 RJ ECD EXPAND CARD IMAGE
WRITEK M,CHAR,B3-CHAR-16D
SX6 B0
SA6 ACTIVE PREVENT SECOND *I CARD
EQ PPM
PPM8 SA1 CDAC
NG X1,PPM1.1 IF NO NET CHANGE
EQ PPM3 IF DELETED (NET)
PPM9 SA1 CDAC
NG X1,PPM4 PROCESS ACTIVE INSERTION
EQ PPM IF INACTIVE INSERTION - IGNORE
PPM10 SA4 A4+B1
ZR X4,PPM1 IF *SUMMARY IDENT* MODE
PPM11 BX4 -X2*X3
IX5 X1-X4
NG X5,PPM12 IF CARD ACTED UPON LATER THAN THIS IDENT
ZR X5,PPM12 IF CARD ACTED UPON BY THIS IDENT
SB6 B6-B1
SA3 A3+B1
NZ B6,PPM11 IF MORE MHB-S
EQ PPM1.1 EXIT NOT A MOD OF THIS COMPOSITE
PPM12 EQ B6,B5,PPM9 IF FIRST COMPOSITE EQUAL TO ORIGINAL MOD
BX2 X2*X3
NZ X2,PPM2.1 IF RESTORE
EQ PPM8
CDC SPACE 4,20
** CDC - COMPLETE DIRECTIVE CARD.
*
* USES ALL.
*
* CALLS CID, WTS=.
CDC PS 0
SA1 ACTIVE
ZR X1,CDC8 IF NOT CURRENTLY PROCESSING DIRECTIVE
SA1 DELD GET -*D,- DIRECTIVE
SA2 DF
NZ X2,CDC1 IF SET *D
SA1 INSD GET -*I,- DIRECTIVE
SA2 IF
NZ X2,CDC1 IF SET *I
SA1 RESD GET -*RESTORE- DIRECTIVE
CDC1 SX6 B0
SA6 CHAR
MX7 -6
CDC2 LX1 6 STORE DIRECTIVE
BX6 -X7*X1
ZR X6,CDC3 IF LAST CHARACTER
SA6 A6+B1
EQ CDC2 LOOP FOR NEXT CHARACTER
CDC3 SA1 ID1 CONVERT FIRST IDENTIFIER
SX0 B0
RJ CID
SA1 ID2 CONVERT ID2, IF ANY
ZR X1,CDC4 IF NO SECOND IDENTIFIER REQUIRED
SX6 1R, INSERT THE , REQUIRED
SA6 A6+B1
SX0 B0
RJ CID
CDC4 SA1 ID1 CHECK FOR ORIGINAL CARD
SA2 DN DECK NAME
MX0 42
BX1 X0*X1
BX1 X1-X2
ZR X1,CDC7 IF ORIGINAL CARD
* APPEND LAST ORIGINAL CARD NUMBER TO MODIFY DIRECTIVE.
SX6 1R PAD AT LEAST ONE BLANK
SA6 A6+1
SB3 CHAR+29 CHECK LINE POSITION
SB2 A6+
GE B2,B3,CDC6 IF AT OR AFTER COLUMN 30
CDC5 SA6 A6+B1 ADD A BLANK
SB2 B2+B1
LT B2,B3,CDC5 IF NOT AT COLUMN 30
CDC6 SX6 1R( ADD PARENTHESIS
SA1 ID3 ORIGINAL CARD SEQUENCE NUMBER
SX0 B0
SA6 A6+B1
RJ CID CONVERT SEQUENCE NUMBER
SX6 1R) ADD CLOSING PARENTHESIS
SA6 A6+1
CDC7 SX1 A6-CHAR
WRITES M,CHAR+1,X1 WRITE OUT DIRECTIVE
CDC8 SX6 B0+ CLEAR FLAGS
SA6 ACTIVE
SA6 DF
SA6 IF
SA6 RF
SA6 ID2
EQ CDC EXIT
ID1 DATA 0 FIRST CARD ID
ID2 DATA 0 SECOND CARD ID
ID3 CON 0 LAST ORIGINAL CARD ID
CID SPACE 4,20
** CID - CONVERT *ID* FOR DIRECTIVE.
*
* ENTRY (X1) - ID.
* (A6) - STRING BUFFER IN WHICH TO INSERT *ID*.
*
* EXIT *ID* INSERTED.
* (A6) ADVANCED.
*
* USES X - 0, 1, 2, 3, 4, 6, 7.
* A - 4, 6.
* B - 2, 3, 4, 5, 6.
*
* CALLS CDD.
* PROCESS IDENT.
CID PS 0
CID1 SB6 6
MX2 42 IDENT MASK
MX7 6
BX3 X2*X1
SA4 DN
IX4 X3-X4
ZR X4,CID4 IF DECK.NUMBER
CID2 BX4 X7*X3
ZR X4,CID3 INSERT .
LX6 X4,B6
LX3 X3,B6
SX4 X6-1R
ZR X4,CID2 NO BLANKS
SA6 A6+B1 STORE IN CHARACTER BUFFER
EQ CID2
CID3 NZ X0,CID IF JUST FINISHED NUMBER
SX6 1R.
SA6 A6+B1
* PROCESS NUMBER.
CID4 MX2 -16 EXTRACT CARD NUMBER
BX1 -X2*X1
RJ CDD
LX6 24
BX1 X6
SX0 B1 SET TO SECOND PASS
EQ CID1
SFI SPACE 4,15
** SFI - SEARCH FOR IDENT IN DECK.
*
* USES X - ALL.
* A - ALL.
* B - ALL.
*
* CALLS WTW=.
*
* MACROS SEARCH, WRITEW.
SFI PS 0
SX7 B0+
SA7 IP PRESET TO *NOT PRESENT*
SA1 PA
ZR X1,SFI1 IF NOT *PULLALL* REQUEST
SA1 A1+B1
BX7 X1
SA7 IN
SX3 B0 INITIAL IDENT
ZR X1,SFI2 IF NOT *PULLALL,IDENT*
SA1 L.TDKI
SB7 X1-1
NZ B7,SFI3 IF MODIFIERS PRESENT
EQ SFI EXIT
SFI1 SA5 IN
MX7 60
SA7 II PRESET TO *NOT FOUND*
SEARCH TDKI,X5
ZR X2,SFI IF NO MATCH
SFI2 SA2 DN
BX7 X2
SA7 DCKD+1 STORE INTO DECK MESSAGE
SX7 X3 IDENT ORDINAL
SA7 II SHOW FOUND
SX6 B1
SA6 IP SHOW PRESENT
WRITEW M,DCKD,2 WRITE *DECK XXXX
EQ SFI
* SEARCH THE DECK *IDENT* TABLE IN CHRONOLOGICAL ORDER
* FOR A MATCHING ENTRY IN THE PULLALL *IDENT* TABLE.
SFI3 SA5 F.TDKI GET FWA OF IDENT TABLE
SA4 L.TDKI GET LENGTH OF IDENT TABLE
SX6 B0 CLEAR IDENT NAME
MX7 60 PRESET *NOT FOUND*
SA6 IN
SA7 II
SB6 B0 PRESET IDENT ORDINAL
SB7 X4 SET IDENT TABLE LENGTH
SFI4 SB6 B6+B1 INCREMENT IDENT ORDINAL
GE B6,B7,SFI IF END OF TABLE, EXIT
SA2 X5+B6 READ IDENT TABLE ENTRY
SEARCH TPAT,X2 SEARCH PULLALL TABLE
ZR X2,SFI4 IF MATCH NOT FOUND, LOOP
BX6 X2 SET IDENT NAME
SX3 B6 SET IDENT ORDINAL
SA6 IN
EQ SFI2 COMPLETE ENTRY
BUFFERS TITLE COMMON DECKS AND BUFFERS.
*CALL COMCCDD
*CALL COMCCIO
*CALL COMCRDA
*CALL COMCRDC
*CALL COMCRDS
*CALL COMCRDW
*CALL COMCSFN
*CALL COMCSYS
*CALL COMCWTA
*CALL COMCWTC
*CALL COMCWTS
*CALL COMCWTW
SPACE 4
** BUFFERS.
USE BUFFERS
* CHARACTER STRING BUFFER.
CHSP BSS 0 SPACING FOR LIST
DUP 10,1
DATA 1R
USBB BSS 0 STRING BUFFER
CHAR BSS 326 150 UPPER/LOWER CASE + SEQUENCE
BUF BSS 0 SCRATCH BUFFER
BUFL EQU 101B
PBUF EQU BUF+BUFL
OBUF EQU PBUF+PBUFL
SBUF EQU OBUF+OBUFL
MBUF EQU SBUF+SBUFL
NBUF EQU MBUF+MBUFL
MTBS EQU NBUF+NBUFL
MFL= EQU MTBS+MTBSL+200000B
IDENT SPACE 4
IDENT TERMINATE BLOCK
TITLE DIRECTIVE CARD PROCESSORS.
ORG NBUF
SPACE 4,10
** DIRECTIVE STATEMENT PROCESSOR TEMPORARY STORAGE.
ZP CON 0 *Z* ARGUMENT PROCESSING FLAG
PDC SPACE 4,10
** PDC - PROCESS DIRECTIVE CARDS.
PDC PS 0 ENTRY/EXIT
RJ RDR READ DIRECTORY
SA1 ZP *Z* MODE PROCESSING FLAG
NZ X1,PDC0 IF *Z* ARGUMENT SELECTED
SA1 I
ZR X1,PDC3 IF NO INPUT FILE
READ I
PDC0 BSS 0
READS I,CHAR,80 READ DIRECTIVE
NZ X1,PDC3 IF EOR
PDC1 CARD CSET
CARD EDIT
CARD PREFIX
CARD PURGE
CARD PULLMOD
CARD PULLALL
EQ ERR1
* DIRECTIVE PROCESSORS RETURN HERE TO LIST CARD.
PDC2 RJ LDC LIST CARD
* DIRECTIVE PROCESSORS RETURN HERE TO READ NEXT CARD.
READS I,CHAR,80 READ NEXT DIRECTIVE
ZR X1,PDC1 LOOP TO EOR
SA1 EC
SA2 DB
ZR X1,PDC RETURN IF NO ERRORS
NZ X2,PDC RETURN IF DEBUG SET
SX6 B0 CLEAR EDIT TABLE
SA6 L.TEDT
RJ LST LIST STATISTICS
SA0 =C* DIRECTIVE ERRORS.*
EQ ABT
* PROCESS EMPTY INPUT FILE.
PDC3 SA0 =C/ NO DIRECTIVES./
SA1 FM
NZ X1,PDC IF -F- MODE
EQ ABT1
ERRM CON 0 ERROR MESSAGE ADDESSS
ERR SPACE 4
** ERR - DIRECTIVE ERROR PROCESSORS.
ERR SA6 ERRM SET ERROR MESSAGE ADDRESS
EQ PDC2 EXIT
ERR1 SX6 =C*INCORRECT DIRECTIVE.*
EQ ERR
ERR2 SX6 =C*FORMAT ERROR IN DIRECTIVE.*
EQ ERR
CSET SPACE 4,10
*** CSET DNAME
*
* DECLARE CHARACTER SET TO BE USED IN PROCESSING
* MODIFICATION DIRECTIVES AND TEXT. THIS CHARACTER
* SET MUST MATCH THAT OF THE DECKS TO BE EDITED.
CSET RJ ASN ASSEMBLE NAME OF *CSET*
SA1 TCST-1 FWA-1 OF CHARACTER SET TABLE
MX3 42
CSET1 SA1 A1+B1
ZR X1,CSET2 IF UNKNOWN CHARACTER SET
BX4 X3*X1
BX7 X6-X4
NZ X7,CSET1 IF NO MATCH
BX7 -X3*X1
SA7 SETC SET NEW CHARACTER SET
EQ PDC2 RETURN
CSET2 SX6 =C* CSET - UNKNOWN CHARACTER SET.*
EQ ERR PROCESS ERROR
EDIT SPACE 4
*** EDIT D1
* EDIT D1,D2,...DN
* EDIT D1.DN
*
* REQUEST EDITING OF DECK(S) D1 - DN.
EDIT RJ ASN ASSEMBLE NAME
ZR X6,ERR2 IF ASSEMBLY ERROR
SEARCH TDKN,X6 CHECK FOR NAME=DECK
ZR X2,EDT3 IF NOT FOUND
SA1 CH CHECK NEXT CHARACTER
SA3 X1
SB7 B0 1 ENTRY
SB2 X3-1R.
SA5 A2 PRESET (A5)
NZ B2,EDT1 IF NOT *.*
SX7 X1+B1 SKIP *.*
SA7 A1
RJ ASN ASSEMBLE NAME
ZR X6,ERR2 IF ASSEMBLY ERROR
SEARCH A0,X6 CHECK FOR NAME=DECK
ZR X2,EDT3 IF NOT FOUND
SB6 A5 SET NUMBER OF ENTRIES
SB7 A2-B6
PL B7,EDT1 IF SECOND NAME AFTER FIRST
SX6 =C+NAMES SEPARATED BY *.* IN WRONG ORDER.+
EQ ERR
EDT1 SEARCH TEDT,X5 SEARCH FOR PREVIOUS ENTRY
NZ X2,EDT2 IF FOUND
BX5 X1*X5 ENTER DECK
SX2 A5
ADDWRD A0,X5+X2
SA4 SETC CHECK FOR CSET
NG X4,EDT2 IF NO CSET DIRECTIVE FOUND
MX0 42
BX0 X0*X6
BX4 X0+X4
ADDWRD TCED,X4 TABLE OF CHARACTER SETS OF EDITED DECKS
EDT2 SB7 B7-2
SA5 A5+2
PL B7,EDT1 LOOP TO END OF REQUESTED DECKS
SA1 CH CHECK NEXT CHARACTER
SA2 X1
SX6 X1+B1
SB2 X2-1R
ZR B2,PDC2 EXIT IF * *
NE B2,B1,ERR2 FORMAT ERROR IF NOT *,*
SA6 A1 SKIP *,*
EQ EDIT LOOP
EDT3 SA1 EDTA+1 SET NAME IN MESSAGE
MX2 30
BX1 X2*X1
LX6 30
BX3 -X2*X6
IX7 X1+X3
MX2 12
BX6 X2*X6
SA7 A1
SA6 A1+B1
SX6 EDTA SET MESSAGE ADDRESS
EQ ERR
EDTA DATA 30HUNKNOWN DECK -
PREFIX SPACE 4,10
*** PREFIX C
*
* SET THE PREFIX CHARACTER FOR THE GENERATED DIRECTIVES TO *C*.
PREFIX BSS 0 ENTRY
SA1 CH GET THE CHARACTER
MX2 6
SA1 X1
SX6 X1-1R
ZR X6,ERR2 IF BLANK
LX1 -6 USE ONLY THE LOWER CHARACTER
BX7 X2*X1
SA1 TDTA UPDATE THE PREFIX OF EACH DIRECTIVE
PRF1 ZR X1,PDC2 IF END OF TABLE
SA3 X1
SA1 A1+B1
BX3 -X2*X3 CLEAR PREFIX CHARACTER
BX6 X3+X7
SA6 A3+
EQ PRF1 CONTINUE
PURGE SPACE 4
*** PURGE MNAME
*
* PURGE MODIFIER *MNAME* IN DECKS SELECTED FOR EDITING.
PURGE SPACE 4
*** PURGE MNAME,*
*
* PURGE MODIFIER *MNAME* AND ALL AFTER
PURGE RJ ASN ASSEMBLE IDENT NAME
ZR X6,ERR2 IF ASSEMBLY ERROR
SEARCH TPRG,X6 SEARCH FOR PURGE NAME
NZ X2,PRG1 IF FOUND
ADDWRD A0,X1*X6 ENTER NEW PURGE NAME
SA2 A6
PRG1 SA1 CH CHECK NEXT CHARACTER
SA3 X1
SB2 X3-1R,
NZ B2,PDC2 EXIT IF NOT *,*
SA3 A3+B1 CHECK NEXT CHARACTER
SX4 B1
SB2 X3-1R*
NZ B2,ERR1 ERROR IF NOT (*)
BX6 X4+X6 SET ALL AFTER FLAG
SA6 A2
EQ PDC2 EXIT
PULLMOD SPACE 4
*** PULLMOD IDENT
*
* PULLMOD IDENT1,IDENT2,IDENT3, . . . ,IDENTN
* CREATE MODSET CORRESPONDING TO *IDENT* ON EDITED DECKS.
PULLMOD RJ ASN ASSEMBLE IDENT NAME
ZR X6,ERR2 IF ASSEMBLY ERROR
SEARCH TPMI,X6 SEARCH FOR PULLMOD NAME ALREADY STORED
NZ X2,PMOD0 IF FOUND
ADDWRD A0,X1*X6 ADD NEW PULLMOD
PMOD0 SA1 CH
SA2 X1 CHECK NEXT CHARACTER
SX6 X1+B1
SB2 X2-1R
ZR B2,PDC2 IF * *
NE B2,B1,ERR2 IF NOT *,*
SA6 A1
EQ PULLMOD
PULLALL SPACE 4,10
*** PULLALL IDENT
*
* CREATE A COMPOSITE MODSET FROM ALL EDITED DECKS
* REFLECTING CHANGES FROM *IDENT* AND LATER MODSETS.
*
*** PULLALL
*
* CREATE A COMPOSITE MODSET FROM ALL EDITED DECKS
PULLALL SX6 B1
SA6 PA SET *PULL ALL* FLAG
SA1 CH
SA2 X1 CHECK NEXT CHARACTER
SB2 X2-1R
ZR B2,PDC2 IF A BLANK
RJ ASN
ZR X6,ERR2 IF MORE THAN 7 CHARACTERS OR BAD CHARACTER
SA6 A6+B1 SET FLAG THAT THERE ARE IDENT ENTRIES
BX5 X6
SEARCH TPAT,X5
NZ X2,PUL IF DUPLICATE REQUEST
ADDWRD A0,X5
PUL SA1 CH
SA2 X1 CHECK NEXT CHARACTER
SB2 X2-1R
NZ B2,ERR2 IF NOT A BLANK
EQ PDC2
TITLE DIRECTIVE CARD PROCESSING SUBROUTINES.
LDC SPACE 4,20
** LDC - LIST DIRECTIVE CARD.
*
* ENTRY (CHAR) - CARD IN *S* FORMAT.
* (ERRM) - ERROR MESSAGE, IF NEEDED.
*
* USES X - 0, 1, 2, 6, 7.
* A - 1, 2, 6, 7.
* B - 3.
*
* CALLS LER, UPN.
*
* MACROS LISTOP, PRINT.
LDC SUBR ENTRY/EXIT
SA1 ERRM
ZR X1,LDC1 IF NO ERROR MESSSAGE
SA2 =9L *ERROR*
BX6 X2
SB3 CHSP
RJ UPN
LISTOP E,LDC2,NG IF ERROR LIST ON
SA2 EC ADVANCE ERROR COUNT
SX6 X2+B1
SA6 A2
EQ LDCX RETURN
LDC1 LISTOP C,LDC3 IF NO LIST SELECTED ON INPUT DIRECTIVES
LDC2 PRINT -CHSP,90
LDC3 SA1 ERRM
ZR X1,LDCX IF NO ERROR MESSAGE - RETURN
SX6 B0 CLEAR ERROR MESSAGE
SA6 A1
SX0 X1
RJ LER LIST ERROR MESSAGE
EQ LDCX RETURN
RDR SPACE 4,20
** RDR - READ DIRECTORY FROM PROGRAM LIBRARY.
*
* CHECK PROGRAM LIBRARY FORMAT. READ DECK NAME TABLE.
*
* USES ALL.
*
* CALLS ABT, ADW, ATS, RDW=.
RDR PS 0 ENTRY/EXIT
SA5 P
ZR X5,RDR RETURN IF NO PROGRAM LIBRARY
SKIPEI P
SKIPB X2,2 BACKSPACE OVER DIRECTORY
READ X2
READW X2,TIDT,TIDTL READ IDENT TABLE
ZR X1,RDR1 IF NO EOR
SA0 =C* PROGRAM LIBRARY EMPTY.*
EQ ABT
RDR1 SA1 TIDT
LX1 18
SA2 A1+B1
SB2 X1-770000B
NZ B2,RDR7 IF NO IDENT TABLE
BX6 X2 SET PROGRAM LIBRARY NAME
SA6 PL
READW P,T1,1 READ FIRST WORD
NZ X1,RDR7 IF EOR
SA1 T1
SX5 X1 SET DIRECTORY LENGTH
LX1 18
SB2 X1-700000B
NZ B2,RDR7 IF NOT DIRECTORY
ZR X5,RDR7 IF EMPTY
RDR2 READW P,T1,2 READ RECORD NAME AND RANDOM ADDRESS
SA1 T1 CHECK TYPE
SB2 X1-OPRT
ZR B2,RDR3 IF OPL DECK
NE B2,B1,RDR4 IF NOT OPL COMMON DECK
ERRNZ OPRT+1-OCRT CODE ASSUMES VALUE
RDR3 ADDWRD TDKN,X1 ENTER DECK NAME
SA1 T2 ENTER RANDOM ADDRESS
ADDWRD A0,X1
RDR4 SX5 X5-2
NZ X5,RDR2 LOOP TO END OF DIRECTORY
SA1 FM
ZR X1,RDR RETURN IF *F* MODE NOT USED
* ENTER ALL DECKS IN EDIT TABLE IF -F- MODE.
SA1 L.TDKN ALLOCATE EDIT TABLE
LX1 -1 COMPENSATE FOR DIFFERENT ENTRY LENGTHS
ALLOC TEDT,X1
SA1 F.TDKN COPY DECK NAMES TO EDIT TABLE
SB4 X3
SB2 B1+B1
MX0 42
SA1 X1
BX6 X0*X1
SB3 B0
RDR5 SX1 A1
BX6 X6+X1
SA6 X2+B3
SA1 A1+B2
SB3 B3+B1
BX6 X0*X1
NE B3,B4,RDR5 LOOP FOR ALL DECK NAMES
EQ RDR RETURN
RDR7 SA0 =C* ERROR IN DIRECTORY.*
EQ ABT
COMMON SPACE 4,10
** INPUT DIRECTIVE PROCESSOR TABLE.
HERE
DATA 0 END OF TABLE
IDENT SPACE 4
IDENT TERMINATE BLOCK
SPACE 4
ERRNG NBUF+NBUFL-* DIRECTIVE PROCESSOR OVERFLOW
TITLE OPLEDIT PRESET.
PRS SPACE 4,10
** PRS - PRESET OPLEDIT.
*
* ENTRY (A0) - FL.
*
* USES X - 0, 1, 2, 3, 4, 6, 7.
* A - 0, 1, 2, 4, 6.
* B - 2, 4, 5, 6, 7.
*
* CALLS ARG, SOF, ZAP.
*
* MACROS CLOCK, DATE, EVICT, GETPP, WRITEC.
PRS SUBR ENTRY/EXIT
SX6 A0-4
SA6 FL
SA1 ACTR ARGUMENT COUNT
SA4 ARGR ADDRESS OF FIRST ARGUMENT
SB4 X1
SB5 ARGT ARGUMENT TABLE
RJ ARG PROCESS ARGUMENTS
ZR X1,PRS2 IF NO ARGUMENT ERROR
PRS1 SA0 =C* ERROR IN ARGUMENTS.*
EQ ABT1
* PROCESS LIST CONTROL.
PRS2 RJ SOF SET OUTPUT FORMAT
CLOCK TIME REQUEST TIME
DATE DATE REQUEST DATE
SA1 TIME SET DATE AND TIME IN SHORT TITLE
SA2 DATE
BX6 X1
LX7 X2
SA6 TERTM
SA7 TERDT
SB6 FETS CHECK FILE NAMES
MX0 42
SB7 FETSL
SB2 8
SA0 =C* FILE NAME CONFLICT.*
PRS3 SA1 B6
SB5 B6+B2
BX1 X0*X1
PRS4 SA2 B5
BX2 X0*X2
ZR X2,PRS5 IF FILE NOT DEFINED
BX7 X2-X1
ZR X7,ABT1 IF FILE NAME CONFLICT
PRS5 SB5 B5+B2 ADVANCE TO NEXT FILE
LT B5,B7,PRS4 IF NOT DONE (INNER LOOP)
SB6 B6+B2
NE B6,B7,PRS3 IF NOT DONE (OUTER LOOP)
SA1 N INITIALIZE PL,S
ZR X1,PRS6 IF NO *NPL*
SX6 B1
BX6 X6+X1 SET COMPLETE BIT
SA6 A1
SA6 A1+7 SAVE FILE NAME
EVICT A1
PRS6 SA1 M INITIALIZE MODSET FILE
ZR X1,PRS7 IF NO MODSET FILE REQUESTED
SX6 B1
BX6 X6+X1
SA6 A1 SET COMPLETE
SA6 A1+7 SAVE NAME
EVICT A1
PRS7 SA1 ZP
ZR X1,PRS8 IF *Z* ARGUMENT NOT SELECTED
SX2 I SET INPUT FET ADDRESS
RJ ZAP PROCESS *Z* ARGUMENT
* SPACE FILL COMMAND.
PRS8 SB7 4
PRS9 SA1 CCDR+B7
RJ SFN
SA6 A1
SB7 B7-B1
PL B7,PRS9 IF NOT COMPLETE
GETPP BUF,LL,BUF GET PAGE SIZE PARAMETERS
SA1 TO
ZR X1,PRSX IF TERMINAL OUTPUT
WRITEC O,BUF WRITE PRINT DENSITY FORMAT CONTROL
EQ PRSX RETURN
TITLE PRESET DATA.
ARGT SPACE 4,20
** ARGT - ARGUMENT TABLE.
ARGT BSS 0 ARGUMENT TABLE
I ARG I,I INPUT FILE
L ARG O,O LIST OUTPUT
P ARG P,P *OPL* FILE
N ARG NNPL,N *NPL* FILE
U ARG =1,UM *U* MODE FLAG
M ARG NMODSET,M *MODSET* FILE
LO ARG LO,LO,400B LIST OPTIONS
F ARG -=1,FM *F* MODE FLAG
D ARG -=1,DB *D* MODE FLAG
Z ARG -*,ZP *Z* MODE FLAG
ARG
NNPL CON 0LNPL+3
NMODSET CON 0LMODSETS+3
TITLE PRESET SUBROUTINES.
SLC SPACE 4,10
** SLC - SET LIST CONTROL.
*
* EXIT (LO) INITIALIZED.
*
* USES X - ALL.
* A - 0, 1, 3, 6.
* B - 2, 3, 4.
SLC3 SA6 LO
SLC SUBR ENTRY/EXIT
SX4 B1+ BIT CONSTANT
SA1 LO GET *LO* OPTIONS
MX0 -6
BX6 X6-X6 INITIALIZE RESULT REGISTER
ZR X1,SLCX IF NOT SELECTED
SA0 =C* INCORRECT -LO- PARAMETER.*
SB2 SLCA LIST OPTION TABLE
SLC1 LX1 6 PICK NEXT LETTER
BX5 -X0*X1
ZR X5,SLC3 IF COMPLETE
SB3 B0+
SLC2 SA3 B2+B3 GET NEXT OPTION
BX2 X5-X3 COMPARE
ZR X3,ABT1 IF END OF OPTION TABLE
SB3 B3+B1 ADVANCE INDEX
NZ X2,SLC2 IF NO MATCH
SB4 B3-B1
LX7 X4,B4
BX6 X6+X7 ADD CURRENT OPTION
EQ SLC1 LOOP FOR NEXT LETTER
SLCA BSS 0 OPTION TABLE
OPTION HERE
CON 0 END OF TABLE
SOF SPACE 4,15
** SOF - SET OUTPUT FORMAT.
*
* SET TERMINAL OUTPUT FLAG AND DEFAULT LIST OPTIONS.
*
* ENTRY (LO) = COMMAND *LO* PARAMETERS.
* = 0 IF OMITTED.
*
* EXIT (LO) = LIST OPTION BIT MAP.
* = DEFAULT OPTIONS IF OMITTED FROM
* COMMAND.
* (TO) = 0 IF OUTPUT ASSIGNED TO
* INTERACTIVE TERMINAL.
*
* USES X - 1, 2, 6.
* A - 1, 2, 6.
*
* CALLS SLC, STF.
SOF SUBR ENTRY/EXIT
* SET TERMINAL FILE DEFAULT OPTIONS.
SX2 O CHECK OUTPUT FILE RESIDENCE
RJ STF
SA6 TO SET TERMINAL OUTPUT FLAG
SA2 SOFA
ZR X6,SOF2 IF ASSIGNED TO TERMINAL
* SET NON-TERMINAL FILE DEFAULT OPTIONS.
SA2 SOFB SET DEFAULT LIST OPTIONS
* PROCESS SPECIFIED OR DEFAULT OPTIONS.
SOF2 SA1 LO READ COMMAND OPTIONS
NZ X1,SOF3 IF OPTIONS ENTERED
BX6 X2 STORE DEFAULT OPTIONS
SA6 A1
SOF3 RJ SLC SET LIST CONTROLS
EQ SOFX RETURN
SOFA CON 0LE DEFAULT TERMINAL OPTIONS
SOFB CON 0LECMDS DEFAULT NON-TERMINAL OPTIONS
COMMON SPACE 4,10
** PRESET COMMON DECKS.
*CALL COMCARG
*CALL COMCCPM
*CALL COMCSTF
*CALL COMCUSB
*CALL COMCZAP
OPLEDIT TTL OPLEDIT - OPL EDITING PROGRAM.
SPACE 4
END OPLEDIT OPL EDITING PROGRAM