IDENT MODIFY,FETS,MODIFY
ABS
ENTRY MODIFY
ENTRY RFL=
SYSCOM B1
MODIFY TITLE MODIFY - SOURCE LIBRARY EDITING PROGRAM.
*COMMENT MODIFY - SOURCE LIBRARY EDITING PROGRAM.
COMMENT COPYRIGHT CONTROL DATA SYSTEMS INC. 1992.
DOC SPACE 4
*** MODIFY - SOURCE LIBRARY EDITING PROGRAM.
* G. R. MANSFIELD. 69/06/22.
* A. D. FORET. 74/12/05.
* A. D. FORET. 76/08/04.
SPACE 4,20
*** MODIFY IS A SOURCE LIBRARY EDITING PROGRAM
* DESIGNED TO AID IN THE DEVELOPMENT AND MAINTENANCE
* OF A SYSTEM OF PROGRAMS OR DECKS. THE SOURCE LINES
* ARE MAINTAINED IN SUCH A MANNER THAT EACH DIRECTIVE HAS
* PERMANENT SEQUENCING INFORMATION AS LONG AS THE LINE
* REMAINS ON THE PROGRAM LIBRARY.
CARD SPACE 4,20
*** COMMAND CALL.
*
* MODIFY(P1,P2,P3...PN)
*
* *PN* MAY BE ONE OF THE FOLLOWING -
*
* SECOND DEFAULT IS THE VALUE OF THE PARAMETER IF IT IS NOT
* EQUATED. IF NO SECOUND DEFAULT IS SPECIFIED IT IS THE SAME
* AS THE FIRST DEFAULT.
*
* PN DESCRIPTION
*
* I DIRECTIVE INPUT. DEFAULT IS *INPUT*.
*
* P PROGRAM LIBRARY FILE. DEFAULT IS *OPL*.
*
* C COMPILE FILE OUTPUT. DEFAULT IS *COMPILE*.
*
* N NEW PROGRAM LIBRARY. DEFAULT IS NOT SELECTED.
* SECOND DEFAULT IS *NPL*.
*
* S SOURCE FILE. DEFAULT IS NOT SELECTED.
* SECOND DEFAULT IS *SOURCE*.
*
* L LIST OUTPUT FILE. DEFAULT IS *OUTPUT*.
*
* LO LIST OPTIONS. DEFAULT IS *E* IF LIST OUTPUT FILE IS
* ASSIGNED TO THE TERMINAL, OTHERWISE DEFAULT IS
* *ECTMWDS*.
*
* OPTION DESCRIPTION
*
* E ERRORS.
* C DIRECTIVES OTHER THAN *INSERT*,
* *DELETE*, AND *RESTORE*.
* T INPUT TEXT.
* M MODIFICATIONS PERFORMED.
* W COMPILE FILE DIRECTIVES.
* D DECK STATUS.
* S STATISTICS.
* I INACTIVE LINES.
* A ACTIVE LINES.
*
*
* A WRITE COMPRESSED COMPILE. DEFAULT IS NOT SELECTED.
*
* BL BURSTABLE LISTING. GENERATE OUTPUT LISTING EASILY
* SEPARABLE INTO COMPONENTS. A NEW PAGE WILL BE
* STARTED ON THE OUTPUT LISTING FOR EACH INDIVIDUAL
* DECK. DEFAULT IS NOT SELECTED.
*
* D IGNORE ALL ERRORS. DEFAULT IS NOT SELECTED.
*
* F MODIFY ALL DECKS. DEFAULT IS NOT SELECTED.
*
* U MODIFY ONLY DECKS MENTIONED ON *DECK* DIRECTIVES.
* DEFAULT IS NOT SELECTED.
*
* NR NO REWIND ON COMPILE. DEFAULT IS NOT SELECTED.
*
* X REWIND *INPUT* AND *OUTPUT* FILES, SET *A*
* OPTION AND CALL SPECIFIED PROGRAM WHEN
* MODIFICATION IS COMPLETE. DEFAULT PROGRAM
* IS *COMPASS*. DEFAULT IS NOT SELECTED.
*
* Q SAME AS *X* EXCEPT THAT *INPUT* AND *OUTPUT*
* ARE NOT REWOUND.
*
* Z TAKE DIRECTIVES ONLY FROM COMMAND. DEFAULT IS
* NOT SELECTED.
* EXAMPLE - MODIFY(...Z...)XDDDDDXDDDXDDD
* X IS ANY CHARACTER NOT IN *D*.
* D IS A MODIFY DIRECTIVE.
*
* CV CONVERSION OPTION. DEFAULT NOT SELECTED.
* *CV* MAY BE EITHER 63 OR 64.
* CV=MAD64 INDICATES THAT MODIFY SHOULD CONVERT THE
* OLD *MADIFY* COMPRESSION CODES TO THE MODIFY CODE.
*
* IF *X* OR *Q* OPTIONS ARE SELECTED THE FOLLOWING
* ADDITIONAL OPTIONS APPLY.
*
* CB SET ASSEMBLER *B* ARGUMENT. DEFAULT IS *LGO*.
*
* CS SET ASSEMBLER *S* ARGUMENT. DEFAULT IS *SYSTEXT*.
*
* CG SET ASSEMBLER *G* ARGUMENT. DEFAULT IS *0*.
* SECOND DEFAULT IS *SYSTEXT*.
*
* CL SET ASSEMBLER *L* ARGUMENT. DEFAULT IS *0*.
* SECOND DEFAULT IS *OUTPUT*.
DAYFILE SPACE 4,25
*** DAYFILE MESSAGES.
*
*
* * MODIFICATION COMPLETE.* - NORMAL COMPLETION MESSAGE.
*
* * MODIFICATION ERRORS.* - ERRORS ENCOUNTERED WHILE
* PROCESSING DIRECTIVES.
*
* * ERROR IN MODIFY ARGUMENTS.* - AN INCORRECT COMMAND
* OPTION WAS ENCOUNTERED.
*
* * FILE NAME CONFLICT.* - TWO OR MORE FILES HAVE THE SAME
* NAME.
*
* * DIRECTIVE ERRORS.* - INCORRECT DIRECTIVES WERE ENCOUNTERED.
*
* * NO DIRECTIVES.* - INPUT FILE WAS EMPTY, AND DIRECTIVES
* WERE REQUIRED.
*
* * ERROR IN DIRECTORY.* - THE DIRECTORY ON THE PROGRAM
* LIBRARY WAS NOT IN THE PROPER FORMAT.
*
* * PL ERROR IN DECK DECKNAM* - AN ERROR WAS ENCOUNTERED
* DURING PROCESSING OF DECK *DECKNAM*.
*
* * PROGRAM LIBRARY EMPTY.* - THE SPECIFIED OPL FILE CONTAINED
* NO DATA.
*
* * -LO- ERROR, MUST BE IN -ECTMWDSIA-.* - *LO* OPTION
* SPECIFIED NOT VALID.
*
* * NNNN ERRORS IN DECKNAM - * - DECK *DECKNAM*
* CONTAINED *NNNN* ERRORS.
*
* * S OPTION INCORRECT WITH A, X OR Q.* - COMPRESSED COMPILE
* AND SOURCE OUTPUT NOT ALLOWED SIMULTANEOUSLY.
*
* * X OR Q INCORRECT WITHOUT COMPILE.* - SELECTION OF *X*
* OR *Q* OPTIONS WITHOUT WRITING A COMPILE FILE
* IS NOT PERMITTED.
*
* * DECKNAM - INCORRECT CS, 63 ASSUMED.* - CHARACTER SET
* IDENTIFICATION FOR DECK *DECKNAM* DID NOT INDICATE
* IT WAS EITHER 63 OR 64 CHARACTER SET. MODIFY
* ASSUMES IT TO BE 63 CHARACTER SET AND MAKES IT
* SUCH ON A NEW PROGRAM LIBRARY, IF ONE IS BEING
* CREATED.
*
* * DECKNAM - MIXED CHARACTER SET DETECTED.* - UPON EDITING
* THE INDICATED DECK MODIFY DETECTED THAT THE CHARACTER
* SET OF THIS DECK WAS DIFFERENT FROM THOSE ALREADY
* PROCESSED. PROGRAM LIBRARIES CONTAINING RECORDS OF
* MORE THAN ONE CHARACTER SET ARE INCORRECT.
*
* * REDUNDANT CONVERSION IGNORED.* - CONVERSION TO THE
* DESIRED CHARACTER SET IS REDUNDANT SINCE THE
* OLD PROGRAM LIBRARY IS ALREADY IN THE SPECIFIED
* RESULTANT CHARACTER SET MODE.
*
* *INCORRECT CS ON INPUT.* - A 64 CHARACTER INPUT WAS
* DETECTED WHILE THE PL IS 63. THIS MIXED MODE
* IS NOT ALLOWED. A 63 CHARACTER SET ZERO CHARACTER
* IS NOT DEFINED.
*
* * CSET - UNKNOWN CHARACTER SET.* - AN UNKNOWN CHARACTER
* SET WAS SPECIFIED.
*
* * DECKNAM - INCORRECTLY NESTED CALL OF COMMON DECK*
* A REDUNDANT NESTED CALL WAS FOUND. A CALL, CALLC,
* NIFCALL, OR IFCALL CALLS A COMMON DECK WHICH HAS
* HAS ALREADY BEEN CALLED IN THE CURRENT NESTING
* SEQUENCE.
OPERATOR SPACE 4,15
*** OPERATOR MESSAGES.
*
* * MODIFY / DECKNAM * - DECK *DECKNAM* IS CURRENTLY HAVING
* MODIFICATIONS PROCESSED AGAINST IT.
*
* * CREATE / DECKNAM * - DECK *DECKNAM* IS CURRENTLY BEING
* TRANSFORMED FROM SOURCE TO COMPRESSED FORMAT.
*
* * IGNORE / DECKNAM * - MODIFICATIONS TO DECK *DECKNAM*
* ARE BEING IGNORED, IN RESPONSE TO AN *IGNORE*
* DIRECTIVE.
*
* * SKIP / RECNAME * - RECORD *RECNAME* IS BEING SKIPPED.
MODIFY TITLE GENERAL DESCRIPTION.
*** THE MODIFY EDITING PROCESS IS CONTROLLED BY THE USE OF
* DIRECTIVE LINES, WHICH ARE NORMALLY READ FROM THE JOB
* INPUT FILE. A DIRECTIVE CONSISTS OF A PREFIX CHARACTER
* IN COLUMN ONE FOLLOWED IMMEDIATELY BY A DIRECTIVE NAME. THE
* PREFIX CHARACTER IS PRESET TO -*-, BUT MAY BE CHANGED VIA A
* DIRECTIVE. THE DIRECTIVE IS TERMINATED BY ANY CHARACTER
* WITH A DISPLAY CODE VALUE .GE. 55B. THE MAXIMUM LENGTH OF
* ANY MODIFY NAME IS SEVEN CHARACTERS.
*
* OUTPUT FROM MODIFY IS PLACED ON A FILE CALLED *COMPILE* FOR
* FURTHER PROCESSING BY OTHER PROGRAMS. THESE LINES CONTAIN
* SEQUENCING INFORMATION AFTER THE LAST CHARACTER OF SOURCE
* DATA. THIS INFORMATION MAY BE SUPPRESSED OR IT,S POSITION
* CHANGED VIA DIRECTIVES. THE *COMPILE* MAY ALSO BE DIVIDED
* INTO LOGICAL RECORDS OR FILES.
*
* THE PROGRAM LIBRARY CONSISTS OF TWO OR MORE LOGICAL RECORDS
* OF SOURCE LINES WHICH ARE REFERRED TO AS DECKS. THE USUAL
* DECKS CONSISTS OF A SINGLE PROGRAM. CERTAIN DECKS MAY BE
* *COMMON* DECKS. COMMON DECKS MAY BE CALLED FROM OTHER DECKS
* FOR INSERTION OF THE TEXT OF THE *COMMON* DECK INTO THE
* COMPILE FILE. THIS FEATURE ALLOWS SEVERAL ROUTINES TO SHARE
* IDENTICAL SUBROUTINES OR DATA BLOCKS. *COMMON* DECKS MAY ALSO
* BE CALLED FROM OTHER *COMMON* DECKS.
*
* THE PROGRAM LIBRARY IS TREATED AS A RANDOM ACCESS FILE AND
* AS SUCH, MUST RESIDE ON MASS STORAGE. A DIRECTIVE IS PROVIDED
* FOR COPYING THE PROGRAM LIBRARY ONTO MASS STORAGE.
*
* DECKS MAY REMOVED, REPLACED, OR INSERTED INTO THE PROGRAM
* LIBRARY BY USE OF COPY UTILITIES SUCH AS *COPYX*, *COPYBR*,
* OR *LIBEDIT*.
*
* DECKS MAY BE MODIFIED BY INSERTION, DELETION, AND RESTORATION
* OF LINES VIA DIRECTIVE. DELETED LINES ARE MARKED INACTIVE,
* BUT NOT DELETED FROM THE PROGRAM LIBRARY. THE LINE MAY BE
* REACTIVATED BY RESTORATION.
*
* FACILITIES INCLUDED IN MODIFY ARE -
*
* PREPARATION OF PROGRAM LIBRARY FROM SOURCE.
* MODIFICATION OF DECKS BY INSERTION, DELETION, AND RESTORATION.
* PRODUCTION OF SOURCE FROM THE PROGRAM LIBRARY.
* GENERATION OF PROGRAM LIBRARIES.
* COMPREHENSIVE LIST OUTPUT OF THE MODIFICATION PROCESS.
* COMPREHENSIVE LIST OUTPUT OF THE STATUS OF THE LIBRARY.
* CONTROL OF MODIFIED OUTPUT FOR PROCESSING BY OTHER PROCESSORS.
* ABILITY TO PROCESS INPUT FROM ALTERNATE INPUT FILES.
* PROCESSING OF DIRECTIVES FROM THE MODIFY COMMAND.
* DIVISION OF COMPILE FILE INTO RECORDS AND FILES.
* ABILITY TO SIMULTANEOUSLY PROCESS MORE THAN ONE LIBRARY.
* SUPPORT OF 63 OR 64 CHARACTER SET PROGRAM LIBRARIES.
* CONDITIONAL PROCESSING OF OUTPUT TO COMPILE FILE.
FILES TITLE FILE FORMATS.
** FILE FORMATS.
*
* SOURCE.
* THE SOURCE FILE CONSISTS OF ONE OR MORE RECORDS
* REPRESENTING THE DECKS. EACH DECK IS PRECEEDED BY ONE OR TWO
* LINES WHICH ARE USED FOR DECK GENERATION. THE FIRST
* CONTAINS THE NAME OF THE DECK BEGINNING IN COLUMN ONE.
* THE SECOND LINE, IF IT CONTAINS THE NAME *COMMON* BEGINNING
* IN COLUMN ONE, SIGNIFIES THAT THE DECK WILL BE GIVEN COMMON
* STATUS ON THE PROGRAM LIBRARY. THESE LINE(S) ARE NOT PART
* OF THE DECK RECORD WHEN PLACED ON THE PROGRAM LIBRARY.
*
*
* PROGRAM LIBRARY.
*
* THE PROGRAM LIBRARY CONTAINS TWO OR MORE RECORDS.
* THE LAST RECORD IS A DIRECTORY OF ALL PRECEEDING RECORDS.
* EACH DECK RECORD IS OF THE FOLLOWING FORMAT -
*
* WORD CONTENTS
*
* PREFIX TABLE.
*
*T ID 12/7700,12/0016,36/
*T,ID+1 42/DECKNAM,18/
*T,ID+2 60/CREATION DATE
*T,ID+3 60/LAST MODIFICATION DATE
*T,ID+4 60/
*T,ID+5 60/
*T,ID+6 60/
*T,ID+7 60/
*T,ID+10 60/
*T,ID+11 60/
*T,ID+12 60/
*T,ID+13 60/
*T,ID+14 60/
*T,ID+15 60/
*T,ID+16 48/,6/A,6/CS
*
* A ASCII CHARACTER SET FLAG.
* 1 = ASCII 6/12 CHARACTER SET.
* 0 = DISPLAY CODE.
*
* CS CHARACTER SET OF RECORD.
* 64 = 64 CHARACTER SET.
* 0 = 63 CHARACTER SET.
* OTHER, IMPLIES 63 CHARACTER SET.
*
*
* MODIFIER TABLE, N+1 WORDS LONG.
*
*T MT 12/TYPE,36/,12/N
*T, MT+1 42/MODNAM,1/,1/Y,16/
*
* TYPE 7001, IF NORMAL DECK.
* 7002, IF COMMON DECK.
* N NUMBER OF MODIFIERS.
* Y YANK FLAG.
*
* MODNAM MODIFIER NAME.
*
* CONTROL INFORMATION FOR EACH LINE.
*
*T CARD 1/A,5/WC,18/SEQ,18/MHB,18/MHB
*T,CARD+1 6/,18/MHB,18/MHB,18/MHB
*T,CARD+2 6/,18/MHB,18/MHB,18/END
*T,LINE+N 60/TEXT OF COMPRESSED LINE
*
* A IF SET, LINE IS ACTIVE.
* WC WORD COUNT OF COMPRESSED LINE.
* SEQ LINE SEQUENCE NUMBER.
* END THE LIST OF MHB-S IS TERMINATED BY ONE TO FIVE ZERO
* BYTES, AS REQUIRED TO FILL THE WORD.
*
* MODIFICATION HISTORY BYTE.
*
*T MHB 1/,1/A,16/MOD
*
* MOD ORDINAL INTO MODIFIER TABLE OF THE MODIFIER THAT
* CAUSED THIS STATUS CHANGE FOR THE LINE.
* 0, IF ORIGINAL LINE.
* A SET IF THE MODIFIER ACTIVATED THE LINE.
*
* PROGRAM LIBRARY DIRECTORY.
*
* THE PREFIX TABLE FOR THE PROGRAM LIBRARY DIRECTORY
* IS IN STANDARD KRONOS PREFIX TABLE FORMAT.
*
* DIRECTORY TABLE.
*
*T DIR 12/7000,30/,18/L
*T DIR+1 42/DECK NAME 1,18/TYPE
*T DIR+2 30/,30/RANDOM ADDRESS 1
*T DIR+3 42/DECK NAME 2,18/TYPE
*T DIR+4 30/,30/RANDOM ADDRESS 2
*T DIR+N*2 42/ DECK NAME N,18/TYPE
*T DIR+N*2+1 30/,30/RANDOM ADDRESS N
*
* L LENGTH IN WORDS.
* TYPE 7001, IF NORMAL DECK
* 7002, IF COMMON DECK.
TITLE ASSEMBLY CONSTANTS AND MACRO DEFINITIONS.
ASSEMBLY SPACE 4,10
**** ASSEMBLY CONSTANTS.
OBUFL EQU 4004B OUTPUT BUFFER LENGTH
CBUFL EQU 10022B COMPILE FILE BUFFER LENGTH
SBUFL EQU 4004B SOURCE FILE BUFFER LENGTH
MBUFL EQU 10022B SCRATCH FILE BUFFER LENGTH
PBUFL EQU 16044B OPL FILE BUFFER LENGTH
NBUFL EQU 10022B NPL FILE BUFFER LENGTH
TBUFL EQU 4004B SCRATCH BUFFER (MULTIPLE OF 1001B)
IWMACS EQU 150 MAXIMUM INPUT LINE WIDTH 150 CHARACTERS
IWMAX EQU IWMACS*2 MAXIMUM INPUT WIDTH BUFFER SIZE
BUFL EQU IWMAX+1 BUFFER LENGTH
FLINL EQU 2000B FIELD LENGTH INCREMENT
MTBSL EQU 14000B NOMINAL TABLE LENGTH
MXCCL EQU 37B MAXIMUM LENGTH OF COMPRESSED LINE
CMFL EQU 600B *COMPASS* DEFAULT FL
FETLEN EQU 10 ALL FETS MUST BE 10 WORDS LONG
FETODL EQU 16 LENGTH OF OD FET EXTENSION
****
COMMON SPACE 4,10
* COMMON DECKS.
*CALL COMCMAC
*CALL COMCCMD
*CALL COMSSRT
MACROS SPACE 4,20
** MACRO DEFINITIONS.
ADDWRD SPACE 4,10
** ADDWRD - ADD WORD TO TABLE.
*
* ADDWRD TNAM,WORD
*
* TNAM NAME OF TABLE.
* WORD WORD TO ADD.
*
* CALLS ADW.
PURGMAC ADDWRD
ADDWRD MACRO T,W
IFC NE,$X1$W$,1
BX1 W
R= A0,T
RJ ADW
ENDM
CARD SPACE 4,20
** CARD - GENERATE LIST AND CALL FOR DIRECTIVE TRANSLATION.
*
* CARD NAME,ADDR
*
* NAME DIRECTIVE NAME.
* ADDR ADDRESS OF DIRECTIVE PROCESSOR
* IF *ADDR* NOT SPECIFIED, EXECUTION BEGINS
* AT *NAME*.
*
* CALLS CKC.
NOREF .X
PURGMAC CARD
CARD MACRO N,AD
LOCAL A,B,C
IF DEF,//.X,1
D IFNE //.X,*
RMT
CON 0
A BSS 0
RMT
SA0 A
RJ CKC
QUAL
B BSS 0
.X SET B
QUAL *
D ENDIF
RMT
C SET AD N
CON 0L_N+C
RMT
ENDM
ALLOC SPACE 4,10
** ALLOC - ALLOCATE *N* ADDITIONAL WORDS TO TABLE *TNAM*.
*
* ALLOC TNAM,N,S
*
* TNAM TABLE NAME.
* N NUMBER OF WORDS TO ALLOCATE.
* S ALLOCATE TABLE SLACK ROOM ONLY.
*
* CALLS ATS, ATX.
PURGMAC ALLOC
ALLOC MACRO T,N,S
R= X1,N
R= A0,T
IFC EQ,$S$$
RJ ATS
ELSE
RJ ATX
ENDIF
ENDM
PRINT SPACE 4,10
** PRINT - PRINT LINE.
*
* PRINT FWA,N
*
* FWA FWA OF LINE.
* N WORD COUNT OF LINE IN *S* FORMAT. IF MISSING
* LINE IN *C* FORMAT.
*
* CALLS WOF.
PURGMAC PRINT
PRINT MACRO F,N
SX1 F
IFC NE,$N$$
R= X2,N
ELSE
BX2 X2-X2
ENDIF
RJ WOF
ENDM
SEARCH SPACE 4,20
** SEARCH - SEARCH TABLE *TNAM* FOR *ENTRY*.
*
* SEARCH TNAM,ENTRY,BITS
*
* TNAM TABLE NAME.
* ENTRY ENTRY TO SEARCH FOR.
* BITS ADDITIONAL BITS FROM 0 - 16.
*
* CALLS STB.
PURGMAC SEARCH
SEARCH MACRO T,E,B
R= A0,T
IFC NE,$X6$E$,1
BX6 E
MX1 42
IFC NE,$B$$,2
R= X2,B
BX1 X1+X2
RJ STB
ENDM
TABLE SPACE 4,15
** TABLE - GENERATE MANAGED TABLE.
*
* TABLE TNAM
*
* TNAM NAME OF TABLE.
*
* EXIT F.TNAM - NAME OF WORD CONTAINING TABLE FWA.
* L.TNAM - NAME OF WORD CONTAINING TABLE LENGTH.
PURGMAC TABLE
MACRO TABLE,T,N
T EQU *
CON MTBS
F.T EQU FTAB+T
RMT
L.T EQU LTAB+T
ORG L.T
CON 0
ORG NTAB+T
CON N
RMT
ENDM
LISTOP SPACE 4,15
** LISTOP - CHECK LIST OPTION.
*
* LISTOP TYPE,ADDR,INS,REG
*
* TYPE OPTION LETTER.
* ADDR ADDRESS TO JUMP TO.
* INS ALTERNATE INSTRUCTION TO EXECUTE, DEFAULT IS *PL*.
* REG ALTERNATE REGISTER TO USE, DEFAULT IS *X1*.
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
ENDM
OPTION SPACE 4,15
** OPTION - DEFINE BIT VALUE OF OPTION.
*
* OPTION TYPE
*
* TYPE OPTION LETTER.
*
* 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
ENDM
READK SPACE 4
*** READK - READ CODED LINE TO WORKING BUFFER.
*
*
* READK FILE,BUF,N
*
* WORDS ARE UNPACKED AND STORED IN THE WORKING BUFFER ONE 6/12
* CHARACTER/WORD UNTIL THE END OF LINE (0000) BYTE IS SENSED.
* 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
R= B6,S
R= B7,N
R= X2,F
RJ =XSSR
ENDM
WRITEK SPACE 4,10
*** WRITEK - WRITE CODED LINE FROM LINE BUFFER.
*
*
* WRITEK FILE,BUF,N
*
* 6/12 CHARACTERS ARE PACKED FROM THE WORKING BUFFER 5-10
* CHARACTERS PER WORD.
* TRAILING CODES ARE DELETED BEFORE CHARACTERS ARE PACKED.
*
* CALLS SSW.
PURGMAC WRITEK
WRITEK MACRO F,S,N
R= B6,S
R= B7,N
R= X2,F
RJ =XSSW
ENDM
QUAL SPACE 4
** DEFINE QUAL BLOCK ORDER.
QUAL
QUAL DIRECT
QUAL PRESET
QUAL MACRO$
QUAL
FETS TITLE FILE DEFINITIONS.
** FILE DEFINITIONS.
ORG 110B
FETS BSS 0 ALL FETS ARE 26 WORDS LONG
I BSS 0 DIRECTIVE INPUT FILE
INPUT FILEC SBUF,SBUFL,FET=10
BSSZ FETODL
O BSS 0 LIST OUTPUT FILE
OUTPUT FILEC OBUF,OBUFL,FET=10
BSSZ FETODL
C BSS 0 COMPILE FILE
COMPILE FILEC CBUF,CBUFL+SBUFL,FET=10
BSSZ FETODL
S BSS 0 SOURCE FILE
SOURCE FILEC SBUF,SBUFL,FET=10
ORG S
CON 0
ORG S+FETLEN
BSSZ FETODL
M BSS 0 SCRATCH FILE
ZZZZZG0 RFILEB MBUF,MBUFL,FET=10
ORG M+7
CON 0LSCR1+3
ORG M+FETLEN
BSSZ FETODL
P BSS 0 PROGRAM LIBRARY FILE
OPL RFILEB PBUF,PBUFL,FET=10
ORG P+7
CON 0LOPL+3
ORG P+FETLEN
BSSZ FETODL
N BSS 0 NEW PROGRAM LIBRARY FILE
NPL RFILEB NBUF,NBUFL,FET=10
ORG N
CON 0
ORG N+8
ORG N+FETLEN
BSSZ FETODL
A BSS 0 SCRATCH FILE
ZZZZZG1 RFILEC CBUF,CBUFL,FET=10
ORG A+7
CON 0LSCR2+3
ORG A+FETLEN
BSSZ FETODL
T BSS 0 INSERTION TEXT OVERFLOW FILE
ZZZZZG2 RFILEB TBUF,TBUFL,FET=10
ORG T
CON 0
ORG T+7
CON 0LSCR3+3
ORG T+FETLEN
BSSZ FETODL
FETSL BSS 0
TITLE MANAGED TABLE DEFINITIONS.
TABLES SPACE 4,10
** MODIFY MANAGED TABLES.
*
* MANAGED TABLES ARE REFERENCED BY TABLE NUMBER *TNAM*.
*
* F.TNAM FWA OF TABLE.
* L.TNAM LENGTH OF TABLE.
*
* *TABLE* MACRO GENERATES THE ABOVE SYMBOLS.
FTAB BSS 0
LOC 0
TDKN SPACE 4,10
** TDKN - TABLE OF DECK NAMES.
*
*T TDKN 42/DECK NAME,18/
*T,TDKN+1 24/ADDRESS OF FILE NAME,36/RANDOM ADDRESS OF RECORD
TDKN TABLE 10 TABLE OF DECK NAMES
TNME SPACE 4,15
** TNME - TABLE OF NAMES MENTIONED ON DIRECTIVE LINES.
*
*T TNME 42/ NAME, 1/, 1/ U, 1/ Y, 1/, 1/ I, 12/, 1/ A
*
* NAME NAME MENTIONED ON DIRECTIVE LINE.
* U IF NOT SET, INDICATED *UNYANK*. SET FOR *YANK*.
* Y SET FOR *YANK* OR *UNYANK*.
* I SET IF IDENT NAME.
* A ALL AFTER FLAG.
*
* SET TO -*******- ON INITIAL ENTRY.
TNME TABLE 10 TABLE OF NAMES
TMOD SPACE 4,20
** TMOD - TABLE OF MODIFICATIONS.
*
*T TMOD 1/I,1/R,4/,18/AFC,18/NFC,18/NEXT
*T,TMOD+1 1/E,5/,18/ALC,18/NLC,18/EC
*T,TMOD+2 2/,16/IMN,18/NCI,24/AIT
*
* I SET IF INSERT. NOT SET IF DELETE.
* R SET IF RESTORE.
* AFC ADDRESS OF MODIFIER OF FIRST LINE FOR MODIFICATION.
* NFC NUMBER OF FIRST LINE FOR MODIFICATION.
* NEXT ADDRESS OF NEXT MODIFICATION.
* E SET IF ERROR.
* ALC ADDRESS OF MODIFIER OF LAST LINE FOR MODIFICATION.
* NLC NUMBER OF LAST LINE FOR MODIFICATION.
* EC ERROR CODE.
* IMN INDEX OF MODIFIER NAME FOR MODIFICATION.
* NCI NUMBER OF LINES TO INSERT.
* AIT ADDRESS OF INSERTION TEXT.
TMOD TABLE 30 TABLE OF MODIFICATIONS
TDKI SPACE 4,12
** TDKI - TABLE OF DECK IDENTIFIERS.
*
* WHEN PROCESSING DIRECTIVES -
*
*T TDKI 42/DECK NAME,18/
*
* WHEN PROCESSING MODIFICATIONS -
*
*T TDKI 42/IDENTIFIER,1/Y,17/CARD NUMBER
*
* Y YANK FLAG.
TDKI TABLE 10 TABLE OF DECK IDENTIFIERS
TNCD SPACE 4,10
** TNCD - TABLE OF NEXT LINES.
*
* TABLE PARALLELS *TDKI*.
*
*T TNCD 42/,18/NEXT
*
* NEXT NEXT LINE TO BE PROCESSED.
TNCD TABLE 10 TABLE OF NEXT LINES
TEDT SPACE 4,12
** TEDT - TABLE OF DECKS TO BE EDITED.
*
*T TEDT 42/DECK NAME,18/AFM
*T TEDT+1 42/,18/ADK
*
* AFM ADDRESS OF FIRST MODIFICATION.
* ADK ADDRESS OF DECK IN *TDKN*.
TEDT TABLE 10 TABLE OF DECKS TO BE EDITED
TNDK SPACE 4,10
** TNDK - TABLE OF NEW DECKS.
*
* SEE *TDKN* TABLE FORMAT.
TNDK TABLE 10 TABLE OF NEW DECKS
TECD SPACE 4,10
** TECD - TABLE OF EDITED COMMON DECKS.
*
* SEE *TDKN* TABLE FORMAT.
TECD TABLE 10 TABLE OF EDITED COMMON DECKS
TDEF SPACE 4,10
** TDEF - TABLE OF DEFINED NAMES.
*
*T DEF 42/ DEFINED NAME, 1/ I, 1/ , 16/ VALUE
*
* I DEFINITION OF SYMBOL ENCOUNTERED ON INPUT. IF THIS
* BIT IS SET COMPILE FILE DEFINITIONS OF THE SAME
* SYMBOL WILL BE IGNORED.
TDEF TABLE 10 TABLE OF DEFINED NAMES
TIGD SPACE 4,10
** TIGD - TABLE OF DECKS TO BE IGNORED.
*
*T TIGD 42/DECK NAME,18/
TIGD TABLE 10 TABLE OF DECKS TO BE IGNORED
TMVE SPACE 4,10
** TMVE - TABLE OF MOVE AND PURGE DIRECTIVES.
*
*T TMVE 1/P,23/,18/DNR,18/DNP
*
* P PURGE BIT.
* DNR DECK NAME INDEX OF MOVE REFERENCE.
* DNP DECK NAME INDEX OF PURGE/MOVE.
TMVE TABLE 10 TABLE OF MOVE AND PURGE DIRECTIVES
TNCC SPACE 4,10
** TNCC - TABLE OF NESTED COMMON DECK CALLS.
*
*T TNCC 42/DECK NAME,18/SKIP COUNT
TNCC TABLE 50 TABLE OF NESTED COMMON DECK CALLS
TCCD SPACE 4,10
** TCCD - TABLE OF CALLED COMMON DECKS.
*
*T TCCD 42/DECK NAME,18/0
TCCD TABLE 200 TABLE OF CALLED COMMON DECKS
TTXT SPACE 4,10
** TXTT - TABLE OF INSERTION TEXT.
*
* VARIABLE LENGTH ENTRIES.
*
* COMPRESSED LINE TEXT.
TTXT TABLE IWMAX TABLE OF INSERTION TEXT
TCDK SPACE 4,10
** TCDK - TABLE OF COMMON DECKS.
*
* SEE *TXTT* TABLE FORMAT.
TCDK TABLE 0 TABLE OF COMMON DECKS
SPACE 4
* MANAGED TABLES VALUES.
FTABL BSS 0
LOC *O
CON MTBS LWA+1 OF 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 T INPUT TEXT
OPTION M MODIFICATIONS
OPTION W COMPILE FILE DIRECTIVES
OPTION D DECK STATUS
OPTION S STATISTICS
OPTION I INACTIVE LINES
OPTION A ACTIVE LINES
TITLE TEMPORARY STORAGE ASSIGNMENTS.
COMMON SPACE 4
** COMMON DATA.
T1 CON 0 TEMPORARY STORAGE
T2 CON 0 TEMPORARY STORAGE
FL CON 0 FIELD LENGTH
DL CON -0 LENGTH OF ORIGINAL DECK TABLE
PC CON 1R* DIRECTIVE PREFIX CHARACTER
PCC CON 1R* COMPILE PREFIX CHARACTER
CH CON 0 CHARACTER POINTER
SC CON 72 SEQUENCE NUMBER COLUMN - 1
CON 0 CURRENT VALUE OF SC (RESET FOR EACH DECK)
PL CON 0LOPL PROGRAM LIBRARY NAME
NC CON 0 LINES WRITTEN TO COMPILE THIS RECORD
CON 0 TOTAL NUMBER OF LINES ON COMPILE FILE
RI CON 0 RANDOM INDEX RETURN
CON 0
IW CON 72 DEFAULT INPUT LINE WIDTH
DISCOL CON 00B DISPLAY CODE COLON CHARACTER
DISPER CON 63B DISPLAY CODE PERCENT CHARACTER
SFL CON 0 STORE FL
EFL CON 0 *ECS* FIELD LENGTH
CDC CON 0 OPLC LINE COUNT - RESET FOR EACH DECK
CDS CON 0 OPLC SKIP COUNT - RESET FOR EACH DECK
SPACE 4
** MODIFICATION CONTROLS.
EI CON 0 EDIT TABLE INDEX
MA CON 0 MODIFICATION ADDRESS
CON 0 DELETE MODIFICATION ADDRESS
CON 0 INSERT MODIFICATION ADDRESS
DN CON 0 CURRENT DECK NAME
DA CON 0 CURRENT DECK ADDRESS
EC CON 0 DECK ERROR COUNTER
CC CON 0 INACTIVE LINE COUNTER
CON 0 ACTIVE LINE COUNTER
CON 0 INSERTED LINE COUNTER
SPACE 4
** LIST CONTROLS.
BL CON 0 BURSTABLE LISTING FLAG
ERRM CON 0 ADDRESS OF ERROR MESSAGE
LO CON 0 LIST OPTIONS
LC CON 99999 LINE COUNT
LL CON 0 LINE LIMIT
ERRNZ LL-LC-1 LOCATIONS MUST BE CONTIGUOUS
PN CON 1 PAGE NUMBER
TL CON TLT ADDRESS OF TITLE TEXT
TO CON 0 TERMINAL OUTPUT FORMAT FLAG
TI CON 1 TERMINAL INPUT FORMAT FLAG
FLAGS SPACE 4,6
** FLAGS.
EF CON 0 ERROR (TOTAL ERRORS DURING MODIFICATION)
DE CON 0 DIRECTIVE ERROR COUNT
EA CON DE DIRECTIVE ERROR COUNTER ADDRESS
CD CON 0 COMMON DECK
LF CON 0 SET IF DATA TRANSMITTED TO LIST FILE
YK CON 0 YANK IN DIRECTIVES
YD CON 0 YANK IN DECK
UP CON 0 *UPDATE* FLAG FOR INSERTION LINE NUMBERS
COPL CON -1 CHARACTER SET OF OPL
CNPL CON -1 CHARACTER SET OF NPL
CVT CON 0 CONVERSION OPTION
MADCV CON 0 MADIFY CONVERSION FLAG
IG CON 0 IGNORE DIRECTIVES PRESENT
IFIP CON 0 *IF IN PROGRESS FLAG
* .EQ. 0 IMPLIES NO IF IN PROGRESS
* .LT. 0 IMPLIES FALSE CONDITION PRESENT
* .GT. 0 IMPLIES TRUE CONTITION PRESENT
SPACE 4,6
** FLAGS SET BY COMMAND PARAMETERS.
CL CON 0 LINE LISTED
CON 0 LINE TO BE LISTED FLAG
DB CON 0 DEBUG
NR CON 0 NO REWIND FOR PROGRAM LIBRARY
NS CON 0 NO SEQUENCE NUMBERS ON COMPILE FILE
CON 0 CURRENT NO SEQUENCE FLAG (RESET EACH DECK)
SS CON 0 SEQUENCE NUMBERS ON SOURCE FILE
AM CON 0 *A* MODE
CON 0 FIRST LINE OF RECORD FLAG
FM CON 0 *F* MODE
QM CON 0 *Q* MODE
UM CON 0 *U* MODE
XM CON 0 *X* MODE
ZM CON 0 *Z* MODE
CMNF CON 1 COMMENTS NEEDED FLAG
CSR CON -0 CHARACTER SET REQUEST (*EC*)
CSD SPACE 4,10
* CHARACTER SET DEFINITIONS.
.DIS EQU 0 DISPLAY CODE 63/64
.AS612 EQU 1 ASCII 6/12 (63/64)
TCST SPACE 4,10
** 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
* CHARACTER SET CONTROLS.
CSC CON .AS612 CURRENT CHARACTER SET
SETC CON -1 NEG = USE CHARACTER SET OF DECK
* 0 = USE DISPLAY SET (FOLD IF NECESSARY)
* 1 = USE 6/12 ASCII SET
MODIFY TITLE MODIFY - MAIN PROGRAM.
** MODIFY - MAIN PROGRAM.
MODIFY SB1 1 (B1) = 1
RJ /PRESET/PRS PRESET PROGRAM
RJ /DIRECT/PDC PROCESS DIRECTIVE LINES
RJ /DIRECT/IMP INITIALIZE MODIFICATION PASS
RJ /DIRECT/PMP PROCESS *MOVE* AND *PURDECK*
SX6 EC SET MODIFICATION ERROR COUNTER ADDRESS
SA6 EA
EQ MOD6 BEGIN NEXT DECK
* PROCESS MODIFICATIONS.
MOD1 BX6 X6-X6 CLEAR LINE LIST
SA5 MA+2 CHECK MODIFICATIONS
SA6 CL
SA6 CL+1
SA6 CDAC CLEAR LINE ACTIVITY
ZR X5,MOD2 IF NO MODIFICATIONS
RJ INS PROCESS INSERT
SA5 MA CHECK MODIFICATIONS
EQ MOD3
MOD2 SA0 P READ LINE FROM PROGRAM LIBRARY
RJ RPF READ PROGRAM FILE
NZ X1,MOD5 IF EOR
SA5 MA+1 CHECK MODIFICATION ADDRESS
MOD3 ZR X5,MOD4 IF NO MODIFICATIONS
RJ DEL PROCESS DELETE/RESTORE
MOD4 RJ SCS SET LINE STATUS
RJ WRC WRITE LINE
SA1 CL+1
ZR X1,MOD1 IF NO LIST
RJ LCS LIST LINE STATUS
EQ MOD1 LOOP
* COMPLETE PROCESSING.
MOD5 RJ CDK COMPLETE DECK
MOD6 RJ BDK BEGIN NEXT DECK
NZ X7,MOD1 IF DECK TO BE PROCESSED
SA0 N WRITE DIRECTORY
RJ WDR WRITE DIRECTORY
RJ LST LIST STATISTICS
RJ CMF COMPLETE FILES
SA1 EF
SA2 DB
SA3 DE DIRECTIVE ERROR COUNT
SA0 =C* MODIFICATION/DIRECTIVE ERRORS.*
NZ X3,MOD8 IF DEBUG AND AT LEAST DIRECTIVE ERRORS
ZR X1,MOD7 IF NO MODIFICATION ERRORS
SA0 =C* MODIFICATION ERRORS.*
ZR X2,ABT1 IF DEBUG NOT SET AND MODIFICATION ERRORS
EQ MOD8 ISSUE MESSAGE
MOD7 SA0 =C* MODIFICATION COMPLETE.*
MOD8 MESSAGE A0
RJ CAS CALL ASSEMBLER
ENDRUN
BDK SPACE 4,20
** BDK - BEGIN DECK.
*
* EXIT (X7) .NE. 0, IF DECK READY FOR PROCESSING.
*
* USES X - ALL.
* A - 1, 2, 3, 4, 5, 6, 7.
* B - 2.
*
* CALLS LDS, RMT, SFN, SNC.
BDK SUBR ENTRY/EXIT
SA1 EI CHECK EDIT TABLE
SA2 L.TEDT
IX7 X2-X1
SX6 X1+2 ADVANCE EDIT INDEX
ZR X7,BDKX IF END OF TABLE - RETURN
SA3 F.TEDT LOOK UP EDIT TABLE ENTRY
SB2 X1
SA2 X3+B2
SA6 A1
MX4 -17 SET MODIFICATION ADDRESS
BX7 -X4*X2
MX0 42 MASK DECK NAME
SA7 MA
BX6 X0*X2
SA1 A2+B1 SET DECK ADDRESS
BX7 X1
SA6 A2 CLEAR MODIFICATION POINTER
SA6 DN SET DECK NAME
SA6 BDKA+1 ENTER DECK NAME IN MESSAGE
SA7 DA
BX1 X6
RJ SFN ENTER DECK NAME IN SUBTITLE
SA6 SBTL+2
SA1 BL
ZR X1,BDK1 IF BURSTABLE LISTING NOT SPECIFIED
SX7 99999 FORCE PAGE EJECT
SA7 LC
BDK1 BX7 X7-X7 CLEAR DECK IDENTIFIER TABLE LENGTH
SA7 L.TDKI
SA7 L.TCCD CLEAR TABLE OF CALLED COMMON DECKS
SA7 L.TNCC CLEAR TABLE OF NESTED COMMON DECK CALLS
SA7 CD CLEAR COMMON DECK FLAG
SA7 L.TNCD CLEAR NEXT LINE TABLE
SA7 IFIP CLEAR *IF CONDITION FLAG
RJ RMT READ MODIFIER TABLE
MESSAGE BDKA,1 ISSUE CONSOLE MESSAGE
SA1 S
ZR X1,BDK1.2 IF NO SOURCE
RECALL A1
WRITEW S,DN,1 WRITE DECK NAME
SA1 CSC
ZR X1,BDK1.1 IF NOT AN ASCII DECK
WRITEW X2,(=0LASCII),1
BDK1.1 SA1 CD
ZR X1,BDK1.2 IF NOT COMMON DECK
WRITEW X2,(=0LCOMMON),1
BDK1.2 SA1 SC RESET SEQUENCE COLUMN
SA2 NS RESET NO SEQUENCE FLAG
BX6 X1
LX7 X2
SA6 A1+B1
SA7 A2+B1
SA3 BDKB
ZR X3,BDK2 IF NO PREVIOUS USE OF SCRATCH FILE
RECALL M
BX6 X6-X6 CLEAR NEW PROGRAM LIBRARY
SA6 A3
SA6 M
BDK2 SA1 CD
ZR X1,BDK3 IF NOT COMMON DECK
SA3 MA
SA4 YD
IX5 X3+X4
ZR X5,BDK3 IF NO MODIFICATIONS
SA1 M+7 USE SCRATCH FILE FOR COMMON DECK
BX6 X1
SX7 B1 SET NEW PROGRAM LIBRARY FLAG
SA6 M
SA7 BDKB
BDK3 SA1 N
SA2 M
BX1 X1+X2
ZR X1,BDK4 IF NO NEW PROGRAM LIBRARY
RJ WMT WRITE MODIFIER TABLE
SA2 M
ZR X2,BDK4 IF NO SCRATCH NPL
SA1 F.TNDK
SA2 L.TNDK
IX3 X1+X2
SA1 X3-1
ADDWRD TECD,X1 ENTER DECK NAME
BDK4 RJ LDS LIST DECK STATUS
SA1 CD
SA2 AM
NZ X1,BDK5 IF COMMON DECK
ZR X2,BDK5 IF NOT *A* MODE
SA1 C
ZR X1,BDK5 IF NO COMPILE FILE
SA2 A2+B1
NZ X2,BDK5 IF NOT FIRST DECK
SX6 B1
SA6 A2
WRITEW C,CIDT,1 WRITE *A* MODE FLAG
BDK5 BX6 X6-X6 CLEAR LINE COUNTS
SA6 CC
SA6 A6+B1
SA6 A6+B1
RJ SNC SET NEXT LINES
SA1 MA FORCE INITIAL MODIFICATION
SX6 X1
SX7 B1
SA6 A1+B1
EQ BDKX RETURN
BDKA CON 10H MODIFY /
CON 0
BDKB CON 0 NEW PROGRAM LIBRARY FLAG FOR COMMON DECK
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, 5, 6, 7.
* A - 1, 2, 5, 6, 7.
* B - 7.
*
* CALLS ADW, CDD, LUM, WOF.
CDK SUBR ENTRY/EXIT
SA5 MA
ZR X5,CDK1 IF NO MODIFICATIONS
RJ LUM LIST UNPROCESSED MODIFICATIONS
CDK1 SA2 EF PROPAGATE ERRORS
SA1 EC
BX7 X7-X7 CLEAR ERROR COUNT
IX6 X2+X1
SA7 A1
SA6 A2
SA7 CD CLEAR COMMON DECK FLAG
SX6 -B1
SA6 SETC CLEAR *CSET INDICATOR
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 -6
SA7 CDKA+1
SA6 A7+B1
SX1 B7 CONVERT COUNT
RJ CDD CONVERT TO DECIMAL DISPLAY
SA6 A7-B1
MESSAGE A6,3
CDK3 SA1 N
ZR X1,CDK4 IF NO NPL
WRITER N,R
SA1 RI ENTER RANDOM INDEX
SX2 N+7
LX2 36
ADDWRD TNDK,X2+X1
CDK4 SA1 M
ZR X1,CDK5 IF NO SCRATCH NPL
WRITER M,R
SA1 RI+1
SX2 M+7
LX2 36
ADDWRD TECD,X2+X1
CDK5 WRITER S
LISTOP D,CDKX IF *D* OPTION OFF
PRINT (=C* *)
SA1 CC INACTIVE LINE COUNT
RJ CDD CONVERT TO DECIMAL DISPLAY
SA6 CDKC
SA1 A1+1 ACTIVE LINE COUNT
RJ CDD CONVERT TO DECIMAL DISPLAY
SA6 CDKB+1
SA1 A1+1 INSERTED LINE COUNT
RJ CDD CONVERT TO DECIMAL DISPLAY
SA6 CDKD
PRINT CDKB
SA1 MA
SA2 YD
IX6 X1+X2
ZR X6,CDK 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 LINE(S).
CDKC DATA 10H
DATA 20H INACTIVE LINE(S).
CDKD DATA 10H
DATA 20H INSERTED LINE(S).
DATA 0
INS TITLE MODIFICATION PROCESSORS.
INS SPACE 4,20
** INS - PROCESS INSERTIONS.
*
* ENTRY (A5) = INSERT POINTER ADDRESS.
* (X5) = INSERT ADDRESS.
*
* USES X - 0, 1, 2, 3, 5, 6, 7.
* A - 1, 2, 3, 5, 6, 7.
* B - 2, 4.
*
* CALLS RTF.
INS SUBR ENTRY/EXIT
SA5 X5+
SA5 X5+2 READ TEXT
RJ RTF READ TEXT FILE
LX5 -42 EXTRACT IDENTIFIER ADDRESS
SA1 X5+B1 ADVANCE LINE COUNT
SX2 B1
IX7 X1+X2
SA7 A1
LX2 24 DECREMENT INSERTION COUNT
IX6 X6-X2
SA6 A5
AX6 24 CHECK FOR END OF TEXT
SB2 X6
NZ B2,INS1 IF NOT END OF TEXT
SA2 MA+2 UNLINK INSERT
BX6 X6-X6
MX0 -18
SA6 A2 CLEAR INSERT
SA2 X2
SA3 X2
BX6 X0*X2
BX0 -X0*X3
IX6 X6+X0
SB4 A2-MA-1
SA6 A2
NZ B4,INS1 IF NOT FIRST INSERT
SA6 A2-B1
INS1 LX1 -24 SET IDENTIFIER INDEX
SA2 F.TDKI
SB2 X1
SA3 X2+B2 MERGE DECK IDENTIFIER AND LINE NUMBER
MX0 44
SX6 X7
BX1 X0*X3
IX6 X1+X6
SX7 B2+1S16 SET FIRST MHB RESTORED
SA6 A3 SET LINE COUNTER
SA7 TMHB
SA6 CDID SET LINE ID
SX7 B1 SET MHB COUNT = 1
SA7 A7-B1
EQ INSX RETURN
DEL SPACE 4,15
** DEL - PROCESS DELETIONS.
*
* ENTRY (A5) = MODIFICATION TABLE ADDRESS.
* (X5) = ADDRESS OF MODIFICATION ADDRESS TABLE.
*
* USES ALL.
DEL11 SX6 X5 SET INSERT ADDRESS
BX7 X7-X7 CLEAR MODIFICATION INDICATOR
SA6 MA+2
NZ X0,DELX IF MODIFICATIONS REMAIN
SA7 MA+1
DEL SUBR ENTRY/EXIT
SA1 L.TNCD
SA2 F.TNCD
SB3 B0
SB4 X1
SX7 1S16
DEL0 SA7 X2+B3 SET HIGH LINE NUMBER
SB3 B3+B1
NE B3,B4,DEL0 IF NOT COMPLETE
SA1 F.TDKI (B7) = TABLE DIFFERENCE
IX6 X2-X1
SB7 X6
SB2 X5
BX0 X0-X0
MX5 0
SA1 A5 SET POINTER ADDRESS
DEL1 ZR B2,DEL11 IF END OF MODIFICATION TABLE
SA0 A1 SAVE POINTER ADDRESS
SA1 B2 CHECK NEXT ENTRY
SA2 B2+B1 (B4) = LAST LIMIT LINE COUNTER
SB2 X1 SET NEXT INDEX
MI X2,DEL1 IF ERROR FLAG SET
LX1 -18 (B3) = FIRST LIMIT LINE NUMBER
SB3 X1
LX1 -18 (B5) = CURRENT LINE NUMBER
SA4 X1
SA3 X1+B7 (B6) = MINIMUM LINE NUMBER
SB5 X4
SB6 X3
LX2 -18
GT B3,B6,DEL2 IF LAST MODIFICATION LOWER
SX6 B3
SA6 A3
DEL2 LT B5,B3,DEL1 IF FIRST LIMIT NOT REACHED
* PROCESS ACTIVE INSERT OR DELETE.
LX1 36
SB4 X2
SX7 1S16
BX4 X7*X4
NZ X4,DEL9 IF MOD TO YANKED IDENT
PL X1,DEL5 IF NOT INSERT
DEL3 SA2 A1+2 CHECK TEXT STATUS
AX2 24
SB4 X2
SX0 X0+B1
ZR B4,DEL4 IF NO TEXT
SX5 A0 UPDATE MODIFICATON INDEX
EQ DEL1 LOOP
DEL4 MX7 -18 UNLINK INSERT
SA1 A1
BX6 -X7*X1
SA1 A0
BX7 X7*X1
IX6 X6+X7
SB4 A0-MA-1
SA6 A0
NZ B4,DEL1 IF NOT FIRST INSERT
SA6 A0-B1
EQ DEL1 LOOP
* PROCESS DELETE.
DEL5 LX2 -18 (B6) = CURRENT LINE NUMBER
SA3 X2
SB6 X3
SX0 X0+B1 COUNT DELETION
GT B6,B4,DEL8 IF CURRENT LINE BEYOND LAST LIMIT
SA3 A2+B1 EXTRACT MODIFICATION SET INDEX
LX3 -42
SA4 X3+B1
LX4 -24
SX6 X4
LX1 59-57
SA4 NMHB (X4) = INDEX OF LAST MHB
PL X1,DEL6 IF MODIFICATION IS DELETION
SX6 X6+1S16 SET RESTORE BIT
DEL6 SA6 X4+TMHB STORE LAST MHB
MX7 -16 CHECK PREVIOUS MHB
SA3 A6-B1
BX3 -X7*X3
BX6 -X7*X6
IX2 X6-X3
ZR X2,DEL8 IF SAME IDENTIFIER
MI X2,DEL7 IF PREVIOUS MODIFIER
SX6 X4+1
SA6 A4+
DEL7 NE B4,B6,DEL1 IF LAST LIMIT NOT REACHED
SA2 A2 CONVERT TO INSERT AT LAST LIMIT
MX1 1
SX7 B2
IX2 X2+X7
BX7 X1+X2
SA7 A2-B1
EQ DEL3 LOOP
* NOTE- IF (X2) = 0, ERROR IS OVERLAP.
DEL8 SX7 B1+B1 SET OVERLAP
ZR X2,DEL10 IF OVERLAP
SX7 X7+B1 SET RANGE ERROR
NE B3,B4,DEL10 IF RANGE ERROR
NE B5,B6,DEL10 IF NOT SAME LINE
DEL9 SX7 B0+ SET DIRECTIVE NOT REACHED
DEL10 SA2 A2 ADD ERROR CODE TO WORD 2
MX1 1
BX7 X1+X7
BX7 X7+X2
SA7 A2
EQ DEL1 LOOP
SCS SPACE 4,20
** SCS - SET LINE STATUS.
*
* SET LINE ACTIVITY ACCORDING TO LAST MHB AND YANK
* STATUS. LIST MODIFICATION TO LINE.
*
* ENTRY (NMHB) = MHB COUNT.
*
* USES X - 0, 1, 2, 3, 6, 7.
* A - 1, 2, 3, 6, 7.
* B - 2, 3.
*
* CALLS ECD.
SCS SUBR ENTRY/EXIT
SA1 NMHB (B2) = MHB COUNT
SA2 F.TDKI (B3) = FWA DECK IDENTIFIER TABLE
MX0 -16 MHB INDEX MASK
SB2 X1
SB3 X2
BX7 X7-X7 CLEAR STATUS
SA2 A1+B1 FIRST MHB
BX3 -X0*X2
ZR X3,SCS1 IF ORIGINAL LINE
SA2 CC+2 ADVANCE INSERTED LINE 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
LX2 59-16 CHECK YANK
MI X2,SCS2 IF MODIFIER YANKED
BX7 X1 STATUS = MHB STATUS
SCS2 NZ B2,SCS1 IF NOT END OF MHB,S
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 LINE
SX7 X3+B1
SA7 A3
PL X6,SCSX IF UNCHANGED - RETURN
LISTOP M,SCSX IF NO LIST FOR MODIFICATION - RETURN
RJ ECD EXPAND LINE
SA3 CDAC CHECK STATUS
SX6 1RA
SX7 1R
MI X3,SCS3 IF ACTIVE
SX6 1R
SX7 1RD
SCS3 SA6 CHSP+5
SA7 A6+1
SA6 CL+1
EQ SCSX RETURN
SNC SPACE 4,10
** SNC - SET NEXT LINES.
*
* USES X - 1, 2, 3, 4, 6, 7.
* A - 0, 1, 2, 3, 4, 6.
* B - 2, 3, 4, 6, 7.
SNC SUBR ENTRY/EXIT
SA1 L.TNCD
SA2 F.TNCD
SB3 B0
SB4 X1
SX7 1S16
SX2 X2+
SB2 2
SNC1 SA7 X2+B3 SET HIGH LINE NUMBER
SB3 B3+B1
NE B3,B4,SNC1 IF END OF TABLE NOT REACHED
SA1 MA
SA4 F.TDKI (B7) = TABLE DIFFERENCE
SB2 X1+
IX6 X2-X4
SB7 X6
SNC2 ZR B2,SNCX IF END OF MODIFICATION TABLE - RETURN
SA0 A1 SAVE POINTER ADDRESS
SA1 B2 CHECK NEXT ENTRY
SA4 B2+B1
SB2 X1 SET NEXT ENTRY
LX1 -18 (B3) = FIRST LIMIT LINE NUMBER
SB3 X1
LX1 -18 (B6) = MINIMUM LINE NUMBER
MI X4,SNC2 IF ERROR FLAG SET
SA3 X1+B7
SB6 X3+
GT B3,B6,SNC3 IF LAST MODIFICATION LOWER
SX6 B3+ UPDATE MINIMUM LINE NUMBER
SA6 A3+
SNC3 NZ B3,SNC2 IF FIRST LIMIT NOT REACHED
* PROCESS ACTIVE INSERT OR DELETE.
LX1 36
PL X1,SNC2 IF NOT INSERT
SA2 A1+2
AX2 24
SB4 X2
ZR B4,SNC4 IF NO TEXT
SX6 A0+
SA6 MA+2
EQ SNC2 LOOP
SNC4 MX7 -18 UNLINK INSERT
SA1 A1
BX6 -X7*X1
SA1 A0
BX7 X7*X1
IX6 X6+X7
SA6 A0+
EQ SNC2 LOOP
TITLE WRITE COMPILE FILE PROCESSORS.
** WRC - WRITE LINE.
*
* WRITE LINE TO NEW PROGRAM LIBRARY, SOURCE, COMPILE, AND
* LIST OUTPUT AS REQUIRED.
* *WRC* WILL CALL *WCC* IF A COMPRESSED COMPILE FILE IS TO
* BE WRITTEN. FOR NON-COMPRESSED COMPILE FILE GENERATION
* *WCF* WILL BE CALLED.
*
* USES X - 1, 2.
* A - 1, 2.
*
* CALLS WCC, WNF, WSC.
WRC2 RJ WSC WRITE STANDARD COMPILE FILE
WRC SUBR ENTRY/EXIT
SA1 N
SA2 M
BX1 X1+X2
ZR X1,WRC1 IF NO NEW PROGRAM LIBRARY
RJ WNF WRITE NEW PROGRAM LIBRARY
WRC1 SA1 AM
SA2 CD
ZR X1,WRC2 IF NOT *A* MODE
NZ X2,WRCX IF COMMON DECK - RETURN
RJ WCC WRITE COMPRESSED COMPILE FILE
EQ WRCX RETURN
WCC SPACE 4,10
** WCC - WRITE COMPRESSED COMPILE FILE.
*
* ENTRY (PCC) = PREFIX CHARACTER.
* (CDTX) = FIRST WORD OF LINE TEXT.
*
* EXIT (X1) = 0, IF COMMENT LINE AND COMMENTS NOT NEEDED.
* COMPRESSED LINE WRITTEN TO COMPILE FILE.
* IF SUSPECTED COMPILE FILE DIRECTIVE ENCOUNTERED
* *WSC* WILL BE CALLED TO PROCESS THE INTERESTING LINE.
*
* USES X - 1, 2, 3, 4, 6, 7.
* A - 1, 2, 3.
*
* CALLS WSC, WTW=.
WCC2 SA1 CMNF CHECK FOR COMMENTS NEEDED
ZR X1,WCCX IF NO COMMENTS NEEDED
* WRITE LINE TO COMPILE FILE.
WCC3 SA2 IFIP *IF CONDITION FLAG
MI X2,WCC4 IF INACTIVE SEQUENCE IN PROGRESS
SA2 CSC GET CHARACTER SET OF COMDECK
SA1 SETC CHECK FOR *CSET
NG X1,WCC3.1 IF NO *CSET
NZ X1,WCC3.1 IF *CSET,ASCII
ZR X2,WCC3.1 IF DISPLAY COMMON DECK AND *CSET DISPLAY
RJ ECD EXPAND AND CONVERT ASCII LINE
RJ RCL RE-COMPRESS CONVERTED LINE
WCC3.1 SA1 CDWC WRITE IDENTIFICATION + COMPRESSED LINE
WRITEW C,A1+B1,X1+B1
SA1 NC ADVANCE LINE COUNT
SX2 B1
IX6 X1+X2
SA6 A1+
WCC4 SX1 B1+ SET NOT COMMENT LINE FLAG
WCC SUBR ENTRY/EXIT
SA1 CDAC CHECK LINE ACTIVITY
SA2 C CHECK FOR COMPILE FILE BEING WRITTEN
PL X1,WCCX IF LINE NOT ACTIVE
ZR X2,WCCX IF NO COMPILE FILE BEING WRITTEN
SA1 CDTX FIRST WORD OF COMPRESSED LINE
SA4 WCCA COMPILE FILE PREFIX CHARACTER
BX3 X1-X4 COMPARE FIRST CHARACTER AGAINST PREFIX
AX3 54
NZ X3,WCC3 IF NOT COMMENT LINE
NG X3,WCC3 IF NOT COMMENT LINE
MX0 -12
* CHECK FOR SUSPECTED COMPILE FILE DIRECTIVES.
SA2 CD CHECK FOR COMMON DECK
ZR X2,WCC1 IF NOT COMMON DECK
SA4 WCCB BEGIN SEARCH AFTER CALLS FOR COMMON DECKS
WCC1 BX3 X4-X1 COMPARE DATA
BX2 -X0*X4
ZR X4,WCC2 IF AT END OF DIRECTIVES AND COMMENT LINE
SB2 X2+
AX3 X3,B2
SA4 A4+B1
NZ X3,WCC1 IF NO MATCH - LOOP FOR NEXT DIRECTIVE
RJ WSC WRITE COMPILE FILE
SX1 B1
EQ WCCX RETURN
WCCA BSS 0 DECK TABLE FWA
VFD 6/0,42/0LCALL,12/5*6 *CALL
VFD 6/0,42/0LCALLC,12/4*6 *CALLC
VFD 6/0,42/0LCALLALL,12/2*6 *CALLALL
VFD 6/0,42/0LIFCALL,12/3*6 *IFCALL
VFD 6/0,42/0LNIFCALL,12/2*6 *NIFCALL
WCCB BSS 0 COMMON DECK/DECK TABLE FWA
VFD 6/0,42/0LCOMMENT,12/2*6 *COMMENT
VFD 6/0,42/0LCSET,12/5*6 *CSET
VFD 6/0,42/0LCWEOR,12/4*6 *CWEOR
VFD 6/0,42/0LDEFINE,12/3*6 *DEFINE
VFD 6/0,42/0LELSE,12/5*6 *ELSE
VFD 6/0,42/0LENDIF,12/4*6 *ENDIF
VFD 6/0,42/0LIF,12/7*6 *IF
VFD 6/0,42/0LNOSEQ,12/4*6 *NOSEQ
VFD 6/0,42/0LSEQ,12/6*6 *SEQ
VFD 6/0,42/0LWEOF,12/5*6 *WEOF
VFD 6/0,42/0LWEOR,12/5*6 *WEOR
VFD 6/0,42/0LWIDTH,12/4*6 *WIDTH
CON 0 TABLE TERMINATOR
WCF SPACE 4,10
** WCF - WRITE COMPILE FILE.
*
* ENTRY (CHAR) = FWA OF CHARACTER STRING BUFFER.
*
* USES X - 1, 2, 6.
* A - 1, 2, 6.
*
* CALLS LCS.
WCFX LISTOP W,WCF IF NO LIST FOR DIRECTIVE
RJ LCS LIST LINE STATUS
WCF PS 0 ENTRY/EXIT
* PROCESS POSSIBLE *IF CONDITION ALTERATION.
CARD ELSE
CARD ENDIF
* PROCESS ALL OTHER POSSIBLE COMPILE FILE DIRECTIVES.
WCF1 SA1 IFIP CHECK *IF CONDITION
MI X1,WCF IF INACTIVE SEQUENCE IN PROGRESS
CARD COMMENT
CARD CWEOR
CARD DEFINE
CARD IF,IFX
CARD NOSEQ,NSQ
CARD SEQ
CARD WEOF
CARD WEOR
CARD WIDTH,WDH
WCF2 SA2 NS+1
SA1 AM
NZ X1,WCF5 IF *A* MODE
* *WCF3* AND *WCF4* ENTERED FROM *COMMENT DIRECTIVE PROCESSOR.
WCF3 SA1 SC+1
NZ X2,WCF4 IF NO SEQUENCE NUMBERS
SX1 X1+14
WCF4 WRITEK C,CHAR,X1 WRITE LINE TO COMPILE
EQ WCF6
* WRITE COMPRESSED LINE.
WCF5 WRITEW C,CDID,1 WRITE IDENTIFICATION
WRITEC X2,CDTX WRITE COMPRESSED LINE
WCF6 SA1 NC ADVANCE LINE COUNT
SX2 B1
IX6 X1+X2
SA6 A1
EQ WCF RETURN
WSC SPACE 4,10
** WSC - WRITE STANDARD COMPILE FILE.
*
* ENTRY (C) = COMPILE FILE NAME.
* (S) = SOURCE FILE NAME.
* (CD) = COMMON DECK FLAG.
* (CDAC) = LINE ACTIVITY FLAG.
*
* EXIT COMPILE FILE WRITTEN AS NEEDED.
*
* USES X - 1, 2, 6.
* A - 1, 2, 6.
*
* CALLS CKC, ECD, WCF.
WSC4 LISTOP I,WSCX IF NO LIST FOR INACTIVE LINE - RETURN
SX6 1RI
WSC5 SA6 CHSP+4 SET ACTIVITY INDICATOR
SA6 CL+1 SET LIST REQUESTED FLAG
WSC SUBR ENTRY/EXIT
RJ ECD EXPAND LINE
SA1 CDAC
SA2 S
PL X1,WSC3 IF LINE NOT ACTIVE
ZR X2,WSC2 IF NO SOURCE FILE
SA1 SC+1 WRITE SOURCE
SA2 SS
ZR X2,WSC1 IF NO SEQUENCE NUMBERS
SX1 X1+14
WSC1 WRITEK S,CHAR,X1
WSC2 SA1 C CHECK FOR COMPILE FILE BEING WRITTEN
SA2 CD COMMON DECK FLAG
ZR X1,WSC3 IF NO COMPILE FILE
NZ X2,WSC3 IF COMMON DECK
* CHECK FOR COMMON DECK CALL DIRECTIVES.
CARD CALL *CALL
CARD CALLC *CALLC
CARD CALLALL *CALLALL
CARD CSET
CARD IFCALL *IFCALL
CARD NIFCALL *NIFCALL
RJ WCF WRITE COMPILE FILE
WSC3 SA1 CDAC CHECK LINE ACTIVITY
PL X1,WSC4 IF LINE INACTIVE
SX6 1RA
LISTOP A,WSC5,MI IF LIST FOR ACTIVE LINE SELECTED
EQ WSCX RETURN
TITLE COMPILE FILE DIRECTIVE PROCESSORS.
*** COMPILE FILE CONTROL DIRECTIVES.
*
* THESE DIRECTIVES CONTROL THE PROCESSING OF THE COMPILE FILE.
* THEY ARE PROCESSED WHEN THEY OCCUR FROM THE PROGRAM LIBRARY
* OR RESULT FROM INSERTION.
CALL SPACE 4,10
*** CALL DNAME
*
* PLACE A COPY OF DECK *DNAME* ON COMPILE FILE.
CALL SA1 IFIP CHECK FOR INACTIVE SEQUENCE IN PROGRESS
MI X1,WRCX IF INACTIVE SEQUENCE IN PROGRESS
RECALL M
RJ ASN ASSEMBLE NAME
RJ WCD WRITE COMMON DECK
EQ WRCX RETURN
CALLC SPACE 4,10
*** CALLC DNAME
*
* PLACE A COPY OF DECK *DNAME* ON COMPILE FILE, IF IT HAS NOT
* ALREADY BEEN CALLED BY A PREVIOUS *CALL* OR *CALLC* COMPILE
* FILE DIRECTIVE.
CALLC SA1 IFIP CHECK FOR INACTIVE SEQUENCE IN PROGRESS
NG X1,WRCX IF INACTIVE SEQUENCE IN PROGRESS
RECALL M
RJ ASN ASSEMBLE NAME
SEARCH TCCD,X6 SEARCH TABLE OF PREVIOUSLY CALLED DECKS
NZ X2,WRCX IF FOUND - RETURN
RJ WCD WRITE COMMON DECK
EQ WRCX RETURN
CALLALL SPACE 4,10
*** CALLALL STRING
*
* PLACE COPY OF EACH COMMON DECK WITH LEADING CHARACTERS =
* STRING.
CALLALL SA1 CH SAVE FIRST CHARACTER ADDRESS
SA2 IFIP CHECK INACTIVE SEQUENCE
SX6 X1+B1
MI X2,WRCX IF INACTIVE SEQUENCE IN PROGRESS
SA6 CLAA
RJ ASN ASSEMBLE NAME
SA1 CH
SA2 CLAA
MX4 6 FORM NAME MASK
IX5 X1-X2
LX5 1
SB3 X5
LX5 1
SB3 B3+X5
AX7 X4,B3
BX3 X6
SA6 CLAA STORE STRING
SA7 A6+B1 STORE MASK
LX4 X7
SB2 B1+B1
BX2 X2-X2
SA1 L.TDKN
CLA1 IX6 X1-X2
ZR X6,WRCX IF END OF DECK NAMES - RETURN
SB3 X2
SA5 F.TDKN CHECK NAME
SX2 X2+B2 ADVANCE DECK NAME INDEX
SA5 X5+B3
BX6 X4*X5
IX7 X6-X3
NZ X7,CLA1 IF NO MATCH
SX6 X5-7
NZ X6,CLA1 IF NOT COMMON DECK
LX5 59-16
MI X5,CLA1 IF DECK NOT ACTIVE
LX5 17
MX0 42 MASK NAME
SX7 X2+ SAVE INDEX
BX6 X0*X5
SA7 CLAA+2
RJ WCD WRITE COMMON DECK
SA3 CLAA RESTORE STRING
SA4 A3+B1 RESTORE MASK
SA2 A4+B1 RESTORE INDEX
SB2 2
SA1 L.TDKN
EQ CLA1 LOOP
CLAA CON 0
CON 0
CON 0
COMMENT SPACE 4,10
*** COMMENT CCC-CCC
*
* PLACE COMMENT CCC-CCC IN COMPILE FILE IN FOLLOWING FORMAT -
* COMMENT CRDATE MODDATE CCC-CCC
* 1 2 3
* 2 1 1 1
* WHERE CRDATE = CREATION DATE
* MODDATE = LAST MODIFICATION DATE
COMMENT SA1 SC+1 SET SEQUENCE NUMBER COLUMN
SA2 CHAR+X1 PRESET (A6)
BX6 X2
SA3 CH SET FIRST CHARACTER
SA6 A2
SB2 A2-B1 SET LAST COLUMN OF COMMENT
SB3 X3 SET FIRST COLUMN OF COMMENT
GE B3,B2,CMT2 IF COMMENT EMPTY
SB4 B2-CHAR-30 SET WORD COUNT FOR COMMENT
MI B4,CMT2 IF NO ROOM FOR COMMENT
SA2 B3+B4 UNPACK COMMENT
CMT1 BX6 X2
SA6 A6-B1
SB4 B4-B1
SA2 A2-B1
PL B4,CMT1 IF NOT COMPLETE
CMT2 SB3 CHAR ENTER COMMENT PSEUDO
SA1 =9L COMMENT
RJ UPN UNPACK NAME
SA1 TIDT+2 ENTER CREATION DATE
RJ UPN UNPACK NAME
SA1 TIDT+3 CHECK MODIFICATION DATE
NZ X1,CMT3 IF DECK MODIFIED
SA1 =1H
CMT3 RJ UPN UNPACK NAME
SX6 1R
SA6 B3+
SA1 AM
NZ X1,CMT4 IF *A* MODE
SA2 NS+1
EQ WCF3
* WRITE COMPRESSED LINE IDENTIFICATION.
CMT4 WRITEW C,CDID,1 WRITE IDENTIFICATION
SA1 SC+1
EQ WCF4
CSET SPACE 4,10
*** CSET DNAME
*
* DECLARE CHARACTER SET TO BE USED IN PROCESSING
* CALLED COMMON DECKS.
CSET RJ ASN ASSEMBLE NAME OF *CSET*
MX3 42
SA1 TCST-1 FWA-1 OF CHARACTER SET TABLE
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 WRCX RETURN
CSET2 SA0 =C/ CSET - UNKNOWN CHARACTER SET./
RJ LCE LIST COMPILE FILE DIRECTIVE ERROR
EQ WRCX RETURN
CWEOR SPACE 4,10
*** CWEOR
*
* WRITE END OF RECORD ON COMPILE FILE IF BUFFER IS NOT EMPTY.
CWEOR RECALL C
SA1 NC CHECK LINE COUNT
ZR X1,WRCX IF NO LINES WRITTEN THIS RECORD - RETURN
EQ WEOR
DEFINE SPACE 4,10
*** DEFINE NAME,VALUE
*
* SET THE VALUE OF *NAME* TO *VALUE*. IF *VALUE* IS
* NOT PRESENT A VALUE OF ZERO IS ASSUMED.
*
* DEFINED NAMES ARE USED IN CONJUNCTION WITH *IF*, *ELSE*,
* *ENDIF* AND *IFCALL* DIRECTIVES.
*
* WHEN A SYMBOL IS DEFINED ON THE INPUT STREAM ( NO INSERT IN
* PROGRESS ) THE INPUT DEFINITION WILL OVERRIDE ANY COMPILE
* FILE SPECIFICATIONS FOR VALUES OF THE SPECIFIED NAME *NAME*.
DEFINE RJ ASN ASSEMBLE NAME
BX5 X6 SAVE NAME
SX7 X7+B1 ADVANE BEYOND SEPARATOR
SA7 A1+
RJ ASD ASSEMBLE VALUE
BX0 X7 SAVE VALUE
* CHECK FOR VALUE IN RANGE.
AX7 16
ZR X7,DEF1 IF VALUE WITHIN RANGE
SA0 =C/ VALUE ERROR./
RJ LCE LIST COMPILE FILE DIRECTIVE ERROR
EQ WCF RETURN
* SEARCH FOR SYMBOL.
DEF1 SEARCH TDEF,X5 SEARCH FOR PREVIOUSLY DEFINED SYMBOL
NZ X2,DEF2 IF PREVIOUSLY DEFINED
ADDWRD A0,X5 ADD SYMBOL TO TABLE
SA2 A6+ SET VALUE
* ENTER SYMBOL VALUE INTO DEFINITION.
DEF2 LX2 59-17
MI X2,WCFX IF DEFINED ON INPUT
LX2 17-59 REPOSITION SYMBOL
MX1 42
BX2 X1*X2 CLEAR PREVIOUS VALUE DEFINITION
BX6 X2+X0 SYMBOL + VALUE
SA6 A2 SET IN TABLE
EQ WCFX RETURN
ELSE SPACE 4,10
*** ELSE
*
* REVERSE MODIFICATION EFFECTS OF PREVIOUS *IF.
ELSE SA1 IFIP CHECK FOR *IF IN PROGRESS
ZR X1,ELS1 IF NO *IF IN PROGRESS
BX6 -X1 REVERSE PREVIOUS *IF CONDITION
SA6 A1
EQ WCFX
ELS1 SA0 =C/ NO *IF IN PROGRESS./
RJ LCE LIST COMPILE FILE DIRECTIVE ERROR
EQ WCF RETURN
ENDIF SPACE 4,10
*** ENDIF
*
* TERMINATE *IF RANGE.
ENDIF SA1 IFIP CHECK FOR *IF IN PROGRESS
ZR X1,EIF1 IF NO *IF IN PROGRESS
BX6 X6-X6 CLEAR *IF IN PROGRESS FLAG
SA6 A1
EQ WCFX RETURN
EIF1 SA0 =C/ NO *IF IN PROGRESS./
RJ LCE LIST COMPILE FILE ERROR MESSAGE
EQ WCF RETURN
IFX SPACE 4,10
*** IF ATR,NAME,VALUE
*
* *ATR* MAY ASSUME ONE OF THE FOLLOWING VALUES.
*
* DEF SYMBOL REFERENCED BY ATTRIBUTE DEFINED.
* UNDEF SYMBOL REFERENCED BY ATTRIBUTE UNDEFINED.
* EQ SYMBOL REFERENCED BY ATTRIBUTE EQUAL TO *VALUE*.
* NE SYMBOL REFERENCED BY ATTRIBUTE NOT EQUAL TO *VALUE*.
*
* IF THE CONDITION SPECIFIED BY THE ATTRIBUTE EXPRESSION
* IS TRUE, AN ACTIVE *IF RANGE WILL BE INITIATED.
*
* IF THE CONDITION IS FALSE THEN ALL LINES NORMALLY
* WRITTEN TO THE COMPILE FILE AND COMPILE FILE DIRECTIVES
* WILL BE TREATED AS INACTIVE FOR THE CURRENT MODIFICATION
* RUN.
*
* LINES WILL BE SKIPPED UNTIL THE OCCURENCE OF AN *ELSE OR
* *ENDIF COMPILE FILE DIRECTIVE.
IFX RJ ASN ASSEMBLE ATTRIBUTE
SX7 X7+B1 SKIP SEPARATOR
SA6 IFXA SAVE ATTRIBUTE
SA7 A1
RJ ASN ASSEMBLE SYMBOL NAME
SX7 X7+B1
SA6 A6+B1 SAVE SYMBOL NAME
SA7 A1+
RJ ASD ASSEMBLE SYMBOL VALUE
* CHECK FOR VALUE SPECIFICATION IN RANGE.
BX3 X7
AX7 16
SA0 =C/ VALUE ERROR./
NZ X7,IFX6 IF VALUE ERROR.
* PROCESS SPECIFICATION.
SA1 IFIP CHECK *IF IN PROGRESS FLAG
SA0 =C/ RECURSIVE *IF-S INCORRECT./
NZ X1,IFX6 IF *IF ALREADY IN PROGRESS
SA2 IFXA ATTRIBUTE
SA4 A2+B1 SYMBOLIC NAME
SA0 =C/ INCORRECT ATTRIBUTE./
ZR X2,IFX6 IF NO ATTRIBUTE
MX0 36
SA5 IFXB-1 FWA - 1 OF ATTRIBUTE TABLE
* SEARCH FOR ATTRIBUTE.
IFX1 SA5 A5+1 ADVANCE TO NEXT ENTRY
BX7 X0*X5
BX6 X7-X2 COMPARE SYMBOL
ZR X5,IFX6 IF AT END OF ATTRIBUTE TABLE
NZ X6,IFX1 IF NO MATCH
SX2 X5 VALUE MASKING EXPRESSION
LX5 59-18 ATTRIBUTE TEST TYPE FLAG
* SEARCH FOR SYMBOL AND DETERMINE ACTION.
SEARCH TDEF,X3+X4,X2
MI X5,IFX2 IF NEGATIVE ATTRIBUTE TEST
EQ IFX3 POSITIVE ATTRIBUTE TEST
* PROCESS NEGATIVE ATTRIBUTE EXPRESSIONS.
IFX2 ZR X2,IFX4 IF *IF EXPRESSION TRUE
EQ IFX5 *IF EXPRESSION FALSE
* PROCESS POSITIVE ATTRIBUTE EXPRESSIONS.
IFX3 ZR X2,IFX5 IF *IF EXPRESSION FLASE
EQ IFX4 *IF EXPRESSION TRUE
* EXPRESSION TRUE.
IFX4 SX6 B1 SET TRUE *IF EXPRESSION TEST FALG
SA6 A1
EQ WCFX RETURN
* EXPRESSION FLASE.
IFX5 SX6 -B1 SET FALSE *IF EXPRESSION TEST
SA6 A1
EQ WCFX RETURN
IFX6 RJ LCE LIST COMPILE FILE DIRECTIVE ERROR MESSAGE
EQ WCF RETURN
IFXA CON 0 ATTRIBUTE TEMPORARY
CON 0 SYMBOL TEMPORARY
IFXB BSS 0 TABLE OF ATTRIBUTES
VFD 36/0LDEF,6/0,18/0 DEFINED TEST
VFD 36/0LUNDEF,6/1,18/0 UNDEFINED TEST
VFD 36/0LEQ,6/0,18/377777B EQUAL TEST
VFD 36/0LNE,6/1,18/377777B NOT EQUAL TEST
CON 0
IFCALL SPACE 4,10
*** IFCALL NAME,DNAME
*
* PLACE COPY OF COMMON DECK *DNAME* ON COMPILE FILE, IF
* *NAME* IS DEFINED.
IFCALL RJ ASN ASSEMBLE NAME
SEARCH TDEF,X6 SEARCH FOR NAME
ZR X2,WRCX IF NOT FOUND - RETURN
SX7 X7+B1 SKIP SEPARATOR
SA7 CH
EQ CALL PROCESS AS *CALL
NIFCALL SPACE 4,10
*** NIFCALL NAME,DNAME
*
* PLACE COPY OF COMMON DECK *DNAME* ON COMPILE FILE, IF
* *NAME* IS NOT DEFINED.
NIFCALL RJ ASN ASSEMBLE NAME
SEARCH TDEF,X6 SEARCH FOR NAME
NZ X2,WRCX IF FOUND - RETURN
SX7 X7+B1 SKIP SEPARATOR
SA7 CH
EQ CALL PROCESS AS *CALL
NOSEQ SPACE 4,10
*** NOSEQ
*
* REQUEST NO SEQUENCE NUMBERS ON COMPILE FILE.
NSQ SX6 B1+ SET NO SEQUENCE NUMBER FLAG
SA6 NS+1
EQ WCFX LIST LINE
SEQ SPACE 4,8
*** SEQ
*
* REQUEST SEQUENCE NUMBERS ON COMPILE FILE.
SEQ SX6 B0+ CLEAR NO SEQUENCE NUMBER FLAG
SA6 NS+1
EQ WCFX LIST LINE
WIDTH SPACE 4,10
*** WIDTH N
*
* SET LINE WIDTH BEFORE SEQUENCE NUMBERS = *N*.
WDH RJ ASD ASSEMBLE COLUMN NUMBER
SB2 X7-IWMACS-1
MI B2,WDH1 IF IN RANGE
SA0 =C/ COLUMN NUMBER OUT OF RANGE./
RJ LCE LIST COMPILE FILE DIRECTIVE ERROR MESSAGE
EQ WCF RETURN
* PROCESS WIDTH DIRECTIVE.
WDH1 SA1 SC+1 READ CURRENT SEQUENCE NUMBER COLUMN
SB2 X1+CHAR
SB3 X7+CHAR
EQ B2,B3,WCFX IF NEW WIDTH = CURRENT WIDTH - LIST LINE
SA7 A1 UPDATE WIDTH
SB5 B0
SB4 16
GT B2,B3,WDH4 IF DECREASE IN WIDTH
* PROCESS INCREASE IN WIDTH.
WDH2 SA1 B2+B4 MOVE SEQUENCE FIELD UP
BX6 X1
SA6 B3+B4
SB4 B4-B1
PL B4,WDH2 IF MOVE NOT COMPLETE
SX6 1R
WDH3 SA6 A6-B1 BLANK FILL LINE
SB3 B3-B1
NE B2,B3,WDH3 IF NOT AT END OF LINE
EQ WCFX LIST LINE
* PROCESS DECREASE IN WIDTH.
WDH4 SA1 B2+B5 MOVE SEQUENCE FIELD DOWN
BX6 X1
SA6 B3+B5
SB5 B5+B1
NE B4,B5,WDH4 IF MOVE NOT COMPLETE
SX6 1R BLANK FILL REMAINDER OF BUFFER
WDH5 SA6 B3+B5
SB3 B3+B1
NE B2,B3,WDH5 IF NOT COMPLETE
EQ WCFX LIST LINE
WEOF SPACE 4,10
*** WEOF
*
* WRITE END OF FILE ON *COMPILE* FILE.
WEOF WRITEF C,R
WEF1 SA1 NC PROPAGATE TOTAL LINE COUNT
SA2 A1+B1
BX6 X6-X6 CLEAR LINE COUNT THIS RECORD
IX7 X1+X2
SA6 A1
SA7 A2+
SA1 AM
ZR X1,WCFX IF NOT *A* MODE
WRITEW C,CIDT,1 WRITE COMPILE FILE *A* MODE FLAG
EQ WCFX LIST LINE
WEOR SPACE 4,10
*** WEOR N
*
* WRITE END OF RECORD (LEVEL N) ON COMPILE FILE.
* IF N = 15 THIS IS THE SAME AS A WEOF DIRECTIVE.
* ANY OTHER VALUE WRITES AN END OF RECORD.
WEOR RJ ASD ASSEMBLE LEVEL NUMBER
SB2 X7-17B
ZR B2,WEOF IF EOR LEVEL 17 PROCESS AS *WEOF*
WRITER C,R
EQ WEF1
WCD TITLE COMMON DECK PROCESSOR.
WCD SPACE 4,20
** WCD - WRITE COMMON DECK.
*
* DECK WRITTEN FROM EITHER MEMORY, NEW PROGRAM LIBRARY,
* OR PROGRAM LIBRARY.
*
* ENTRY (X6) = DECK NAME, ELSE ZERO IF DECK NAME NOT CORRECT.
*
* USES ALL.
*
* CALLS DNL, ECD, INL, LCE, LCS, PCS, PCW, RPF, WCC, WCF.
WCD14 LISTOP E,WCD15 IF NO ERROR LIST
BX7 X7-X7
SA7 CL CLEAR LINE LISTED STATUS
SA0 =C/ UNKNOWN DECK./
RJ LCE LIST COMPILE FILE DIRECTIVE ERROR
WCD15 RJ DNL DECREMENT COMMON DECK NESTING LEVEL
NZ X6,WCD0.1 IF STACK NOT EMPTY
SA6 CD
SA6 WCDE CLEAR NESTING COMMON DECK NAME
SA1 WCDF
BX7 X1
SA7 CSC RESTORE CHARACTER SET OF CALLING DECK
WCD SUBR ENTRY/EXIT
SA1 CSC GET CHARACTER SET OF CALLING DECK
BX7 X1
SA7 WCDF SAVE IT
NZ X6,WCD0 IF NAME IS OK
BX7 X7-X7
SA7 CL CLEAR LINE LISTED STATUS
SA0 =C/ UNKNOWN DECK./
RJ LCE LIST COMPILE FILE DIRECTIVE ERROR
EQ WCDX RETURN AFTER ERROR
WCD0 RJ INL INCREMENT COMMON DECK NESTING LEVEL
WCD0.1 SA1 L.TCDK
ZR X1,WCD4 IF NO DECKS IN MEMORY
* CHECK DECKS IN MEMORY.
SA2 F.TCDK
MX0 42
SB3 X1
SB2 B0+
WCD1 EQ B2,B3,WCD4 IF END OF DECKS
SA3 X2+B2 CHECK NAME
BX7 X0*X3
SB2 X3+B2
IX4 X7-X6
NZ X4,WCD1 IF NO MATCH
SX6 X3 EXTRACT LENGTH OF TCDK COMMON DECK
SA3 A3+B1 SET CHARACTER SET OF COMMON DECK
BX7 X3
SA7 CSC
SX7 A3+1 SET START
SA6 WCDC SAVE DECK LENGTH
SA7 WCDD SAVE DECK START POSITION
LISTOP W,WCD1.1 IF NO LIST SET FOR DIRECTIVE
RJ LCS LIST LINE STATUS
* COPY DECK FROM MEMORY.
WCD1.1 SX6 B1+ SET COMMON DECK FLAG
SA6 CD
WCD2 SA1 WCDC RESET LENGTH OF DECK
SA4 A1+B1
ERRNZ WCDD-WCDC-1 CODE ASSUMES VALUE
SB2 X1
ZR B2,WCD15 IF END OF COPY - RETURN
SA1 X4 STORE IDENTIFICATION
SA2 A1+B1 START MOVE
BX6 X1
SA6 CDID
MX0 48
WCD3 LX6 X2
SA6 A6+B1
BX3 -X0*X2
SA2 A2+B1
SB2 B2-B1
NZ X3,WCD3 IF NOT AT END OF LINE
SX7 A2 UPDATE START OF NEXT LINE
SX6 A6-CDID WORD COUNT OF COMPRESSED LINE
SA6 CDWC SET WORD COUNT OF COMPRESSED LINE
SX6 B2-1 SET WORD COUNT
SA7 WCDD
SA6 A7-1
RJ PCW WRITE COMPILE FILE
ZR X6,WCD2 IF SAME NESTING LEVEL
EQ WCD0 ENTER NEXT NESTING LEVEL
* SEARCH DECK NAME TABLES.
WCD4 BX0 X6 SAVE DECK NAME
RECALL M
SX3 7 SEARCH FOR DECK IN NEW DECKS
SEARCH TECD,X0+X3,377777B
NZ X2,WCD5 IF FOUND
SX3 7 SEARCH FOR DECK IN OLD DECKS
SEARCH TDKN,X0+X3,377777B
ZR X2,WCD14 IF COMMON DECK NOT FOUND
* INITIALIZE COMMON DECK READ FROM PROGRAM LIBRARY.
WCD5 SA2 A2+1
BX6 X2
AX2 36 SET FILE NAME
SA1 X2
BX7 X1
SA6 M+6
SA7 M
SA2 A7+B1 GET *FIRST*
SX6 X2
SA6 A2+B1
SA6 A6+B1 SET BUFFER EMPTY
SA2 CL+1
NZ X2,WCD6 IF LINE SHOULD BE LISTED
LISTOP W,WCD7 IF NO LIST FOR DIRECTIVE
WCD6 RJ LCS LIST LINE STATUS
WCD7 RECALL P
READ M BEGIN READ
READW M,BUF,TIDTL READ IDENT TABLE
SX6 B1+
SA6 CD INDICATE COMMON DECK
SB5 BUF FWA OF IDENT TABLE
RJ PCS PROCESS OPL CHARACTER SET
READW M,T1,1 READ MODIFIER TABLE WORD
SA5 L.TDKI SAVE CURENT IDENTIFIER TABLE LENGTH
SA1 T1 AUGMENT IDENTIFIER TABLE
+ ZR X1,*
ALLOC TDKI,X1+B1
BX6 X2 SAVE CURRENT FWA
LX7 X5
SA6 WCDB
SA7 A6+B1
IX6 X2+X5 SET TEMPORARY FWA
SA4 BUF+1 SET DECK NAME
SA1 T1
SX2 B1
BX7 X4+X2
SX1 X1
SA6 F.TDKI
SA7 X6
SX7 X7+1 ADD WORD FOR CHARACTER SET INDICATOR
SA7 WCDD SET POINTER WORD
ZR X1,WCD8 IF NO MODIFIERS
READW M,X6+B1,X1 READ MODIFIERS
WCD8 SA3 L.TCDK SET COMMON DECK LENGTH
BX6 X3
SA6 WCDC
ALLOC TCDK,2 ALLOCATE FOR POINTER AND CHARACTER SET
ZR X3,WCD11.1 IF NO ROOM
SA1 CSC SET CHARACTER SET INDICATOR IN TCDK
SA3 L.TCDK
BX7 X1
SA2 F.TCDK
SB2 X3-1
SA7 X2+B2
* COPY COMMON DECK TO COMPILE FILE.
WCD9 SA0 M FET ADDRESS
RJ RPF READ PROGRAM FILE
NZ X1,WCD13 IF EOR
SA1 CDAC
PL X1,WCD9 IF LINE INACTIVE
RJ PCW WRITE COMPILE FILE
SA6 WCDE SAVE NAME OF COMMON DECK
NZ X6,WCD12 IF NEXT NESTING LEVEL
ZR X1,WCD9 IF COMMENT OR NOT SAVING IN MEMORY
* SAVE COMMON DECK IN MEMORY IF POSSIBLE.
SA1 WCDD
SA5 CDWC
ZR X1,WCD9 IF NO ROOM FOR COMMON DECK
ALLOC TCDK,X5+B1 ALLOCATE FOR TEXT
ZR X3,WCD12 IF NO ROOM
IX7 X3-X5 SET FWA
SB2 X5+B1
SB3 X7-1
SA1 CDID
WCD11 BX6 X1
SA6 X2+B3 X2 = FWA OF TABLE
SB2 B2-B1
SA1 A1+B1
SB3 B3+B1
NZ B2,WCD11 IF MORE TEXT REMAINS
SX5 X5+B1 ADVANCE LENGTH
SA1 WCDD
IX6 X1+X5
SA6 A1
EQ WCD9 READ NEXT LINE
WCD11.1 MX6 0
SA6 WCDE CLEAR COMMON DECK NAME
WCD12 SA1 WCDC RESET OLD LENGTH
SX6 X1
BX7 X7-X7 CLEAR POINTER WORD
SA6 L.TCDK
SA7 WCDD
SA2 F.TCDK RESET END OF TABLE
IX6 X2+X1
SA6 A2+B1
SA1 WCDE
ZR X1,WCD9 IF SAME NESTING LEVEL, READ NEXT LINE
* RESET ALL CONDITIONS.
WCD13 RECALL P
SA2 WCDB RESET DECK IDENTIFIER FWA
BX6 X6-X6 CLEAR SCRATCH FILE
SA3 A2+B1 RESET LENGTH
SA6 M
SA4 P+6 RESET FILE
BX6 X2
LX7 X3
SA6 F.TDKI
SA7 L.TDKI
MX1 30 RESET FILE POSITION
BX2 X1*X4
SA3 WCDD GET POINTER WORD
AX4 30
IX6 X2+X4
SA1 A3-B1 LAST LENGTH
SA6 A4
SA2 L.TCDK
ZR X2,WCD13.1 IF *TCDK* EMPTY
SA2 F.TCDK
BX6 X3
SB2 X1+
SA6 X2+B2
WCD13.1 SA3 WCDE
ZR X3,WCD15 IF NESTING STACK IS EMPTY, RETURN
BX6 X3
EQ WCD0 ENTER NEXT NESTING LEVEL
WCDB CON 0 FWA OF DECK IDENTIFIER TABLE
CON 0 LENGTH OF DECK IDENTIFIER TABLE
WCDC CON 0 LAST COMMON DECK LENGTH
WCDD CON 0 NEW POINTER WORD
WCDE CON 0 COMMON DECK NAME OF NEXT NESTING LEVEL
WCDF CON 0 SAVE CHARACTER SET OF CALLING DECK
ABT TITLE SUBROUTINES.
ABT SPACE 4,10
** ABT - ABORT MODIFY.
*
* ENTRY (X0) = ADDRESS OF ERROR MESSAGE.
*
* CALLS CMF.
ABT RJ CMF COMPLETE FILES
ABT1 MESSAGE A0 SEND ERROR MESSAGE
ABORT
ADW SPACE 4,20
** ADW - ADD ENTRY TO A TABLE.
*
* ENTRY (A0) = TABLE POINTER ADDRESS.
* (X1) = TABLE ENTRY TO ADD.
*
* EXIT (X6) = TABLE ENTRY.
* (A6) = ADDRESS OF TABLE ENTRY.
* (X3) = INDEX OF TABLE 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 SUBR 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 TEMPORARY STORAGE
AMD SPACE 4,15
** AMD - ASSEMBLE MODIFIER.
*
* ADD AND LINK MODIFIERS INTO MODIFIER TABLE.
*
* ENTRY (B6) = ADDRESS OF LINKED LIST OF MODIFIERS.
*
* USES X - ALL.
* A - 1, 2, 4, 5, 6, 7.
* B - 2, 3, 6, 7.
*
* CALLS LER, UPN.
*
* MACROS ADDWRD, PRINT, SEARCH.
* PROCESS DUPLICATED MODIFIER NAME.
AMD6 SB3 CHAR ENTER NAME IN ERROR MESSAGE
BX1 X6
SX7 B6 SAVE ADDRESS OF LINKED LIST
SX6 B1 SET ERROR FLAG
SA7 AMDA
SA6 A7+B1
RJ UPN UNPACK NAME
PRINT -CHSP,B3+X1
SX0 =C*DUPLICATE MODIFIER NAME.*
RJ LER LIST ERROR
SA2 AMDA RESTORE ADDRESS OF LINKED LIST
SB6 X2+
NZ B6,AMD0 IF NOT AT THE END OF THE CHAIN
AMD7 SX6 B0+ CLEAR MODIFICATIONS
SA6 MA
AMD SUBR ENTRY/EXIT
SX7 B0+ CLEAR ERROR FLAG
SA7 AMDB
AMD0 SA2 L.TDKI SET CURRENT LENGTH
SB7 X2
MX0 42
AMD1 SA1 B6 NEXT MODIFICATION LINK
SA5 A1+2 EXTRACT MODIFICATION IDENTIFIER ADDRESS
SB6 X1
LX5 18
SA4 X5 SEARCH FOR IDENTIFIER IN DECK TABLE
SEARCH TDKI,X4
NZ X2,AMD2 IF FOUND
ADDWRD TDKI,X1*X4 ADD NEW MODIFIER
SA1 X5+B1 ENTER MODIFIER INDEX
SX6 X3
SA2 UP CHECK UPDATE MODE
LX6 24
SA6 A1
ZR X2,AMD2 IF NOT *UPDATE* MODE
BX1 -X0*X1 PROPAGATE LINE COUNT
IX6 X6+X1
SA6 A1+
AMD2 SB2 X3+ CHECK MODIFIER INDEX
LT B2,B7,AMD6 IF OLD MODIFIER
NZ B6,AMD1 IF NOT AT END OF CHAIN
SA1 AMDB
NZ X1,AMD7 IF ERRORS OCCURRED
SA1 MA SET MODIFICATION ADDRESS
SB6 X1+
ZR X1,AMDX IF NO MODIFIERS - RETURN
* CONVERT LINE IDENTIFIERS.
AMD3 SA5 B6 LOOK UP FIRST LIMIT
SB6 X5
LX5 24
SA2 X5
SEARCH A0,X2
ZR X2,AMD5 IF NOT FOUND
BX2 X1*X5 ADD MODIFIER ADDRESS
SA4 A5+B1 LOOK UP SECOND LIMIT
SX3 A2
IX6 X2+X3
LX6 36
SA6 A5
ZR X4,AMD4 IF NOT DEFINED
LX4 24
SA2 X4
SEARCH A0,X2
ZR X2,AMD5 IF NOT FOUND
BX2 X1*X4 ADD MODIFIER ADDRESS
SX3 A2
IX6 X2+X3
LX6 36
SA6 A4+
AMD4 NZ B6,AMD3 IF NOT AT END OF MODIFICATION CHAIN
EQ AMDX RETURN
* PROCESS UNKNOWN IDENTIFIER NAME.
AMD5 SA1 A5+B1 SET UNKNOWN MODIFIER FLAG
MX3 2
SA2 A1+B1 CLEAR TEXT
LX3 1
MX0 42
BX6 X3+X1
LX0 24
SA6 A1
BX7 X0*X2
SA7 A2
EQ AMD4
AMDA CON 0 ADDRESS OF LINKED LIST
AMDB CON 0 DUPLICATE MODIFIER ERROR FLAG
ASD SPACE 4,20
** ASD - ASSEMBLE DIGITS.
*
* ENTRY (CH) = CHARACTER POINTER.
*
* EXIT (X7) = ASSEMBLED DIGITS.
* (B2) = 0, IF NUMERIC FIELD NULL.
* (B2) .NE. 0, IF NUMERIC FIELD NOT NULL.
*
* USES X - 1, 2, 3, 6, 7.
* A - 1, 2, 6.
* B - 2.
ASD3 SX6 =C*INCORRECT NUMERIC FIELD.*
SA6 ERRM
SX7 B0+
ASD SUBR ENTRY/EXIT
SA1 CH GET NEXT CHARACTER
BX7 X7-X7 CLEAR ASSEMBLY
SA2 X1
SB2 B0+
SX3 X2-1R+
ZR X2,ASD3 IF TERMINATOR
PL X3,ASD3 IF SEPARATOR
ASD1 SX2 X2-1R0
MI X2,ASD3 IF ALPHA
LX3 X7,B1 LAST DIGIT * 10
LX7 3
IX3 X3+X7
SX1 X1+B1 SET NEXT CHARACTER
IX7 X3+X2 ADD NEW DIGIT
SA2 X1
SB2 X2-1R+
ZR X2,ASD2 IF SEPARATOR
MI B2,ASD1 IF NOT SEPARATOR
ASD2 SX6 X1 UPDATE CHARACTER POINTER
SA6 A1
EQ ASDX RETURN
ASN SPACE 4,20
** ASN - ASSEMBLE NAME.
*
* ASSEMBLE UP TO 7 CHARACTER NAME TO A SEPARATOR.
*
* ENTRY (CHAR) = FIRST CHARACTER IN STRING.
* (CH) = CHARACTER STRING CURRENT INDEX.
*
* EXIT (X6) = NAME, LEFT JUSTIFIED ZERO FILL.
* (X6) = 0, IF SEPARATOR OR .GT. 7 CHARACTERS ASSEMBLED.
* (A1) = CH.
* (X7) = UPDATED CHARACTER POINTER.
*
* USES X - 1, 2, 6, 7.
* A - 1, 2, 7.
* B - 2.
ASN2 MX1 6
SX7 A2
ASN3 LX6 6
BX2 X1*X6
ZR X2,ASN3 IF NOT YET LEFT JUSTIFIED
SA7 A1+ UPDATE CHARACTER POINTER
MX1 -18
BX2 -X1*X6
ZR X2,ASNX IF .GT. 7 CHARACTERS
SX6 B0+ CLEAR ASSEMBLY
SA2 X1+
ASN SUBR ENTRY/EXIT
SA1 CH CHECK FIRST CHARACTER
SA2 X1
BX6 X6-X6 CLEAR ASSEMBLY
MX1 -6
BX2 -X1*X2 MASK OFF POSSIBLE ESCAPE CODE
SB2 X2-1R
ZR X2,ASNX IF SEPARATOR, RETURN
NG B2,ASN1 IF NOT SEPARATOR
* CHECK POSSIBLE 6/12 ESCAPE CODE.
SB2 X2-76B
NZ B2,ASNX IF SEPARATOR
SA2 A2+B1
BX2 -X1*X2
SB2 X2-1RZ-1 END OF LOWER CASE LETTERS (Z)
ZR X2,ASNX IF SEPARATOR, RETURN
PL B2,ASNX IF SEPARATOR, RETURN
ASN1 LX6 6 SHIFT ASSEMBLY
BX6 X6+X2 MERGE NEW CHARACTER
SA2 A2+1 NEXT CHARACTER
BX2 -X1*X2 MASK OFF POSSIBLE ESCAPE CODE
SB2 X2-1R
ZR X2,ASN2 IF SEPARATOR
MI 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
BX2 -X1*X2
SB2 X2-1RZ-1 END OF LOWER CASE ALPHABETICS
ZR X2,ASN2 IF SEPARATOR
NG B2,ASN1 IF NOT SEPARATOR
EQ ASN2
ATS SPACE 4,20
** ATS - ALLOCATE TABLE SPACE.
*
* ENTRY (A0) = TABLE NUMBER.
* (X1) = NUMBER OF ADDITIONAL WORDS TO ALLOCATE.
*
* EXIT (X2) = TABLE FWA.
* (X3) = NEW TABLE LENGTH.
* = ZERO - NO ROOM FOR TCDK TABLE EXPANSION.
*
* USES X - 1, 2, 3, 4, 6, 7.
* A - 1, 2, 3, 4, 6, 7.
* B - 2, 3.
*
* CALLS ABT, WTW=.
ATS9 SA2 FTAB+A0 SET RESPONSE
SA3 LTAB+A0
ATS SUBR 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
MI X4,ATS1 IF NO ROOM FOR CHANGE
BX3 X7
EQ ATSX RETURN
* CHECK AVAILABLE STORAGE.
ATS1 SA2 FTAB+FTABL CHECK STORAGE
SA3 FL
IX6 X2+X1
IX7 X3-X6
MI 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,ATS9 IF LAST TABLE - RETURN
* 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 IF NOT END OF TABLES
IX3 X4-X2 (B2) = WORD COUNT
SB3 X1 (B3) = MOVE INCREMENT
ZR X3,ATS9 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 IF MOVE NOT COMPLETE
EQ ATS9 EXIT TO SET RESPONSE
ATS4 SX3 A0-TCDK
SA2 L.TCDK
ZR X3,ATSX IF COMMON DECK TABLE - RETURN
* CLEAR COMMON DECKS.
ZR X2,ATS5 IF NO COMMON DECKS IN MEMORY
SA3 F.TCDK
BX6 X6-X6 CLEAR COMMON DECKS
LX7 X3
SA6 A2+
SA7 FTAB+FTABL
EQ ATS1 ATTEMPT TO ALLOCATE AGAIN
* DUMP INSERTION TEXT.
ATS5 SA2 T
SA4 L.TTXT
NZ X2,ATS8 IF TEXT FILE BEGUN
ZR X4,ATS8 IF NO TEXT
SX7 X1 SAVE CHANGE
SX6 B4 SAVE B4 - B7
SB2 A0-TTXT
NZ B2,ATS6 IF NOT TEXT TABLE INCREASE
IX4 X4-X1 (X4) = ACTUAL LENGTH
ATS6 SA7 ATSA
SX7 B5
SA6 A7+B1
SA7 A6+B1
SX6 B6
SX7 B7
SA6 A7+B1
SA7 A6+B1
SA3 F.TTXT LWA+1 ALL TABLES = FWA TEXT TABLE
BX6 X6-X6 CLEAR TEXT TABLE LENGTH
LX7 X3
SA6 A4
SA7 FTAB+FTABL
SA7 A7-B1 FWA COMMON DECKS = FWA TEXT TABLE
SA1 T+7 SET TEXT FILE NAME
BX6 X1
SA6 A2
EVICT A2,R DUMP TEXT TABLE
WRITEW X2,X3,X4
SA1 EI
ZR X1,ATS7 IF NO EDITING BEGUN
WRITER X2,R
SA1 X2+1 REWIND POINTERS
SX7 X1
SA7 A1+B1
SA7 A7+B1
BX7 X7-X7 INSURE NO HIT ON TEXT INDEX
SA7 T+5
ATS7 SA1 ATSA RESET CHANGE
SB2 A0-TTXT
SA2 A1+B1 RESTORE B4 - B7
SA3 A2+B1
SB4 X2
SB5 X3
SA2 A3+B1
SA3 A2+B1
SB6 X2
SB7 X3
NZ B2,ATS1 IF NOT TEXT TABLE REQUEST - RETRY
EQ ATSX RETURN
* ALLOCATE ADDITIONAL MEMORY.
ATS8 SA3 FL INCREMENT FL
SX7 X3+FLINL
BX4 X1 SAVE X1
SA7 A3 SET NEW FL
MEMORY CM,,R,X7
BX1 X4 RESTORE X1
EQ ATS1 ATTEMPT TO ALLOCATE AGAIN
ATSA CON 0 TEMPORARIES
CON 0
CON 0
CON 0
CON 0
ATX SPACE 4,20
** ATX - ALLOCATE TABLE EXPANSION SPACE.
*
* ENTRY (A0) = TABLE POINTER ADDRESS.
* (X1) = TABLE BLOCK SIZE.
*
*
* USES X - 1, 2, 3, 4, 6, 7.
* A - 1, 2, 3, 4, 6, 7.
* B - 2.
*
* CALLS ATS.
ATX SUBR ENTRY/EXIT
SA2 FTAB+A0 CHECK TABLE ROOM
SA3 LTAB+A0
IX2 X2+X1 ADD DESIRED BLOCK SIZE
SA4 A2+B1
IX6 X2+X3
SB2 X3
IX7 X4-X6
PL X7,ATXX IF ROOM FOR BLOCK
BX6 X1 SAVE WORD
SA6 ATXA
ALLOC A0,X1
SA1 ATXA RESTORE WORD
IX7 X3-X1
SA7 A3 RESET TABLE CONTENT LENGTH
EQ ATXX RETURN
ATXA CON 0 TEMPORARY STORAGE
CAS SPACE 4,20
** CAS - CALL ASSEMBLER.
*
* ENTRY (QM) = *Q* MODE ASSEMBLER NAME.
* (XM) = *X* MODE ASSEMBLER NAME.
* (NC) = LINES WRITTEN TO COMPILE FILE.
* (NC+1) = LINES WRITTEN TO COMPILE FILE
* IN LAST RECORD.
* (SFL) = SYSTEM FIELD LENGTH.
*
* EXIT IF *X* OR *Q* MODE, EXIT IS TO ASSEMBLER
* AND A0 AND X0 ARE SET UP WITH EXTENDED MEMORY AND FL,
* OTHERWISE RETURN.
*
* USES X - 0, 1, 2, 3, 4, 6, 7.
* A - 0, 1, 2, 3, 4, 6, 7.
*
* CALLS MVE=.
CAS SUBR ENTRY/EXIT
SA1 QM CHECK FOR *X* OR *Q* MODE
SA2 XM
SA3 NC CHECK FOR LINES WRITTEN ON COMPILE
BX6 X1+X2
SA4 A3+B1
ZR X6,CASX IF NOT *X* OR *Q* MODE - RETURN
BX3 X3+X4
ZR X3,CASX IF NO LINES WRITTEN ON COMPILE - RETURN
SA1 SFL
SA0 X1
SA6 CASA STORE ASSEMBLER NAME
MEMORY CM,,R,X1 RESTORE ORIGINAL FL
SX7 CASBL-1
SA7 ACTR SET ARGUMENT COUNT
MOVE CASBL,CASB,ARGR MOVE PARAMETERS
MOVE CASGL,CASG,CCDR MOVE COMMAND
SA1 EFL RESTORE *ECS* FIELD LENGTH
BX0 X1
SYSTEM LDR,R,CASA CALL ASSEMBLER
EQ CASX RETURN
CASA CON 0 LOADER CALL WORDS
CON 140BS36
CASB BSS 0 ASSEMBLER PARAMETER LIST
CON 0LI+1R=
CON 0LCOMPILE
CON 0LL+1R=
CASC CON 0L0
CON 0LB+1R=
CASD CON 0LLGO
CON 0LS+1R=
CASE CON 0LSYSTEXT
CON 0LG+1R=
CASF CON 0L0
CON 0
CASBL EQU *-CASB
CASG BSS 0 ASSEMBLER COMMAND
DUP 8,1
CON 1H
CON 0
CASGL EQU *-CASG
CKC SPACE 4,20
** CKC - CHECK LINE.
*
* ENTRY (A0) - ADDRESS OF FLAG LIST WORD.
*
*T LIST 42/FLAG NAME,18/PROCESSOR ADDR.
*
* EXIT (X4) = 0 IF NULL DIRECTIVE.
*
* USES X - 0, 1, 2, 3, 4, 6, 7.
* A - 1, 2, 7.
* B - 2, 3, 5.
*
* CALLS *ASN* AND SPECIAL LINE PROCESSORS.
CKC SUBR ENTRY/EXIT
SA1 CHAR CHECK FIRST CHARACTER
SA2 PC CHECK PREFIX CHARACTER
MX6 -6
BX1 -X6*X1 USE 6 BIT CHARACTER ONLY
SX7 A1+B1
BX3 X1-X2
SX4 X1-1R
SA7 CH SET SECOND CHARACTER
RJ ASN ASSEMBLE NAME
MX0 42
SA1 A0+
BX4 X4+X6 SET EXIT CONDITION
SB3 64
NZ X3,CKCX IF FIRST CHARACTER .NE. PREFIX - RETURN
ZR X6,CKCX IF BLANK NAME - RETURN
CKC1 ZR X1,CKCX IF END OF LIST - RETURN
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+1
CKC2 SB2 X2-1R
NZ B2,CKC3 IF NOT BLANK
SA2 A2+B1 NEXT CHARACTER
SB3 B3-B1
PL B3,CKC2 IF NOT AT END OF LINE
CKC3 SX7 A2 SET NEXT CHARACTER ADDRESS
SA7 A1
JP B5 PROCESS SPECIAL LINE
CMF SPACE 4,20
** CMF - COMPLETE FILES.
*
* WRITE DIRECTORY, RETURN SCRATCH FILES, REWIND MODSET,
* INSURE EVEN PAGE COUNT AND TERMINATE OUTPT FILE.
*
* USES X - 1, 2, 3, 4, 6, 7.
* A - 1, 2, 3, 4, 6, 7.
* B - 6, 7.
*
* MACROS RECALL, RETURN, REWIND, WRITER, WRITEW.
CMF SUBR ENTRY/EXIT
RECALL P
WRITER C
RETURN T
REWIND S
SA1 NR
NZ X1,CMF1 IF NO REWIND SET
REWIND C
CMF1 SA1 O
SA2 LF
ZR X1,CMF3 IF NO OUTPUT FILE
SA3 PN
ZR X2,CMF3 IF NOTHING LISTED
LX3 59-0
NG X3,CMF2 IF PAGE NUMBER EVEN
SA1 TO
ZR X1,CMF2 IF TERMINAL OUTPUT
WRITEW O,(=2L1 ),1 EJECT
CMF2 WRITER O
CMF3 SA1 A
ZR X1,CMF4 IF FILE NOT USED
RECALL A
CMF4 RECALL M
SA1 M+7
SA2 A+7
BX6 X1
LX7 X2
SA6 M
SA7 A
RETURN M
RETURN A
SB6 FETS WAIT FOR ALL FILES QUIET
SB7 FETSL
CMF5 SA1 B6
ZR X1,CMF6 IF FILE NOT DEFINED
RECALL B6
CMF6 SB6 B6+FETLEN+FETODL
NE B6,B7,CMF5 IF MORE FILES TO PROCESS
EQ CMFX RETURN
CPF SPACE 4,30
** CPF - CONVERT PROGRAM FILE.
*
* ENTRY (CDTX) = FIRST WORD OF COMPRESSED LINE.
* (CDWC) = WORD COUNT OF COMPRESSED LINE.
*
* EXIT (X2) = -6 BIT MASK.
* (X0) = 2074BS48.
* (B5) = (B7) = 60.
* (B2) = 6.
* (A5) = CDTX.
* (X5) = (CDTX).
*
* USES X - 0, 1, 2, 5.
* A - 1, 5.
* B - 2, 4, 5, 7.
*
* CALLS CFT, CTF.
CPF SUBR ENTRY/EXIT
SA1 CVT CHECK FOR CONVERSION
ZR X1,CPFX IF NO CONVERSION
SX0 2074B CONSTANT - XN=0, BN=60 UPON UNPACK
SB7 60 CONSTANT 60
LX0 48
SB5 B7
SB2 6 CONSTANT 6
MX2 -6 CHARACTER MASK
SA5 CDTX FWA OF COMPRESSED LINE BUFFER
MI X1,CFT IF 64 TO 63 CHARACTER SET CONVERSION
* EQ CTF 63 TO 64 CHARACTER SET CONVERSION
CTF SPACE 4,20
** CTF - CONVERT 63 TO 64 CHARACTER SET.
*
* CONVERTS A COMPRESSED LINE FROM 63 TO 64 CHARACTER
* SET. A *0001* BYTE IS CONVERTED TO *5555* AND A *63*
* CODE BECOMES A *0001* BYTE. THE WORD COUNT IS ALSO
* UPDATED. SINCE THE NEW COMPRESSED LINE MAY BE LONGER THAN
* THE OLD, THE LINE IS NOT CONVERTED IN PLACE. THE CONVERTED
* LINE IS MOVED BACK TO THE *CDTX* BUFFER AFTER CONVERSION.
*
* IN *ASCII* MODE, 63 CHARACTER SET PERCENT (*7404B*) IS
* CONVERTED TO *63B*.
*
*
* ENTRY (X2) = -6 BIT MASK.
* (X0) = 2074BS48.
* (B5) = (B7) = 60.
* (B2) = 6.
* (A5) = CDTX.
* (X5) = (CDTX).
*
* EXIT (CDTX) = CONVERTED LINE IMAGE.
* (CDWC) = UPDATED LINE WORD COUNT.
*
* USES X - 1, 3, 4, 5, 6, 7.
* A - 1, 5, 6, 7.
* B - 3, 4, 5, 6, 7.
*
* CALLS MVE=.
*CTF BSS 0
SA1 CSC CHARACTER SET (DISPLAY/ASCII) CURRENT DECK
SB4 X1
SA1 CVTX-1 PRESET (A6)
BX6 X1
SA6 A1+
UX6,B6 X0 SET REGISTERS
CTF1 LX5 6 PICK NEXT CHARACTER
SB5 B5-6 DECREMENT CHARACTER COUNT
BX4 -X2*X5
NZ B5,CTF2 IF NOT END OF INPUT WORD
SA5 A5+B1 ADVANCE TO NEXT WORD
SB5 B7 RESET CHARACTER COUNT
CTF2 SX1 X4-63B CHECK FOR 63 CHARACTER SET COLON
ZR X4,CTF4 IF COMPRESSION CHARACTER (*00*)
ZR X1,CTF8 IF COLON
SA1 MADCV
ZR B4,CTF3 IF DISPLAY CODE MODE
NZ X1,CTF3 IF MADIFY CONVERSION
SX1 X4-74B
NZ X1,CTF3 IF NOT ESCAPE CODE 74B
LX7 B2,X5 TRY NEXT CHARACTER
BX1 -X2*X7
SX7 X1-04
NZ X7,CTF3 IF NOT *7404B* (PERCENT)
SX4 63B (X4) = 64 CHARACTER SET PERCENT
LX5 6
SB5 B5-6
NZ B5,CTF3 IF NOT END OF INPUT WORD
SA5 A5+B1
SB5 B7 RESET CHARACTER COUNT
CTF3 LX6 6 PROCESS NORMAL CHARACTER
SB6 B6-6 DECREMENT CHARACTER COUNT
BX6 X6+X4 INSERT NEXT CHARACTER
NZ B6,CTF1 IF OUTPUT WORD NOT EXHAUSTED
SA6 A6+B1 SET CURRENT WORD
UX6,B6 X0 RESET REGISTERS
EQ CTF1 GET NEXT CHARACTER
* PROCESS COMPRESSION CODE.
CTF4 LX5 6 PROCESS CHARACTER FOLLOWING COMPRESSION
BX4 -X2*X5
SB5 B5-6 DECREMENT CHARACTER COUNT
NZ B5,CTF5 IF INPUT WORD NOT EMPTY
SA5 A5+B1 ADVANCE TO NEXT WORD
SB5 B7
CTF5 ZR X4,CTF9 IF END OF LINE
SB3 X4-1 CHECK FOR *0001* BYTE
ZR B3,CTF7 IF *0001* BYTE
LX6 6 INSERT *00*
CTF6 SB6 B6-B2
NZ B6,CTF3 IF NOT END OF OUTPUT WORD
SA6 A6+B1 SET CURRENT WORD
UX6,B6 X0 RESET REGISTERS
EQ CTF3 PROCESS COMPRESSION AS NORMAL CHARACTER
* PROCESS *0001* CODE.
CTF7 SX4 1R CONVERT *0001* TO *5555*
LX6 6 INSERT *55*
BX6 X6+X4
EQ CTF6 PROCESS SPACE AS NORMAL CHARACTER
* PROCESS *63* CODE.
CTF8 SA1 MADCV
NZ X1,CTF3 IF MADIFY CONVERSION
SX4 B1 CONVERT *63* TO *0001*
LX6 6 INSERT *00*
ZR B4,CTF6 IF DISPLAY CODE, PROCESS *01* AS NORMAL
SX1 74B
BX6 X6+X1
SX4 04B MAKE *63* INTO *7404* IN ASCII MODE
EQ CTF6 PROCESS *01* AS NORMAL CHARACTER
* PROCESS END OF LINE.
CTF9 LX6 X6,B6 POSITION LAST WORD
MX3 -12
SA6 A6+B1
BX4 -X3*X6 CHECK FOR END OF LINE IN CURRENT WORD
ZR X4,CTF10 IF END OF LINE PRESENT
BX6 X6-X6 SET END OF LINE WORD
SA6 A6+B1
CTF10 SX7 A6-CVTX+1 SET UPDATED WORD COUNT
SA7 CDWC
MOVE X7,CVTX,CDTX MOVE TO COMPRESSED LINE BUFFER
EQ CPFX RETURN
CFT SPACE 4,20
** CFT - CONVERT 64 TO 63 CHARACTER SET.
*
* CONVERTS A COMPRESSED LINE FROM 64 TO 63 CHARACTER
* SET. A *0001* BYTE IS CONVERTED TO A *63* AND A
* *63* IS CONVERTED TO A *55*.
*
* ENTRY (X2) = -6 BIT MASK.
* (X0) = 2074BS48.
* (B5) = (B7) = 60.
* (B2) = 6.
* (A5) = CDTX.
* (X5) = (CDTX).
*
* EXIT (CDTX) = CONVERTED LINE IMAGE.
* (CDWC) = UPDATED LINE WORD COUNT.
*
* USES X - 1, 3, 4, 5, 6, 7.
* A - 1, 4, 5, 6, 7.
* B - 4, 5, 6.
CFT SA1 CSC CHARACTER SET (DISPLAY/ASCII) CURRENT DECK
SA4 CVTX-1 PRESET (A6)
SB4 X1
BX6 X4
SA6 A4
UX6,B6 X0 SET REGISTERS
CFT1 LX5 6 GET NEXT CHARACTER
SB5 B5-6 DECREMENT CHARACTER COUNT
BX4 -X2*X5
NZ B5,CFT2 IF NOT END OF INPUT WORD
SA5 A5+B1 SET NEXT WORD
SB5 B7 RESET CHARACTER COUNT
CFT2 ZR X4,CFT4 IF COMPRESSION CODE OR COLON
SX1 X4-74B
NZ X1,CFT2.1 IF NOT ESCAPE CODE 74B
LX7 B2,X5 CHECK NEXT CHARACTER
BX1 -X2*X7
SX7 X1-04B CHECK FOR 64 CHARACTER SET COLON
NZ X7,CFT2.1 IF NOT 64 CHARACTER SET COLON (*7404*)
SX4 63B SET 63 CHARACTER SET COLON (*63B*)
LX5 6
SB5 B5-6
NZ B5,CFT3 IF NOT END OF INPUT WORD
SA5 A5+B1
SB5 B7 RESET CHARACTER COUNT
EQ CFT3 INSERT CHARACTER
CFT2.1 SX1 X4-63B CHECK FOR PERCENT SIGN
NZ X1,CFT3 IF NOT PERCENT SIGN
EQ B4,B1,CFT9 IF ASCII MODE
SX4 1R CONVERT PERCENT TO BLANK
CFT3 LX6 6 INSERT CHARACTER
SB6 B6-6
BX6 X6+X4
NZ B6,CFT1 IF OUTPUT WORD NOT FULL
SA6 A6+B1 SET CURRENT WORD
UX6,B6 X0 RESET REGISTERS
EQ CFT1 GET NEXT CHARACTER
* PROCESS COMPRESSION/COLON CODES.
CFT4 LX5 6 GET NEXT CHARACTER
SB5 B5-6 DECREMENT CHARACTER COUNT
BX4 -X2*X5
ZR X4,CFT7 IF END OF LINE
NZ B5,CFT5 IF INPUT WORD NOT EXHAUSTED
SA5 A5+1 GET NEXT CHARACTER
SB5 B7+ RESET CHARACTER COUNT
CFT5 SX1 X4-1 CHECK FOR *0001* CODE
ZR X1,CFT6 IF COLON (*0001*)
LX6 6 SET *00*
SB6 B6-B2 DECREMENT CHARACTER COUNT
NZ B6,CFT3 IF OUTPUT WORD NOT EXHAUSTED
SA6 A6+B1
UX6,B6 X0
EQ CFT3 PROCESS AS NORMAL CHARACTER
* PROCESS *0001* CODE.
CFT6 SX4 63B CONVERT *0001* TO *63*
EQ CFT3 PROCESS AS NORMAL CHARACTER
* PROCESS END OF LINE.
CFT7 LX6 X6,B6 LEFT JUSTIFY ASSEMBLY
MX3 -12 CHECK FOR END OF LINE SUPPLIED
SA6 A6+B1 SET LAST WORD
BX4 -X3*X6
ZR X4,CFT8 IF END OF LINE PRESENT
BX6 X6-X6
SA6 A6+B1
CFT8 SX7 A6-CVTX+1 SET UPDATED WORD COUNT
SA7 CDWC
MOVE X7,CVTX,CDTX MOVE TO COMPRESSED LINE BUFFER
EQ CPFX RETURN
* PROCESS *63* IN ASCII MODE.
CFT9 SX1 74B MAKE PERCENT IN ASCII CHARACTER SET
LX6 6
SB6 B6-B2
SX4 04B
BX6 X6+X1
NZ B6,CFT3 IF OUTPUT WORD NOT EXHAUSTED
SA6 A6+B1
UX6,B6 X0
EQ CFT3 PROCESS AS NORMAL CHARACTER
DNL SPACE 4,15
** DNL - DECREMENT NESTING LEVEL.
*
* ENTRY NONE.
*
* EXIT (X6) = COMMON DECK NAME OF PREVIOUS NESTING LEVEL.
* = 0 IF NO NESTING.
*
* USES X - 1, 2, 3, 6, 7.
* A - 1, 2, 6, 7.
DNL SUBR ENTRY/EXIT
SX6 0
SA1 L.TNCC
SA6 CDC CLEAR COMMON DECK LINE COUNT
SA6 CDS CLEAR COMMON DECK SKIP COUNT
ZR X1,DNLX IF NO NESTING
SX6 X1-1
SA6 A1 DECREMENT TABLE LENGTH
ZR X6,DNLX IF NO NESTING
SA2 F.TNCC
IX3 X6+X2
MX2 42
SA1 X3-1 GET PREVIOUS NESTING LEVEL NAME
SX7 X1 SKIP COUNT
BX6 X2*X1 COMMON DECK NAME
SA7 CDS SET SKIP COUNT
EQ DNLX RETURN
ECD SPACE 4,20
** ECD - EXPAND LINE.
*
* ENTRY (CDTX) = FIRST WORD OF COMPRESSED LINE.
*
* EXIT (B7) = LWA+1 OF LAST CHARACTER IN EXPANDED LINE.
* (CHAR) = FIRST CHARACTER OF EXPANDED LINE.
*
* USES X - 0, 1, 2, 3, 4, 6, 7.
* A - 1, 2, 3, 4, 6, 7.
* B - ALL.
*
* CALLS CDD.
ECD SUBR ENTRY/EXIT
SA3 CSC CHARACTER SET OF DECK
SA4 SETC CHECK FOR *CSET
ZR X3,ECD0 IF DECK IS DISPLAY
* DECK IS 6/12 ASCII.
SB6 B1+
NZ X4,ECD0.1 IF NOT *CSET,DISPLAY - UNPACK 6/12 ASCII
SB6 B0+
EQ ECD0.1 OTHERWISE *CSET,DISPLAY FOLD TO UPPER CASE
* DECK IS DISPLAY.
ECD0 SB6 -B1 UNPACK 6 BIT CHARACTERS
NG X4,ECD0.1 IF NO *CSET
ZR X4,ECD0.1 IF *CSET,DISPLAY
SB6 B1+ UNPACK 6/12 ASCII CHARACTERS
ECD0.1 SA1 SC+1 SET LAST COLUMN
SX6 1R SET TO BLANK FILL BUFFER
SB7 X1+B1
SA6 CHAR PRESET (A6)
MX0 -6
SB2 -B7
SB5 10 CONSTANT 10
SB4 B5
ECD1 SB7 B7-B1 BLANK FILL LINE
SA6 A6+B1
PL B7,ECD1 IF NOT COMPLETE
SB3 CHAR+1+X1
SA1 CDTX
EQ ECD3
* EXPAND LINE 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
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,ECD7 IF LINE LIMIT REACHED
SA7 B2+B3 STORE CHARACTER
SB2 B2+B1
ECD3 SB4 B4-1 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 CURRENT CHARACTER IS *00*
NG B6,ECD2 IF UNPACKING 6 BIT CHARACTERS
ZR B6,ECD11 IF CONVERTING LOWER TO UPPER CASE
EQ ECD1.1 OTHERWISE UNPACK 12 BIT ASCII
ECD4.1 SB4 B4-1
LX1 6 EXTRACT SPACE COUNT
BX7 -X0*X1
ECDA BSS 0
NZ B4,ECD5 IF NOT END OF WORD
* NZ B4,ECD6 (63 CHARACTER SET)
SA1 A1+B1 SET NEXT WORD
SB4 B5 RESET CHARACTER COUNT
ECDB BSS 0
ECD5 SB7 X7 CHECK COMPRESSION CODE
* EQ ECD6 (63 CHARACTER SET)
NE B7,B1,ECD6 IF NOT *0001*
BX7 X7-X7 INSERT *00* CHARACTER
EQ ECD2
* PROCESS COMPRESSION CODE.
ECD6 SX4 X7+B1 SET COMPRESSION COUNT
SB2 X4+B2 SET BLANKS IN BUFFER
NZ X7,ECD3 IF NOT END OF WORD
* ENTER IDENTIFIER NAME.
ECD7 SA2 CDID GET LINE IDENTIFICATION
SB7 B2+B3 SET ADDRESS OF LAST CHARACTER +1
MX3 -16
SB2 7
LX2 6
ECD8 BX7 -X0*X2 NEXT CHARACTER
SB2 B2-1
LX2 6
NZ X7,ECD9 IF NOT *00*
SX7 1R SET BLANK
ECD9 SA7 B3-B1
SB3 B3+B1
NZ B2,ECD8 IF NOT AT END OF NAME
* ENTER LINE NUMBER.
LX2 12 CONVERT LINE NUMBER
BX1 -X3*X2
RJ CDD CONVERT TO DECIMAL DISPLAY
SB2 9
LX6 24
MX0 -6
ECD10 BX7 -X0*X6 ENTER SEQUENCE NUMBER
SB2 B2-B1
SA7 A7+B1
LX6 6
NZ B2,ECD10 IF NOT AT END OF SEQUENCE NUMBER
SB3 A7+1 RETURN WITH NEXT CHARACTER POSITION
EQ ECDX
* CONVERT 6/12 ASCII TO DISPLAY CODE.
*
* X0 = 6 BIT CHARACTER MASK (LOW ORDER CHARACTER).
* X1 = UNPACK REGISTER POSITIONED TO NEXT CHARACTER.
* X7 = CURRENT ESCAPE CODE RIGHT JUSTIFIED.
* B4 = COUNT OF CHARACTERS UNPACKED FROM X1.
* B5 = 10 (NUMBER OF 6 BIT CHARACTERS IN A WORD).
ECD11 BX3 X1
LX3 6
BX2 -X0*X3 GET NEXT CHARACTER
SX4 X7-74B
SX3 X7-76B
ZR X4,ECD14 IF 74B ESCAPE CODE
NZ X3,ECD2 IF NO ESCAPE CODES
ZR X2,ECD2 IF 7600B, PROCESS AS 2 CHARACTERS
SX4 X2-37B
PL X4,ECD2 IF .GT. 7636B, PROCESS AS 2 CHARACTERS
SX4 X2-33B
NG X4,ECD12 IF LOWER CASE CONVERT TO UPPER CASE
* CHECK FOR ISO NATIONAL CHARACTERS.
SX7 61B
ZR X4,ECD13 IF LEFT BRACE CONVERT TO LEFT BRACKET
SX4 X2-34B
SX7 75B
ZR X4,ECD13 IF VERTICAL LINE CONVERT TO BACK SLASH
SX4 X2-35B
SX7 62B
ZR X4,ECD13 IF RIGHT BRACE CONVERT TO RIGHT BRACKET
SX2 76B CONVERT TILDE TO CIRCUMFLEX
ECD12 BX7 X2 STRIP AWAY 76B ASCII ESCAPE CODE
ECD13 SB4 B4-B1
LX1 6
NZ B4,ECD2 IF DISPLAY CODE CHARACTER
SA1 A1+B1 SET UP NEXT WORD
SB4 B5
EQ ECD2 STORE DISPLAY CODE CHARACTER
ECD14 BX3 X2 POSSIBLE 74B ESCAPE CODE FOUND
SX4 X3-1
ZR X4,ECD13 IF AT SIGN (IN X7)
SX4 X3-2
SX2 76B
ZR X4,ECD12 IF CIRCUMFLEX
SX4 X3-7
ZR X4,ECD13 IF 7407B - UNPACK GRAVE ACCENT
SX4 X3-4
NZ X4,ECD2 IF NOT 7407B - 2 CHARACTERS
SA4 COPL CHECK FOR 63 OR 64 CHARACTER SET
SA2 DISCOL
NZ X4,ECD12 IF 64 UNPACK COLON
SA2 DISPER
EQ ECD12 OTHERWISE UNPACK 63 PERCENT (55B)
INL SPACE 4,15
** INL - INCREMENT NESTING LEVEL.
*
* INCREMENT NESTING LEVEL OF COMMON DECK CALLS.
*
* ENTRY (X6) = COMMON DECK NAME.
*
* EXIT (X6) = COMMON DECK NAME.
*
* USES X - 0, 1, 4, 7.
* A - 1, 4, 7.
* B - 2.
*
* MACROS ADDWRD, SEARCH.
INL1 SX7 0
SA7 CDC RESET LINE COUNT
SA7 CDS RESET SKIP COUNT
SEARCH TCCD,X6
NZ X2,INLX IF ALREADY CALLED COMMON DECK
ADDWRD TCCD,X6 ADD NAME TO TABLE OF CALLED DECKS
INL SUBR ENTRY/EXIT
MX0 42
BX6 X0*X6
ADDWRD TNCC,X6 PUSH DECK NAME ON STACK
LE B2,B0,INL1 IF NO PREVIOUS ENTRY
SA1 CDC GET COUNT OF LINES OF PREVIOUS OPLC
SA4 A6-B1 GET PREVIOUS ENTRY
BX4 X0*X4
BX7 X4+X1 INCLUDE SKIP COUNT
SA7 A4
EQ INL1 SEARCH TABLE OF CALLED COMMON DECKS
PCS SPACE 4,15
** PCS - PROCESS OPL CHARACTER SET.
*
* CHECK AND/OR INITIALIZE *MODIFY* FOR 63/64 CHARACTER
* AND DISPLAY/ASCII CHARACTER SET OPL PROCESSING.
*
* ENTRY (B5) = FWA OF IDENT TABLE FOR RECORD.
*
* EXIT IF INITIAL ENTRY.
* (ECDA) INITIALIZED.
* (ECDB) INITIALIZED.
*
* USES X - 1, 2, 3, 4, 5.6, 7.
* A - 0, 1, 3, 4, 6, 7.
* B - 2.
*
* CALLS ABT, SFN.
PCS SUBR ENTRY/EXIT
SA5 B5+16B CHECK CHARACTER SET OF RECORD
MX1 -6 MASK OFF 63/64 CHARACTER SET
BX5 -X1*X5
* VERIFY OPL CHARACTER SET.
SX3 X5-64B CHECK FOR 64 CHARACTER SET PL
ZR X3,PCS1 IF 64 CHARACTER SET
ZR X5,PCS1 IF 63 CHARACTER SET (*00*)
SA1 B5+B1 INCORRECT CHARACTER SET DECK NAME
RJ SFN SPACE FILL DECK NAME
SX2 1R &1R- FORM MESSAGE
BX5 X5-X5 SET 63 CHARACTER SET
LX6 -6
BX6 X6-X2
SA6 PCSB SET MESSAGE
SA1 A5 CORRECT CHARACTER SET IN HEADER
MX2 54
BX7 X2*X1 PRESERVE ASCII FLAG
SA7 A1
MESSAGE A6,3 * DECKNAM - INCORRECT CS, 63 ASSUMED.*
* CHECK FOR MIXED PL,S.
PCS1 SA4 COPL PREVIOUS CHARACTER SET
BX3 X4-X5 COMPARE PREVIOUS AGAINST CURRENT
BX6 X5 CHARACTER SET OF CURRENT RECORD
SB2 X5 CHARACTER SET OF CURRENT RECORD
SA6 A4 SET PREVIOUS CHARACTER SET
MI X4,PCS2 IF INITIAL ENTRY
* COMPARE AGAINST CHARACTER SET OF PREVIOUS RECORD.
ZR X3,PCS11 IF SAME CHARACTER SET - CHECK ASCII FLAG
SA1 B5+B1 SET DECK NAME IN MESSAGE
RJ SFN SPACE FILL DECK NAME
SX2 1R &1R- FORM MESSAGE
LX6 -6
BX6 X6-X2
SA6 PCSC
SA0 A6 ADDRESS OF MESSAGE
EQ ABT
* CHECK REDUNDANT CONVERSION.
PCS2 SA3 CVT CHECK AGAINST CONVERSION OPTION
ZR X3,PCS7 IF NO CONVERSION SPECIFIED
SB2 X3-63B
NZ X5,PCS4 IF PROGRAM LIBRARY IS 64 CHARACTER SET
NZ B2,PCS5 IF NOT REDUNDANT, NOT 63 TO 63 CONVERSION
PCS3 MESSAGE (=C* REDUNDANT CONVERSION IGNORED.*),3
BX6 X6-X6 CLEAR CONVERSION IF REDUNDANT
SA6 A3
EQ PCS7 PROCESS AS NO CONVERSION
PCS4 NE B1,B2,PCS5 IF NOT 64 TO 64 REDUNDANCY
SA1 MADCV
NZ X1,PCS5 IF MADIFY CONVERSION - NOT REDUNDANT
SB2 64B NEW PROGRAM LIBRARY CHARACTER SET
EQ PCS3 REDUNDANT 64 TO 64 CONVERSION
PCS5 ZR B2,PCS6 IF CONVERSION TO 63 CHARACTER SET
SB2 64B SET CONVERSION TO 64 CHARACTER SET
PCS6 SX7 B2-1 SET CONVERSION FLAG
SA7 A3+
* MODIFY INSTRUCTIONS FOR 63 CHARACTER SET.
PCS7 NZ B2,PCS8 IF 64 CHARACTER SET
SA1 PCSE
SA0 PCSD
NZ X1,ABT IF INPUT 64 WHILE PL IS 63
SA1 PCSA MODIFY INSTRUCTIONS
SA2 A1+B1
BX6 X1
BX7 X2
SA6 ECDA
SA7 ECDB
* INITIALIZE PROGRAM LIBRARY/COMPILE FILE CHARACTER SETS.
PCS8 SX7 B2 NEW CHARACTER SET
SA1 CIDT COMPILE FILE HEADER SKELETON
SA7 CNPL CHARACTER SET OF NEW PROGRAM LIBRARY
LX7 24
BX6 X7+X1
SA6 A1
* STORE DISPLAY CODE COLON AND PERCENT CHARACTERS.
ZR B2,PCS9 IF 63 CHARACTER SET
MX7 0 00B = 64 CHARACTER SET COLON
SX6 63B 63B = 64 CHARACTER SET PERCENT
EQ PCS10 STORE CHARACTERS
PCS9 SX7 63B 63 CHARACTER SET COLON
SX6 1R 63 CHARACTER SET PERCENT
PCS10 SA7 DISCOL COLON
SA6 DISPER PERCENT
* DETERMINE IF DECK IS DISPLAY OR 6/12 ASCII.
PCS11 SA2 MADCV CHECK FOR MADIFY CONVERSION
SX6 1 SET ASCII BIT FOR THIS DECK
NZ X2,PCS12 IF MADIFY CONVERSION
SA1 A5 GET CHARACTER SET WORD
MX4 -6
LX1 -6 SHIFT TO ASCII/DISPLAY FIELD
BX6 -X4*X1
PCS12 SA6 CSC SET CURRENT CHARACTER SET
EQ PCSX RETURN
PCSA NZ B4,ECD6 IF NOT END OF WORD (63 CHARACTER SET)
SA1 A1+B1
SB4 B5
+ EQ ECD6 (63 CHARACTER SET)
PCSB DATA C* DECKNAM - INCORRECT CS, 63 ASSUMED.*
PCSC DATA C* DECKNAM - MIXED CHARACTER SET DETECTED.*
PCSD DATA C* INCORRECT CS ON INPUT.*
PCSE DATA 0 INPUT 64 SET INDICATOR
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 CON 0
PCW SPACE 4,20
** PCW - PROCESS COMPILE FILE WRITE.
*
* WRITE COMMON DECK DATA IF NOT CALL TO OTHER COMMON DECK.
* TRAP NESTING OF COMMON DECKS.
*
* ENTRY NONE.
*
* EXIT (X1) = ZERO = NORMAL RETURN
* = NONZERO = SKIP THIS LINE
* (X6) = COMMON DECK NAME IF CALL ENCOUNTERED.
* ELSE 0, AND LINE WRITTEN.
*
* USES ALL.
*
* CALLS ASN, ECD, LCE, WCC, WCF.
*
* MACROS CARD, LISTOP, RECALL, SEARCH.
PCW7 SA1 AM CHECK FOR COMPRESSED COMPILE FILE
ZR X1,PCW8 IF NOT COMPRESSED MODE
RJ WCC WRITE COMPRESSED COMPILE FILE
EQ PCW10 NORMAL RETURN
PCW8 RJ ECD EXPAND LINE
PCW9 RJ WCF WRITE COMPILE FILE
SX1 1 THIS LINE IS NOT A COMMENT
PCW10 MX6 0 NORMAL RETURN - NO COMMON DECK NESTING
PCW SUBR ENTRY/EXIT
SA2 CDC INCREMENT LINE COUNT
SA1 CDS GET SKIP COUNT
SX7 X2+B1
SA7 A2
ZR X1,PCW1 IF NOTHING TO SKIP
SX7 X1-1
SA7 A1
MX1 0 INDICATE SKIPPING
BX6 X6-X6
EQ PCWX RETURN SKIPPING THIS LINE
PCW1 SA1 CDTX
SA2 WCCA GET PREFIX CHARACTER
BX3 X2-X1
AX3 54
NG X3,PCW7 IF NOT COMMENT LINE
NZ X3,PCW7 IF NOT COMMENT LINE
RJ ECD EXPAND LINE
CARD CALL,PCW2 *CALL
CARD CALLC,PCW4 *CALLC
CARD IFCALL,PCW5 *IFCALL
CARD NIFCALL,PCW6 *NIFCALL
EQ PCW9 WRITE COMPILE FILE
COMPILE SPACE 4,10
*** COMPILE FILE CONTROL DIRECTIVES.
*
* THESE DIRECTIVES CONTROL THE PROCESSING OF THE COMPILE FILE.
* THEY ARE PROCESSED WHEN THEY OCCUR FROM THE PROGRAM LIBRARY
* OR RESULT FROM INSERTION.
CALL SPACE 4,10
*** CALL DNAME
*
* PLACE COPY OF COMMON DECK *DNAME* ON COMPILE FILE.
PCW2 SA1 IFIP
NG X1,PCW10 IF INACTIVE
RECALL M
RJ ASN ASSEMBLE NAME
PCW3 NZ X6,PCW3.5 IF NAME IS OK
BX7 X7-X7
SA7 CL CLEAR LINE LISTED STATUS
SA0 =C/ UNKNOWN DECK./
RJ LCE LIST COMPILE FILE DIRECTIVE ERROR
EQ PCW10 RETURN AFTER ERROR
PCW3.5 SEARCH TNCC,X6 CHECK IF RECURSIVE CALL
ZR X2,PCWX IF NOT FOUND IN NESTING STACK
LISTOP E,PCW10 IF NO ERROR LIST - RETURN
SA0 PCWA
RJ LCE LIST COMPILE FILE DIRECTIVE ERROR
EQ PCW10 NORMAL RETURN
CALLC SPACE 4,10
*** CALLC DNAME
*
* PLACE COPY OF COMMON DECK *DNAME* ON COMPILE FILE, IF IT
* HAS NOT BEEN CALLED BY A PREVIOUS *CALL* OR *CALLC* COMPILE
* FILE DIRECTIVE.
PCW4 SA1 IFIP
NG X1,PCW10 IF INACTIVE
RECALL M
RJ ASN ASSEMBLE NAME
SEARCH TCCD,X6
ZR X2,PCW3 IF NOT FOUND - PROCESS AS *CALL
EQ PCW10 NORMAL RETURN
IFCALL SPACE 4,10
*** IFCALL NAME,DNAME
*
* PLACE COPY OF COMMON DECK *DNAME* ON COMPILE FILE, IF
* *NAME* IS DEFINED.
PCW5 RJ ASN ASSEMBLE NAME
SEARCH TDEF,X6 SEARCH FOR NAME
ZR X2,PCW10 IF NOT FOUND - RETURN
SX7 X7+B1 SKIP SEPARATOR
SA7 CH
EQ PCW2 PROCESS AS *CALL
NIFCALL SPACE 4,10
*** NIFCALL NAME,DNAME
*
* PLACE COPY OF COMMON DECK *DNAME* ON COMPILE FILE, IF
* *NAME* IS NOT DEFINED.
PCW6 RJ ASN ASSEMBLE NAME
SEARCH TDEF,X6 SEARCH FOR NAME
NZ X2,PCW10 IF FOUND - RETURN
SX7 X7+B1 SKIP SEPARATOR
SA7 CH
EQ PCW2 PROCESS AS *CALL
PCWA DATA C* DECKNAM - INCORRECTLY NESTED CALL OF COMMON DECK*
RCL SPACE 4,15
** RCL - RE-COMPRESS LINE.
*
* ENTRY (CHAR) = CHARACTER STRING OF LINE.
* (B7) = LAST CHARACTER POSITION IN STRING BUFFER.
*
* EXIT (CDTX) = COMPRESSED LINE.
* (CDWC) = WORD COUNT OF COMPRESSED LINE.
*
* USES ALL.
* PROCESS END OF LINE.
RCL8 LX6 X6,B6 SHIFT UP LAST WORD
MX3 -12
SA6 A6+1
BX4 -X3*X6
SB2 A1+
BX6 X6-X6
ZR X4,RCL9 IF LINE TERMINATED
SA6 A6+1 TERMINATE LINE
RCL9 SX7 A6-B2 SET WORD COUNT
SA7 A1-B1
RCL SUBR ENTRY/EXIT
SX7 B7-1 SAVE LAST CHARACTER POSITION
SA7 RCLL
SX0 2074B (X0) = CONSTANT 60 FOR UNPACK
SB4 100B
SB3 -B1
SA1 CDID PRESET (A6)
LX0 48
SA5 CHAR FIRST CHARACTER
SB7 B4+B1
BX6 X1
SA6 A1
SB2 6
UX6,B6 X0 RESET REGISTERS
SA2 RCLL SET LAST CHARACTER POSITION
SB5 -B1
BX1 -X2
SX7 1R
EQ RCL7 ENTER TO PROCESS FIRST CHARACTER
RCL1 SB5 B5+1
RCL2 LX6 6 00 CHARACTER
SB6 B6-B2
SX4 B4-B1 COMPRESSION = 77B
SB3 B5-B7
NZ B6,RCL3 IF NOT END OF WORD
SA6 A6+B1
UX6,B6 X0 RESET REGISTERS
RCL3 PL B3,RCL4 IF .GT. 64 BLANKS
SX4 B5-B1 COMPRESSION = COUNT - 1
SB3 -B1
RCL4 NZ X4,RCL5 IF CHARACTER IS NOT *00*
LX6 6 INSERT *00*
SB6 B6-B2
SX4 B1 SET *01*
NZ B6,RCL5 IF NOT END OF WORD
SA6 A6+B1
UX6,B6 X0 RESET REGISTERS
RCL5 BX3 X4 SAVE CHARACTER
AX4 6 CHECK FOR ESCAPE CODE
ZR X4,RCL6 IF NO ESCAPE CODE
LX6 6 SHIFT ASSEMBLY
SB6 B6-B2
BX6 X6+X4 MERGE NEW CHARACTER
SB5 B3
NZ B6,RCL6 IF NOT END OF WORD
SA6 A6+B1
UX6,B6 X0 RESET REGISTERS
RCL6 MX4 -6
BX4 -X4*X3 CLEAN OFF ESCAPE CODE
LX6 6 SHIFT ASSEMBLY
SB6 B6-B2
BX6 X6+X4 MERGE NEW CHARACTER
SB5 B3
NZ B6,RCL7 IF NOT END OF WORD
SA6 A6+B1
UX6 B6,X0
RCL7 IX3 X5-X7 CHECK CHARACTER
BX4 X5
SB5 B5+B1 COUNT BLANK
SB3 X1 -( LWA + 1 ) OF STRING BUFFER
SB3 B3+A5 CHECK FOR END OF LINE
SA5 A5+B1 NEXT CHARACTER
ZR B3,RCL8 IF END OF LINE
ZR X3,RCL7 IF BLANK
SB3 -1
ZR B5,RCL4 IF NO BLANKS
BX4 X7
SA5 A5-B1 BACKSPACE
EQ B5,B1,RCL4 IF 1 BLANK
SB5 B5-1
NE B5,B1,RCL1 IF NOT 2 BLANKS
SA5 A5-1 BACKSPACE
EQ RCL4 CHECK FOR *00* CHARACTER
RCLL CON 0 LAST CHARACTER POSITION IN STRING BUFFER
RMT SPACE 4,25
** RMT - READ MODIFIER TABLE.
*
* ENTRY (DN) = DECK NAME.
* (MA) = MODIFICATION TABLE ADDRESS.
*
* USES X - ALL.
* A - 1, 2, 3, 4, 5, 6, 7.
* B - ALL.
*
* CALLS AMD, ATS, PCS, POC.
RMT SUBR ENTRY/EXIT
SA1 DA GET DECK TABLE ENTRY
SA3 X1+B1 SET RANDOM ADDRESS
MX7 -30
BX7 -X7*X3
AX3 36 SET FILE NAME
SA7 P+6
SA2 X3
BX6 X2
SA6 P
READ A6 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
ADDWRD TNCD,X6-X6 ADD NEXT LINE NUMBER
SB5 TIDT FWA OF IDENT TABLE
RJ PCS PROCESS CHARACTER SET
READW P,T1,1 READ MODIFIER TABLE LENGTH
NZ X1,PLE IF EOR
SA1 T1 CHECK TABLE
LX1 18
BX6 X6-X6
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,RMT2 IF NO MODIFIERS
ALLOC TNCD,B7 ALLOCATE FOR MODIFIERS
ALLOC TDKI,B7
READW P,X2+B1,B7 READ MODIFIERS
RMT2 SA3 MA
ZR X3,RMT3 IF NO MODIFICATIONS
SB6 X3
RJ AMD ADD MODIFIERS
SA1 L.TDKI ALLOCATE PARALLEL TABLE
SB7 X1
ALLOC TNCD,B7
RMT3 SA1 YK
ZR X1,RMTX IF NO YANKS - RETURN
* ADD YANKS.
SA2 L.TDKI SEARCH MODIFIER TABLE
SA1 F.TDKI
SX0 1S16 YANK/UNYANK MASK
SB4 X2+
SA5 X1
BX7 X7-X7 CLEAR YANK COUNT
RMT4 EQ B4,B1,RMT6 IF END OF MODIFIER TABLE
SA5 A5+B1 NEXT ENTRY
SB4 B4-B1
SX2 1S15 SEARCH FOR YANK
SEARCH TNME,X5+X2,X2
ZR X2,RMT4 IF NOT FOUND
BX1 X0*X2 CLEAR/SET YANK IN MODIFIER
LX2 59-0
RMT5 BX5 -X0*X5
IX6 X5+X1
SA6 A5
SX7 X7+B1 COUNT YANK
PL X2,RMT4 IF NOT YANK AFTER
SA5 A5+B1 NEXT ENTRY
SB4 B4-B1
NZ B4,RMT5 IF NOT AT END OF MODIFIERS
RMT6 SA7 YD SET YANK FLAG
EQ RMTX RETURN
RPF SPACE 4,25
** RPF - READ LINE FROM PROGRAM LIBRARY.
*
* EXIT (X1) = 0, IF NO EOR READ.
*
* USES ALL.
*
* CALLS RDC=.
RPF SUBR ENTRY/EXIT
READC A0,BUF,BUFL READ MHB,S
NZ X1,RPFX IF EOR - RETURN
SA1 BUF SHIFT TO FIRST MHB
LX1 24
SX6 -B1 CLEAR MHB COUNT
MX0 -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 IF NOT AT END OF WORD
SA1 A1+B1 NEXT WORD
SB2 B1+B1 RESET MHB COUNT
LX1 6
EQ RPF1 LOOP
* READ COMPRESSED LINE.
RPF2 SA5 BUF SET LINE ACTIVITY
MX0 -16 SET IDENTIFIER INDEX MASK
BX7 X5
SA6 NMHB
SA7 CDAC
READC A0,CDTX,MXCCL READ COMPRESSED LINE
NZ X1,PLE IF EOR
SX7 B6-CDTX SET WORD COUNT OF LINE
LX5 -18 EXTRACT IDENTIFIER INDEX
SA7 CDWC
BX4 -X0*X5
SA2 F.TDKI
SB2 X4
AX5 18 SET LINE NUMBER
SA2 X2+B2 SET LINE IDENTIFIER
SX3 X5
SA4 F.TNCD
BX6 X0*X2
IX7 X6+X3
SA4 X4+B2 CHECK NEXT LINE FOR MODIFICATION
SA7 A2 SET LINE COUNTER
SA7 CDID
IX6 X3-X4
NZ X6,RPF3 IF NO MODIFICATION
SA2 MA SET MODIFICATION
SX6 X2+
SA6 A2+1
RPF3 RJ CPF CONVERT PROGRAM FILE
BX1 X1-X1 CLEAR EOR
EQ RPFX RETURN
RTF SPACE 4,20
** RTF - READ LINE FROM TEXT FILE.
*
* ENTRY (A5) = TEXT INDEX ADDRESS.
* (X5) = TEXT INDEX.
*
* EXIT (X6) = UPDATED TEXT INDEX.
*
* USES X - 1, 2, 3, 4, 5, 6, 7.
* A - 1, 2, 3, 4, 6, 7.
* B - ALL.
RTF SUBR ENTRY/EXIT
SA1 T
SA2 F.TTXT
NZ X1,RTF2 IF TEXT FILE WRITTEN
SB2 X5 FIRST WORD INDEX
MX4 -12
SA6 CDID PRESET (A6)
SB3 A6-1
SA1 X2+B2 FIRST WORD
BX7 X7-X7
RTF1 LX6 X1 MOVE WORD
BX2 -X4*X1
SA6 A6+B1
SX7 X7+B1 COUNT WORD
SA1 A1+B1 READ NEXT WORD
NZ X2,RTF1 IF NOT ZERO BYTE
SA7 B3 SET LINE LENGTH
IX6 X5+X7 ADVANCE TEXT INDEX
EQ RTFX RETURN
* PROCESS DATA ON TEXT FILE.
RTF2 SA1 T+5 CHECK TEXT FILE POSITION
SA2 T+2
SX6 TBUF
MX4 -24
IX7 X2-X6
BX4 -X4*X5
IX6 X4-X1
MI X6,RTF4 IF REQUIRED TEXT BEFORE BUFFER
IX7 X6-X7
MX3 -12
PL X7,RTF4 IF REQUIRED TEXT AFTER BUFFER
SB7 X2 (B7) = BUFFER LIMIT
BX7 X7-X7 CLEAR WORD COUNT
SB6 X6+TBUF (B6) = STARTING ADDRESS
SA6 CDID PRESET (A6)
SA1 B6 FIRST WORD
SB3 A6-B1
RTF3 EQ B6,B7,RTF4 IF END OF BUFFER REACHED
LX6 X1 MOVE WORD
BX2 -X3*X1
SB6 B6+B1
SA6 A6+B1
SX7 X7+B1 COUNT WORD
SA1 A1+B1 READ NEXT WORD
NZ X2,RTF3 IF NOT ZERO BYTE
SA7 B3 SET LINE LENGTH
IX6 X5+X7 ADVANCE TEXT INDEX
EQ RTFX RETURN
RTF4 AX4 6 SET RANDOM ADDRESS
SX6 B1
IX6 X4+X6
LX4 6 SET CURRENT TEXT INDEX
BX7 X4
SA6 T+6
SA7 A6-B1
SX6 TBUF SET IN = OUT = FIRST
SA6 T+2
SA6 A6+B1
READ T,R
EQ RTF2 RESTART MOVE
STB SPACE 4,20
** STB - SEARCH TABLE FOR ENTRY WITH MASK.
*
* ENTRY (A0) = TABLE NUMBER.
* (X1) = MASK.
* (X6) = ENTRY TO SEARCH FOR.
*
* EXIT (X2) = 0, IF ENTRY NOT FOUND.
* (X2) .NE. 0, TABLE ENTRY.
* (A2) = ADDRESS OF TABLE ENTRY.
* (X3) = INDEX OF TABLE ENTRY.
*
* USES X - 2, 3.
* A - 2, 3.
* B - 2.
STB2 SA2 A2-B1 RESTORE ENTRY
SX3 A2-B3 SET INDEX
STB SUBR ENTRY/EXIT
SA3 FTAB+A0
SA2 LTAB+A0
ZR X2,STBX IF TABLE EMPTY - RETURN
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 IF NOT END OF TABLE
BX2 X2-X2 IF ENTRY NOT FOUND
EQ STBX RETURN
UPN SPACE 4,20
** UPN - UNPACK NAME.
*
* ENTRY (X1) = NAME, LEFT JUSTIFIED ZERO FILL.
* (B3) = CHARACTER ADDRESS.
*
* EXIT (B3) = UPDATED CHARACTER ADDRESS.
*
* USES X - 1, 6, 7.
* A - 7.
* B - 3.
UPN1 BX7 -X6*X1 GET NEXT CHARACTER
BX1 X6*X1 ERASE CURRENT CHARACTER
SA7 B3+
SB3 B3+B1 ADVANCE ADDRESS
LX1 6
NZ X1,UPN1 IF NOT END OF NAME
SX7 1R SET TERMINAL BLANK
SA7 B3+
UPN SUBR ENTRY/EXIT
MX6 -6
LX1 6
EQ UPN1
WDR SPACE 4,25
** WDR - WRITE DIRECTORY TO PROGRAM LIBRARY.
*
* ENTRY (A0) = ADDRESS OF FET FOR FILE.
*
* SET DATE IN IDENT TABLE AND WRITE TO *NPL*.
*
* USES X - 1, 2, 3, 4, 5, 6, 7.
* A - 1, 2, 3, 4, 6, 7.
* B - ALL.
*
* CALLS WTW=.
WDR SUBR ENTRY/EXIT
SA1 A0+
SA2 L.TNDK
ZR X1,WDRX IF NO NEW PROGRAM LIBRARY - RETURN
ZR X2,WDRX IF NO NEW DECKS - RETURN
RECALL A0
SA1 PL ENTER PROGRAM LIBRARY NAME
SA2 DATE ENTER DATE IN IDENT TABLE
BX6 X1
LX7 X2
SA6 TIDT+1
SA7 A6+B1
BX7 X7-X7 CLEAR MODIFICATION DATE
SA7 A7+B1
WRITEW A0,TIDT,TIDTL
SA5 L.TNDK MERGE DECK COUNT AND DIRECTORY ID
SA2 WDRA
BX6 X5+X2
SA6 T1
WRITEW A0,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 IF NOT COMPLETE
WRITEW A0,X1,X5 WRITE DECK NAME TABLE
WRITEF X2,R
EQ WDRX RETURN
WDRA CON 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 SUBR ENTRY/EXIT
SA1 MA
SA2 DN ENTER DECK NAME IN IDENT TABLE
SA3 TIDT+3
ZR X1,WMT1 IF NO MODIFICATIONS
SA3 DATE ENTER NEW DATE
WMT1 BX6 X2
LX7 X3
SA6 TIDT+1
SA7 TIDT+3
SA1 CD
SX3 X1+6
ADDWRD TNDK,X2+X3 ENTER DECK NAME
SX1 RI SET RANDOM INDEX RETURN ADDRESS
SX2 X1
LX1 30
BX6 X1+X2
SA6 N+6
SX1 X2+B1
SX2 X1
LX1 30
BX6 X2+X1
SA6 M+6
SA1 CD
SA2 WMTA
ZR X1,WMT2 IF NOT COMMON DECK
SA2 WMTB
WMT2 SA1 L.TDKI MERGE MODIFIER COUNT AND MODIFIER TABLE ID
SX5 X1-1
BX6 X2+X5
SA6 T1
SA2 CSC GET DISPLAY/ASCII FLAG
SA1 CNPL SET CHARACTER SET OF NEW PROGRAM LIBRARY
LX2 6
BX6 X1+X2 MERGE DISPLAY/ASCII FLAG
SA6 TIDT+16B
SA1 N
ZR X1,WMT3 IF NO NEW PROGRAM LIBRARY
WRITEW N,TIDT,TIDTL WRITE IDENT TABLE
WRITEW N,T1,1 WRITE MODIFIER ID
SA1 F.TDKI WRITE DECK MODIFIERS
WRITEW X2,X1+B1,X5
SA1 M
ZR X1,WMTX IF NOT SCRATCH FILE - RETURN
WMT3 WRITEW M,TIDT,TIDTL WRITE IDENT TABLE
WRITEW X2,T1,1 WRITE MODIFIER ID
SA1 F.TDKI WRITE DECK MODIFIERS
WRITEW X2,X1+B1,X5
EQ WMTX RETURN
WMTA CON 7001BS48 MODIFIER TABLE ID FOR DECK
WMTB CON 7002BS48 MODIFIER TABLE ID FOR COMMON DECK
WNF SPACE 4,25
** WNF - WRITE LINE TO NEW PROGRAM LIIBRARY.
*
* ENTRY (CDAC) = LINE ACTIVITY FLAG.
* (CDID) = LINE IDENTIFICATION.
* (CDWC) = WORD COUNT OF COMPRESSED LINE.
* (CDTX) = FWA OF TEXT OF COMPRESSED LINE.
* (NMHB) = NUMBER OF MODIFICATION HISTORY BYTES (MHBS).
* (THMB) = TABLE OF MHBS.
*
* USES ALL.
*
* CALLS WTW=.
WNF SUBR ENTRY/EXIT
SA1 CDAC ACTIVITY TO BIT 59
SA5 NMHB STORE MHB TERMINATORS
MX3 1
SA2 A1+B1 WORD COUNT OF LINE TO BITS 54 - 58
BX6 X6-X6
BX1 X3*X1
SA6 TMHB+X5
LX1 24
SA3 A2+B1 LINE NUMBER TO BITS 36 - 53
MX0 -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 IF NOT AT END OF WORD OF MHB,S
SA7 A7+B1 STORE WORD
SB2 B1+B1
BX7 X7-X7
PL B3,WNF1 IF NOT DONE WITH ALL MHB,S
SX5 A7-BUF
* WRITE MHB TABLE AND COMPRESSED LINE.
SA1 N
ZR X1,WNF2 IF NO NEW PROGRAM LIBRARY
WRITEW N,BUF+1,X5
SA1 CDWC
WRITEW X2,CDTX,X1
SA1 M
ZR X1,WNFX IF NO SCRATCH LIBRARY - RETURN
WNF2 WRITEW M,BUF+1,X5
SA1 CDWC
WRITEW X2,CDTX,X1
EQ WNFX RETURN
WOF SPACE 4,20
** WOF - WRITE OUTPUT FILE.
*
* ENTRY (X1) .GT. 0, FWA OF LINE IN *C* FORMAT.
* (X1) .LT. 0, -(FWA) OF LINE IN *S* FORMAT.
* (X2) = LENGTH OF LINE IN *S* FORMAT.
*
* USES X - 1, 2, 3, 4, 6, 7.
* A - 1, 2, 3, 4, 6, 7.
*
* CALLS CDD.
*
* MACROS WRITEC, WRITES, WRITEW.
WOF SUBR ENTRY/EXIT
SX6 B1+ INDICATE DATA WRITTEN TO OUTPUT FILE
SA3 LC ADVANCE LINE COUNT
SA6 LF
SX6 X3+B1
SA6 A3
SA4 A3+B1
IX7 X6-X4
NG X7,WOF5 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 -12
LX6 4*6 STORE PAGE NUMBER
BX6 X1*X6
SA6 PAGE
SA1 TO
SX2 O
ZR X1,WOF1 IF TERMINAL OUTPUT
WRITEW X2,(=1H1),1
SA1 TL
WRITEW X2,X1,6
WRITEW X2,TITL,TITLL
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 WOFB CHECK IF TIME FOR CONTROL IMAGE
SX6 B1
SA6 A1
SA3 TO
NZ X1,WOF4 IF *MODIFY* CONTROL HAS BEEN OUTPUT
ZR X3,WOF3 IF TERMINAL OUTPUT
WRITEW X2,(=1H),1 *MODIFY* CONTROL IMAGE
WOF3 WRITEW X2,CCDR,8
WRITEW X2,(=C* *),1 WRITE END OF LINE
SA1 LC SET LINE COUNT FOR EXTRA LINE
SX6 X1+B1
SA6 A1
WOF4 WRITEW X2,SBTL,SBTLL
SA1 WOFA RESTORE REQUEST
SA2 A1+B1
WOF5 NG X1,WOF6 IF *S* FORMAT
WRITEC O,X1
EQ WOFX RETURN
WOF6 BX1 -X1
WRITEK O,X1,X2
EQ WOFX RETURN
WOFA CON 0
CON 0
WOFB CON 0 *MODIFY* CONTROL LINE ISSUE FLAG
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.
*
* CALLS RDA=, RDS=.
SSR SUBR ENTRY/EXIT
SA3 CSC GET CURRENT CHARACTER SET
NZ X3,SSR1 IF ASCII
RJ =XRDS= DISPLAY CODE
EQ SSRX RETURN
SSR1 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.
*
* CALLS WTA=, WTS=.
SSW SUBR ENTRY/EXIT
SA3 CSC GET CURRENT CHARACTER SET
NZ X3,SSW1 IF ASCII
RJ =XWTS= DISPLAY CODE
EQ SSWX RETURN
SSW1 RJ =XWTA= 6/12 DISPLAY BASED ASCII
EQ SSWX RETURN
TITLE LIST SUBROUTINES.
LCE SPACE 4,10
** LCE - LIST COMPILE FILE DIRECTIVE ERROR MESSAGE.
*
* ENTRY (A0) = ERROR MESSAGE ADDRESS.
*
* EXIT ERROR MESSAGE AND LINE IN ERROR LISTED.
*
* USES X - 0, 1.
* A - 1.
* B - 3.
*
* CALLS ECD, LCS, LER, UPN.
LCE SUBR ENTRY/EXIT
SA1 AM CHECK FOR COMPRESSED COMPILE GENERATION
ZR X1,LCE1 IF NOT COMPRESSED COMPILE FILE GENERATION
RJ ECD EXPAND COMPRESSED LINE
LCE1 SA1 =9L *ERROR*
SB3 CHSP
RJ UPN UNPACK ERROR DATA
RJ LCS LIST LINE
SX0 A0
RJ LER LIST ERROR MESSAGE
EQ LCEX RETURN
LCS SPACE 4,15
** LCS - LIST LINE STATUS.
*
* USES X - 0, 1, 2, 3, 6.
* A - 1, 2, 3, 6.
* B - 2, 3, 4, 5.
*
* CALLS CDD, UPN, WOF.
LCS SUBR ENTRY/EXIT
SA1 CL
NZ X1,LCSX IF LINE LISTED - RETURN
BX6 X6-X6
SA6 A1+B1 CLEAR LIST REQUEST
SA1 TMHB
SA2 SC+1
MX0 -16
BX6 -X0*X1
SB6 CHAR+15+X2
ZR X6,LCS1 IF DECK LINE
SA2 F.TDKI ADD CURRENT DECK NUMBER
SA3 X2
BX1 -X0*X3
RJ CDD CONVERT TO DECIMAL DISPLAY
LX6 4*6
BX1 X6
SB3 B6+
RJ UPN UNPACK NAME
SB6 B3+
LCS1 PRINT -CHSP,B6+X1 LIST LINE
SX6 1R CLEAR STATUS
SA6 CHSP+4
SA6 A6+B1
SA6 A6+B1
SA6 CL SET LINE LISTED
EQ LCSX RETURN
LDS SPACE 4,15
** LDS - LIST DECK STATUS.
*
* USES X - ALL.
* A - 1, 2, 3, 4, 6, 7.
* B - ALL.
*
* CALLS LTB, SFN, WOF.
LDS SUBR ENTRY/EXIT
LISTOP D,LDSX IF NO LIST FOR DECK STATUS - RETURN
SA1 DN DECK NAME
RJ SFN SPACE FILL NAME
SA2 F.TDKI
LX6 -12
SX4 X2+B1
SA6 BUF
SA3 L.TDKI
SX0 =C*MODIFIERS.*
SX5 X3-1
RJ LTB LIST TABLE
PRINT (=C* *)
EQ LDSX RETURN
LER SPACE 4,20
** LER - LIST ERROR MESSAGE.
*
* ENTRY (X0) = ERROR MESSAGE ADDRESS.
* (EA) = ERROR COUNTER ADDRESS TO BE INCREMENTED.
*
* EXIT CHSP CLEARED.
* (EC) = INCREMENTED BY 1.
*
* USES ALL.
*
* CALLS WTC=, WTW=.
LER SUBR ENTRY/EXIT
LISTOP E,LER1 IF NO ERROR LIST
SA2 O CHECK FOR OUTPUT FILE
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-1
PL B2,LER2 IF NOT COMPLETE
SA1 EA ADVANCE ERROR COUNT
SA1 X1
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 ALL.
*
* CALLS CDD, LTB, WOF.
LST SUBR ENTRY/EXIT
LISTOP S,LSTX IF NO LIST FOR STATISTICS - RETURN
SX6 =60HSTATISTICS.
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 DL
RJ LTB LIST TABLE
* LIST COMMON DECKS ON PROGRAM LIBRARY.
SA1 DL
SA2 F.TDKN
BX7 X7-X7 CLEAR DECK IDENTIFIER TABLE
SA5 X2
SA7 L.TDKI
ZR X1,LST3 IF NO DECKS IN PROGRAM LIBRARY
SB6 B1+B1
MX0 -16
SB7 X1+
LST1 BX1 -X0*X5
SB2 X1-7
NZ B2,LST2 IF NOT COMMON DECK
ADDWRD TDKI,X5 ADD DECK
ADDWRD A0,X6-X6
LST2 SB7 B7-B6
SA5 A5+B6
NZ B7,LST1 IF NOT END OF DECK NAME TABLE
LST3 SA4 F.TDKI
SA5 L.TDKI
SX0 =C*COMMON DECKS ON PROGRAM LIBRARY.*
RJ LTB LIST TABLE
* LIST INTRODUCED DECKS.
SA1 L.TDKN
SA2 DL
IX5 X1-X2
ZR X5,LST4 IF NO DECKS INTRODUCED
SA3 F.TDKN
IX4 X3+X2
SX0 =C*DECKS ADDED BY INITIALIZATION DIRECTIVES.*
RJ LTB LIST TABLE
* LIST DECKS ON NEW PROGRAM LIBRARY.
LST4 SA1 N
ZR X1,LST5 IF NO NEW PROGRAM LIBRARY
SX0 =C*DECKS ON NEW PROGRAM LIBRARY.*
SA4 F.TNDK
SA5 L.TNDK
RJ LTB LIST TABLE
* REMOVE COMMON DECKS FROM EDIT TABLE.
LST5 SA1 L.TEDT
SA4 F.TEDT
SB3 X1
BX5 X5-X5
SA2 X4
SB4 X4
SA3 C
ZR X1,LST8 IF EDIT TABLE EMPTY
ZR X3,LST8 IF NO COMPILE FILE
SB6 B1+B1
SB2 -B6
LST6 BX6 X2 STORE DECK NAME
SA1 A2+B1 CHECK DECK TYPE
SA3 X1
BX7 X1
SB7 X3-OCRT
SA6 B4+X5
SA7 A6+B1
SX5 X5+B6
NZ B7,LST7 IF NOT COMMON DECK
SX5 X5+B2
LST7 SB3 B3-B6
SA2 A2+B6
NZ B3,LST6 IF NOT END OF EDIT TABLE
* LIST DECKS ON COMPILE FILE.
LST8 SX0 =C*DECKS WRITTEN ON COMPILE FILE.*
RJ LTB LIST TABLE
PRINT (=C* *)
* LIST STORAGE USED AND LINE COUNT.
SA1 FTAB+FTABL ROUND UP STORAGE USED
SX7 MTBS+300 MINIMUM CORE REQUIRED
IX3 X1-X7
PL X3,LST9 IF CURRENT USED MORE THAN MINIMUM
SX1 X7
LST9 SA2 =1AB
MX0 -3
SB3 1R0-1R
SB2 B0
SX1 X1+77B ROUND UP FL USED
AX1 6
LX1 6
LST10 BX7 -X0*X1 CONVERT TO OCTAL DISPLAY
LX2 -6
SB2 B2+6
SX3 X7+B3
AX1 3
IX2 X2+X3
NZ X1,LST10 IF NOT FINISHED CONVERTING
LX6 X2,B2
SA6 LSTA+1
SA1 NC LINE COUNT
SA2 A1+B1
IX1 X1+X2
RJ CDD CONVERT TO DECIMAL DISPLAY
SA6 LSTB
PRINT LSTA
EQ LSTX RETURN
LSTA DATA 10H
DATA 10H
DATA H* STORAGE USED.*
LSTB DATA 10H
DATA C* LINES WRITTEN ON COMPILE FILE.*
LTB SPACE 4,20
** LTB - LIST TABLE.
*
* LIST SPECIFIED TABLE ON OUTPUT FILE.
*
* ENTRY (X0) = MESSAGE ADDRESS.
* (X4) = TABLE ADDRESS.
* (X5) = LENGTH OF TABLE.
*
* USES X - 0, 1, 2, 3, 4, 6, 7.
* A - ALL.
* B - 2, 3, 4, 5, 6.
*
* CALLS SFN, WOF.
LTB SUBR 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 -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 IF NOT END OF MESSAGE
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 LTBX RETURN
* LIST SPECIFIED TABLE.
LTB3 SA1 LTBA SET ENTRY COUNT
SB2 X1-1
AX4 X5,B2 COMPUTE NUMBER OF ROWS
SX3 X4+11
PX6 X3
SA2 =12.
FX4 X6/X2
UX3 B2,X4
BX6 X6-X6 CLEAR ENTRY INDEX
LX0 X3,B2
PX2 X0 COMPUTE ENTRY INCREMENT (ROWS*ENTRY)
PX7 X1
SA6 A1+B1
DX3 X7*X2
UX6 X3
SA6 A6+B1
LTB4 SX0 X0-1 DECREMENT ROW COUNT
SA1 LTBA+1 SET ENTRY INDEX
MI X0,LTBX IF ALL ROWS LISTED - RETURN
SA2 A1-B1 ADVANCE TABLE
SA3 A1+B1 SET ENTRY INCREMENT
IX6 X1+X2
SB3 X1
SB6 X3
MX4 42
SA6 A1
SB4 X5
SB5 B0+
LTB5 SA1 B3+A0 TABLE ENTRY
BX1 X4*X1
RJ SFN SPACE FILL NAME
SA1 A1 TABLE ENTRY
LX1 59-16 CHECK YANK BIT
PL X1,LTB6 IF NOT YANKED
SA2 LTBB ADD()
IX6 X6+X2
LTB6 LX6 -6 STORE NAME
SA6 BUF+1+B5
SB5 B5+B1
SB3 B3+B6
LT B3,B4,LTB5 IF NOT AT END OF LINE
BX6 X6-X6
SA6 A6+B1
PRINT BUF
MX4 42
EQ LTB4 LOOP
LTBA CON 2 WORDS/ENTRY
CON 0 TEMPORARY
CON 0 TEMPORARY
LTBB CON 10H ) (-1H
LUM SPACE 4,15
** LUM - LIST UNPROCESSED MODIFICATIONS.
*
* ENTRY (X5) = MODIFICATION TABLE ADDRESS.
*
* USES X - ALL.
* A - 1, 2, 3, 4, 5, 6, 7.
* B - 2, 3.
*
* CALLS LER, PML, SFN, UPN, WOF.
LUM SUBR ENTRY/EXIT
SA1 =9L *ERROR*
SB3 CHAR
RJ UPN UNPACK NAME
LUM1 SB3 X5
ZR B3,LUMX IF END OF MODIFICATIONS - RETURN
SA5 B3
SA1 A5+B1
LX6 X5,B1
MI X1,LUM2 IF ERROR FLAG SET
MI X6,LUM2 IF DELETE
SA2 A1+B1 CHECK TEXT STATUS
AX2 24
SX7 X2
ZR X7,LUM1 IF TEXT PROCESSED
* AN ERROR OCCURRED ON MODIFICATION LINE.
LUM2 SX6 X5 SAVE POSITION
SB2 B1+B1
SA6 LUMA
SA2 A5+B2 ENTER IDENTIFIER NAME
AX2 42
SA1 X2
MX0 42
BX1 X0*X1
RJ SFN SPACE FILL NAME
BX1 X6
SB3 CHAR+10
RJ UPN UNPACK NAME
SB2 B1+1
PL X5,LUM3 IF NOT INSERT
SA1 =7LINSERT,
EQ LUM4
LUM3 SA1 =7LDELETE,
LX2 X5,B2
PL X2,LUM4 IF DELETE
SA1 =8LRESTORE,
LUM4 RJ UPN UNPACK MODIFICATION TYPE
RJ PML PREPARE MODIFICATION LIMIT
SA1 A5
SA5 A5+B1 CHECK NEXT WORD
MX2 36
BX6 X1-X5
LX2 54
BX7 X2*X6
ZR X7,LUM5 IF SAME IDENTIFICATION
BX6 X2*X5
ZR X6,LUM5 IF LIMIT = 0
SX6 1R, ADD COMMA TO PREVIOUS LIMIT
SA6 B3-B1
RJ PML PREPARE MODIFICATION LIMIT
LUM5 SX0 B3-CHAR
PRINT (=C* *)
PRINT -CHAR,X0
SA5 A5 EXTRACT ERROR CODE
SB2 X5
SA1 LUMB+B2 SET ERROR
SX0 X1
RJ LER LIST ERROR
SA5 LUMA RESTORE POSITION
EQ LUM1 LOOP
LUMA CON 0
LUMB BSS 0
LOC 0
CON =C*DIRECTIVE NOT REACHED.*
CON =C*UNKNOWN MODIFIER.*
CON =C*OVERLAPPING MODIFICATION.*
CON =C*FIRST SOURCE LINE IS AFTER SECOND SOURCE LINE.*
LOC *O
PML SPACE 4,15
** PML - PREPARE MODIFICATION LIMIT.
*
* ENTRY (X5) = MODIFICATION LIMIT WORD.
* (A6) = NEXT BUFFER ADDRESS.
*
* USES X - 0, 1, 2, 3, 4, 5, 6.
* A - 1, 6, 7.
* B - 2, 3, 5.
*
* CALLS CDD, UPN.
PML SUBR ENTRY/EXIT
AX5 18 SET LINE NUMBER
SX3 X5
AX5 18
SA1 X5 SET MODIFIER NAME
MX0 42
BX1 X0*X1
RJ UPN UNPACK NAME
SX6 1R. ADD PERIOD
SA6 B3
SB6 B3+B1
SX1 X3 CONVERT NUMBER
RJ CDD CONVERT TO DECIMAL DISPLAY
SB3 B6
BX1 X4 LEFT JUSTIFIED NUMBER
RJ UPN UNPACK NUMNER
EQ PMLX RETURN
BUFFERS TITLE COMMON DECKS AND BUFFERS.
** PROGRAM LIBRARY DIRECTIVE PROCESSOR TABLE.
HERE
DATA 0 END OF TABLE
SPACE 4
*CALL COMCDXB
*CALL COMCCDD
*CALL COMCSFN
*CALL COMCMVE
*CALL COMCRDA
*CALL COMCRDC
*CALL COMCRDS
*CALL COMCRDW
*CALL COMCWTA
*CALL COMCWTC
*CALL COMCWTS
*CALL COMCWTW
*CALL COMCCIO
*CALL COMCSYS
SPACE 4
** BUFFERS.
BUFFERS SPACE 4
USE BUFFERS
BLOCKS SPACE 4,10
** BLOCK STORAGE.
TITLE SPACE 4,6
** TITLE LINE.
TITL DATA 20H MODIFY - VER 1.2
DATE CON 1H
TIME CON 1H
CON 4APAGE
PAGE CON 1H
TITLL EQU *-TITL
** TERMINAL TITLE LINE.
TERL DATA 50H MODIFY - VER 1.2
TERDT CON 1H
TERTM CON 1H
TERLL EQU *-TERL
SPACE 4,6
** ALTERNATE TITLE.
ALT DATA 60HDECK STATUS AND MODIFICATIONS.
* *MODIFY* INPUT SUB-HEADER.
TLT DATA 60HMODIFY INPUT.
SUB SPACE 4,6
** SUB-TITLE LINE.
SBTL DATA 30H
CON 0
CON 2L
SBTLL EQU *-SBTL
IDENT SPACE 4,6
** IDENT TABLE.
TIDT VFD 12/7700B,12/TIDTL-1,36/0
BSSZ 16B
TIDTL EQU *-TIDT
SPACE 4,6
** COMPRESSED COMPILE FILE HEADER.
CIDT VFD 12/7700B,12/TIDTL-1,12/0000B,24/0
OPL SPACE 4,6
** OPL FILE NAME TABLE.
TOFN CON 0 INDEX
BSS 50
TOFNL EQU *-TOFN
CDAC SPACE 4,10
** PROGRAM LIBRARY PROCESSING BUFFERS.
*
* THE ORDER OF THE FOLLOWING MUST
* BE MAINTAINED.
CDAC CON 1S59 LINE ACTIVITY
CDWC CON 0 WORD COUNT OF COMPRESSED LINE
CDID CON 1 CARD ID
CDTX BSS MXCCL TEXT OF COMPRESSED LINE
CVTX BSS MXCCL CONVERSION BUFFER
NMHB CON 1 NUMBER OF MODIFICATION HISTORY BYTES
TMHB CON 1S16 MODIFICATION HISTORY BYTE TABLE
BSS 199
CDCT SPACE 4,10
** CHARACTER STRING BUFFER.
CDCT DATA 1 LINE COUNT-(MUST PROCEED CHSP)
CHSP BSS 0 SPACING FOR LIST
DUP 10+IWMAX+26,1
CON 1R
CHAR EQU CHSP+10
USBB EQU CHAR STRING BUFFER
BUFFERS SPACE 4,10
** BUFFER ALLOCATION.
BUF BSS 0 SCRATCH BUFFER
PBUF EQU BUF+BUFL
OBUF EQU PBUF+PBUFL
CBUF EQU OBUF+OBUFL
SBUF EQU CBUF+CBUFL
MBUF EQU SBUF+SBUFL
NBUF EQU MBUF+MBUFL
TBUF EQU NBUF+NBUFL
MTBS EQU TBUF+TBUFL
RFL= EQU MTBS+MTBSL+4
ERRNG PBUF-USBB-81 STRING BUFFER OVERFLOWS CODE
IDENT SPACE 4
IDENT TERMINATE BLOCK
QUAL DIRECT
PDC TITLE DIRECTIVE LINE PROCESSING.
** DIRECTIVE LINE PROCESSORS WILL BE OVERLAID AFTER COMPLETION.
DATA SPACE 4
** DATA STORAGE.
ORG PBUF
CDLS CON 0 LINE LIST FLAGS
INSF CON 0 INSERT FLAG
AIDT CON 0 ASSUMED IDENTIFIER NUMBER
LCAC CON 0 ADDRESS+1 OF LAST CHARACTER ON *READS*
* THE ORDER OF THE FOLLOWING MUST BE MAINTAINED.
MDTI CON 0 MODIFICATION TABLE INDEX
IDT1 CON 0 FIRST LIMIT IDENTIFICATION
CON 0
IDT2 CON 0 SECOND LIMIT IDENTIFICATION
CON 0
MDSA CON 0 MODIFICATION SET NAME ADDRESS
PDC SPACE 4,10
*** INPUT RECORD COMMENTS.
*
* THE FOLLOWING DIRECTIVE IS RECOGNIZED AS A COMMENT IN THE
* MODIFY INPUT STREAM.
*
* / CCC-CCC
PDC SPACE 4,10
** PDC - PROCESS DIRECTIVE LINES.
PDC10 RJ IPC INSERT PREFIX CHARACTER
PDC SUBR ENTRY/EXIT
SA1 ZM CHECK FOR *Z* MODE ARGUMENT
NZ X1,PDC0 IF *Z* ARGUMENT SELECTED
SA1 I
ZR X1,PDC9 IF NO INPUT FILE
READ I
PDC0 BSS 0
RJ RDD READ FIRST DIRECTIVE
NZ X1,PDC9 IF EOR
EQ PDC2
* PROCESS NEXT DIRECTIVE.
PDC1 RJ RDD READ DIRECTIVE
NZ X1,PDC8 IF EOR
PDC2 CARD COPY
RJ CRD CONDITIONALLY READ DIRECTORY
PDC3 SA1 PDCB INCREMENT DIRECTIVE COUNT
SX7 X1+B1
SA7 A1
CARD COPYPL
CARD CREATE
CARD CSET
CARD DECK
CARD DEFINE
CARD EDIT
CARD IDENT
CARD INWIDTH
CARD MOVE
CARD NOSEQ
CARD OPLFILE
CARD PREFIX
CARD PREFIXC
CARD PURDECK
CARD SEQ
CARD SORSEQ
CARD UNYANK
CARD UPDATE
CARD WIDTH
CARD YANK
CARD IGNORE
RMT
VFD 42/1L/,18/PDC6 LIST COMMENT LINE
RMT
SX6 1S"LO.T"
SA6 CDLS
CARD D,DELETE
CARD DELETE
CARD I,INSERT
CARD INSERT
CARD MODNAME
CARD RESTORE
SA2 INSF
NZ X2,PDC4 IF INSERTING
NZ X4,ERR1 IF NOT NULL DIRECTIVE
SA1 PDCB DECREMENT DIRECTIVE COUNT
SX7 X1-1
SA7 A1
EQ PDC6.1 CONTINUE
PDC4 RJ CCD COMPRESS LINE
RJ WTF WRITE TEXT FILE
SA1 F.TMOD INCREMENT DIRECTIVE COUNT
SA2 L.TMOD
SX0 B1+
IX3 X1+X2
LX0 24
SA1 X3-1
IX6 X1+X0
SA6 A1
* DIRECTIVE PROCESSORS RETURN HERE TO LIST LINE.
PDC5 SX6 1 SET *CREATE*, *COPYPL* NOT ALLOWED
SA6 PDCA
PDC6 RJ LDC LIST LINE
PDC6.1 SA1 DL
MI X1,PDC1 IF NO DIRECTORY
* DIRECTIVE PROCESSORS RETURN HERE TO READ NEXT LINE.
PDC7 RJ RDD READ NEXT DIRECTIVE
ZR X1,PDC3 IF NOT EOR/EOF/EOI
PDC8 SA1 DE CHECK FOR DIRECTIVE ERRORS
SA2 DB
NZ X1,PDC8.1 IF ERRORS
SA1 PDCB GET DIRECTIVE COUNT
ZR X1,PDC9 IF NO DIRECTIVES PROCESSED
EQ PDC10 CONTINUE
PDC8.1 NZ X2,PDC10 IF DEBUG SELECTED
BX6 X6-X6 CLEAR EDIT TABLE
SA6 L.TEDT
RJ LST LIST STATISTICS
SA0 =C* DIRECTIVE ERRORS.*
EQ ABT
* PROCESS EMPTY INPUT FILE.
PDC9 SA1 FM
SA0 =C* NO DIRECTIVES.*
ZR X1,ABT IF NOT *F* MODE
SA5 P+7 READ *P* FILE DIRECTORY
RJ RDR READ DIRECTORY
NZ X0,ABT IF ERRORS IN OPL
SA1 L.TDKN SET ORIGINAL DECK TABLE LENGTH
BX6 X1
SA6 DL
EQ PDC10 COMPLETE PROCESSING
PDCA CON 0 *CREATE*, *COPY* ALLOWED FLAG
PDCB CON 0 DIRECTIVE COUNT
ERR SPACE 4
** ERR - DIRECTIVE ERROR PROCESSORS.
ERR SA6 ERRM SET ERROR MESSAGE ADDRESS
EQ PDC6 EXIT
ERR1 SX6 =C*INCORRECT DIRECTIVE.*
EQ ERR
ERR2 SX6 =C*FORMAT ERROR IN DIRECTIVE.*
EQ ERR
ERR3 SX6 =C*IDENT NAME PREVIOUSLY REFERENCED.*
EQ ERR
ERR4 SX6 =C* INITIALIZATION DIRECTIVE OUT OF ORDER.*
EQ ERR PUT OUT ERROR MESSAGE AND CONTINUE
SPACE 4,10
*** INITIALIZATION DIRECTIVES.
*
* THE FOLLOWING DIRECTIVES MUST BE THE FIRST DIRECTIVES
* OTHER THAN FILE MANIPULATION DIRECTIVES.
* DECKS INTRODUCED BY THESE DIRECTIVES TAKE PRECEDENCE OVER
* ANY PREVIOUS DECKS BY THE SAME NAME.
* THESE PREVIOUS DECKS ARE DENOTED IN THE DIRECTORY LISTS
* BY BEING ENCLOSED IN PARENS.
COPY SPACE 4,10
*** COPY FNAME,RNAME
*
* COPY PROGRAM LIBRARY *FNAME* TO OPL FILE FOR RANDOM ACCESS.
* *RNAME* IF PRESENT, IS THE NAME OF THE LAST RECORD
* TO BE COPIED.
COPY SA1 P
SA2 CPYA
SX5 P+7 SET PROGRAM LIBRARY NAME
ZR X1,ERR1 IF NO PROGRAM LIBRARY NAME
NZ X2,CPY1 IF NOT FIRST ENTRY
EVICT A1,R
CPY1 SA1 PDCA
NZ X1,ERR4 IF *COPY* NOT ALLOWED
RECALL M
SA1 X5 SET FILE NAME
BX6 X1
SX7 X5 SET FILE NAME ADDRESS
SA6 X2
SA7 CPYA
RJ SAF SET ALTERNATE FILE
SA1 CH CHECK NEXT CHARACTER
SX2 B1+B1 SET BINARY FILE
IX7 X6+X2
SA3 X1
BX6 X6-X6
SA7 A
SB2 X3-1R,
NZ B2,CPY2 IF NO COMMA
SX7 X1+B1 SKIP COMMA
SA7 A1
RJ ASN ASSEMBLE RECORD NAME
CPY2 SA6 CPYB SET RECORD NAME
READ A
READW A,BUF,BUFL READ FIRST PART
SX6 =C*COPY FILE EMPTY.*
MI X1,ERR IF EOR/EOF/EOI
* READ REMAINDER OF RECORD(S).
CPY3 BX6 X1 SAVE WORD COUNT
SA6 T1
SX1 B6 LWA+1 OF DATA READ
SX2 BUF SET RECORD TYPE
RJ SRT SET RECORD TYPE
SB2 X6-ODRT
NZ B2,CPY5 IF NOT *OPLD*
CPY4 READW A,BUF,BUFL SKIP DIRECTORY
ZR X1,CPY4 IF NOT EOR/EOF/EOI
EQ CPY8
* COPY ONE RECORD.
CPY5 SA7 CPYC+1 ENTER DECK NAME IN MESSAGE
ADDWRD TNDK,X6 ENTER RECORD NAME
ADDWRD A0,X6-X6
SX7 A6 SET RANDOM RETURN ADDRESS
SA7 M+6
MESSAGE CPYC,1 ISSUE CONSOLE MESSAGE
SA1 T1 CHECK RECORD LENGTH
NZ X1,CPY7 IF SHORT BLOCK
CPY6 WRITEW M,BUF,BUFL WRITE RECORD
READW A,BUF,BUFL READ NEXT BLOCK
ZR X1,CPY6 IF NOT EOR/EOF/EOI
CPY7 WRITEW M,BUF,X1-BUF
WRITER X2
SA1 CPYB
ZR X1,CPY8 IF NO RECORD NAME OPTION
SA2 CPYC+1 COMPARE NAMES
BX6 X2-X1
ZR X6,CPY9 IF RECORD REACHED
* BEGIN NEXT RECORD.
CPY8 READ A BEGIN NEW READ
RECALL M
READW A,BUF,BUFL
PL X1,CPY3 IF NOT EOF
SA2 CPYB
ZR X2,CPY9 IF NO RECORD NAME OPTION
SA3 CPYC+1
BX7 X2-X3
ZR X7,CPY9 IF RECORD REACHED
SX6 =C*RECORD NOT FOUND.*
SA6 ERRM
CPY9 RJ LDC LIST DIRECTIVE LINE
SA2 =10H
LISTOP C,CPY10 IF NO LIST FOR COPY LINE
BX6 X2
SA4 F.TNDK LIST RECORDS COPIED
SA5 L.TNDK
SA6 BUF
SX0 =C*RECORDS COPIED.*
RJ LTB LIST TABLE
PRINT (=C* *)
CPY10 SA0 M WRITE DIRECTORY
RJ WDR WRITE DIRECTORY
SA5 CPYA ADD DECKS
RJ ADK ADD DECK
MESSAGE CCDR,1
SA1 L.TDKN SET ORIGINAL DECK TABLE LENGTH
BX6 X1
SA6 DL
EQ PDC7 EXIT TO READ NEXT LINE
CPYA CON 0 FILE NAME ADDRESS
CPYB CON 0 RECORD NAME IF REQUESTED
CPYC CON 10H COPY /
CON 0
COPYPL SPACE 4,10
*** COPYPL FNAME,DNAME
*
* COPY PROGRAM LIBRARY *FNAME* TO AN INTERNAL FILE FOR RANDOM
* ACCESS.
* *RNAME* IF PRESENT, IS THE NAME OF THE LAST RECORD
* TO BE COPIED.
COPYPL SX5 A+7 COPY TO SCRATCH FILE
EQ CPY1
CREATE SPACE 4,10
*** CREATE FNAME
*
* CREATE DECK(S) FROM SOURCE FILE *FNAME*.
* DECKS ARE CREATED TO A SCRATCH FILE FOR MODIFICATION USE.
* IF A DECK DUPLICATES A DECK ON THE PROGRAM LIBRARY, THE
* NEW DECK IS USED FOR MODIFICATION.
CREATE SA1 PDCA
NZ X1,ERR4 IF *CREATE* NOT ALLOWED
SA1 CVT DIS-ALLOW CREATE WITH CONVERSION
SA0 =C*CREATE NOT ALLOWED WITH CONVERSION.*
NZ X1,ABT IF CONVERSION BEING MADE
RJ SAF SET ALTERNATE FILE
SA1 CH CHECK NEXT CHARACTER
SA3 X1
SB2 X3-1R CHECK FOR BLANK TERMINATOR
NZ B2,ERR1 IF NOT TERMINATED
SA6 A SET CREATION FILE NAME
READ A
READW A,T1,1
SA0 =C*CREATION FILE EMPTY.*
NZ X1,ABT IF EOR/EOF/EOI
RJ LDC LIST DIRECTIVE LINE
SB6 TIDTL-1 CLEAR *77* TABLE
SX7 B0+
CRT0 SA7 TIDT+B6
SB6 B6-1
GT B6,B1,CRT0 IF NOT COMPLETE
SA1 A+7 USE SCRATCH FILE
SA2 DATE SET CREATION DATE
BX6 X1
LX7 X2
SA6 M
BX6 X6-X6
SA6 N CLEAR NEW PROGRAM LIBRARY
SA7 TIDT+2
RECALL A
SA1 X2+B1 SET OUT = FIRST
SX6 X1
SA6 A1+2
SA1 IW
READS A,CHAR,X1
* BEGIN NEW DECK.
CRT1 SX6 CHAR SET CHARACTER POINTER
SA6 CH
BX7 X7-X7
SA7 CD CLEAR COMMON DECK
SA7 CRTF CLEAR CHARACTER SET FOUND
SX7 .DIS NOMINAL CHARACTER SET IS DISPLAY
SA7 CSC
RJ ASN ASSEMBLE NAME
SA0 =C*FORMAT ERROR IN DIRECTIVE.*
ZR X6,ABT IF NAME BLANK OR TOO LONG
SA6 DN SET DECK NAME
SA6 CRTA+1 INSERT NAME IN MESSAGE
MESSAGE A6-B1,1
CRT1.1 SA1 IW LOOP LOOKING FOR COMMON/ASCII/DISPLAY
READK A,CHAR,X1 READ NEXT LINE
SX6 B6 LAST CHARACTER ADDRESS
SA6 LCAC
SX6 CHAR SET CHARACTER POINTER
SA6 CH
RJ ASN ASSEMBLE NAME
ZR X6,CRT2 IF BLANK NAME OR TOO LONG
SA2 CD
NZ X2,CRT1.2 IF COMMON DECK HEADER CARD ALREADY FOUND
SA1 =0LCOMMON
BX2 X6-X1
SX7 B1
NZ X2,CRT1.2 IF NOT A *COMMON* DECK
SA7 CD SET COMMON DECK
EQ CRT1.1 READ NEXT LINE
CRT1.2 SA2 CRTF
NZ X2,CRT2 IF CHARACTER SET HEADER CARD ALREADY FOUND
SA6 CSR INDICATE CHARACTER SET REQUEST
RJ RCS REQUEST CHARACTER SET
NZ X6,CRT2 IF THIS LINE NOT CHARACTER SET HEADER
SX7 B1
SA7 CRTF FIRST PASS CHARACTER SET HEADER
SA1 CD
ZR X1,CRT1.1 IF COMMON DECK HEADER NOT FOUND YET
SA1 IW
READK A,CHAR,X1 READ TEXT FOLLOWING HEADER CARDS
SX6 B6+ SET LAST CHARACTER ADDRESS
SA6 LCAC
CRT2 RJ WMT WRITE MODIFIER TABLE
* COPY SOURCE TEXT.
CRT3 RJ CCD COMPRESS LINE
RJ WNF WRITE NEW PROGRAM LIBRARY
SA1 CDID ADVANCE LINE NUMBER
SX6 X1+B1
SA6 A1
SA1 IW
READK A,CHAR,X1 READ NEXT LINE
SX6 B6+ SET LAST CHARACTER ADDRESS
SA6 LCAC
ZR X1,CRT3 IF NO EOR/EOF/EOI
* COMPLETE CURRENT DECK.
WRITER M,R END CURRENT DECK
SA1 RI+1 ENTER RANDOM INDEX
SX2 N+7
LX2 36
ADDWRD TNDK,X2+X1
SX6 B1 RESET LINE COUNTER
SA6 CDID
READ A BEGIN NEW RECORD
SA1 IW
READS A,CHAR,X1 READ NEXT LINE
ZR X1,CRT1 IF NOT EOR/EOF/EOI
* TERMINATE CREATE.
LISTOP C,CRT4 IF NO LIST FOR DIRECTIVE
SX0 =C*DECKS CREATED.*
SA4 F.TNDK LIST DECKS
SA5 L.TNDK
SA1 =1H
BX6 X1
SA6 BUF
RJ LTB LIST TABLE
PRINT (=C* *)
CRT4 SA1 N+7 RESTORE NEW PROGRAM LIBRARY FILE
SX5 A+7 ADD DECKS
BX7 X1
SA7 N
BX6 X6-X6 CLEAR SCRATCH FILE NAME
SA6 M
RJ ADK ADD DECK
MESSAGE CCDR,1
EQ PDC7 EXIT TO READ NEXT LINE
CRTA CON 10H CREATE /
CON 0
CRTF CON 0 CHARACTER SET REQUEST FOUND FOR THIS DECK
CSET SPACE 4,10
*** CSET DNAME
*
* DECLARE THE INITIAL CHARACTER SET FOR READING MODSETS.
* IF OMITTED, *CSET* DEFAULTS TO *ASCII*.
CSET RJ ASN ASSEMBLE NAME OF *CSET*
MX3 42
SA1 TCST-1 FWA-1 OF CHARACTER SET TABLE
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 CSC
EQ PDC6 RETURN
CSET2 SX6 =C*CSET - UNKNOWN CHARACTER SET.*
EQ ERR EXIT WITH ERROR MESSAGE
OPLFILE SPACE 4,10
*** OPLFILE FNAME,FNAME,...,FNAME
*
* DECLARE FILE(S) *FNAME* TO BE AN ADDITIONAL PROGRAM LIBRARY
* FILE(S).
OPLFILE SA1 PDCA
NZ X1,ERR4 IF *OPLFILE* NOT ALLOWED
RJ SAF SET ALTERNATE FILE
SA1 TOFN
SB2 X1-TOFNL+1
MI B2,OFN1 IF ROOM IN FILE NAME TABLE
SX6 =C*TOO MANY OPL FILES.*
EQ ERR
OFN1 SB2 X1+B1 ADD FILE NAME
SX3 B1+B1
BX6 X6+X3
SX7 B2 ADVANCE INDEX
SA6 A1+B2
SA7 A1+
SA5 A1+B2 READ DIRECTORY
RJ RDR READ DIRECTORY
SX6 A0+
NZ X0,ERR IF ERRORS IN OPL
SA1 CH CHECK NEXT CHARACTER
SA2 X1
SX6 X1+B1
SB2 X2-1R,
SA6 A1+
ZR B2,OPLFILE IF COMMA LOOP
EQ PDC6 EXIT
DECK SPACE 4,10
*** MODIFICATION DIRECTIVES.
*
* MODIFICATION DIRECTIVES WHICH REFER TO ACTUAL LINES ON THE
* PROGRAM LIBRARY INCLUDE THE IDENTIFICATION OF THE LINE AT
* WHICH MODIFICATION TAKES PLACE. THE IDENTIFICATION HAS THE
* GENERAL FORM *MNAME*.*NUMBER*, WHERE *MNAME* = THE NAME OF
* THE MODIFIER, AND *NUMBER* IS THE NUMBER OF THE LINE.
* FOR ORIGINAL LINES IN THE DECK, THE LINE IDENTIFICATION MAY
* BE SHORTENED TO *NUMBER*. THE IDENTIFICATION IS REFERRED
* TO AS *C* OR *CN* IN THE DESCRIPTION OF THE DIRECTIVES.
DECK SPACE 4,10
*** DECK DNAME
*
* SET DECK NAME FOR MODIFICATION TO *DNAME*
* THIS DIRECTIVE MUST PRECEED ALL DIRECTIVES WHICH RESULT IN
* THE MODIFICATION OF A DECK.
DECK RJ ASN ASSEMBLE NAME
ZR X6,ERR2 IF NAME BLANK OR TOO LONG
SA1 IG
ZR X1,DCK2 IF NO IGNORES
SEARCH TIGD,X6
ZR X2,DCK2 IF DECK IS NOT TO BE IGNORED
SA6 DCKA+1
MESSAGE A6-B1,1
SA1 LO CHECK LIST OPTIONS
SA2 CDLS
BX6 X1*X2
ZR X6,DCK0 IF LIST OPTION OFF
PRINT (=C* IGNORE THE FOLLOWING DECK*)
PRINT (=C* *)
DCK0 RJ LDC LIST DIRECTIVE LINE
DCK1 RJ RDD READ DIRECTIVE
NZ X1,PDC8 IF EOR
CARD IDENT
CARD EDIT
CARD DECK
SX7 1S"LO.T"
SA7 CDLS
RJ LDC LIST IGNORED LINES
EQ DCK1
DCK2 SX1 6
SEARCH TDKN,X6+X1,777776B
NZ X2,DCK3 IF DECK FOUND
MX6 0
SA6 MDTI CLEAR CURRENT DECK NAME
SA6 INSF CLEAR INSERT FLAG
SX6 =C*UNKNOWN DECK.*
EQ ERR
DCK3 SX5 A2 SET DECK ADDRESS
SEARCH TDKI,X6 SEARCH FOR PREVIOUS ENTRY
NZ X2,DCK4 IF FOUND
ADDWRD A0,X1*X6 ENTER DECK TABLE
DCK4 BX6 X3 SET EDIT INDEX
SX7 X5 SET DECK NAME ADDRESS
SA6 MDTI
SA7 AIDT
BX6 X6-X6 CLEAR INSERT
SA6 INSF
EQ PDC5 EXIT
DCKA DATA 10H IGNORE /
DATA 0
DEFINE SPACE 4,10
*** DEFINE NAME,VALUE
*
* SET THE VALUE OF *NAME* TO *VALUE*. IF *VALUE* IS
* NOT PRESENT A VALUE OF ZERO IS ASSUMED.
*
* DEFINED NAMES ARE USED IN CONJUNCTION WITH *IF*, *ELSE*,
* *ENDIF* AND *IFCALL* DIRECTIVES.
*
* WHEN A SYMBOL IS DEFINED ON THE INPUT STREAM ( NO INSERT IN
* PROGRESS ) THE INPUT DEFINITION WILL OVERRIDE ANY COMPILE
* FILE SPECIFICATIONS FOR VALUES OF THE SPECIFIED NAME *NAME*.
DEFINE SA1 INSF CHECK FOR INSERT IN PROGRESS
NZ X1,PDC4 IF INSERT FLAG SET
* PROCESS DEFINE DIRECTIVE.
ZR X6,ERR2 IF NAME BLANK OR TOO LONG
RJ ASN ASSEMBLE NAME
SEARCH TDEF,X6 SEARCH FOR NAME
NZ X2,DEF1 IF SYMBOL ALREADY EXISTS
ADDWRD A0,X6 ADD ENTRY TO TABLE
SA2 A6+ GET ENTRY
* ASSEMBLE VALUE AND DEFINITION.
DEF1 SA5 A2
SA1 CH SKIP SEPARATOR
SX6 X1+B1
SA6 A1
RJ ASD ASSEMBLE NUMERIC VALUE
NZ B2,DEF2 IF FIELD NOT NULL
SX6 B0+
SA6 ERRM CLEAR ERROR FLAG AND USE DEFAULT VALUE
DEF2 BX3 X7
AX7 16
NZ X7,DEF3 IF VALUE TO LARGE
MX1 42
BX5 X1*X5
MX4 1 SET DEFINED ON INPUT FLAG
LX4 17-59
BX6 X4+X3 FLAG + VALUE
BX6 X5+X6 FLAG + SYMBOL + VALUE
SA6 A5 SET IN TABLE
EQ PDC6 RETURN
* VALUE ERROR.
DEF3 SX6 =C/ VALUE ERROR./
EQ ERR
DELETE SPACE 4,10
*** DELETE C
* D C
*
* DELETE DIRECTIVE *C* AND INSERT FOLLOWING TEXT.
DELETE SPACE 4,10
*** DELETE C1,C2
* D C1,C2
*
* DELETE LINES *C1* THROUGH *C2* AND INSERT FOLLOWING TEXT.
DELETE SX6 2 SET DELETE
DLT1 SA6 T1
RJ AMI ASSEMBLE FIRST DELETE IDENTIFIER
SA1 CH CHECK NEXT CHARACTER
SA6 IDT1 SET FIRST IDENTIFIER
SA7 A6+B1
SA2 X1
SB7 X2-1R
ZR B7,DLT2 IF BLANK
RJ AMI ASSEMBLE SECOND IDENTIFIER
DLT2 SA6 IDT2 SET SECOND IDENTIFIER
SA7 A6+1
SA1 T1 ENTER MODIFICATION TABLE
RJ EMT ENTER MODIFIER TABLE
SX6 1 SET INSERT FLAG
SA6 INSF
EQ PDC5 EXIT
EDIT SPACE 4,10
*** EDIT D1
* EDIT D1,D2,...DN
* EDIT D1.DN
*
* REQUEST EDITING OF DECK(S) D1 - DN.
EDIT RJ ASN ASSEMBLE NAME
SB7 B0 1 ENTRY
SA1 IG
ZR X1,EDI1 IF NO IGNORES
SEARCH TIGD,X6
NZ X2,EDI5 IF DECK IS TO BE IGNORED
EDI1 SX3 6 SEARCH FOR DECK
SEARCH TDKN,X6+X3,377776B
ZR X6,ERR2 IF BLANK NAME - FORMAT ERROR
ZR X2,EDI6 IF NOT FOUND
SA1 CH CHECK NEXT CHARACTER
SA3 X1
SB2 X3-1R.
SA5 A2+
NZ B2,EDI3 IF NOT PERIOD
SX7 X1+B1 SKIP PERIOD
SA7 A1
RJ ASN ASSEMBLE NAME
ZR X6,ERR2 IF NAME BLANK OR TOO LONG
SA1 IG
ZR X1,EDI2 IF NO IGNORES
SEARCH TIGD,X6
NZ X2,ERR2 IF DECK IS TO BE IGNORED - *D1.DN* ILLEGAL
EDI2 SX3 6 SEARCH FOR DECK
SEARCH TDKN,X6+X3,377776B
ZR X6,ERR2 IF NAME BLANK OR TOO LONG
ZR X2,EDI6 IF NOT FOUND
SB6 A5 SET NUMBER OF ENTRIES
SB7 A2-B6
SX6 =C/NAMES SEPARATED BY *.* IN WRONG ORDER./
MI B7,ERR IF FIRST NAME AFTER SECOND
EDI3 BX6 X5 CHECK DECK STATUS
LX6 59-16
MI X6,EDI4 IF IGNORE BIT SET
SEARCH TEDT,X5 SEARCH FOR PREVIOUS ENTRY
NZ X2,EDI4 IF FOUND
ADDWRD A0,X1*X5 ENTER DECK IN EDIT TABLE
SX1 A5
ADDWRD A0,X1
EDI4 SB7 B7-2
SA5 A5+2
PL B7,EDI3 IF NOT AT END OF REQUESTED DECKS
EDI5 SA1 CH CHECK NEXT CHARACTER
SA2 X1
SX6 X1+B1
SB2 X2-1R
ZR B2,PDC5 IF BLANK - RETURN
NE B2,B1,ERR2 IF NOT COMMA - FORMAT ERROR
SA6 A1 SKIP COMMA
EQ EDIT LOOP
EDI6 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+1
SX6 EDTA SET MESSAGE ADDRESS
EQ ERR
EDTA DATA 30HUNKNOWN DECK -
IDENT SPACE 4,10
*** IDENT MNAME
*
* BEGIN MODIFICATION SET WITH MODIFIER *MNAME*.
IDENT RJ ASN ASSEMBLE NAME
SX2 1S13 SEARCH FOR IDENTIFIER NAME
ZR X6,ERR2 IF NO NAME - FORMAT ERROR
SEARCH TNME,X6 DONT ALLOW DUPLICATE IDENT LINES
NZ X2,ERR3 IF MOD REFERENCED BEFORE IDENT LINE
ADDWRD A0,X6 ADD IDENTIFIER
ADDWRD A0,X6-X6
SA2 A6-B1
SX7 A2
SA1 A2 RESTORE NAME
SA7 MDSA
MX0 42
BX1 X0*X1
RJ SFN SPACE FILL NAME
SA1 =10H-IDENT-
BX7 X1
SA6 SBTL+2
SA7 A6-B1
BX6 X6-X6 CLEAR INSERT
SA6 INSF
LISTOP T,IDN1 IF INPUT TEXT NOT SELECTED
SX7 99999 FORCE PAGE EJECT
SA7 LC
SX6 B1+
SA6 CDCT RESTART INPUT SEQUENCING
EQ PDC5 EXIT
IDN1 LISTOP C,PDC5 IF DIRECTIVE LIST NOT SELECTED
PRINT (=C* *)
PRINT (=C* *)
EQ PDC5
INSERT SPACE 4,10
*** INSERT C
* I C
*
* INSERT FOLLOWING LINES AFTER *C*.
INSERT RJ AMI ASSEMBLE INSERT IDENTIFIER
SA6 IDT1 SET FIRST LIMIT
SA7 A6+B1
BX6 X6-X6
SA1 CH CHECK NEXT CHARACTER
SA2 X1
SB7 X2-1R
NZ B7,ERR2 IF NOT BLANK - FORMAT ERROR
SA6 A7+B1 CLEAR SECOND LIMIT
SA6 A6+B1
SX1 4 ENTER INSERT INTO MODIFICATION TABLE
RJ EMT ENTER MODIFIER TABLE
SX6 1 SET INSERT FLAG
SA6 INSF
EQ PDC5 EXIT
INWIDTH SPACE 4,10
*** INWIDTH N
*
* SET THE WIDTH OF THE INPUT LINES TO N.
INWIDTH RJ ASD ASSEMBLE COLUMN NUMBER
SB2 X7-IWMACS-1
MI B2,INW2 IF IN RANGE
INW1 SX6 =C*COLUMN OUT OF RANGE.*
EQ ERR
INW2 SA7 IW
SX6 1R CLEAR INPUT BUFFER
SB2 CHAR+X7
SB3 CHAR+IWMAX
INW3 EQ B2,B3,PDC6 IF COMPLETE
SA6 B2
SB2 B2+B1
EQ INW3 LOOP FOR REMAINDER OF BUFFER
MODNAME SPACE 4,10
*** MODNAME MNAME
*
* SET ASSUMED MODIFIER NAME TO *MNAME*.
* NOTE - IF THIS DIRECTIVE IS USED, THE DECK NAME MUST BE
* RESET BY ANOTHER -MODNAME- DIRECTIVE.
MODNAME RJ ASN ASSEMBLE NAME
ZR X6,ERR2 IF NO NAME - FORMAT ERROR
SEARCH TNME,X6 SEARCH FOR NAME
NZ X2,MNM1 IF FOUND
ADDWRD A0,X6 ADD NEW NAME
SA2 A6
MNM1 SX6 A2 SET ASSUMED IDENTIFIER ADDRESS
SA6 AIDT
EQ PDC5 EXIT
MOVE SPACE 4,10
*** MOVE D1,D2
* MOVE D1,D2,...,DN
*
* MOVE DECK D2 TO BE AFTER DECK D1.
MOVE RJ ASN ASSEMBLE NAME
ZR X6,ERR2 IF BLANK NAME - FORMAT ERROR
SX3 6 SEARCH FOR DECK
SEARCH TDKN,X6+X3,377776B
ZR X2,EDI6 IF NOT FOUND
SA1 CH CHECK NEXT CHARACTER
SX5 X3
SA3 X1
SB2 X3-1R,
NZ B2,ERR2 IF NOT COMMA
SX7 X1+B1 SKIP COMMA
SA7 A1
MVE1 RJ ASN ASSEMBLE NAME
ZR X6,ERR2 IF BLANK NAME - FORMAT ERROR
SX3 6 SEARCH FOR DECK
SEARCH TDKN,X6+X3,377776B
ZR X2,EDI6 IF NOT FOUND
LX5 18
BX1 X5+X3
SX5 X3+
ADDWRD TMVE,X1 ENTER IN MOVE TABLE
SA1 CH CHECK NEXT CHARACTER
SA3 X1
SX7 X1+B1
SB2 X3-1R
ZR B2,PDC5 IF BLANK - RETURN
NE B2,B1,ERR2 IF NOT COMMA - FORMAT ERROR
SA7 A1 SKIP COMMA
EQ MVE1 LOOP
NOSEQ SPACE 4,10
*** NOSEQ
*
* REQUEST NO SEQUENCE NUMBERS ON COMPILE FILE.
NOSEQ SX6 B1+ SET NO SEQUENCE NUMBERS FLAG
SA1 INSF
NZ X1,PDC4 IF INSERT FLAG
SA6 NS
EQ PDC6 EXIT
PREFIX SPACE 4,10
*** PREFIX C
*
* SET DIRECTIVE PREFIX = *C*. C MAY BE ANY 6 BIT DISPLAY
* CODE CHARACTER.
PREFIX SA1 CH
SA2 X1+
SB7 X2-1R
ZR B7,ERR2 IF CHARACTER IS BLANK
MX3 -6
BX6 -X3*X2 USE 6 BIT CHARACTER ONLY
SA6 PC
EQ PDC6 EXIT
PREFIXC SPACE 4,10
*** PREFIXC C
*
* SET COMPILE FILE DIRECTIVE PREFIX = *C*. C MAY BE ANY 6
* BIT DISPLAY CODE CHARACTER.
PREFIXC SA1 CH CHECK NEW PREFIX CHARACTER
SA2 X1
SB7 X2-1R
ZR B7,ERR2 IF CHARACTER IS BLANK
MX3 -6
BX6 -X3*X2 USE 6 BIT CHARACTER ONLY
SA6 PCC
EQ PDC6 EXIT
PURDECK SPACE 4,10
*** PURDECK D1
* PURDECK D1,D2,...,DN
* PURDECK D1.DN
*
* REQUEST PURGE OF DECK(S) D1 - DN.
PURDECK RJ ASN ASSEMBLE NAME
ZR X6,ERR2 IF NO NAME - FORMAT ERROR
SX3 6 SEARCH FOR DECK NAME
SEARCH TDKN,X6+X3,377776B
ZR X2,EDI6 IF NOT FOUND
MX1 1
ADDWRD TMVE,X1+X3 ENTER IN MOVE TABLE
SA5 A6
SA1 CH CHECK NEXT CHARACTER
SA3 X1
SX7 X1+1
SB2 X3-1R
ZR B2,PDC5 IF BLANK - RETURN
NE B2,B1,PUR1 IF NOT COMMA
SA7 A1 SKIP COMMA
EQ PURDECK LOOP
PUR1 SB2 X3-1R.
NZ B2,ERR2 FORMAT ERROR IF NOT PERIOD
SA7 A1
RJ ASN ASSEMBLE NAME
ZR X6,ERR2 IF NO NAME - FORMAT ERROR
SX3 6
SEARCH TDKN,X6+X3,377776B
ZR X2,EDI6 IF NOT FOUND
LX3 18
IX6 X5+X3
SA6 A5
JP PDC5
RESTORE SPACE 4,10
*** RESTORE C
*
* RESTORE DIRECTIVE *C*, AND INSERT FOLLOWING TEXT.
RESTORE SPACE 4,10
*** RESTORE C1,C2
*
* RESTORE LINES *C1* THROUGH *C2*, AND INSERT FOLLOWING TEXT.
RESTORE SX6 3 SET RESTORE
EQ DLT1 PROCESS AS DELETE
SEQ SPACE 4,10
*** SEQ.
*
* REQUEST SEQUENCE NUMBERS ON COMPILE FILE.
SEQ SX6 B0+ SET SEQUENCE NUMBERS FLAG
SA1 INSF
NZ X1,PDC4 IF INSERT FLAG
SA6 NS
EQ PDC6 EXIT
SORSEQ SPACE 4,10
*** SORSEQ
*
* REQUEST SEQUENCE NUMBERS ON SOURCE FILE.
SORSEQ BSS 0 ENTRY
SX6 B1+ SET SEQUENCE NUMBERS FLAG
SA6 SS
EQ PDC6 EXIT
UNYANK SPACE 4,10
*** UNYANK MNAME
*
* REMOVE A PREVIOUS YANK ON MODIFIER *MNAME*.
UNYANK SPACE 4,10
*** UNYANK MNAME,*
*
* REMOVE PREVIOUS YANKS ON ALL MODIFIERS FROM *MNAME* ON.
UNYANK RJ ASN ASSEMBLE IDENT NAME
ZR X6,ERR2 IF NAME BLANK OR TOO LONG
SX7 1S15 SET UNYANK STATUS
BX6 X6+X7
EQ YNK1 PROCESS YANK
UPDATE SPACE 4,10
*** UPDATE
*
* PROPAGATE LINE COUNTS FOR IDENTS BETWEEN DECKS.
* WHEN THIS OPTION IS USED, THE ORDER OF EDITING IS DETERMINED
* BY THE ORDER OF THE PROGRAM LIBRARY, AND INSERTION TEXT
* NUMBERS WILL BE THE SAME AS THOSE PRODUCED BY *UPDATE*.
UPDATE SX6 B1 SET -UPDATE- FLAG
SA6 UP
EQ PDC6 EXIT
WIDTH SPACE 4,10
*** WIDTH N
*
* SET LINE WIDTH BEFORE SEQUENCE NUMBERS = *N*.
WIDTH RJ ASD ASSEMBLE COLUMN NUMBER
SB2 X7-IWMACS-1
PL B2,INW1 IF OUT OF RANGE
SA1 INSF
NZ X1,PDC4 IF INSERT FLAG
SA7 SC SET SEQUENCE NUMBER COLUMN
EQ PDC6 EXIT
YANK SPACE 4,10
*** YANK MNAME
*
* REMOVE EFFECTS OF MODIFIER *MNAME*.
YANK SPACE 4,10
*** YANK MNAME,*
*
* REMOVE EFFECTS OF MODIFIERS FROM *MNAME* ON.
* ANY MODIFIERS WHICH HAVE BEEN YANKED ARE DENOTED IN THE
* MODIFIER LIST BY ENCLOSING PARENS.
YANK RJ ASN ASSEMBLE IDENT NAME
ZR X6,ERR2 IF NO NAME - FORMAT ERROR
SX7 3S15 SET YANK BIT
BX6 X6+X7
YNK1 SX3 6 SEARCH FOR DECK NAME
SEARCH TDKN,X6+X3,777776B
NZ X2,ERR1 IF INCORRECT DIRECTIVE FOUND
SX2 1S15 SEARCH FOR YANK NAME
SEARCH TNME,X6+X2,X2
ZR X2,YNK2 IF NOT FOUND
MX4 -15 ENTER NEW STATUS
BX2 -X4*X2
BX6 X6+X2
SA6 A2
EQ YNK3
* PROCESS ALL PARAMETERS.
YNK2 ADDWRD A0,X6 ENTER NEW YANK NAME
YNK3 SA1 CH CHECK NEXT CHARACTER
SX7 B1 SET YANK FLAG
SA2 X1
SX7 X1+1
SA7 YK
SB2 X2-1R,
NZ B2,PDC5 IF NOT COMMA - RETURN
SA2 X7 CHECK NEXT CHARACTER
SX3 B1
SB2 X2-1R*
NZ B2,ERR1 IF NOT ASTERISK
BX6 X3+X6 SET ALL AFTER FLAG
SA6 A6
EQ PDC5 EXIT
IGNORE SPACE 4,10
*** IGNORE D1
* IGNORE D1,D2,...,DN
*
* CAUSES ANY FURTHER MODIFICATION DIRECTIVES TO THE DESIGNATED
* DECK(S) TO BE IGNORED.
IGNORE RJ ASN ASSEMBLE NAME
ZR X6,ERR2 IF NO NAME - FORMAT ERROR
SEARCH TIGD,X6
NZ X2,IGN1 IF FOUND - IGNORE DUPLICATED IGNORES
ADDWRD A0,X6 ENTER DECK NAME
IGN1 SA1 CH CHECK NEXT CHARACTER
SX7 B1 IGNORE FLAG
SA2 X1
SX7 X1+1
SA7 IG SET IGNORE FLAG
SB2 X2-1R
ZR B2,PDC5 IF BLANK - RETURN
NE B2,B1,ERR2 IF NOT COMMA
SA7 A1+
EQ IGNORE
ADK TITLE DIRECTIVE PROCESSING SUBROUTINES.
ADK SPACE 4,20
** ADK - ADD FROM NEW DECK TABLE TO DECK TABLE.
*
* ENTRY (X5) - FILE NAME ADDRESS.
*
* EXIT TNDK - CLEARED.
*
* USES ALL.
*
* CALLS ADW, STB.
ADK SUBR ENTRY/EXIT
SA1 L.TNDK
ZR X1,ADKX IF NO NEW DECKS - RETURN
ALLOC TDKN,X1,S ALLOCATE TABLE SLACK FOR LARGE BLOCK
SA1 L.TNDK
SB4 B0 PREPARE TO ADD NEW DECKS
SB5 X1
SX6 X5 SET FILE NAME ADDRESS
MX0 24
SB6 2
SA6 T1
ADK1 SA1 F.TNDK CHECK FOR PREVIOUS DECK
SA5 X1+B4
SB2 X5-OPRT
ZR B2,ADK2 IF TYPE = OPL
NE B2,B1,ADK6 IF TYPE .NE. OPLC
ADK2 SEARCH TDKN,X5,377777B
ZR X2,ADK3 IF NOT FOUND
SX1 1S16 SET IGNORE BIT
BX6 X2+X1
SA6 A2
ADK3 SA1 FM
ZR X1,ADK5 IF NOT -F- MODE
SEARCH TEDT,X5 LOOK UP EDIT ENTRY
NZ X2,ADK4 IF FOUND
ADDWRD A0,X1*X5 ADD ENTRY
ADDWRD A0,X6-X6
SA2 A6-B1
ADK4 SA1 F.TDKN SET NEW DECK ADDRESS
SA3 L.TDKN
IX6 X1+X3
SA0 TDKN
SA6 A2+B1
ADK5 ADDWRD A0,X5 ADD NEW DECK
SB2 B4+B1 REPLACE FILE NAME ADDRESS
SA1 F.TNDK
SA5 X1+B2
SA2 T1
BX5 -X0*X5
LX2 36
IX1 X2+X5
ADDWRD A0,X1
ADK6 SB5 B5-B6 ADVANCE TABLE
SB4 B4+B6
NZ B5,ADK1 IF NOT END OF NEW DECKS
SA1 F.TNME SET ASSUMED IDENTIFIER ADDRESS
BX6 X6-X6 CLEAR NEW DECK NAME TABLE
LX7 X1
SA6 L.TNDK
SA7 MDSA
EQ ADKX RETURN
AMI SPACE 4,20
** AMI - ASSEMBLE MODIFICATION IDENTIFICATION.
*
* EXIT (X6) - LINE NAME.
* (X7) - LINE NUMBER.
*
* USES ALL.
*
* CALLS ADW, ASD, ASN, STB.
AMI SUBR ENTRY/EXIT
SA1 MDTI
ZR X1,ERR1 IF NO DECK DIRECTIVE - INCORRECT DIRECTIVE
SA5 CH SAVE CURRENT CHARACTER POINTER
RJ ASN ASSEMBLE IDENTIFIER NAME
SA1 A5 CHECK NEXT CHARACTER
SA4 AIDT GET ASSUMED IDENTIFIER
SA2 X1
SB2 X2-1R.
ZR B2,AMI1 IF PERIOD
NZ X4,AMI2 IF ASSUMED IDENTIFIER PRESENT
EQ ERR1 INCORRECT DIRECTIVE
AMI1 SX5 X1+B1 SKIP PERIOD
SEARCH TNME,X6 SEARCH FOR IDENTIFIER
SX4 A2
NZ X2,AMI2 IF FOUND
ADDWRD A0,X6 ENTER IDENTIFIER
SX4 A6+ SET ADDRESS
AMI2 SX6 X5 SET CHARACTER POSITION
SA6 A5
RJ ASD ASSEMBLE NUMBER
SA1 A5+ CHECK NEXT CHARACTER
SX6 X4 SET ADDRESS
SA2 X1
SB2 X2-1R
ZR B2,AMIX IF NOT BLANK - RETURN
NE B2,B1,ERR1 IF NOT COMMA
SX6 X1+B1 SKIP COMMA
SA6 A1
SX6 X4 RESET ADDRESS
EQ AMIX RETURN
CCC SPACE 4,10
** CCC - COMPRESS CONVERTED LINE.
*
* ENTRY (B7) = LAST CHARACTER +1 OF CONVERTED LINE.
*
* CALLS CCD.
CCC1 RJ CCD COMPRESS LINE
CCC SUBR ENTRY/EXIT
SX7 B7-1
SA7 LCAC STORE END OF LINE POSITION
EQ CCC1 COMPRESS LINE
CCD SPACE 4,15
** CCD - COMPRESS LINE.
*
* ENTRY (CHAR) - CHARACTER STRING OF LINE.
*
* EXIT (CDTX) - COMPRESSED LINE.
* (CDWC) - WORD COUNT OF COMPRESSED LINE.
*
* USES ALL.
* PROCESS END OF LINE.
CCD8 LX6 X6,B6 SHIFT UP LAST WORD
MX3 -12
SA6 A6+1
BX4 -X3*X6
SB2 A1+
BX6 X6-X6
ZR X4,CCD9 IF LINE TERMINATED
SA6 A6+1 TERMINATE LINE
CCD9 SX7 A6-B2 SET WORD COUNT
SA7 A1-B1
SX6 A0 SET 64 CHARACTER INDICATOR
SA6 PCSE
CCD SUBR ENTRY/EXIT
SA0 B0 INITIALIZE 64 CHARACTER INDICATOR
SX0 2074B (X0) = CONSTANT 60 FOR UNPACK
SB4 100B
SB3 -B1
SA1 CDID PRESET (A6)
LX0 48
SA5 CHAR FIRST CHARACTER
SB7 B4+B1
BX6 X1
SA6 A1
SB2 6
UX6,B6 X0 RESET REGISTERS
SA2 LCAC SET LAST CHARACTER POSITION
SB5 -B1
BX1 -X2
SX7 1R
EQ CCD6 ENTER TO PROCESS FIRST CHARACTER
CCD1 SB5 B5+1
CCD2 LX6 6 00 CHARACTER
SB6 B6-B2
SX4 B4-B1 COMPRESSION = 77B
SB3 B5-B7
NZ B6,CCD3 IF NOT END OF WORD
SA6 A6+B1
UX6,B6 X0 RESET REGISTERS
CCD3 PL B3,CCD4 IF .GT. 64 BLANKS
SX4 B5-B1 COMPRESSION = COUNT - 1
SB3 -B1
CCD4 NZ X4,CCD5 IF CHARACTER IS NOT *00*
LX6 6 INSERT *00*
SA0 B1 64 CHARACTER SET CHARACTER ENCOUNTERED
SB6 B6-B2
SX4 B1 SET *01*
NZ B6,CCD5 IF NOT END OF WORD
SA6 A6+B1
UX6,B6 X0 RESET REGISTERS
CCD5 BX3 X4 SAVE CHARACTER
AX4 6 CHECK FOR ESCAPE CODE
ZR X4,CCD5.1 IF NO ESCAPE CODE
LX6 6 SHIFT ASSEMBLY
SB6 B6-B2
BX6 X6+X4 MERGE NEW CHARACTER
SB5 B3
NZ B6,CCD5.1 IF NOT END OF WORD
SA6 A6+B1
UX6,B6 X0 RESET REGISTERS
CCD5.1 MX4 -6
BX4 -X4*X3 CLEAN OFF ESCAPE CODE
LX6 6 SHIFT ASSEMBLY
SB6 B6-B2
BX6 X6+X4 MERGE NEW CHARACTER
SB5 B3
NZ B6,CCD6 IF NOT END OF WORD
SA6 A6+B1
UX6 B6,X0
CCD6 IX3 X5-X7 CHECK CHARACTER
BX4 X5
SB5 B5+B1 COUNT BLANK
SB3 X1 -( LWA + 1 ) OF STRING BUFFER
SB3 B3+A5 CHECK FOR END OF LINE
SA5 A5+B1 NEXT CHARACTER
ZR B3,CCD8 IF END OF LINE
ZR X3,CCD6 IF BLANK
SB3 -1
ZR B5,CCD4 IF NO BLANKS
BX4 X7
SA5 A5-B1 BACKSPACE
EQ B5,B1,CCD4 IF 1 BLANK
SB5 B5-1
NE B5,B1,CCD1 IF NOT 2 BLANKS
SA5 A5-1 BACKSPACE
EQ CCD4
EMT SPACE 4,20
** EMT - ENTER MODIFICATION TABLE.
*
* ENTRY (X1) - MODIFICATION REQUEST.
* 4 = INSERT.
* 3 = RESTORE.
* 2 = DELETE.
* (MDTI) - EDIT TABLE INDEX.
* (MDSA) - ADDRESS OF MODIFICATION SET NAME.
* (IDT1 - IDT1+1) - FIRST MODIFICATION LIMIT.
* (IDT2 - IDT2+1) - SECOND MODIFICATION LIMIT.
*
* CALLS ADW.
EMT SUBR ENTRY/EXIT
* ENTER FIRST WORD
SA2 MDTI EDIT INDEX TO BITS 00 - 17
LX1 57 MODIFICATION TO BITS 57 - 59
SA3 A2+B1 MODIFIER NAME POINTER TO BITS 36 - 53
IX1 X1+X2
SA4 A3+B1 LINE NUMBER TO BITS 18 - 35
LX3 18
IX6 X3+X4
LX6 18
BX1 X1+X6
ADDWRD TMOD,X1
* ENTER SECOND WORD.
SA2 IDT2 MODIFIER NAME POINTER TO BITS 36 - 53
LX2 18
SA3 A2+B1 LINE NUMBER TO BITS 18 - 35
BX1 X2+X3
LX1 18
ADDWRD A0,X1
* ENTER THIRD WORD
SA2 MDSA MODIFICATION SET ADDRESS TO BITS 42 - 59
SA1 T+5 TEXT ADDRESS TO BITS 00 - 24
LX2 42
IX1 X2+X1
ADDWRD A0,X1
EQ EMTX RETURN
IMP SPACE 4,15
** IMP - INITIALIZE MODIFICATION PROCESSING.
*
* LINK MODIFICATION TABLE BY DECKS. ENTER MODIFICATION TABLE
* LINKAGE IN EDIT TABLE. RESET FETS.
*
* USES ALL.
IMP SUBR ENTRY/EXIT
SA1 PCC COMPILE PREFIX CHARACTER
BX6 X1
SA6 PC
SA1 =10H DECK -
SX6 ALT SET ALTERNATE TITLE LINE
SX7 99999 FORCE PAGE EJECT
SA6 TL
SA7 LC
BX6 X1
SX7 B1 WORDS/ENTRY = 1
SA6 SBTL+1
SA7 LTBA
* LINK MODIFICATION TABLE BY DECKS.
SA1 L.TMOD INITIALIZE REGISTERS
SA2 F.TMOD
SB2 X1
MX0 42
ZR B2,IMP2 IF MODIFICATION TABLE EMPTY
SA3 F.TDKI
SB3 3
SB4 X3
SB2 B2-B3
SA2 X2+B2 GET MODIFICATION TABLE ENTRY
BX5 X0*X2 REMOVE DECK LINKAGE
IMP1 SA1 B4+X2 GET DECK TABLE ENTRY
SX3 A2 SET NEW DECK TO MOD LINK
BX4 X0*X1 REMOVE PREVIOUS LINK FROM DECK ENTRY
SB2 B2-B3
SA2 A2-B3 DECREMENT TO NEXT MODIFICATION
BX7 -X0*X1
IX6 X4+X3 RESTORE EDIT ENTRY
BX7 X5+X7
SA6 A1+
SA7 A2+B3 STORE LINKED MODIFICATION
BX5 X0*X2 REMOVE EDIT LINKAGE
PL B2,IMP1 IF NOT AT END OF TABLE
* ENTER MODIFICATION TABLE LINKAGE IN EDIT TABLE.
IMP2 SA3 UM
NZ X3,IMP7 IF *U* MODE
SA1 L.TDKI
SA2 F.TDKI
SB5 X1
SA5 X2
ZR B5,IMP5 IF DECK TABLE EMPTY
IMP3 SEARCH TEDT,X5 SEARCH EDIT TABLE
ZR X2,IMP4 IF NOT FOUND
SX1 X5 ENTER MODIFICATION TABLE LINK
BX6 X1+X2
SA6 A2+
IMP4 SB5 B5-B1
SA5 A5+B1
NZ B5,IMP3 IF NOT END OF DECK IDENTIFIERS
IMP5 SA1 UP
NZ X1,IMP9 IF *UPDATE* OPTION SELECTED
* GUARANTEE THAT COPYRIGHT RECORD, IF PRESENT, IS FIRST.
IMP6 SX6 7 COMMON DECK
SA1 =C*COPYRT* COPYRIGHT RECORD
SEARCH TDKN,X6+X1,777776B
ZR X2,IMP6.3 IF COPYRIGHT RECORD IS NOT PRESENT
MX2 42 CLEAR DECK FLAGS
BX6 X2*X6
SB5 A2 SAVE DECK ADDRESS
SEARCH TEDT,X6
SB4 A2 SAVE ENTRY ADDRESS
NZ X2,IMP6.1 IF DECK IN EDIT TABLE
ADDWRD TEDT,X6
SX1 B5
ADDWRD TEDT,X1
* MOVE THE COPYRIGHT DECK TO THE FIRST ENTRY.
SB4 A6-B1 SAVE ENTRY ADDRESS
IMP6.1 SX4 X3-2
NG X4,IMP6.3 IF FIRST ORDINAL OF THE TABLE
SA1 F.TEDT FIRST ORDINAL LOCATION
SB5 X1
SA1 B4 PRESENT POSITON
SA2 B4+B1 SECOND ENTRY
SB4 A2+B1
IMP6.2 BX6 X1
BX7 X2
SA1 B5
SA2 B5+B1
SA6 B5
SA7 B5+B1
SB5 A2+B1
NE B5,B4,IMP6.2 IF NOT FINISHED MOVING DOWN
* RESET FETS.
IMP6.3 SA1 T
SX6 B0+
SA6 M
ZR X1,IMPX IF TEXT FILE NOT USED - RETURN
WRITER A1,R
SA1 X2+1 REWIND POINTERS
SX7 X1
SA7 A1+B1
SA7 A7+B1
MX7 60 INSURE NO HIT ON TEXT ADDRESS
SA7 T+5
EQ IMPX RETURN
* FOR *U* MODE, ENTER DECK IDENTIFIER TABLE IN EDIT TABLE.
IMP7 SA1 F.TDKI
SA2 L.TDKI
BX7 X7-X7 CLEAR EDIT LENGTH
SB7 X2
SA7 L.TEDT
SB7 B7-B1
ZR B7,IMP5 IF NO DECKS
SA5 X1+B1 FIRST ENTRY
IMP8 ADDWRD TEDT,X5
MX0 42
SX1 6
BX6 X0*X6
SEARCH TDKN,X1+X6,777776B
SX1 A2
ADDWRD TEDT,X1
SB7 B7-B1
SA5 A5+B1
NZ B7,IMP8 IF MORE DECKS TO PROCESS
EQ IMP5
* FOR *UPDATE* OPTION, ORDER EDIT TABLE ACCORDING TO DECK TABLE.
IMP9 SA1 F.TDKN
SA2 L.TDKN
BX7 X7-X7 CLEAR DECK IDENTIFIER TABLE LENGTH
SB7 X2
SA7 L.TDKI
SA5 X1+
SB6 2
IMP10 SEARCH TEDT,X5
ZR X2,IMP11 IF DECK NOT IN EDIT TABLE
SA1 A2+B1 ENTER EDIT ENTRY
BX0 X1
ADDWRD TDKI,X2
ADDWRD A0,X0
IMP11 SB7 B7-B6
SA5 A5+B6
PL B7,IMP10 IF MORE DECKS TO PROCESS
SA1 L.TEDT COPY BACK TO EDIT TABLE
SA2 F.TEDT
SB7 X1
SB6 B0
SA3 F.TDKI
IMP12 EQ B6,B7,IMP6 IF COMPLETE
SA1 X3+B6
BX6 X1
SA6 X2+B6
SB6 B6+B1
EQ IMP12 LOOP
IPC SPACE 4,10
** IPC - INSERT PREFIX CHARACTER.
*
* ENTRY (PCC) = COMPILE FILE PREFIX CHARACTER.
* (WCCA) = TABLE OF COMPILE FILE DIRECTIVES.
*
* EXIT (WCCA) = INITIALIZED WITH PREFIX CHARACTER IN UPPER
* 6-BITS OF TABLE ENTRY.
*
* USES X - 1, 2, 6.
* A - 1, 2, 6.
IPC SUBR ENTRY/EXIT
SA2 PCC COMPILE FILE PREFIX CHARACTER
SA1 WCCA-1 INITIALIZE LOOP
LX2 54
IPC1 SA1 A1+B1 INSERT CHARACTER
BX6 X1+X2
ZR X1,IPCX IF AT END OF TABLE
SA6 A1
EQ IPC1 LOOP FOR REMAINDER OF TABLE
LDC SPACE 4,20
** LDC - LIST DIRECTIVE LINE.
*
* ENTRY (CHAR) - LINE IN *S* FORMAT.
* (CDLS) - LINE LIST STATUS.
* (ERRM) - ERROR MESSAGE, IF NEEDED.
*
* USES X - 0, 1, 2, 3, 4, 6, 7.
* A - 1, 2, 3, 4, 6, 7.
* B - ALL.
*
* CALLS LER, UPN, WOF.
LDC SUBR ENTRY/EXIT
SA1 ERRM
ZR X1,LDC1 IF NO ERROR MESSSAGE
SX7 1S"LO.E"
SA1 =9L *ERROR*
SA7 CDLS
SB3 CHSP
RJ UPN UNPACK NAME
LISTOP E,LDC1,MI IF ERROR LIST ON
SA1 EA ADVANCE DIRECTIVE ERROR COUNTER
SA2 X1
SX6 X2+B1
SA6 A2
BX6 X6-X6 CLEAR ERROR
SA6 ERRM
EQ LDCX RETURN
LDC1 SA1 LO CHECK LIST OPTION
SA2 CDLS
BX6 X1*X2
ZR X6,LDC5 IF NO LIST FOR LINE
SA1 RDDB
SX6 2
IX1 X1-X6
SX2 125
PL X1,LDC3 IF READPL
SA1 CDCT
MX0 -16
SX6 B1
BX1 -X0*X1
IX7 X6+X1
SA7 A1 DIRECTIVE COUNT
RJ CDD CONVERT TO DECIMAL DISPLAY
SB2 9
MX0 -6
LX6 24
LDC2 BX7 -X0*X6
SB2 B2-B1
SA7 A7+B1
LX6 6
NZ B2,LDC2 IF NOT COMPLETE
SA4 IW INPUT WIDTH
SX2 X4+10
SA1 A
ZR X1,LDC3 IF NO ALTERNATE FILE
SX2 118
LDC3 PRINT -CHSP,X2
SX6 1R
SB2 8
SA6 CHSP RESTORE SPACES TO CHSP
LDC4 SB2 B2-B1
SA6 A6+B1
NZ B2,LDC4 IF NOT COMPLETE
LDC5 SA1 ERRM
ZR X1,LDCX IF NO ERROR MESSAGE - RETURN
BX6 X6-X6 CLEAR ERROR MESSAGE
SA6 A1
SX0 X1
RJ LER LIST ERROR MESSAGE
EQ LDCX
PMP SPACE 4
** PMP - PROCESS MOVE AND PURDECK DIRECTIVES.
*
* USE TABLE *TMVE* TO REORDER THE EDIT TABLE.
PMP SUBR ENTRY/EXIT
BX6 X6-X6
SA6 T1
PMP1 SA1 T1 CHECK MOVE TABLE
SA2 L.TMVE
IX7 X2-X1
SX6 X1+B1 ADVANCE MOVE INDEX
ZR X7,PMPX IF END OF TABLE - RETURN
SA3 F.TMVE LOOK UP MOVE ENTRY
SB2 X1
SA2 X3+B2
SA6 A1
SA3 F.TDKN LOOK UP DECK NAME
IX6 X2+X3
LX3 18
IX6 X6+X3
SA6 T2
SA1 X6
SEARCH TEDT,X1 SEARCH FOR DECK NAME
ZR X2,PMP1 IF NOT FOUND
SA1 A2+B1 SAVE EDIT ENTRY
BX6 X2
BX7 X1
SA6 PMPA
SA7 A6+B1
SA2 F.TEDT
SA1 L.TEDT DECREMENT EDIT LENGTH
SX6 X1-2
SA6 A1
IX1 X6-X3
IX3 X2+X3
BX6 X3
SA6 PMPA+2
ZR X1,PMP2 IF NO MOVE
MOVE X1,X3+2,X3 PURGE EDIT ENTRY
PMP2 SA1 T2
MI X1,PMP4 IF MOVE COMPLETE
LX1 -18
SA2 X1 SEARCH FOR DECK NAME
SEARCH TEDT,X2
ZR X2,PMP1 IF NOT FOUND
SB2 B1+B1
SX6 A2+B2
SA1 L.TEDT
SA2 F.TEDT
SA6 T2
SX7 X1+B2 INCREMENT TABLE LENGTH
SA7 A1
SX3 X3+B2
IX2 X2+X3
IX1 X1-X3
ZR X1,PMP3 IF NO MOVE
MOVE X1,X2,X2+B2 ADD MOVED ENTRY
PMP3 SA1 T2
SA2 PMPA
SA3 A2+B1
BX6 X2
BX7 X3
SA6 X1
SA7 X1+B1
EQ PMP1 LOOP
PMP4 LX1 -18
SX3 X1
SA2 F.TDKN
BX1 X3-X2
ZR X1,PMP1 IF NO SECOND ADDRESS TO PURGE
SA2 X3
SEARCH TEDT,X2
ZR X2,PMP1 IF NOT FOUND
SX2 A2+2
SA3 PMPA+2 PICK UP WHERE 1ST PURGE WAS PERFORMED
IX1 X2-X3
SX6 =C/NAMES SEPARATED BY *.* IN WRONG ORDER./
ZR X1,PMP1 IF NOTHING TO MOVE
NG X1,ERR IF PURGE ORDER INCORRECT
SA4 L.TEDT
SA5 F.TEDT
IX6 X4-X1
IX5 X5+X4
IX1 X5-X2
SA6 A4
MOVE X1,X2,X3
EQ PMP1
PMPA CON 0
CON 0
CON 0
RCS SPACE 4,15
** RCS - RESET CHARACTER SET.
*
* RESET CURRENT CHARACTER SET.
*
* ENTRY (CSR) = REQUESTED CHARACTER SET NAME.
* = 0 - DISPLAY CHARACTER SET MESSAGE.
*
* EXIT (X6) = ERROR MESSAGE ADDRESS IF NON-ZERO.
* (CSC) = CURRENT CHARACTER SET.
* (CSR) = 0.
*
* USES A - 1, 2, 3, 6, 7.
* X - 1, 2, 3, 4, 6, 7.
* B - NONE.
*
* MACROS MESSAGE, TLX.
*
* CALLS NONE.
RCS SUBR ENTRY/EXIT
SA1 CSR GET REQUESTED CHARACTER SET
ZR X1,RCS4 IF MESSAGE REQUEST
MX3 42
BX2 X1
SA1 TCST-1 FWA-1 OF CHARSET TABLE
SX6 RCSA PRESET ERROR MESSAGE
RCS1 SA1 A1+B1
ZR X1,RCSX IF UNKNOWN CHARSET
BX4 X3*X1
BX7 X2-X4
NZ X7,RCS1 IF NO MATCH
BX7 -X3*X1
SA7 CSC SET NEW CHARACTER SET
RCS3 BX6 X6-X6 CLEAR ERROR MESSAGE FLAG
SA6 CSR CLEAR CHARACTER SET REQUEST
EQ RCSX RETURN
RCS4 SA2 RCSB
NG X1,RCS3 IF NO EXPLICIT CS REQUEST
ZR X2,RCS3 IF NO MESSAGE, RETURN
MESSAGE X2,3,R
EQ RCS3 RETURN
RCSA DATA C* UNKNOWN CHARACTER SET.*
RCSB CON 0 MESSAGE ADDDRESS IF NON-ZERO.
RDD SPACE 4,15
** RDD - READ DIRECTIVE.
*
* *READ*, *SKIP*, *REWIND* DIRECTIVES PROCESSED HERE.
*
* EXIT (X1) - .NE. 0, IF EOR/EOF ENCOUNTERED.
*
* USES ALL.
*
* CALLS ECD, LDC, UPN, WOF.
RDD SUBR ENTRY/EXIT
RDD1 SA5 RDDB
NZ X5,RDD9 IF READPL INPUT
SA1 A
NZ X1,RDD6 IF ALTERNATE INPUT
SA1 IW
READK I,CHAR,X1
NZ X1,RDDX IF EOR/EOF/EOI - RETURN
RDD2 SX6 B6+
SA6 LCAC
RDD3 SX6 1BS"LO.C"
SA6 CDLS
CARD BKSP
CARD READ
CARD READPL
CARD RETURN
CARD REWIND
CARD SKIP
CARD SKIPR
BX1 X1-X1 RETURN WITH NO EOR
EQ RDDX RETURN
* RETURN HERE TO CLEAR ALTERNATE INPUT AND LIST LINE.
RDD4 BX6 X6-X6 CLEAR ALTERNATE INPUT
SA6 A
SA6 RDDB CLEAR READPL FLAG
RJ LDC LIST LINE
MESSAGE CCDR,1 ISSUE CONSOLE MESSAGE
SX6 1R BLANK FILL BUFFER
SB2 25
RDD5 SA6 CHAR+IWMAX+B2
SB2 B2-B1
PL B2,RDD5 IF NOT COMPLETE
EQ RDD1 PROCESS NEXT INPUT
* ALTERNATE INPUT READ.
RDD6 SA5 RDDB
NZ X5,RDD9 IF READPL INPUT
SA1 IW
READK A,CHAR,X1
ZR X1,RDD2 IF NO EOR
SA3 RDDA
ZR X3,RDD7 IF NOT *READ* N,*
MI X1,RDD7 IF EOF
READ A BEGIN NEW READ
READC A,BUF,20 READ FIRST LINE
MI X1,RDD7 IF EOF
SX6 X1-BUF CHECK LENGTH
NZ X6,RDD6 IF NEXT RECORD NOT ZERO LENGTH
RDD7 BX7 X7-X7 CLEAR ALTERNATE INPUT
SA7 X2
SA7 RDDA CLEAR (*) FLAG
RDD8 SA7 RDDB CLEAR READPL FLAG
LISTOP C,RDD1 IF NO LIST SET FOR DIRECTIVE
PRINT (=C* *)
PRINT (=C* *)
EQ RDD1 PROCESS NEXT INPUT
RDD9 SA1 RDDB+1
ZR X1,RDD11 IF LAST LINE READ
READC N,BUF,BUFL READ MHBS
NZ X1,RDD11 IF EOR
READC X2,CDTX,MXCCL READ COMPRESSED LINE
NZ X1,RDD11 IF EOR
RDD10 SA1 BUF
SA2 =00177777177777000000B
SA3 RDDB
BX6 X2*X1
IX6 X6-X3
SA6 A3+B1
PL X1,RDD9 IF LINE INACTIVE
MX0 -16 SET LINE ID
SA2 F.TNCD
AX1 18
BX6 -X0*X1
IX6 X6+X2
AX1 18
SA2 X6 LINE NAME
BX6 -X0*X1 SEQUENCE NUMBER
BX2 X0*X2
IX6 X2+X6
SA6 CDID
RJ ECD EXPAND LINE
SX6 B7 ADDRESS OF LAST CHARACTER FROM LINE + 1
SA6 LCAC
EQ RDD3
* TERMINATE READPL.
RDD11 RECALL N
SA1 X2+B1 SET IN = OUT = FIRST
SX6 X1
SA6 A1+B1
SA6 A6+B1
SA1 A FILE NAME
MX0 42
BX1 X0*X1
RJ SFN SPACE FILL NAME
SB3 CHAR+IWMAX+1 ENTER NAME IN CHAR
BX1 X6
RJ UPN UNPACK NAME
BX7 X7-X7 CLEAR MODIFIER TABLE
SA1 N+7 REPLACE NPL NAME
BX6 X1
SA7 L.TNCD
SA6 N
EQ RDD8
RDDA CON 0 -READ- (*) FLAG
RDDB CON 0 -READPL- FLAG
CON 0
SPACE 4
*** FILE MANIPULATION DIRECTIVES.
*
* PROCESSED FROM INPUT FILE. THESE DIRECTIVES ARE NOT ALLOWED
* ON ALTERNATE INPUT.
BKSP SPACE 4,10
*** BKSP FNAME
*
* BACKSPACE FILE *FNAME* 1 RECORD.
BKSP SPACE 4,10
*** BKSP FNAME,N
*
* BACKSPACE FILE *FNAME* *N* RECORDS.
BKSP SX6 B1 SET BACKSPACE FLAG
EQ SKP1
READ SPACE 4,10
*** READ FNAME,RNAME
*
* USE FILE *FNAME* FOR DIRECTIVE INPUT.
* *RNAME* IF PRESENT, SPECIFIES THE NAME OF THE RECORD TO
* BE USED. *FNAME* MUST BE IN SOURCE FILE FORMAT.
* I.E. THE FIRST WORD OF EACH RECORD IS THE NAME OF THE
* RECORD. THIS WORD IS DISCARDED BEFORE DIRECTIVE INPUT
* IS PROCESSED. THE SEARCH TERMINATES ON AN END OF FILE.
* WHEN END OF RECORD IS REACHED, DIRECTIVE INPUT RETURNS TO
* NORMAL INPUT FILE.
*
* IF *RNAME* = (*), ALL RECORDS UP TO AN EOF OR A ZERO
* LENGTH RECORD ARE READ.
READ RJ SAF SET ALTERNATE FILE
SA6 A SET FILE NAME
SA1 CH CHECK NEXT CHARACTER
SA2 X1
SX6 X1+B1
SB2 X2-1R,
NZ B2,RAF6 IF NOT COMMA
SA6 A1 SKIP COMMA
RJ ASN ASSEMBLE RECORD NAME
BX1 X6 CHECK NAME
LX7 X6
ZR X6,RAF7 IF NO RECORD NAME
LX7 18
SX7 X7-1L*
ZR X7,RAF5 IF ASTERISK
RJ SFN SPACE FILL NAME
BX5 X6 SAVE NAME
READ A
RAF1 READC A,BUF,MXCCL READ FIRST LINE
MI X1,RAF4 IF EOF
SA1 BUF SPACE FILL NAME
RJ SFN SPACE FILL NAME
BX7 X6-X5
ZR X7,RAF3 IF RECORDS MATCH
SB2 BUF+BUFL
READW A,B6,B2-B6
SX1 B6 LWA+1 OF DATA READ
SX2 BUF SET RECORD TYPE
RJ SRT SET RECORD TYPE
SA7 RAFA+1 ENTER NAME IN MESSAGE
MESSAGE A7-B1,1
RAF2 READW A,BUF,BUFL READ NEXT PART
ZR X1,RAF2 IF NOT EOR/EOF/EOI
READ X2 BEGIN NEW READ
EQ RAF1 PROCESS NEXT RECORD
RAF3 RJ LDC LIST LINE
SA1 A SPACE FILL FILE NAME
MX0 42
BX1 X0*X1
RJ SFN SPACE FILL NAME
SB3 CHAR+IWMAX+1 ENTER NAME IN CHARACTER BUFFER
BX1 X6
RJ UPN UNPACK NAME
MESSAGE CCDR,1 RESET CONSOLE MESSAGE
EQ RDD1 READ NEXT LINE
RAF4 SX6 =C*RECORD NOT FOUND.*
EQ RAF8 SET ERROR MESSAGE
RAF5 SX6 B1 SET ASTERISK FLAG
SA6 RDDA
READ A BEGIN READ
READC A,BUF,MXCCL READ FIRST LINE
EQ RAF3
RAF6 READ A,R LOAD BUFFER
SA1 A+2
SA3 A1+B1 (A+3)
BX6 X1-X3
NZ X6,RAF3 IF DATA READ
SX6 =C*EMPTY FILE.*
EQ RAF8 SET ERROR MESSAGE
RAF7 SX6 =C*RECORD NAME MISSING.*
RAF8 SA6 ERRM SET ERROR MESSAGE
EQ RDD4 EXIT
RAFA CON 10H SKIP /
CON 0
READPL SPACE 4,10
*** READPL DNAME,C1,C2
*
* READ LINES *C1* THROUGH *C2* FROM PROGRAM LIBRARY.
*
* IF *C1* AND *C2* ARE MISSING, READ ENTIRE DECK.
READPL SA1 RDDB
SX6 =C*OPERATION INCORRECT FROM ALTERNATE INPUT.*
NZ X1,ERR IF ALTERNATE INPUT ACTIVE
RJ CRD CONDITIONALLY READ DIRECTORY
RJ ASN ASSEMBLE NAME
ZR X6,ERR2 IF NO NAME - FORMAT ERROR
SEARCH TDKN,X6,200000B SEARCH FOR DECK
SX6 =C*UNKNOWN DECK.*
ZR X2,ERR IF DECK NOT FOUND
SA1 A2+B1 SET RANDOM ADDRESS
SX6 A2 SET IDENTIFIER ADDRESS
SA6 RPLA
MX0 30
BX6 -X0*X1
AX1 36
SA3 X1 PROGRAM LIBRARY NAME
SA6 N+6
BX7 X3
SX6 B1
SA7 N
SA6 RDDB
SX6 IWMACS+1 SET LINE NUMBER COLUMN
SA6 SC+1
READ N INITIATE NEW READ
READW N,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 ADD DECK NAME TO IDENTIFIER TABLE
ADDWRD TNCD,X1
SB5 TIDT FWA OF IDENT TABLE
RJ PCS PROCESS CHARACTER SET
READW N,T1,1 READ MODIFIER TABLE LENGTH
NZ X1,PLE IF EOR
SA1 T1 CHECK TABLE
SB7 X1 SET TABLE LENGTH
LX1 18
SB2 X1-700100B
SB3 X1-700200B
ZR B2,RPL1 IF NORMAL DECK
NZ B3,PLE IF NOT COMMON DECK
RPL1 ZR B7,RPL2 IF NO MODIFIERS
ALLOC TNCD,B7 ALLOCATE FOR MODIFIERS
READW N,X2+B1,B7 READ MODIFIERS
RPL2 SA1 CH CHECK SEPARATOR CHARACTER
SA2 X1
SX6 X1+B1
SB2 X2-1R
SA6 A1+
ZR B2,RPL9 IF READ ENTIRE DECK
NE B2,B1,ERR2 IF FORMAT ERROR
SA1 MDTI MODIFICATION TABLE INDEX
SA2 AIDT ASSUMED IDENTIFIER
BX6 X1
LX7 X2
SA3 RPLA DECK NAME ADDRESS
SA6 A3
SA7 A3+B1
BX6 X3
SX7 B1
SA6 A2 ASSUMED IDENTIFIER = DECK NAME ADDRESS
SA7 A1 INDEX = 1
RJ AMI ASSEMBLE FIRST IDENTIFIER
SA7 T1
SA1 X6 FIND MODIFIER INDEX
SEARCH TNCD,X1
NZ X2,RPL4 IF FOUND
RPL3 SA1 RPLA RESTORE MODNAME
SA2 A1+1
BX6 X1
LX7 X2
SA6 MDTI
SA7 AIDT
SX6 =C*UNKNOWN MODNAME.*
EQ RPL8
RPL4 LX3 18 FORM FIRST LINE MASK
SA1 T1
LX1 36
BX6 X1+X3
SA6 A1
RJ AMI ASSEMBLE SECOND IDENTIFIER
SA7 T2
SA1 X6+ FIND MODIFIER INDEX
SEARCH TNCD,X1
ZR X2,RPL3 IF NOT FOUND
SA1 T2 FORM LAST LINE MASK
LX3 18
LX1 36
BX6 X1+X3
SA6 A1
SA1 RPLA RESTORE MODNAME
SA2 A1+1
BX6 X1
LX7 X2
SA6 MDTI
SA7 AIDT
SA1 =00177777177777000000B
SA5 T1
BX0 X1
* SEARCH FOR START OF TEXT.
RPL5 READC N,BUF,BUFL READ MHBS
NZ X1,RPL7 IF EOR
READC X2,CDTX,MXCCL READ COMPRESSED LINE
NZ X1,RPL7 IF EOR
SA1 BUF
BX1 X0*X1
IX6 X1-X5
NZ X6,RPL5 IF NOT AT BEGINNING OF TEXT
RPL6 RJ LDC LIST LINE
SA1 T2 SET ALTERNATE READ
BX6 X1
SA6 RDDB
MESSAGE CCDR,1 RESET CONSOLE MESSAGE
EQ RDD10 PROCESS LINE
RPL7 SX6 =C*CARD NOT FOUND.*
RPL8 SA6 ERRM
RECALL N
SA1 N+1 RESET IN = OUT = FIRST
SX6 X1
BX7 X7-X7
SA6 A1+B1
SA6 A6+B1
SA7 L.TNCD
EQ RDD4 EXIT
* READ ENTIRE DECK.
RPL9 READC N,BUF,BUFL READ MHBS
NZ X1,RPL7 IF EOR
READC X2,CDTX,MXCCL READ COMPRESSED LINE
SX6 10 SET ALTERNATE READ
SA6 T2
EQ RPL6
RPLA CON 0 MODIFICATION TABLE INDEX
CON 0 ASSUMED IDENTIFIED
RETURN SPACE 4,10
*** RETURN FNAME,FNAME,...,FNAME
*
* RETURN FILE(S) *FNAME*.
RETURN RJ SAF SET ALTERNATE FILE
SA6 A SET FILE NAME
EVICT A,R RETURN FILE
SA1 CH CHECK NEXT CHARACTER
BX6 X6-X6 CLEAR ALTERNATE FILE
SA2 X1
SB2 X2-1R,
SA6 A
NZ B2,RDD4 IF NO COMMA - LIST LINE
SX7 X1+B1 SKIP COMMA
SA7 A1
EQ RETURN PROCESS NEXT NAME
REWIND SPACE 4,10
*** REWIND FNAME,FNAME,...,FNAME
*
* REWIND FILE(S) *FNAME*.
REWIND RJ SAF SET ALTERNATE FILE
SA6 A SET FILE NAME
REWIND A,R REWIND FILE
SA1 CH CHECK NEXT CHARACTER
BX6 X6-X6 CLEAR ALTERNATE FILE
SA2 X1
SB2 X2-1R,
SA6 A
NZ B2,RDD4 IF NO COMMA - LIST LINE
SX7 X1+B1 SKIP COMMA
SA7 A1
EQ REWIND PROCESS NEXT NAME
SKIP SPACE 4,10
*** SKIP FNAME
*
* SKIP 1 RECORD ON FILE *FNAME*.
SKIP SPACE 4,10
*** SKIP FNAME,N
*
* SKIP *N* RECORDS ON FILE *FNAME*.
SKIP SX6 B0+ SET FORWARD FLAG
SKP1 SA6 T2
RJ SAF SET ALTERNATE FILE
SA1 CH CHECK NEXT CHARACTER
SA2 X1
SX6 X1+B1
SB2 X2-1R
ZR B2,SKP2 IF BLANK
NE B2,B1,ERR1 IF NOT COMMA
SA6 A1
RJ ASD ASSEMBLE RECORD COUNT
SB2 X7
SKP2 SA1 T1 SET FILE NAME
SA5 T2
LX6 X1
BX7 X7-X7 SEND SKIPPING MESSAGE
SA6 A
SA7 RAFA+1
MESSAGE A7-B1,1
NZ X5,SKP3 IF BACKSPACE
SKIPF A,B2,R
EQ RDD4 EXIT
SKP3 SKIPB A,B2,R
EQ RDD4 EXIT
SKIPR SPACE 4,10
*** SKIPR FNAME,RNAME
*
* SKIP RECORDS ON FILE *FNAME* THROUGH RECORD *RNAME*.
SKIPR RJ SAF SET ALTERNATE FILE
SA1 CH CHECK NEXT CHARACTER
SA2 X1
SX6 X1+B1
SB2 X2-1R,
NZ B2,ERR1 IF NOT COMMA
SA6 A1 SKIP COMMA
RJ ASN ASSEMBLE RECORD NAME
BX5 X6
SA1 T1 SET FILE NAME
BX7 X1
SA7 A
SKR1 READ A BEGIN READ
READW X2,BUF,BUFL
MI X1,SKR3 IF EOF
SX1 B6 LWA+1 OF DATA READ
SX2 BUF SET RECORD TYPE
RJ SRT SET RECORD TYPE
BX0 X7 SAVE NAME
SA7 RAFA+1
MESSAGE A7-B1,1
SKR2 READW A,BUF,BUFL
ZR X1,SKR2 IF NOT EOR/EOF/EOI
BX7 X0-X5 COMPARE NAMES
NZ X7,SKR1 IF NO MATCH
EQ RDD4 EXIT
SKR3 SX6 =C*RECORD NOT FOUND.*
SA6 ERRM
EQ RDD4
CRD SPACE 4,10
** CRD - CONDITIONALLY READ DIRECTORY.
*
* USES ALL.
*
* CALLS RDR.
CRD SUBR ENTRY/EXIT
SA1 DL
PL X1,CRDX IF DIRECTORY ALREADY READ - RETURN
SA5 P+7
RJ RDR READ DIRECTORY
NZ X0,ABT IF ERRORS IN OPL
SA1 L.TDKN SET ORIGINAL DECK TABLE LENGTH
BX6 X1
SA6 DL
EQ CRDX RETURN
RDR SPACE 4,20
** RDR - READ DIRECTORY FROM PROGRAM LIBRARY.
*
* CHECK PROGRAM LIBRARY FORMAT. READ DECK NAME TABLE.
*
* ENTRY (A5) - ADDRESS OF FILE NAME.
* (X5) - FILE NAME.
*
* EXIT (X0) - 0, IF NO ERRORS.
* (A0) - ADDRESS OF ERROR MESSAGE, IF ERROR.
*
* USES ALL.
*
* CALLS ABT, ADW, ATS, RDW=.
RDR5 SA0 =C* ERROR IN DIRECTORY.*
RDR6 SX0 B1+ ERROR RETURN
RDR SUBR ENTRY/EXIT
BX0 X0-X0 CLEAR ERROR
ZR X5,RDRX IF NO PROGRAM LIBRARY - RETURN
RECALL M
BX6 X5
SA6 X2
SKIPEI X2
SKIPB M,2 BACKSPACE OVER DIRECTORY
READ M
READW X2,TIDT,TIDTL READ IDENT TABLE
SA0 =C* PROGRAM LIBRARY EMPTY.*
NZ X1,RDR6 IF EOR - FILE NOT FOUND
SA1 TIDT
LX1 18
SA2 A1+B1
SB2 X1-770000B
NZ B2,RDR5 IF NO IDENT TABLE
BX6 X2 SET PROGRAM LIBRARY NAME
SA6 PL
READW M,T1,1 READ FIRST WORD
NZ X1,RDR5 IF EOR
SA1 T1
SX5 X1 SET DIRECTORY LENGTH
LX1 18
SB2 X1-700000B
NZ B2,RDR5 IF NOT DIRECTORY
ZR X5,RDR5 IF EMPTY
ALLOC TNDK,X5,S ALLOCATE TABLE SLACK FOR LARGE BLOCK
RDR2 READW M,T1,2 READ RECORD NAME
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 TNDK,X1 ENTER DECK NAME
SA1 T2 ENTER RANDOM INDEX
ADDWRD A0,X1
RDR4 SX5 X5-2
NZ X5,RDR2 IF NOT AT END OF DIRECTORY
SX5 A5 ADD DECKS
RJ ADK ADD DECK
RECALL M RESET SCRATCH BUFFER
SA1 X2+B1
SA2 M+7
SX6 X1
BX7 X2
SA6 A1+B1
SA6 A6+B1
SA7 A1-B1
BX0 X0-X0
EQ RDRX RETURN
SAF SPACE 4,15
** SAF - SET ALTERNATE INPUT FILE.
*
* EXIT (X6) - FILE NAME AND STATUS.
* (X7) - FILE NAME, ZERO FILL.
* (T1) - FILE NAME AND STATUS.
*
* USES X - 0, 1, 3, 6, 7.
* A - 1, 6.
* B - 2, 6, 7.
*
* CALLS ASN.
SAF SUBR ENTRY/EXIT
SA1 A
ZR X1,SAF1 IF ALTERNATE FILE NOT ACTIVE
SX6 =C*OPERATION INCORRECT FROM ALTERNATE INPUT.*
EQ ERR
SAF1 RJ ASN ASSEMBLE NAME
ZR X6,ERR2 IF NO NAME - FORMT ERROR
MX0 42
SB6 FETS SET FET SEARCH
SB7 FETSL
SB2 FETLEN+FETODL
SAF2 SA1 B6 READ FET NAME
BX3 X6-X1
SB6 B6+B2
BX7 X0*X3
NZ X7,SAF3 IF NO MATCH
SX6 =C*RESERVED FILE NAME.*
EQ ERR
SAF3 NE B6,B7,SAF2 IF MORE FETS TO PROCESS
SX1 B1 SET CODED FILE STATUS
BX7 X0*X6
IX6 X7+X1
SA6 T1 SET NEW FILE NAME
EQ SAFX RETURN
WTF SPACE 4,12
** WTF - WRITE LINE TO TEXT FILE.
*
* ADD LINE TO TEXT TABLE, IF NOT FULL. OTHERWISE WRITE TO
* TEXT FILE.
*
* USES X - 1, 2, 3, 4, 6.
* A - 0, 1, 2, 3, 4, 6.
* B - 2, 3.
*
* CALLS ATS, CCD.
WTF SUBR ENTRY/EXIT
SA1 CDWC ADVANCE FTEXT ADDRESS
SA2 T+5
SA3 T CHECK FTEXT FILE
IX6 X1+X2
SA6 A2
NZ X3,WTF2 IF TEXT FILE BEGUN
ALLOC TTXT,X1 ALLOCATE ROOM
SA4 T
SA1 CDWC
NZ X4,WTF2 IF TEXT FILE BEGUN
SB3 X1
IX3 X2+X3
SB2 B0
IX4 X3-X1
SA1 CDTX
WTF1 BX6 X1 COPY TEXT LINE
SA6 X4+B2
SB2 B2+B1
SA1 A1+B1
NE B2,B3,WTF1 IF NOT AT END OF LINE
EQ WTFX RETURN
WTF2 WRITEW T,CDTX,X1
EQ WTFX RETURN
SPACE 4
** ADDITIONAL COMMON DECKS.
*CALL COMCSRT
SPACE 4
** INPUT DIRECTIVE PROCESSOR TABLE.
HERE
CON 0 END OF TABLE
IDENT SPACE 4
IDENT
QUAL PRESET
ERR SPACE 4,4
ERRMI PBUF+PBUFL-* DIRECTIVE PROCESSOR OVERFLOWS INTO PRESET
PRESET TITLE MODIFY PRESET.
PRS SPACE 4,10
** PRS - PRESET MODIFY.
*
* ENTRY (A0) - FL.
*
* USES X - 1, 2, 4, 6.
* A - 0, 1, 2, 4, 6.
* B - 4, 5.
*
* CALLS ARG, IAF, ICS, IVI, IXQ, IZI, PCV, SMM, SOF.
*
* MACROS CLOCK, DATE, GETFLC, GETPP, WRITEC.
PRS SUBR ENTRY/EXIT
BX6 X0 SAVE *ECS* FIELD LENGTH
SA6 EFL
SX6 A0-10B
SA6 FL SET FIELD LENGTH
GETFLC SFL
SA1 SFL
MX2 -12
LX1 -36
BX6 -X2*X1 LAST COMMAND FL
LX6 6 *100
SX1 CMFL COMPARE DEFAULT FL
LX1 6
IX2 X1-X6 DEFAULT - LAST COMMAND FL
NG X2,PRS1 IF LAST COMMAND FL .GT. DEFAULT FL
BX6 X1
PRS1 SA6 A1+ SET FL
DATE DATE REQUEST DATE
SA1 DATE SET DATE IN SHORT TITLE
BX6 X1
SA6 TERDT
SA1 ACTR SET ARGUMENT COUNT
SA2 DATE SET DATE IN IDENT TABLE
SB4 X1
BX6 X2
SA6 TIDT+2
CLOCK TIME REQUEST TIME
SA1 TIME SET TIME IN SHORT TITLE
BX6 X1
SA6 TERTM
SB5 ARGT AGRUMENT TABLE ADDRESS
SA4 ARGR FIRST ARGUMENT
RJ ARG PROCESS ARGUMENTS
SA0 =C* ERROR IN MODIFY ARGUMENTS.*
NZ X1,ABT1 IF ARGUMENT ERROR
RJ SOF SET OUTPUT FORMAT
RJ SMM SET MODIFICATION MODE
RJ IAF INITIALIZE ALL FILES
RJ IXQ INITIALIZE *X* OR *Q* MODE PARAMETERS
ZR X1,ABT1 IF ERROR IN *Q* OR *X* MODE
RJ PCV PROCESS CONVERSION OPTION
NZ X4,ABT1 IF ERROR IN *CV* OPTION
RJ IZI INITIALIZE *Z* MODE INPUT
RJ IVI INITIALIZE VARIOUS ITEMS
RJ ICS INITIALIZE CHARACTER SET
NZ X6,ABT1 IF INCORRECT CHARACTER SET SPECIFIED
GETPP BUF,LL,BUF GET PAGE SIZE PARAMETERS
RJ IOD INITIALIZE OPTICAL DISK FET EXTENSIONS
SA1 TO
ZR X1,PRSX IF TERMINAL OUTPUT
WRITEC O,BUF WRITE PRINT DENSITY FORMAT CONTROL
EQ PRSX RETURN
TITLE ARGUMENT TABLE AND PRESET TEMPORARIES.
ARGT SPACE 4,10
** ARGT - ARGUMENT TABLE.
ARGT BSS 0
A ARG -NSN,AM COMPRESSED COMPILE
BL ARG -NSN,BL BURSTABLE LISTING
C ARG C,C COMPILE FILE
CB ARG CASD,CASD,400B *CB* OPTION
CG ARG NGTXT,CASF,400B *CG* OPTION
CL ARG CLO,CASC,400B *CL* OPTION
CS ARG CASE,CASE,400B *CS* OPTION
CV ARG CVT,CVT CONVERSION OPTION
D ARG -NSN,DB DEBUG MODE
F ARG -NSN,FM FULL MODIFY MODE
I ARG I,I INPUT FILE
L ARG O,O LIST OUTPUT FILE
LO ARG LO,LO,400B LIST OPTIONS
N ARG NNPL,N NEW PROGRAM LIBRARY
NR ARG -NSN,NR *NR* OPTION
P ARG P,P PROGRAM LIBRARY
Q ARG NASSM,QM *Q* OPTION
S ARG NSOURCE,S SOURCE FILE
U ARG -NSN,UM *U* MODE
X ARG NASSM,XM *X* MODE
Z ARG -*,ZM *Z* MODE
ARG
SPACE 4,10
** PRESET TEMPORARIES.
NNPL CON 0LNPL+3
NSOURCE CON 0LSOURCE+1
NASSM CON 0LCOMPASS
NGTXT CON 0LSYSTEXT
NSN CON 1
CLO CON 0LOUTPUT
TITLE MODIFY PRESET SUBROUTINES.
IAF SPACE 4,20
** IAF - INITIALIZE ALL FILES.
*
* CHECK FOR FILE NAME CONFLICTS AND INITIALIZE ALL FILES.
*
* USES X - 0, 1, 2, 3, 4, 6, 7.
* A - 0, 1, 2, 3, 4, 6, 7.
* B - 2, 5, 6, 7.
IAF SUBR ENTRY/EXIT
* CHECK FOR FILE NAME CONFLICTS.
SB6 FETS INITIALIZE FOR FET SEARCH
SB7 FETSL
MX0 42
SB2 FETLEN+FETODL LENGTH OF EACH FET+EXTENSION
SA0 =C* FILE NAME CONFLICT.*
IAF1 SA1 B6+ OUTER SEARCH LOOP
SB5 B6+B2 ADVANCE TO NEXT FET
BX1 X0*X1 CLEAR C/S BITS
IAF2 SA2 B5+ INNER SEARCH LOOP
BX2 X0*X2 CLEAR C/S BITS
BX7 X2-X1 COMPARE
ZR X2,IAF3 IF FILE NOT DEFINED
ZR X7,ABT1 IF FILE NAMES COMPARE
IAF3 SB5 B5+B2 ADVANCE INNER SEARCH LOOP
LT B5,B7,IAF2 IF SEARCH NOT COMPLETE
SB6 B6+B2
NE B6,B7,IAF1 IF NOT COMPLETE
* INITIALIZE FILES.
SA1 O SET UP FOR INTERACTIVE I/O
BX6 X0*X1
SX2 A1 ADDRESS OF FET
BX7 X7-X7
IX6 X6+X2
R= A6,ARGR
SA7 A6+B1
EVICT A,R
EVICT M,R
SA1 S CHCK FOR SOURCE REQUESTED
ZR X1,IAF4 IF NOT SOURCE FILE
REWIND A1
SA1 AM CHECK FOR *A*, *X* OR *Q* SELECTED
SA2 XM
SA3 QM
SA0 =C* S OPTION INCORRECT WITH X, Q, OR A.*
BX4 X1+X2
BX4 X4+X3
NZ X4,ABT1 IF EITHER *A*, *X*, OR *Q* SELECTED
SX7 CBUF+CBUFL REDUCE COMPILE FILE BUFFER LENGTH
SA7 C+4
IAF4 SA1 N CHECK FOR NEW PROGRAM LIBRARY
ZR X1,IAF5 IF NO NEW PROGRAM LIBRARY
BX6 X1 SAVE FILE NAME
SA6 N+7
EVICT A1,R
IAF5 SA1 NR CHECK FOR *NR* SELECTED
NZ X1,IAF6 IF *NR* SELECTED
REWIND C,R
IAF6 SA1 P SAVE OLD PROGRAM LIBRARY FILE NAME
BX6 X1
BX7 X7-X7 CLEAR SCRATCH FILE NAME
SA6 P+7
SA7 A
EQ IAFX
SPACE 4
** IOD - INITIALIZE OPTICAL DISK FET EXTENSIONS.
*
* USES X - 0, 1, 2, 3, 6, 7.
* A - 1, 2, 3, 6, 7.
* B - 6, 7.
IOD SUBR ENTRY/EXIT
* CHECK FOR OPTICAL DISK FILE AND SET EXTENSION.
SX6 FETS INITIALIZE FOR FET SEARCH
IOD1 SA1 X6 LOAD FIRST FET WORD
MX0 42
SA6 IODA
SX6 X6-M
ZR X6,IOD1.1 IF FILE M
SA2 IODB
BX3 X0*X1 FILE NAME
SX2 X2
BX6 X3+X2
SA6 A2
FILINFO IODB GET FILE INFORMATION
SA3 IODB+1 GET DEVICE TYPE AND STATUS
AX3 48
SX2 X3-2ROD OPTICAL DISK DEVICE TYPE
NZ X2,IOD2 IF NOT OPTICAL DISK DEVICE
IOD1.1 SA2 IODA
SX7 FETODL OPTICAL DISK FET EXTENSION LENGTH
SX3 X2+12B SET OPTICAL FET BUFFER AFTER FET
LX7 18
BX7 X3+X7
SA7 X2+11B STORE POINTER AND LENGTH
OPEN X2,READNR,R
IOD2 SX0 FETLEN+FETODL
SA2 IODA
IX6 X2+X0
SB6 X6
SB7 FETSL
LT B6,B7,IOD1 IF FET SCAN NOT COMPLETE
SB6 0
SB7 FETODL
IOD3 SA1 B6+P+FETLEN MOVE P FET EXTENSION TO M
BX6 X1
SA6 B6+M+FETLEN
SB6 B6+B1
NE B7,B6,IOD3 IF NOT DONE WITH MOVE
EQ IODX RETURN
IODA BSSZ 1 FET ADDRESS STORAGE
IODB VFD 42/0,6/5,12/1 *FILINFO* PARAMETER BLOCK
BSSZ 5
ICS SPACE 4,20
** ICS - INITIALIZE CHARACTER SET.
*
* CHECK AND INITIALIZE CHARACTER SET AND
* ENSURE COMPRESSED COMPILE FILE IS NOT IN USE.
*
* ENTRY (CSR) = CHARACTER SET NAME.
*
* EXIT (X6) = 0, IF NO ERROR ENCOUNTERED.
* (A0) = ADDRESS OF ERROR MESSAGE, IF APPROPRIATE.
* (CSC) = CURRENT CHARACTER SET.
*
* USES X - 1, 2, 3, 4, 6, 7.
* A - 1, 2, 7.
* B - NONE.
*
* MACROS TSTATUS.
*
* CALLS RCS, STF.
ICS SUBR ENTRY/EXIT
SA2 I
MX3 42
BX4 X3*X2
ZR X4,ICS2 IF *Z* INPUT
SX2 A2
RJ STF
NZ X6,ICS2 IF NOT CONNECTED *INPUT* FILE
TSTATUS ICSA GET TERMINAL CHARACTER SET
MX3 -1
SA2 ICSA+1
LX2 -2
BX1 -X3*X2 (X1) = 0 FOR DISPLAY, 1 FOR ASCII
BX6 -X1
SA6 TI TERMINAL INPUT CHARACTER SET FLAG
ICS2 RJ /DIRECT/RCS RESET CHARACTER SET
SA0 X6 SET POSSIBLE ERROR MESSAGE
EQ ICSX RETURN
ICSA BSSZ 2 TSTATUS RETURN BLOCK
IVI SPACE 4,15
** IVI - INITIALIZE VARIOUS ITEMS.
*
* SPACE FILL COMMAND, PRESET DECK INENTIFIER TABLE
* AND SET ASSUMED MODIFIER NAME.
*
* USES X - 1, 6.
* A - 0, 1, 6.
* B - 4, 5.
*
* CALLS ADW, SFN.
IVI SUBR ENTRY/EXIT
SB4 B0+ BLANK FILL COMMAND
SB5 8
IVI1 SA1 CCDR+B4
RJ SFN SPACE FILL NAME
SB4 B4+B1
SA6 A1
NE B4,B5,IVI1 IF NOT COMPLETE
BX6 X6-X6
SA6 A6+B1 SET END OF LINE
ADDWRD TDKI,X6-X6 PRESET DECK IDENTIFIER TABLE
SA1 =7L******* SET ASSUMED MODIFIER NAME
ADDWRD TNME,X1
ADDWRD A0,X6-X6
EQ IVIX RETURN
IXQ SPACE 4,20
** IXQ - INITIALIZE *X* OR *Q* MODE PARAMETERS.
*
* ENTRY (XM) - COMMAND *X* MODE PARAMETER.
* (QM) - COMMAND *Q* MODE PARAMETER.
* (ZM) = CONTROL STATEMENT *Z* MODE PARAMETER.
*
* EXIT (X1) - 0, IF ERROR ENCOUNTERED.
* (A0) - ADDRESS OF ERROR MESSAGE, IF APPROPRIATE.
*
* USES X - ALL.
* A - ALL.
* B - 2.
*
* CALLS SFN, ZTB.
*
* MACROS REWIND.
IXQ4 SX1 B1+
IXQ SUBR ENTRY/EXIT
SA1 XM CHECK *X* OR *Q* SELECTED
SA2 QM
BX1 X1+X2
MX0 -6
ZR X1,IXQ4 IF NEITHER SELECTED
RJ SFN SPACE FILL ASSEMBLER NAME
BX6 X0*X6
SX7 1R(
BX6 X6+X7
SA1 C SET COMPILE FILE NAME
MX2 42 CLEAR C/S BITS
BX1 X2*X1
SA0 =C* X OR Q INCORRECT WITHOUT COMPILE.*
ZR X1,IXQX IF NO COMPILE FILE
SA7 AM SELECT MODIFY *A* MODE
SA2 LO CHECK USER SELECTED LIST OPTIONS
SA6 CASG SET ASSEMBLER NAME
NZ X2,IXQ1 IF USER SELECTED LIST OPTION
SX7 1S"LO.E" SELECT ERROR LIST
SA7 LO SET LIST OPTION
IXQ1 SA5 IXQA SET UP PARAMETER STENCIL
SA4 =0L0
LX1 -12 MOVE ASSEMBLER INPUT FILE NAME INTO PLACE
BX1 X1+X5 OVERLAY WITH STENCIL
RJ ZTB CONVERT ZEROES TO BLANKS
SA1 CASC GET LIST OPTION SPECIFIED
SA6 A6+B1 SET ASSEMBLER LIST OPTION
SA5 A5+B1 SET UP STENCIL FOR ASSEMBLER LIST OPTION
BX7 X4-X1 CHECK FOR DISPLAY *0*
NZ X7,IXQ2 IF COMPASS LIST SELECTED
SA7 CMNF CLEAR COMPILE FILE COMMENTS FLAG
IXQ2 LX1 -12 POSITION ARGUMENT
BX1 X1+X5 OVERLAY WITH STENCIL
RJ ZTB CONVERT ZEROES TO BLANKS
SA1 CASD ASSLEMBLER BINARY OUTPUT FILE
SA6 A6+B1 SET LIST OPTION
SA5 A5+B1 BINARY OUTPUT PARAMETER STENCIL
LX1 -12 POSITION ARGUMENT
BX1 X1+X5
RJ ZTB CONVERT ZEROES TO BLANKS
SA1 CASE ASSEMBLER *S* OPTION
SA6 A6+B1 BINARY OUTPUT FILE NAME
SA5 A5+B1
LX1 -12
BX1 X1+X5
RJ ZTB CONVERT ZEROES TO BLANKS
SA1 CASF ASSEMBLER *G* OPTION
SA5 A5+B1
BX2 X4-X1
ZR X2,IXQ3 IF *G* NOT SELECTED
SA4 IXQB CLEAR *S* IF *G* SELECTED
BX6 X4
IXQ3 SA6 A6+B1 *S* OPTION TO COMMAND
LX1 -12 SET *G* OPTION
BX1 X1+X5
RJ ZTB CONVERT ZEROES TO BLANKS
SX7 2RA)
SA6 A6+B1 *G* OPTION TO COMMAND
LX7 48
SA1 XM CHECK FOR MODIFY *X* MODE
SA7 A6+B1 COMMAND TERMINATOR
ZR X1,IXQ4 IF *X* NOT SELECTED - RETURN
REWIND O REWIND OUTPUT FILE
SA1 ZM CHECK FOR MODIFY *Z* MODE
NZ X1,IXQX IF SELECTED
REWIND I REWIND INPUT FILE
EQ IXQ4 RETURN
IXQA CON 2LI=+1R, INPUT COMMAND STENCIL
CON 2LL=+1R, LIST COMMAND STENCIL
CON 2LB=+1R, BINARY OUTPUT COMMAND STENCIL
CON 2LS=+1R, *S* OPTION COMMAND STENCIL
CON 2LG=+1R, *G* OPTION COMMAND STENCIL
IXQB CON 10HS=0 ,
IZI SPACE 4,20
** IZI - INITIALIZE *Z* MODE INPUT.
*
* CLEARS THE FILE NAME IN THE *INPUT* FILE FET AND
* ENTERS THE *Z* DIRECTIVES IN THE *INPUT* FILE
* CIRCULAR BUFFER.
*
* ENTRY (ZM) = NONZERO IF *Z* MODE SELECTED.
*
* EXIT (I) = FILE NAME CLEARED.
* = CIRCULAR BUFFER PRESET WITH CONTROL STATEMENT
* *Z* MODE DIRECTIVES.
*
* USES A - 2, 6.
* X - 2, 6.
* B - 2, 3.
*
* CALLS ZAP.
IZI SUBR ENTRY/EXIT
SA2 ZM CHECK FOR *Z* MODE
ZR X2,IZIX IF NOT SELECTED, RETURN
SA2 I CLEAR *INPUT* FILE NAME
MX6 -18
BX6 -X6*X2
SA6 A2
SX2 A2 SET FET ADDRESS FOR *ZAP*
RJ ZAP PROCESS *Z* MODE DIRECTIVES
SA2 IW
SX6 1R CLEAR INPUT BUFFER
SB2 CHAR+X2
SB3 CHAR+IWMAX
IZI1 EQ B2,B3,IZIX IF COMPLETE
SA6 B2
SB2 B2+B1
EQ IZI1 CONTINUE CLEARING BUFFER
PCV SPACE 4,15
** PCV - PROCESS *CV* OPTION.
*
* ENTRY (CVT) - .NE. 0, IF *CV* OPTION SELECTED.
*
* EXIT (X4) - 0, IF NO ERROR.
* (A0) - ADDRESS OF ERROR MESSAGE, IF APPROPRIATE.
*
* USES X - ALL.
* A - 0, 1, 5, 6.
* B - 2, 3, 4, 5, 7.
*
* CALLS DXB.
PCV1 SA1 CSMR SET NEW PROGRAM LIBRARY CHARACTER SET
SX6 64B
MI X1,PCV2 IF SYSTEM IS 64 CHARACTER SET
SX6 B0+
PCV2 SA6 CNPL CHARACTER SET OF NEW PROGRAM LIBRARY
PCV SUBR ENTRY/EXIT
SA5 CVT CHECK FOR CONVERSION SPECIFIED
BX4 X4-X4 CLEAR ERROR
SB7 B0 SET OCTAL BASE
ZR X5,PCV1 IF NO CONVERSION SPECIFIED
SA1 MAD64
BX1 X5-X1 COMPARE CVT AND MAD64
NZ X1,PCV0 IF MAD64 NOT SPECIFIED
SX6 B1
SA6 MADCV SET MADIFY CONVERSION FLAG
SA1 MOD64
BX6 X1
SA6 CVT TREAT AS 63 TO 64 CONVERSION
BX5 X6 UPDATE X5 AS WELL
PCV0 BSS 0
RJ DXB CONVERT TO BINARY
SA0 =C* CV OPTION INCORRECT.*
NZ X4,PCVX IF INCORRECT *CV* OPTION
SA6 A5+ SET OPTION
SB2 X6-63B CHECK OPTION
BX6 X6-X6
SA6 C CLEAR COMPILE FILE IF CONVERTING
ZR B2,PCV2 IF *63*
SX6 64B
EQ B1,B2,PCV2 IF *64*
SX4 B1+ SET ERROR
EQ PCVX IF NOT *64* OR *63*
MAD64 CON 5LMAD64
MOD64 CON 2L64
SLC SPACE 4,20
** SLC - SET LIST CONTROL.
*
* EXIT (LO) INITIALIZED.
*
* USES X - ALL.
* A - 0, 1, 3, 6, 7.
* 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* -LO- ERROR MUST BE IN -ECTMWDSIA-.*
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
SMM SPACE 4,20
** SMM - SET MODIFICATION MODE.
*
* SET MODIFICATION MODE ACCORDING TO *F* AND
* *U* OPTIONS. THE *F* OPTION OVER-RIDES THE
* *U* OPTION.
*
* EXIT (UM) INITIALIZED.
*
* USES X - 1, 2, 6.
* A - 1, 2, 6.
SMM SUBR ENTRY/EXIT
SA1 FM
SA2 UM
BX6 X6-X6 SET TO CLEAR *U* MODE
NZ X1,SMM1 IF *F* MODE SELECTED
BX6 X2 RESET *U* MODE
SMM1 SA6 A2 CLEAR/SET *U* MODE
EQ SMMX RETURN
SOF SPACE 4,20
** SOF - SET OUTPUT FORMAT.
*
* SET TERMINAL OUTPUT FLAG AND DEFAULT LIST OPTIONS.
*
* ENTRY (LO) = CONTROL STATEMENT *LO* PARAMETERS.
* = 0 IF OMITTED.
*
* EXIT (LO) = LIST OPTION BIT MAP.
* = DEFAULT OPTIONS IF OMITTED FROM
* CONTROL STATEMENT.
* (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.
SA1 XM
NZ X1,SOF2 IF *X* PARAMETER SELECTED
SA2 SOFB SET *X* DEFAULT OPTIONS
* PROCESS SPECIFIED OR DEFAULT OPTIONS.
SOF2 SA1 LO READ CONTROL STATEMENT 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 0LECTMWDS DEFAULT NON-TERMINAL OPTIONS
COMMON SPACE 4,10
** PRESET COMMON DECKS.
QUAL$ EQU 1 PREVENT QUALIFICATION
*CALL COMCARG
*CALL COMCCPM
*CALL COMCSTF
*CALL COMCUSB
*CALL COMCZAP
*CALL COMCZTB
MODIFY TTL MODIFY - SOURCE LIBRARY EDITING PROGRAM.
SPACE 4
*CALL COMCLFM
END MODIFY SOURCE LIBRARY EDITING PROGRAM