TITLE 'TELEFILE ASSEMBLY PROGRAM - APDG'
PCC 0
SPACE 6
* %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
* %%%%% MODULE NAME: APDG %%%%%
* %%%%% LAST UPDATED: MAR 07, 1984 %%%%%
* %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SPACE 2
SPACE 12
* T E L E F I L E P R O P R I E T A R Y P R O D U C T
SPACE 2
* THIS DOCUMENT INCLUDES DATA AND INFORMATION WHICH IS CONSIDERED
* PROPRIETARY TO TELEFILE COMPUTER PRODUCTS, INC. REPRODUCTION,
* DUPLICATION, DISCLOSURE OR DISSEMINATION, IN WHOLE OR IN PART,
* TO OTHERS THAN REPRESENTATIVES OF THE UNITED STATES GOVERNMENT
* SHALL NOT BE MADE WITHOUT PRIOR WRITTEN AUTHORIZATION OF TELEFILE
* COMPUTER PRODUCTS, INC. NOTWITHSTANDING THE FOREGOING, USE OF
* THE DATA OR INFORMATION IN WHOLE OR IN PART FOR DESIGN,
* PROCUREMENT OR MANUFACTURE IS STRICTLY FORBIDDEN.
PAGE
SPACE 12
* T E L E F I L E P R O P R I E T A R Y P R O D U C T
SPACE 2
* THIS DOCUMENT INCLUDES DATA AND INFORMATION WHICH IS CONSIDERED
* PROPRIETARY TO TELEFILE COMPUTER PRODUCTS, INC. REPRODUCTION,
* DUPLICATION, DISCLOSURE OR DISSEMINATION, IN WHOLE OR IN PART,
* TO OTHERS THAN REPRESENTATIVES OF THE UNITED STATES GOVERNMENT
* SHALL NOT BE MADE WITHOUT PRIOR WRITTEN AUTHORIZATION OF TELEFILE
* COMPUTER PRODUCTS, INC. NOTWITHSTANDING THE FOREGOING, USE OF
* THE DATA OR INFORMATION IN WHOLE OR IN PART FOR DESIGN,
* PROCUREMENT OR MANUFACTURE IS STRICTLY FORBIDDEN.
PAGE
DGPROC CSECT 1 PROCEDURE
DEF BOBUF
DEF DEFGEN
DEF DG
DEF DGD
*
DEF BOUND4
DEF DEFHEXLBL
DEF DEFINE2
DEF DELETEXP
DEF GETPLOC1
DEF LCLDLTE
DEF LENGTH
DEF LINE%FLDS
DEF LITSRCH
DEF LOADXM
DEF LOADXW
DEF MAXLOC
DEF NXTRECRD
DEF OLDCSECT
DEF SCAN
DEF SUBVAL
*
* ROOT MODULE
*
REF ABORT
REF BLANC
REF BO%FLAG BINARY OUTPUT OPTION FLAG
REF BO%SIZE BINARY RECORD SIZE
REF LSTBF
REF MAJLINE ASSEMBLY LINE NUMBER
REF PGLINES
REF POSITIONSTD
REF POSITIONX1
REF RD%STD
REF READSTD
REF READX1
REF ROOTRTN
REF SD%FLAG
REF SUBLINE ASSEMBLY UPDATE LINE NUMBER
REF SYSLEVEL
REF SYSNAME
REF TITLEBUF
REF X1BUF
*
* PARTICULARIZATION SEGMENT
*
REF ADJKLINE
REF ADV%ITM
REF PARTIC
*
* ASSEMBLER COMMON MODULE
*
REF AEDIT
REF BEDIT
REF CERR
REF DERR
REF EDIT
REF EDITDDLR
REF EDITDLR
REF EDITV
REF EDITV1
REF EERR
REF GENERATE
REF GENERATE1
REF GENERATE2
REF GETCSADD
REF HILIMIT
REF HILIMIT4
REF IERR
REF KERR
REF LERR
REF LOADABS
REF ORIGIN
REF PRINT
REF PRINTC
REF PRINTC1
REF PRINTC2
REF SERR
REF TERR
REF TYPE
REF UERR
*
SYSTEM AP%IL
SYSTEM AP%DG
PAGE
*
* STORAGE
*
*
TITLEPG EQU TITLEBUF+24 FOLLOWS LAST WORD OF TITLE CHARS
INBUF EQU X1BUF BUFFER FOR ENCODED INPUT
DGD EQU XAPDATA
PAGE
USECT DGPROC
DIRBASE RES 0
COMBASE RES 0
DG RES 0
ZERO DATA,8 0 DOUBLE WORD OF ZERO
RNG%INT%FUNC# ; INTRINSIC FUNCTION NUMBERS
DATA LO%INT%FUNC,HI%INT%FUNC
RNG%LOC%CTR ; % AND %% SYMBOLS
DATA ENC%,ENC%%
RNG%PREFIX%FUNC ; FUNCS W/ ACTION PRIOR TO ARG EVAL.
DATA LO%PREFIX%FUNC+ENCSSYM,HI%PREFIX%FUNC+ENCSSYM
RNG%STD%FUNC ; FUNCS NOT REQ VALUE
DATA LO%VAL%FUNC|ENCSSYM,HI%INT%FUNC|ENCSSYM
RNG%TCOR%SYM ; SPECIAL SYMBOLS IN 'TCOR' FUNCTION
DATA S:AADSYM,S:SUMSYM
RNG%VAL%FUNC ; FUNCTIONS EVALUATED IN SCAN
DATA LO%VAL%FUNC+ENCSSYM,HI%VAL%FUNC+ENCSSYM
*
SPILWBND DATA,8 X'FFFFFFFF80000000' SINGLE PRECISION LOWER BOUND
SPIUPBND DATA,8 X'80000000' SINGLE PRECISION UPPER BOUND
SMIUPBND DATA,8 X'400000' SMALL INTEGER UPPER BOUND
DBLONE DATA,8 1 DOUBLE WORD OF ONE
ASTMSG TEXT ' **** '
PAGE
*
* A S E C T
* PROCESSES THE ASECT DIRECTIVE.
*
* USES REGISTERS
* RL
* XT
*
ASECT RES 0
BAL,RL OLDCSECT SAVE CURRENT CONTROL SECTION INFO.
LI,XT 0
STW,XT DLRCS SET TO CONTROL SECTION ZERO
BAL,RL SETDLRS SET CONTROL SECTION, RESOLUTION, AND
* CLEAR VALUES FOR % AND %%
CALL DEFHEXLBL DEFINE LABEL FIELD ENTRY
B LINE5 SKIP REST OF ASECT DIRECTIVE
PAGE
*
* A S S M B D L R
* ASSEMBLE EXECUTION LOCATION COUNTER INTO A SPECIAL ADDRESS
* OR SYMBOL ITEM
* A SPECIAL ADDRESS ITEM IS BUILT IF THE ADDRESS OFFSET WILL
* FIT IN 17 BITS WITH INTRINSIC RESOLUTION, THE LOW ORDER
* BITS ARE 0, AND CONTROL SECTION NUMBER IS LESS THAN 32;
* OTHERWISE, A SYMBOLIC ITEM OF LENGTH 2 IS BUILT.
* THE ITEM IS BUILT IN A TEMP AREA.
* DLRVAL, DLRCS, AND DLRRS CONTAIN THE VALUE, CONTROL SECTION,
* AND INTRINSIC RESOLUTION RESPECTIVELY.
*
* OUTPUT: TEMP AND TEMP+1 (IF NEEDED) CONTAIN THE ITEM BUILT.
*
* CALL: BAL,RL ASSMBDLR
*
* USES REGISTERS
* XT
* XT1
* XT2
* RL
*
ASSMBDLR RES 0
LI,XT2 0
ASDLR RES 0
LW,XT DLRCS
AWM,XT DATAGEN INDICATE % OR %% REFERENCED
LW,XT DLRRS,XT2 GET RESOLUTION
SHIFT,XT 31,ARLOB POSITION RESOLUTION
AW,XT PASSDEF VALUE FOR DEF FIELD
STW,XT TEMP STORE SPA,DUP,SET,DEF,AR, AND EXT.
LW,XT DLRVAL,XT2 LOCATION COUNTER VALUE
AND,XT =MAXDDFLD TRIM LOCATION COUNTER
LCW,XT1 DLRRS,XT2 LOCATION COUNTER RESOLUTION
SCS,XT 0,XT1 SHIFT DLRVAL TO SPECIFIED RESOLUTION
STW,XT TEMP+1 WITH LOW ORDER BIT(S) TO XT(0-2)
LC XT
BCR,14 ASDLR2 LOW ORDER BIT(S)ARE ZERO
ASDLR1 RES 0 BUILD A 2 WORD SYMBOL ITEM
LV,XT1 SYMBOL+LNGTH2
STS,XT1 TEMP STORE AD,STYPE,TYPE, AND LENGTH
LW,XT1 DLRCS,XT2 LOCATION COUNTER CONTROL SECTION
SHIFT,XT1 31,FCSLOB POSITION IT
STS,XT1 TEMP+1 STORE FCS.
EXIT RL
ASDLR2 RES 0
CV,XT ADDFLD ADDRESS FIELD
BG ASDLR1 LARGE ADDRESS REQUIRES TWO WORDS
LW,XT1 DLRCS,XT2 LOCATION COUNTER CONTROL SECTION
CI,XT1 32
BGE ASDLR1 REQUIRES TWO WORD ITEM
* BUILD A ONE WORD SPECIAL ADDRESS ITEM
AV,XT1 1**(CSLOB-SPALOB) SET SPA TO ONE
SHIFT,XT1 31,CSLOB POSITION SPA AND CS FIELDS
AW,XT1 TEMP+1 ADD IN ADDRESS
STS,XT1 TEMP STORE SPA,CS, AND ADD. FIELDS
EXIT RL
PAGE
*
* B L D P L T
* THIS SUBROUTINE BUILDS A PROCEDURE LEVEL TABLE. THE OFFSET
* TO THE PREVIOUS PROCEDURE LEVEL TABLE IS STORED IN THE PLOC
* ENTRY IN THIS TABLE AND VARIOUS ENTRIES ARE INITIALIZED.
*
* INPUT: LVL CONTAINS THE ADDRESS OF THE CURRENT PROCEDURE
* LEVEL TABLE
* XT CONTAINS THE ADDRESS OF THE CONTROL WORD FOR THE
* COMMAND ENTRY
*
* OUTPUT: LVL CONTAINS THE ADDRESS OF THE NEW (AND NOW CURRENT)
* PROCEDURE LEVEL TABLE.
*
* USES REGISTERS
* RL, XT, XT1, LVL
*
BLDPLT RES 0
STW,RL BLDPLTXIT SAVE RETURN ADDRESS
BLDPLT1 RES 0
LW,XW STO,XT GET INDEX TO SAMPLE STORAGE
SLS,XW 1 MAKE IT A HALFWORD INDEX
AV,XW SYMTBASE INDICATE IT'S A SYMT BASE ADDRESS
SW,XT SYMT
AI,XT 2
SLS,XT 1
AV,XT SYMTBASE
STW,XT NAMELOC,LVL SAVE INDEX FOR 'NAME' REFERENCES
BAL,RL LOADXW SET ENCODED TEXT BASE ADDRESS
MTW,1 PROCREF INCREMENT PROCEDURE REFERENCE LEVEL
LW,XT EVT,LVL INDEX TO NEXT EVT ENTRY BECOMES THE
AW,XT KLINE ADDRESS OF NEW PROC LEVEL TABLE
LI,XT1 0
STW,XT1 DOCT,XT INITIALIZE DO COUNT TO ZERO
STW,XT1 DO1CT,XT INITIALIZE DO1 COUNT TO ZERO
STW,XT1 SYSLVL,XT INITIALIZE SYSTEM LEVEL COUNT TO 0
LW,XT1 NXTLOCAL
SW,XT1 SYMT INITIALIZE LOCAL COUNT TO ZERO,
STW,XT1 LOCALORG,XT AND LOCAL ORIGIN INDEX
LW,XT1 ECT,LVL END OF ECT AT PREVIOUS LEVEL BECOMES
STW,XT1 ECTORG,XT ORIGIN OF ECT AT THIS LEVEL
SW,LVL KLINE STORE INDEX TO PREVIOUS PROCEDURE
STW,LVL PLOC,XT LEVEL TABLE
LW,LVL XT NOW LVL POINTS TO THIS PLT
BAL,RL DELETEXP TO INITIALIZE ECT,LVL AND EVT,LVL
BAL,RL HILIMIT MAKE SURE THERE'S ROOM FOR THIS PLT
B *BLDPLTXIT RETURN
PAGE
*
* B O U N D
* THIS ROUTINE PROCESSES THE BOUND DIRECTIVE. EVAL1EXP IS
* CALLED TO EVALUATE THE OPERAND FIELD. THE VALUE RETURNED
* SHOULD BE 1 TO 2048 AND A POSITIVE POWER OF TWO. IF NOT,
* AN ERROR IS MARKED AND BOUND CALLS BOUND4 (ASSUMES A VALUE
* OF 4) AND THEN BRANCHES TO GENR IN MAIN CONTROL. OTHERWISE
* BOUNDN IS CALLED AND BOUND BRANCHES TO GENR.
*
* USES REGISTERS
* RL
* XT
* ER
*
BOUND RES 0
CALL EV1OPRNDEXP EVALUATE ONE OPERAND EXPRESSION
LW,XT TEMP
BLEZ BOUND1 NEGATIVE OR ZERO IS ERROR
CI,XT X'8000'
BG BOUND1 GREATER THAN 32K IS ERROR
AI,XT -1
AND,XT TEMP
BNEZ BOUND1 NOT A POWER OF TWO
BAL,RL BOUNDN ADVANCE LOCATION COUNTERS N BYTES
B GENR BACK TO MAIN CONTROL
BOUND1 RES 0
BAL,RL BOUND4 ADVANCE LOCATION COUNTERS 4 BYTES
EXP%ERR RES 0
BAL,ER EERR ILLEGAL OPERAND
B GENR
*
REPEAT EQU 15 CONTROL BYTE FOR A REPEAT LOAD
PAGE
*
* B O U N D 4
* IS AN ENTRY POINT TO THE CLOSED SUBROUTINE BOUNDN. IT PREPARES
* A 4 BYTE BOUNDRY BY SETTING TEMP TO 4 AND THEN BRANCHES TO
* BOUNDN.
*
* INPUT: NONE
*
* OUTPUT: TEMP IS SET TO 4
*
BOUND4 RES 0
LI,XT 4
STW,XT TEMP
*
* B O U N D N
* ADVANCES THE LOCATION COUNTERS TO THE BYTE BOUNDARY SPECIFIED
* IN TEMP IF NOT ALREADY AT THAT BOUNDRY. IF DLRVAL IS AT THE
* SPECIFIED BOUNDARY, THIS ROUTINE EXITS. OTHERWISE, BOTH
* LOCATION COUNTERS ARE ADVANCED TO THE SAME BOUNDARY, AND
* ZEROS ARE GENERATED IN THE OBJECT MODULE FOR THE BYTES
* ADVANCED.
*
* INPUT: TEMP CONTAINS THE BYTE BOUNDRY TO ADVANCE TO
* DLRVAL AND DDLRVAL CONTAIN THE CURRENT BYTE ADDRESSES
* OF THE EXECUTION AND LOAD LOCATION COUNTERS.
* LASTVAL CONTAINS THE BYTE ADDRESS OF THE LAST LOAD
* LOCATION COUNTER OUPUT TO THE OBJECT MODULE.
*
* OUTPUT: DLRVAL, DDLRVAL, AND LASTVAL ARE SET TO THE SPECIFIED
* BOUNDRY IF NOT ALREADY THERE.
*
* USES REGISTERS
* XT
* RL
* NBYTES
* XT1
*
LOCAL %10
*
BOUNDN RES 0
LW,XT TEMP BOUNDARY
AI,XT -1
AND,XT DLRVAL IF EXECUTION LOCATION COUNTER IS
EXIT,EQ RL AT THE SPECIFIED BOUNDARY,EXIT
SW,XT TEMP
LCW,XT XT NUMBER OF BYTES TO ADVANCE
AWM,XT DLRVAL ADVANCES % TO PROPER BOUNDARY
STW,RL BNDEXIT SAVE RETURN ADDRESS
MTW,0 PASS
BEZ BND1 DEFINITION PASS
STW,XT TEMP
BAL,RL ORIGIN GENERATE ORIGIN IF REQUIRED
MTW,0 SOCW%FLG
IF,NZ
*
* UNDER SOCW CONTROL, IT IS NECESSARY TO ACTUALLY GENERATE ALL
* REQUIRED DATA BYTES OF ZERO, RATHER THAN USING A REPEAT-LOAD.
*
LW,XT TEMP *D-DG
STW,XT NOBYTES # ZERO BYTES REQUIRED *D-DG
%10 RES 0
LI,NBYTES 1
LI,XT1 BA(L(0))
CALL BEDIT
MTW,-1 NOBYTES DECREMENT
BGZ %10
*
ELS
LI,NBYTES 1
LI,XT1 BA(L(REPEAT))+3
BAL,RL BEDIT GENERATE 'REPEAT' CONTROL CODE
LI,NBYTES 2
LI,XT1 BA(TEMP)+2
BAL,RL BEDIT GENERATE REPEAT COUNT
LI,XT1 0
STW,XT1 HEXVAL
LI,XT1 1
STW,XT1 NOBYTES
BAL,RL LOADABS OUTPUT AN ABSOLUTE ZERO
FI
LW,XT TEMP
BND1 RES 0
AWM,XT DDLRVAL ADVANCE LOAD LOCATION COUNTER
AWM,XT LASTVAL AND LAST LOCATION OUTPUT TO OBJECT
B *BNDEXIT
PAGE
*
* C K % P R E F
* IF THE PROCEDURE REFERENCE LEVEL IS NOT LESS THAN THE MAXIMUM
* ALLOWED, AN ERROR IS REPORTED, AND THE COMMAND REFERENCE
* OR FUNCTION REFERENCE IS IGNORED.
*
* INPUT: XT1 CONTAINS THE ADDRESS TO RETURN TO IF THE
* PROCEDURE REFERENCE LEVEL EXCEEDS THE MAXIMUM
*
* OUTPUT: RETURN IS TO CALLING ADDRESS IF NO ERROR
* RETURN TO ADDRESS SPECIFIED IN XT1 IF ERROR
*
* USES REGISTERS
* RL, XT, XT1
*
CK%PREF RES 0
LW,XT PROCREF
CI,XT MAXPREF RETURN IF PROCEDURE REFERENCE
EXIT,L RL LEVEL IS LESS THAN MAXIMUM
BAL,ER KERR PROCS NESTED TOO DEEP
EXIT XT1 ERROR RETURN
PAGE
*
* C L N % E X P
* THIS SUBROUTINE 'DELETES' THE ECT AND EVT ENTRIES PRODUCED BY
* THE LAST CALL TO SCAN.
*
* INPUT: XS CONTAINS A POINTER TO THE 1ST ECT ENTRY
* ECT POINTS TO THE WORD BEYOND ITS LAST ENTRY
* EVT POINTS TO THE WORD BEYOND ITS LAST ENTRY
*
* OUTPUT: XS IS UNCHANGED
* ECT POINTS TO ITS 1ST ENTRY
* EVT POINTS TO ITS 1ST ENTRY
*
* CALL: BAL,RL CLN%EXP
*
* USES REGISTERS
* XS, XT, RL
*
CLN%EXP RES 0
LW,XT 0,XS BACKUP
AND,XT =LOCFLD EVT
STW,XT EVT,LVL TO ITS '1ST' ENTRY
SW,XS KLINE BACKUP
STW,XS ECT,LVL ECT
AW,XS KLINE TO ITS
EXIT RL '1ST' ENTRY
PAGE
*
* C M N D A S N
* THIS SUBROUTINE ASSIGNS A COMMAND WHOSE DEFINITION HAS ALREADY
* BEEN CHECKED BY CMNDDEF.
*
* INPUT: CMNDCW CONTAINS THE CONTROL WORD FOR THE COMMAND
* CMNDLSN CONTAINS THE SYMBOL NUMBER OF THE COMMAND'S
* LABEL FIELD ENTRY
*
* OUTPUT: XT CONTAINS THE ADDRESS OF THE COMMAND ENTRY
* RETURN IS TO THE BAL + 1 FOR THE DEFINITION PASS
* AND TO BAL + 2 FOR THE GENERATION PASS
*
* CALL: BAL,RL CMNDASN
*
* USES REGISTERS
* XT, XT1, XT2, RL
*
CMNDASN RES 0
LW,XT2 CMNDLSN GET SYMBOL # OF COMMAND LABEL
LI,XT1 -1 MASK FOR ENTIRE WORD
LW,XT *SYMT,XT2 GET CONTROL WORD FROM FIXED TABLE
BFNZ,XT SPAFLD,CMNDASN3 BRANCH IF IT'S A ONE WORD ENTRY
LV,XT1 FUNCNAME+LNGTH2
CW,XT1 CMNDCW
BE CMNDASN2 BRANCH IF PROCESSING FUNCTION NAME
LV,XT1 CPTRFLD MASK FOR CPTR FIELD
SHIFT,XT CPTRLOB,31 RIGHT JUSTIFY CPTR
CMNDASN1 RES 0
MTW,0 PASS
BEZ CMNDASN3 BRANCH IF THIS IS DEFINITION PASS
AW,XT SYMT RETURN WITH ADDRESS OF COMMAND
EXIT RL CONTROL WORD IN XT
CMNDASN2 RES 0
LV,XT1 LPTRFLD MASK FOR LPTR FIELD
AND,XT =LPTRFLD CLEAN LPTR RIGHT JUSTIFIED
B CMNDASN1
CMNDASN3 RES 0
LW,XT NXTSYMT CONVERT THE ADDRESS FOR THE COMMAND
SW,XT SYMT ENTRY TO AN OFFSET
BFNZ,XT1,1 LPTRFLD,CMNDASN4 POSITION THE OFFSET TO EITHER
SHIFT,XT 31,CPTRLOB THE LPTR OR THE CPTR FIELD
CMNDASN4 RES 0
STS,XT *SYMT,XT2 STORE OFFSET TO COMMAND ENTRY
LW,XT NXTSYMT GET 2 WORDS OF TABLE SPACE FOR
MTW,2 NXTSYMT THE COMMAND ENTRY
LW,XT1 CMNDCW STORE THE COMMAND CONTROL WORD IN
STW,XT1 0,XT THE FIRST WORD AND EXIT TO
B 1,RL THE BAL INSTRUCTION +2
PAGE
*
* C M N D D E F
* THIS SUBROUTINE CHECKS A COMMAND DEFINITION TO INSURE THAT IT
* IS BOTH CORRECT AND REFERENCED. THE SUBROUTINE DOES NOT
* RETURN TO THE CALLING ROUTINE IF THE COMMAND IS SKIPPED.
*
* INPUT: XT CONTAINS A SKELETON CONTROL WORD
*
* OUTPUT: CMNDCW CONTAINS THE CONTROL WORD FOR THE COMMAND
* CMNDLSN CONTAINS THE SYMBOL NUMBER OF THE COMMAND'S
* LABEL FIELD ENTRY
*
* CALL: BAL,RL CMNDDEF
*
* USES REGISTERS
* XT XT1 XT2 RL ER LVL
CMNDDEF RES 0
STW,XT CMNDCW STORE COMMAND CONTROL WORD
MTW,0 PROCREF
BNEZ SPCD1 ERROR IF WITHIN A PROC
LW,XT LBL,LVL INDEX TO ENCODED LABEL FIELD
NXTENC,XT XT,NOINC GET LABEL FIELD ITEM
LI,XT2 TFLD MASK FOR ENCODED TYPE FIELD
AND,XT2 XT
CI,XT2 ENCSYM
IF,NE -10- DOIF LABEL IS NOT A SYMBOL
BAL,ER LERR
ELS 10.
AND,XT =VFLD GET CLEAN SYMBOL NUMBER
STW,XT CMNDLSN SAVE SYMBOL # OF COMMAND LABEL
LV,XT2 FUNCNAME+LNGTH2
CW,XT2 CMNDCW
IF,NE -20- DOIF NOT FNAME
*
* HERE WE ARE ABOUT TO DEFINE A COMMAND NAME - MAKE SURE IT
* IS NOT A DIRECTIVE. IF IT IS, JUST KICK IT OUT.
*
CI,XT HI%DIR
IF,LE -30- DOIF ATTEMPTING TO DEFINE DIRECTIVE
BAL,ER DERR
B SETSKIPTRIG
*
FI -30-
LW,XT *SYMT,XT LOAD FIXED SYMBOL TABEL ENTRY
BFNZ,XT SPAFLD,SETSKIPTRIG BRANCH IF NOT A CPTR ENTRY
BFZ,XT CPTRFLD,SETSKIPTRIG BRANCH IF COMMAND NOT REF'ED
SHIFT,XT CPTRLOB,31 RIGHT JUSTIFY CPTR
MTW,0 PASS
IF,NZ -40- DOIF GENERATION PASS
CMNDDEF8 RES 0
LW,XT1 *SYMT,XT LOAD COMMAND CONTROL WORD
EXIT,FZ DUPFLD,XT1 EXIT IF DUP NOT SET
BAL,ER DERR DUPLICATE DEFINITION ERROR
BFNZ,XT1,1 COMDFLD,SETSKIPTRIG SKIP THIS DEFINITION IF
AV,XT1 1**(31-COMDLOB) COMMAND IS ALREADY
STW,XT1 *SYMT,XT DEFINED FOR THIS PASS
ELS 40. DOIF DEFINITION PASS
CI,XT 1
BNE CMNDDEF1 COMMAND IS ALREADY DEFINED
*
FI -40-
EXIT RL
*
FI -20-
*
* HERE WE ARE ABOUT TO DEFINE A FUNCTION NAME - MAKE SURE IT
* IS NOT AN INTRINSIC FUNCTION (OR VALUED SYMBOL). IF IT IS,
* TREAT AS NORMAL DUPLICATE FUNCTION DEFINITION.
*
CLM,XT RNG%INT%FUNC#
IF,OL -60- DOIF NOT INTRINSIC FUNCTION NUMBER
LW,XT1 *SYMT,XT LOAD FIXED SYMBOL TABLE ENTRY
IF,FZ SPAFLD,XT1 DOIF NOT ONE WORD ENTRY
EXIT,FZ LPTRFLD,XT1 EXIT IF NO LPTR EXISTS
LV,XT LPTRFLD
AND,XT XT1 CLEAN INDEX TO DYNAMIC TABLE
LW,XT1 *SYMT,XT LOAD CONTROL WORD FROM DYNAMIC TBL
MTW,0 PASS
IF,NZ DOIF GENERATION PASS
AND,XT1 =TYPEFLD
CV,XT1 FUNCNAME
BE CMNDDEF8 BRANCH IF ENTRY IS A FUNCTION
*
FI
FI
OR,XT1 =SPINTFLD EXIT IF SYMBOL TABLE ENTRY CONTAINS
CW,XT1 =SPAFLD+SPINTFLD THE INITIALIZATION VALUE,
EXIT,EQ RL OR THE UNDEFINED VALUE
*
FI -60-
*
* HAVE AN ATTEMPT AT DUPLICATE FUNCTION DEFINITION
*
BAL,ER DERR REPORT A DUPLICATE DEFINITION ERROR
CMNDDEF1 RES 0
LV,XT1 1**(31-DUPLOB)
STS,XT1 *SYMT,XT SET DUPLICATE BIT
FI -10-
* S:SIN DIRECTIVE
SETSKIPTRIG RES 0
MTW,1 SKIPTRIG SET SKIP INDICATOR
B LINE5
PAGE
*
* C N A M E
* PROCESS THE CNAME DIRECTIVE
*
* A TWO-WORD CONTROL ITEM IS STORED FOLLOWED BY THE VALUE IN
* THE OPERAND FIELD.
* THE CONTROL ITEM CONSISTS OF THE CNAME CONTROL WORD FOLLOWED
* BY THE SAMPLE TABLE ORIGIN (STO FIELD) OF THE PROCEDURE
* BODY.
* THE STO FIELD IS USED TEMPORARILY BY CNAME TO LINK CNAME
* CONTROL ITEMS. THE START OF THE LINK IS CONTAINED IN
* NAMELINK, AND TERMINATED BY A ZERO LINK. THE LINK IS
* UNTHREADED BY THE PROC DIRECTIVE, WHERE IT'S REPLACED BY
* THE SAMPLE TABLE ORIGIN. THREADING IS DONE IN BOTH THE
* DEF AND GEN PASSES.
*
CNAME RES 0
LV,XT CMNDNAME+CNAMECOMT+LNGTH2 COMMAND NAME CONTROL WORD
CNAME2 RES 0
MTW,0 CMNDLIST BRANCH IF THERE ARE
BEZ CNAME3 NO COMMAND FIELD ENTRIES
BAL,ER EERR REPORT ILLEGAL ENTRIES
CNAME3 RES 0
BAL,RL CMNDDEF CHECK COMMAND DEFINITION
CALL EV%CLN%OPRND EVALUATE THE OPERAND FIELD
BAL,RL CMNDASN MAKE COMMAND ASSIGNMENT
* CMNDASN RETURNS HERE DURING THE GENERATION PASS
B CNAME1 RETURN FOR GEN PASS
* CMNDASN RETURNS HERE DURING THE DEFINITION PASS
* STORE TWO WORD CONTROL ENTRY FOLLOWED BY THE OPERAND EXPRESSION
BAL,RL COM1 STORE CONTROL AND STO WORDS
LW,XT1 NAMELINK
STW,XT1 STO,XT STORE NAMELINK
SW,XT SYMT
STW,XT NAMELINK
LW,XW OPRND,LVL OPERAND FIELD INDEX
LI,XT1 0
B SAMPL20 STORE ENCODED 'NAME'
CNAME1 RES 0 HERE FOR GEN PASS, XT CONTAINS INDEX
LW,XT1 NAMELINK NAMELINK TO STO
XW,XT1 STO,XT
STW,XT1 PROCLOC OLD SYMBOL TABLE NAMELINK
SW,XT SYMT
STW,XT NAMELINK
BAL,RL EDITV EDIT OPERAND VALUE INTO LISTING
B GENR
PAGE
*
* C N A M E R E F
* THIS ROUTINE PROCESSES A REFERENCE TO A CNAME DEFINITION.
* CK%PREF IS CALLED TO INSURE THAT THE LEVEL OF PROCEDURE
* REFERENCES IS LESS THAN THE MAXIMUM ALLOWED.
* CNAMEREF%COMREF IS
* CALLED TO COMPLETE THE CURRENT PROCEDURE LEVEL TABLE,
* INCREASE THE PROCEDURE LEVEL BY ONE, AND BUILD A NEW
* PROCEDURE LEVEL TABLE.
*
* INPUT: REFADD CONTAINS THE SYMBOL TABLE ADDRESS OF THE CNAME
* ENTRY BEING REFERENCED.
*
* OUTPUT: LVL CONTAINS THE ADDRESS OF THE NEWLY FORMED
* PROCEDURE LEVEL TABLE
* PROCREF HAS BEEN INCREASED BY ONE
* XW CONTAINS AN INDEX TO THE ENCODED TEXT SAVED IN A
* SAMPLE STORAGE AREA BY THE PROCEDURE ASSOCIATED
* WITH THE CNAME BEING REFERENCED.
* USES REGISTERS
* XT
* RL
*
CNAMEREF RES 0
LI,XT1 LINE5 IGNORE THIS CNAME REFERENCE IF
BAL,RL CK%PREF PROC REF LEVEL EXCEEDS THE MAX
BAL,RL CNAMEREF%COMREF CREATE AN INNER PROC LEVEL
B LINE3
PAGE
*
* C N A M E R E F % C O M R E F
* THIS ROUTINE PROCESSES LOGIC COMMON TO BOTH CNAMEREF AND
* COMREF. AN ERROR IS REPORTED IF THE COMMAND ENTRY IN THE
* SYMBOL TABLE IS NOT DEFINED FOR THE CURRENT PASS, AND THIS
* ROUTINE WILL BRANCH TO LINE1 TO GENERATE A WORD OF ZERO.
* --TO BE PROPERLY DEFINED, A COM DIRECTIVE MUST OCCUR BEFORE
* ANY REFERENCE TO IT AND BOTH THE CNAME AND PROC DIRECTIVES
* MUST OCCUR BEFORE ANY REFERENCE TO THE CNAME-- IF NO ERROR
* IS DETECTED, THE ENCODED TEXT POINTER (XW) IS ADVANCED TO
* THE START OF THE LINE FOLLOWING THE COMMAND REFERENCE LINE,
* AND IS SAVED IN THE CURRENT PROCEDURE LEVEL TABLE; THE
* CURRENT PROCEDURE LEVEL TABLE IS COMPLETED; PROCREF IS
* INCREASED BY ONE; A NEW PROCEDURE LEVEL TABLE IS BUILT; AND
* THE ENCODED TEXT POINTER (XW) IS SET TO THE PROCEDURE SAMPLE
* ASSOCIATED WITH THE COMMAND BEING REFERENCED.
*
* INPUT: REFADD CONTAINS THE SYMBOL TABLE ADDRESS OF THE
* COMMAND ENTRY BEING REFERENCED.
* LVL CONTAINS THE ADDRESS OF THE CURRENT PROCEDURE
* LEVEL TABLE
* PROCREF CONTAINS THE PROCEDURE REFERENCE LEVEL OF THE
* COMMAND REFERENCE
* XW CONTAINS AN INDEX TO THE ENCODED TEXT ITEM
* FOLLOWING THE CF(1) FIELD
*
* OUTPUT: LVL CONTAINS THE ADDRESS OF THE NEWLY FORMED PROCEDURS
* LEVEL ABLE.
* PROCREF HAS BEEN INCREASED BY ONE
* XW CONTAINS AN INDEX TO THE FIRST ENCODED TEXT ITEM
* IN THE PROCEDURE SAMPLE STORAGE FOR THIS COMMAND
* DEFINITION.
*
* CALL: BAL,RL CNAMEREF%COMREF
*
* USES REGISTERS
* RL, XT, XT1, ER, XW, LVL
*
CNAMEREF%COMREF RES 0
STW,RL BLDPLTXIT
LW,XT1 *REFADD
AND,XT1 =DEFFLD GET DEF ASSIGNMENT FOR COMMAND
CW,XT1 PASSDEF
BNE LINE10 REFERENCE OCCURRED BEFORE DEFINITION
* HERE IF COMMAND IS DEFINED FOR THE CURRENT PASS
BAL,RL LINESKIP SKIP REST OF LINE
STW,XW SAMP,LVL SAVE INDEX TO ENCODED LINE FOLLOWING
* COMMAND REFERENCE LINE.
LW,XT REFADD ADDRESS OF COMMAND ENTRY
B BLDPLT1 BUILD A PROCEDURE LEVEL TABLE
PAGE
*
* C O M
* PROCESS THE COM DIRECTIVE
*
* A COM TYPE 0 CONTROL WORD IS STORED IN THE SYMBOL TABLE IF
* EITHER THERE'S NO COMMAND LIST, OR THEIR VALUES SUM = 32;
* OTHERWISE A COM TYPE 1 CONTROL WORD IS STORED. THE CONTROL
* WORD IS FOLLOWED BY THE SAMPLE TABLE ORIGIN OF THE COM LINE.
* THE COM LINE IS STORED IN SAMPLE, WITH ITS LABEL REPLACED
* BY THE INTRINSIC SYMBOL 'LF'.
* SAMPLIN IS USED TO STORE THE COM LINE (ENTRY AT SAMPL20)
*
LOCAL %10,%20,%30,%40
COM RES 0
LW,XT COM0%CW CONTROL WORD FOR COM0
BAL,RL CMNDDEF CHECK COMMAND DEFINITION
LI,XT 32
MTW,0 CMNDLIST IF NO COMMAND FIELD EXPRESSION,
BEZ %30 USE COM TYPE ZERO
BAL,RL EVALUATE%AND%CLEAN EVALUATE COMMAND EXPRESSIONS
LI,XT 0 CLEAR PARTIAL SUM
%10 RES 0
LW,XT1 0,XS NEXT EVT ENTRY
LW,XT1 *KLINE,XT1
BFZ,XT1 SPAFLD,%40 IT SHOULD BE A
BFZ,XT1 SPINTFLD,%40 SPECIAL INTEGER
AND,XT1 =VALFLD KEEP VALUE
AW,XT XT1 ADD IT TO PARTIAL SUM
%20 RES 0
AI,XS -1
MTW,-1 LSTCT
BGZ %10
CI,XT 32
BE %30 BRANCH IF EXPRESSION SUM IS 32
ERROR,3,(COM1COMT&X'70000')=0 'TRUNCATION'
MTH,COM1COMT**-16 CMNDCW CHANGE CONTROL WORD TO COM1
AI,XT 7
%30 RES 0
SLS,XT -3 TO NUMBER OF BYTES
BAL,RL STACKSPI PUT SPECIAL INTEGER IN EVT
BAL,RL LINESKIP SKIP REMAINDER OF COM LINE
BAL,RL CMNDASN MAKE COMMAND ASSIGNMENT
* CMNDASN RETURNS HERE DURING THE GENERATION PASS
B S:SIN1 GEN PASS EXIT
* CMNDASN RETURNS HERE DURING THE DEFINITION PASS
LV,XT2 LFSYM SYMBOL LF TO LABEL FOR SAMPLIN
LW,XW CMND,LVL SET XW TO COMMAND FIELD
LI,RL SAMPL20 SAMPLIN WILL STORE THE COM LINE
COM1 RES 0
LW,XT1 NXTSYMT
SW,XT1 SYMT
STW,XT1 STO,XT STORE INDEX TO SAMPLE LINE
SLS,XT1 1 MAKE IT A HALFWORD INDEX
STW,XT1 STORESAMP FOR SAMPLIN
EXIT RL
%40 RES 0
BAL,ER EERR ILLEGAL CF ENTRY
B %20
COM0%CW DATA 1**(31-DEFLOB)+COM0COMT+CMNDNAME+LNGTH2
PAGE
*
* C O M R E F 4
* THIS ROUTINE PROCESSES A REFERENCE TO A COMMAND DEFINED BY A
* 32 BIT COM DIRECTIVE. BOTH LOCATION COUNTERS ARE ADVANCED
* TO A WORD BOUNDARY, AND THE ROUTINE GOES TO COMREF.
*
COMREF4 RES 0
BAL,RL BOUND4 ADVANCE LOCATION COUNTERS TO
* A WORD BOUNDARY
*
* C O M R E F
* THIS ROUTINE PROCESSES A REFERENCE TO A COMMAND DEFINED BY A
* COM DIRECTIVE. CNAMEREF%COMREF IS CALLED TO COMPLETE THE
* CURRENT PROCEDURE LEVEL TABLE, INCREASE THE LEVEL BY ONE,
* AND BUILD A NEW PROCEDURE LEVEL TABLE. THEN PARAMETER
* SUBSTITUTION IS PERFORMED BY CALLING PARTIC. THE NEWLY FORMED
* ENCODED TEXT IN THE PARTICULARIZATION BUFFER IS THEN
* PROCESSED BY CALLING GENORCOM. FINALLY, THE PROCEDURE
* REFERENCE LEVEL IS DECREMENTED BY ONE AND THE PREVIOUS
* PROCEDURE LEVEL IS REINSTATED.
*
* INPUT: REFADD CONTAINS THE SYMBOL TABLE ADDRESS OF THE COM
* ENTRY BEING REFERENCED.
*
* OUTPUT: XW CONTAINS AN INDEX TO THE BEGINNING OF THE ENCODED
* LINE FOLLOWING THE COM REFERENCE LINE.
*
* USES REGISTERS
* XT
* RL
* XW
* LVL
*
COMREF RES 0
BAL,RL CNAMEREF%COMREF COMMON LOGIC
AI,XW 1 SKIP THE 'PARTIC' FLAG
LI,XT 0 SET 'NAME' FLAG FOR PARTIC
BAL,RL PARTIC PARAMETER SUBSTITUTION
BAL,RL LINE%FLDS SET LBL, CMND, OPRND POINTERS
BAL,RL GENORCOM
COMREF3 RES 0
BAL,RL GETPLOC RE-INSTATE PREVIOUS PROC LVL TBL
B LINE5 RE-INSTATE XW
PAGE
*
* C S E C T
* PROCESSES THE CSECT DIRECTIVE
*
* USES REGISTERS
* RL
* XT
*
CSECT RES 0
LI,XT CSTYPE
CSECT1 RES 0
STW,XT CS
BAL,RL EVALPT EVALUATE PROTECTION TYPE
BAL,RL NEWCSECT SAVE LOC. COUNTERS & ASSIGN NEW C.S.
CALL DEFHEXLBL DEFINE LABEL FIELD
B GENR BACK TO MAIN CONTROL
PAGE
*
* C T E L E M E N T S
* COUNT THE NUMBER OF ELEMENTS IN THE LAST LIST IN EVT,ECT
* AND COMPLETE THE LIST CONTROL ITEM IN THE EVT.
*
* INPUT: ECT,LVL POINTS TO THE NEXT AVAILABLE ECT ENTRY
* THE ECT CONTAINS A DUMMY LIST ITEM WHICH POINTS TO
* THE INCOMPLETE EVT LIST CONTROL ITEM.
*
* OUTPUT: ECT,LVL IS CHANGED TO REFLECT DELETION OF THE
* INDIVIDUAL LIST ENTRIES
* THE DUMMY LIST ITEM IN ECT IS CHANGED TO A LIST
* THE LIST CONTROL ITEM IN THE EVT CONTAINS THE
* LENGTH & NUMBER OF ELEMENTS IN THE LIST.
* #ELEM CONTAINS THE NUMBER OF ELEMENTS IN THE LIST
*
* REGISTERS USED: XT,XT1,XT2,XT3
*
LOCAL %1,%2
CTELEMENTS RES 0
STW,RL 1ELEMXIT
LW,XT ECT,LVL
LW,XT1 PASSDEF TO RETAIN LOWEST DEF FIELD
LV,XT3 ETFLD ET FIELD MASK
%1 RES 0
AI,XT 1
LW,XT2 *KLINE,XT SEARCH FOR THE
AND,XT1 *KLINE,XT2 UPDATE LOWEST DEF FIELD
CS,XT2 =DLISTET DUMMY LIST ET
BNE %1 NOT FOUND
LS,XT2 =LISTET CHANGE THE DUMMY LIST ET
STS,XT2 *KLINE,XT TO A LIST ET
AI,XT -1 MODIFY TO POINT TO 1ST ELEMENT
LW,XT3 XT
SW,XT ECT,LVL # ELEMENTS IN THE ECT
STW,XT3 ECT,LVL DELETE ECT ELEMENTS
CI,XT 256 TEST FOR TOO MANY ELEMENTS
BL %2
BAL,ER TERR TOO MANY LIST ELEMENTS
LI,XT 255 SET TO MAX # ELEMENTS
SW,XT3 XT LOCATE ECT OF LAST ELEMENT
LW,XT3 *KLINE,XT3 DELETE EXTRA EVT ELEMENTS
AND,XT3 =LOCFLD
STW,XT3 EVT,LVL
%2 RES 0
LW,XT3 EVT,LVL COMPUTE LIST LENGTH
SW,XT3 XT2
AND,XT3 =LOCFLD
AW,XT1 XT3 INSERT LENGTH
AV,XT1 LISTS LIST TYPE FIELD
AW,XT2 KLINE
STW,XT #ELEM STORE NUMBER OF LIST ELEMENTS
STW,XT ELEM,XT2
STW,XT1 0,XT2 STORE EVT CONTROL WORD
B *1ELEMXIT
PAGE
*
* D A T A
* THIS ROUTINE PROCESSES THE DATA DIRECTIVE. FIRST THE LABEL IS
* DEFINED. THEN THE CF(2) FIELD DETERMINES THE LENGTH OF EACH
* OPERAND. THIS LENGTH IS STORED IN THE EXPRESSION VALUE TABLE
* AS A BIT LENGTH. SCAN1 IS CALLED TO EVALUATE ONE OPERAND AT
* A TIME, AND GENERATE IS CALLED TO OUTPUT THE VALUE.
*
* USES REGISTERS
* RL
* XT
* LVL
* XW
* XT1
* ER
*
DATA RES 0
*
CALL DEFHEXLBL DEFINE LABEL FIELD
MTW,0 CMNDLIST
BEZ DATA2 NO CF(2) SPECIFIED
BAL,RL EVAL1EXP EVALUATE CF(2) FIELD
LW,XT TEMP
BLZ DATA1 INVALID CF(2) FIELD
BEZ LINE5 SKIP DATA IF CF(2) IS ZERO
CI,XT 16
BLE DATA3 VALID CF(2) VALUE
BAL,ER EERR CF(2) FIELD TOO LARGE
LI,XT 16 USE MAX
B DATA3
DATA1 RES 0
BAL,ER EERR ILLEGAL CF(2) VALUE
DATA2 RES 0
* HERE FROM LINE10 FOR UNKNOWN COMMANDS
LI,XT 4 USE A CF(2) VALUE OF 4
DATA3 RES 0
STW,XT TEMPO SAVE VALUE OF CF(2)
SLS,XT 3 CHANGE BYTE LENGTH TO BIT LENGTH
BAL,RL STACKSPI SPECIAL INTEGER TO EXPRESSION STACKS
DATA4 RES 0
BAL,RL SCAN1 EVALUATE ONE EXPRESSION
STW,XT NCDITEM SAVE ENCODED ITEM
BAL,RL CLN%EXP REMOVE 'VALUES' BUT LEAVE LENGTH
AI,XS 1
STW,XS TEMP SAVE POINTER TO FIELD LENGTH
DATA5 RES 0
AI,XS -1 POINTER TO NEXT VALUE
STW,XS VALPTR SAVE POINTER TO VALUE
LW,XT TEMP
STW,XT FLDPTR POINTER TO FIELD SIZE
LI,XT 1
STW,XT FLDCNT NUMBER OF FIELD SIZE ENTRIES
STW,XT VALCNT NUMBER OF VALUE ENTRIES
LW,XT TEMPO NUMBER OF BYTES TO GENERATE
BAL,RL GENERATE GENERATE OBJECT DATA
MTW,-1 LSTCT DECREMENT LIST COUNT
BGZ DATA5 BRANCH IF MORE ITEMS IN LIST
LW,XT NCDITEM LOAD ENCODED ITEM SAVED ABOVE
BNE DATA4 NOT END-OF-LINE,PROCESS NEXT OPERAND
B GENR BACK TO MAIN CONTROL
PAGE
*
* D E F
* THIS ROUTINE PROCESSES THE DEF,REF, AND SREF DIRECTIVES.
* EACH OPERAND FIELD ENTRY MUST BE A NON-LOCAL SYMBOL OR A
* SYNTAX ERROR IS MARKED AND THE ENTRY IS SKIPPED. THE SYMBOL
* TABLE ENTRY FOR EACH SYMBOL IS SET TO THE APPROPRIATE
* EXTERNAL TYPE. AN ERROR IS REPORTED FOR ANY DUPLICATIONS
* FOUND FOR DEF,REF,AND SREF. AN ATTEMPT TO DEF AN UNDEFINED
* SYMBOL WILL ALSO REPORT AN ERROR. REF AND SREF CAUSE THE
* SYMBOL TO BE DEFINED AS WELL AS SETTING IT EXTERNAL.
*
* INPUT: XT CONTAINS THE VALUE TO BE ASSIGNED TO THE EXTERNAL
* FIELD OF EACH SYMBOL PROCESSED.
*
* OUTPUT: DEF BRANCHES TO GENR IN MAIN CONTROL AFTER THE LINE
* HAS BEEN PROCESSED.
*
* USES REGISTERS
* XT
* XT1
* XW
* ER
* RL
*
DEF RES 0
LV,XT DEFEXT ASSIGNMENT FOR EXTERNAL DEFINITION
* HERE FROM DEF, REF, OR SREF. XT CONTAINS THE EXTERNAL TYPE.
DEF1 RES 0
STW,XT TEMP SAVE VALUE FOR EXT FIELD
CALL SOCW%CHK SOCW AND EXTERNALS DON'T MIX
LW,XW OPRND,LVL GET INDEX TO OPERAND FIELD
DEF2 RES 0
NXTENC ,NOINC GET NEXT ENCODED ITEM
BE LINE5 END OF LINE, GO TO MAIN CONTROL
AI,XW 1 INCREMENT ENCODED TEXT INDEX
LI,XT1 TFLD
AND,XT1 XT EXTRACT ENCODED TYPE FIELD
CI,XT1 ENCSYM
BE DEF4 ENCODED ITEM IS A NON-LOCAL SYMBOL
AI,XT ENCTYPE1 ADD 1 TO ENCODED TYPE FIELD
BCR,8 DEF3 NOT A MULTIWORD INTEGER
AND,XT =LFLD CLEAN THE LENGTH FIELD
AW,XW XT SKIP THE MULTIWORD INTEGER
DEF3 RES 0
BAL,ER SERR SYNTAX ERROR
B DEF2
DEF4 RES 0
BAL,RL DEFSUB ASSIGN THE EXT FIELD
B DEF2
*
* D E F S U B
*
DEFSUB RES 0
STW,RL DFNEXIT SAVE RETURN ADDRESS
BAL,RL GLBLADD FIND THE SYMT ADDRESS
LW,XT1 *FND SET EXTERNAL FIELD
BFNZ,XT1 EXTFLD,DEF8 BRANCH IF SYMBOL IS ALREADY EXTERNAL
AW,XT1 TEMP
STW,XT1 *FND STORE BACK WITH EXTERNAL ASSIGNMENT
LW,RL TEMP
CV,RL DEFEXT
BNE DEFSUB1 BRANCH IF EXT. ASSIGN. IS REF OR SREF
MTW,0 1STDEF
BGEZ *DFNEXIT EXIT IF THIS IS NOT FIRST DEF
LW,RL MAIN
SW,RL SYMT
STW,RL 1STDEF SAVE SYMBOL NUMBER OF 1ST DEF
B *DFNEXIT
DEFSUB1 RES 0
* HERE IF SYMBOL IS A REF OR SREF
BFNZ,XT1 DEFFLD,DEF9 BRANCH IF SYMBOL ALREADY DEFINED.
AND,XT1 =~SPINTFLD
AW,XT1 DECLRNUM
MTW,1 DECLRNUM INCREMENT DECLARATION NUMBER
DEF7 RES 0
OR,XT1 PASSDEF DEFINE SYMBOL FOR REF OR SREF
STW,XT1 *FND
B *DFNEXIT EXIT
DEF8 RES 0
MTW,0 PASS
BNEZ DEF10 GENERATION PASS
DEF9 RES 0
LV,XT1 DUPFLD
STS,XT1 *FND SET DUP BIT
B *DFNEXIT
DEF10 RES 0
BFZ,XT1 DUPFLD,DEF11 BRANCH IF DUPLICATE BIT NOT SET
BAL,ER DERR DUPLICATION ERROR
DEF11 RES 0
BFNZ,XT1 DEFFLD,DEF12 BRANCH IF SYMBOL IS DEFINED
BAL,ER UERR UNDEFINED SYMBOL
DEF12 RES 0
LW,RL TEMP
CV,RL DEFEXT
BNE DEF7 EXTERNAL ASSIGNMENT IS REF OR SREF
* CHECK FOR A VALID DEF ASSIGNMENT
BFNZ,XT1,1 SPAFLD,*DFNEXIT EXIT IF ONE WORD ASSIGNMENT
LV,RL TYPEFLD
AND,RL XT1 GET TYPE
IF,NE LISTS,RL SCREEN OUT BAD VALUES HERE *D-DG
CV,RL CONSTANT
BNE *DFNEXIT NOT A CONSTANT
LV,RL LENGTHFLD
AND,RL XT1 GET ITEM'S LENGTH
CV,RL LNGTH2
BE *DFNEXIT CONSTANT IS 32 BITS OR LESS
AND,XT1 =CTYPEFLD GET TYPE OF CONSTANT
THEF,EQ CHSTR,XT1 ONLY TEXT MIGHT STILL FIT *D-DG
LI,XT 4 COMPARE NUMBER OF CHARACTERS
CB,XT *FND,XT FOR 4 OR LESS
BGE *DFNEXIT
* *D-DG
FI *D-DG
BAL,ER TERR TRUNCATION ERROR
B *DFNEXIT
PAGE
*
* D E F G E N * * * B E G I N A S S E M B L Y * * *
*
DEFGEN RES 0
STW,IORL ROOTRTN SAVE RETURN ADDRESS TO ROOT
DEFGEN2 RES 0
* READ FIRST ENCODED TEXT RECORD AND BEGIN CURRENT PASS
BAL,RL NXTRECRD
B LINE
PAGE
*
* D E F I N E
* ENTERS A VALUE IN THE SYMBOL TABLE. THE LBL ENTRY IN THE
* PROCEDURE LEVEL TABLE CONTAINS A POINTER TO THE LABEL FIELD.
* ARG CONTAINS A POINTER TOTHE VALUE TO BE STORED.
* IF THE 'SD' OPTION IS IN EFFECT, 'SD%TYPE' IS EXPECTED TO
* HOLD THE TYPE CODE FOR THE GLOBAL SYMBOL TO BE DEFINED.
*
* USES REGISTERS
* RL, LVL, XT, XT1, XT2, XW, TR0, TR1
*
DEFINE RES 0
STW,RL DFNEXIT SAVE RETURN
LW,XT ARG SAVE ARG IN A CELL THAT
STW,XT ARGSAVE IS NOT USED BY SCAN
STW,XW SAVEXW SAVE CURRENT XW
LW,XW LBL,LVL GET LABEL POINTER
BAL,RL LOADXW LOAD APPROPRIATE XWBASE
NXTENC GET 1ST LABEL FIELD ITEM
CI,XT BLANKEXP
BE DFNE1 LABEL FIELD IS BLANK
LI,XT1 TFLD ENCODED TYPE FIELD MASK
CV,XT BEGINLIST BRANCH IF LABEL STARTS WITH
BE DFNE4 A BEGIN LIST
AND,XT1 XT ENCODED TYPE
CI,XT1 ENCSYM
BE DFNE6 LABEL IS A NON-LOCAL SYMBOL
CI,XT1 LOCALSYM
BE DFNE7 LABEL IS A LOCAL SYMBOL
DFNE RES 0
BAL,ER LERR LABEL ERROR
DFNE1 RES 0
LW,XW SAVEXW RESTORE XW
BAL,RL LOADXW LOAD XWBASE
B *DFNEXIT
DFNE4 RES 0
NXTENC ITEM FOLLOWING BEGINLIST
STW,XT SBLBLSYM SAVE ENCODED ITEM
AND,XT1 XT ENCODED TYPE TO XT1
CV,XT1 SBSYM BRANCH IF LABEL IS A
BE DFNE10 SUBSCRIPTED SYMBOL
CV,XT1 LCLSBSYM BRANCH IF LABEL IS NOT
BNE DFNE A LOCAL SUBSCRIPTED SYMBOL
BAL,RL SCAN EVALUATE SUBSCRIPTS
LW,XT SBLBLSYM RESTORE LOCAL SYMBOL NUMBER
BAL,RL LOCALADD GET LOCAL SYMBOL'S ADDRESS
B DFNE11
DEFINE2 RES 0
STW,RL DFNEXIT SAVE RETURN
DFNE6 RES 0
MTW,0 SD%FLAG
IF,NZ DOIF SD
AND,XT L(VFLD) CLEAN SYMBOL NUMBER
LW,XT1 SD%TYPE
STB,XT1 *SDTT,XT SAVE TYPE IN SD BYTE-TABLE
FI
BAL,RL GLBLADD GET GLOBAL SYMBOL'S ADDRESS
BAL,RL ENTER1 ENTER VALUE IN SYMBOL TABLE
LW,XT FND
CW,XT MAIN BRANCH IF FND IS POINTING TO
BE %+2 THE FIXED SYMT AREA
BAL,RL FREESPC FREE DYNAMIC TABLE SPACE
LW,XT *ARG
BFZ,XT SPAFLD,DFNE5 NOT A SPECIAL ADDRESS ITEM
LW,XT *MAIN
BFZ,XT CPTRFLD,DFNE2 SYMBOL NOT USED AS A COMMAND
DFNE5 RES 0
BAL,RL FINDSPC OBTAIN SPACE IN DYNAMIC AREA
LV,XT1 LPTRFLD MASK FOR LPTR FIELD
LW,XT *MAIN
BFZ,XT SPAFLD,DFNE3 ENTRY IS CPTR,LPTR TYPE
LI,XT1 -1 MASK FOR ENTIRE WORD
DFNE3 RES 0
LW,XT FND
SW,XT SYMT UPDATE LPTR WITH INDEX TO
STS,XT *MAIN ENTRY TO BE STORED
BAL,RL NEWENTRY STORE VALUE INTO SYMBOL TABLE
B DFNE1
DFNE7 RES 0
BAL,RL LOCALADD GET LOCAL SYMBOL'S ADDRESS
BAL,RL SRCLCLFD LOOK FOR LOCAL FORWARD OR LOCAL
CI,XT1 0 FORWARD AND HOLD
BE DFNE8 IT'S NEITHER
LV,XT SPAFLD
XW,XT 0,XT1
BAL,RL GENERATE2 GENERATE A FORWARD REFERENCE DEFINITION
LW,XT ARGSAVE
STW,XT ARG RESTORE ARG AFTER GENERATE
DFNE8 RES 0
BAL,RL ENTER1 ENTER VALUE IN SYMBOL TABLE
LW,XT *ARG
BFZ,XT SPAFLD,DFNE9 NOT A SPECIAL ADDRESS ITEM
DFNE2 RES 0
LW,XT *ARG MOVE ITEM POINTED TO BY ARG
STW,XT *MAIN INTO FIXED SYMBOL TABLE
B DFNE1
DFNE9 RES 0
BAL,RL DEFLOC DEFINE LOCAL SYMBOL
B DFNE1
DFNE10 BAL,RL SCAN EVALUATE SUBSCRIPTS
LW,XT SBLBLSYM RESTORE SYMBOL NUMBER
BAL,RL GLBLADD GET GLOBAL SYMBOL'S ADDRESS
DFNE11 RES 0
LW,XT ARGSAVE
STW,XT ARG RESTORE ARG FOLLOWING CALL TO SCAN
LW,XT ECT,LVL SAVE ECT OFFSET TO START OF NEW
STW,XT BASE LIST STRUCTURE TO BE CREATED
STW,XS SUBLOC ADDRESS OF 1ST SUBSCRIPT IN ECT
LW,XT FND SYMBOL TABLE ADDRESS OF LABEL
BAL,RL LENGTH GET LENGTH OF LABEL
AW,XT1 FND SAVE ADDRESS OF WORD FOLLOWING LAST
STW,XT1 LAST WORD OF SYMBOL TABLE ENTRY
DFNE12 RES 0
LW,XT1 *FND GET NEXT ENTRY IN SYMBOL TABLE
BAL,RL TYPE GET ENTRIES TYPE
CV,XT2 LISTET
BNE DFNE18 BRANCH IF ENTRY IS NOT A LIST
LW,XT FND
LI,XT1 2 PUSH THE 2 WORD LIST CONTROL
BAL,RL SCPUSH ITEM OUTO ECT AND EVT
MTW,1 FND
LW,XT *FND GET NUMBER OF ELEMENTS
STW,XT #ELEM IN THIS LIST
MTW,1 FND
BAL,RL SUBVAL GET NEXT SUBSCRIPT FROM EVT
CW,XT #ELEM BRANCH IF THE NUMBER OF ELEMENTS IN
BG DFNE21 SYMT IS LESS THAN THE SUBSCRIPT
AI,XT -1
BAL,RL MOVESYMITEM MOVE SUB#-1 ITEMS FROM SYMT TO EVT
MTW,-1 LSTCT DECREMENT SUBSCRIPT COUNT
BGZ DFNE12 BRANCH IF THERE ARE MORE SUBSCRIPTS
DFNE14 RES 0
MTW,-1 LSTCT DECREMENT SUBSCRIPT COUNT
BGZ DFNE27
*
MTW,0 #ELEM BRANCH IF THERE IS NO ITEM IN
BEZ DFNE13 SYMT TO BE REPLACED
*
LW,XT FND SKIP THE ITEM IN
BAL,RL LENGTH SYMT TO BE
AWM,XT1 FND REPLACED BY ARG
DFNE13 RES 0
LI,XT 0
MTW,-1 LSTCT DECREMENT SUBSCRIPT COUNT
BGZ DFNE20 BRANCH IF THERE ARE MORE SUBSCRIPTS
*
LW,XT ARG PUSH ARG INTO EVT. ITS THE LAST
BAL,RL LENGTH THING THAT WILL CHANGE IN THE
BAL,RL SCPSHV NEWLY GENERATED LIST STRUCTURE
LW,XT FND IF THERE IS ANYTHING
LW,XT1 LAST LEFT IN SYMT,
SW,XT1 FND PUSH IT INTO
BLEZ %+2 EVT BEHIND THE
BAL,RL SCPSHV NEWLY CREATED LIST
LW,XS ECT,LVL
LW,XT2 PASSDEF
DFNE16 RES 0
AI,XS 1
CW,XS BASE BRANCH IF ALL LISTS
BG DFNE23 HAVE BEEN PROCESSED
LW,XT *KLINE,XS GET ADDRESS OF NEXT LIST CONTROL
AW,XT KLINE ITEM IN EVT
STW,XT ARG
LW,XT1 ELEM,XT GET NUMBER OF
STW,XT1 SUB# ELEMENTS IN THE LIST
AI,XT 2 SKIP LIST CONTROL ITEM
LI,TR0 2 INITIALIZE LIST SIZE
DFNE17 RES 0
AND,XT2 0,XT PROPOGATE 'LOWEST' DEF VALUE
BAL,RL LENGTH GET LENGTH OF ITEM
AW,XT XT1 ADD LENGTH TO FIND NEXT LIST ITEM
AW,TR0 XT1 ADD LENGTH TO SIZE
MTW,-1 SUB# DECREMENT NUMBER OF ELEMENTS
BGZ DFNE17 BRANCH IF MORE
AW,TR0 XT2
LV,TR1 DEFFLD+LENGTHFLD
STS,TR0 *ARG STORE DEF VALUE AND LENGTH
B DFNE16
DFNE18 RES 0
LI,XT 1
DFNE20 RES 0
STW,XT #ELEM # OF ELEMENTS TO MOVE FROM SYMT
DFNE27 RES 0
BAL,RL MV:LIST CREATE AND PUSH A 2 WORD LIST
LW,XT *ARG CONTROL ITEM ONTO ECT AND EVT
AND,XT =SETFLD AND STORE THE SET FIELD OF
LW,XT1 EVT,LVL ARG INTO THE
AI,XT1 -2 SET FIELD OF
AWM,XT *KLINE,XT1 THE NEW LIST CONTROL ITEM
BAL,RL SUBVAL GET NEXT SUBSCRIPT FROM EVT
CI,XT 1 BRANCH IF ELEMENT TO BE REPLACED
BE DFNE14 IS THE 1ST ONE
DFNE21 RES 0
LW,XT1 EVT,LVL
AW,XT1 KLINE STORE NUMBER OF ELEMENTS IN THIS
STW,XT -1,XT1 LIST INTO ELEMENT WORD IN EVT
LW,XT *FND IF ITEM CONTAINS THE INITIALIZATION
OR,XT =SPINTFLD VALUE, OR IS ONLY REFERENCED,
CW,XT =SPAFLD+SPINTFLD REPLACE THE ITEM
BE DFNE22 WITH IMPLICIT BLANK(S)
*
LW,XT #ELEM
BAL,RL MOVESYMITEM MOVE ITEMS FROM SYMT TO EVT
LW,XT SUB#
SW,XT #ELEM COMPUTE NUMBER OF
STW,XT SUB# BLANKS REQUIRED
DFNE22 RES 0
MTW,-1 SUB# DECREMENT NUMBER OF BLANKS
BLEZ DFNE13 BRANCH IF NO MORE BLANKS REQUIRED
LV,XT2 3**(31-DEFLOB) DEF VALUE FOR GEN PASS
BAL,RL MOVEBLANK MOVE A BLANK TO EVT
MTW,1 ECT,LVL AND REMOVE IT FROM ECT
B DFNE22
DFNE23 RES 0
NXTENC ,NOINC GET ITEM FOLLOWING ENDSUBSYM
CV,XT ENDLIST IF IT IS NOT
BE DFNE24 AN END OF LIST,
BAL,ER LERR THE LABEL FIELD CONSISTS OF
DFNE24 RES 0 MORE THAN A SINGLE LABEL
LW,XT SBLBLSYM
CV,XT LCLSBSYM-SBSYM BRANCH IF ENCODED ITEM WAS
BAZ DFNE6 SUBSCRIPTED GLOBAL SYMBOL
B DFNE7 HAD TO BE SUBSCRIPTED LOCAL SYMBOL
PAGE
*
* D E F H E X L B L
* USED FOR DEFAULT SETTING OF SD TYPE CODE. SETS 'SD%TYPE'
* TO HEX, AND ENTERS 'DEFLBL'
*
* CALL: BAL,RL DEFHEXLBL
*
* USES REGISTERS
* XT
* (RL IS PASSED ON, AS LINK FOR 'DEFLBL')
*
DEFHEXLBL RES 0
*
LV,XT SDHEXC DEFAULT CODE IS HEX
STW,XT SD%TYPE
*
*
* D E F L B L
* EQUATES THE LABEL FIELD TO THE CURRENT VALUE OF THE
* EXECUTION LOCATION COUNTER.
*
* CALL: BAL,RL DEFLBL
*
* USES REGISTERS
* RL
* XT
*
DEFLBL RES 0
STW,RL DEFLBLXIT SAVE RETURN
BAL,RL ASSMBDLR CREATE A VALUE ITEM
LD,XT TEMP
STD,XT CMNDCW
LI,XT CMNDCW
STW,XT ARG POINTER TO CREATED VALUE
BAL,RL DEFINE ENTER VALUE IN SYMBOL TABLE
LW,RL PROCREF DON'T EDIT THE LOCATION COUNTER
BNEZ *DEFLBLXIT IF WITHIN A PROC
BAL,RL EDITDLR EDIT LOCATION COUNTER FOR LISTING
B *DEFLBLXIT RETURN
PAGE
*
* D E F L O C
* ENTERS A DEFINITION INTO THE APPROPRIATE LOCAL SYMBOL TABLE.
*
* INPUT: PROCREF CONTAINS THE PROCEDURE REFERENCE LEVEL
* PLVL CONTAINS THE PROCEDURE LEVEL OF THE LOCAL SYMBOL
* BEING DEFINED.
* LVL CONTAINS A POINTER TO THE CURRENT PROCEDURE
* LEVEL TABLE
* LARG CONTAINS THE LENGTH OF THE LOCAL SYMBOL.
*
* OUTPUT: NXTLOCAL CONTAINS THE ADDRESS OF THE NEXT AVAILABLE
* ENTRY OF THE LOCAL SYMBOL TABLE AREA.
*
* CALL: BAL,RL DEFLOC
*
* USES REGISTERS
* CT
* XT1
* TMP
* LVL
* NXTL
*
DEFLOC RES 0
STW,RL DEFLOCXIT
BAL,RL FINDLSPC FIND LOCAL TABLE SPACE
LW,CT PROCREF PROC. REFERENCE LEVEL - PROC LEVEL
SW,CT PLVL OF LOCAL SYMBOL IS THE NUMBER OF
BNEZ DEFLOC1 LOCAL SYMBOL TABLES TO BE MOVED
* SYMBOL IS BEING DEFINED ON THE CURRENT PROC LEVEL
LW,CT NXTLOCAL ENTRY ADDRESS IS LARG WORDS BELOW
B DEFLOC8
DEFLOC1 RES 0
LW,NXTL LVL ADDRESS OF CURRENT PROC LEVEL TABLE
DEFLOC2 RES 0
LW,XT1 LOCALORG,NXTL LOAD LOCALCT AND LOCALORG
SW,XT1 LARG PRECESS LOCAL ORIGIN BY (LARG)
STW,XT1 LOCALORG,NXTL WORDS AND STORE BACK
LW,NXTL PLOC,NXTL INDEX TO PREVIOUS PROC LEVEL TABLE
AW,NXTL KLINE BECOMES POINTER TO PROC LEVEL TABLE
AND,NXTL =PLOCFLD
AW,XT1 LARG
AW,XT1 SYMT
STW,XT1 BASE
AND,XT1 =LOCALORGFLD CLEAR LOCALCT FIELD /10761/B-08773
STW,XT1 LAST POINTER TO LOCAL SYMBOL TABLE ORIGIN
LB,XT1 BASE NUMBER OF LOCAL SYMBOLS IN TABLE 761/B-08773
BEZ DEFLOC5 NO SYMBOLS IN THIS TABLE
DEFLOC3 RES 0
LW,TMP *BASE
BFNZ,TMP SPAFLD,DEFLOC4 BRANCH IF ENTRY IS A SPECIAL ADDRESS
SW,TMP LARG ADJUST LPTR BY AMOUNT TO BE MOVED
STW,TMP *BASE AND STORE BACK
DEFLOC4 RES 0
MTW,-1 BASE ADDRESS OF NEXT ENTRY IN LOCAL TABLE
BDR,XT1 DEFLOC3 CONTINUE THRU THIS TABLE
DEFLOC5 RES 0
BDR,CT DEFLOC2 DECREMENT NUMBER OF LEVELS TO DO
* NOW AT LEVEL OF THE LOCAL SYMBOL BEING DEFINED
LW,CT NXTLOCAL ADDRESS OF NEXT AVAILABLE LOCAL
AI,CT 1 INSERTED IS ADDRESS TO BEGIN
STW,CT DESTIN MOVING TO
AW,CT LARG
STW,CT FND ADDRESS TO BEGIN MOVING FROM
SW,CT LAST
AI,CT -1 NUMBER OF WORDS TO BE MOVED
LI,XT1 0
DEFLOC6 RES 0
LW,TMP *FND,XT1 PRECESS LOCAL SYMBOL TABLE BY (LARG)
STW,TMP *DESTIN,XT1 WORDS. THE AREA PRECESSED IS FROM
AI,XT1 1 THE END OF THE TABLE(NXTLOC) TO
BIR,CT DEFLOC6 THE BEGINNING OF THE TABLE AT THE
* LEVEL OF THE SYMBOL BEING DEFINED
LW,CT LAST
SW,CT LARG ADDRESS TO MOVE DEFINITION TO
DEFLOC8 RES 0
AI,CT 1
SW,CT SYMT CONVERT ADDRESS TO A SYMT INDEX
STW,CT *MAIN INDEX TO DEFINITION TO LPTR FIELD
AW,CT SYMT
STW,CT FND ADDRESS OF DEFINITION ENTRY
BAL,RL NEWENTRY MOVE DEFINITION TO LOCAL TABLE
B *DEFLOCXIT
PAGE
*
* D E L E T E % D O
* DELETE THE CURRENT DO TABLE RECORD
*
DELETE%DO RES 0
MTW,-1 DOCT,LVL DECREASE ACTIVE DO'S ON THIS LEVEL
LW,XT DOLOC
STW,XT FND ADDRESS OF THIS DO RECORD
LW,XT2 DOSWD,XT PUT SIZE OF THIS DO RECORD
LB,XT1 XT2 IN LFND
STW,XT1 LFND
AND,XT2 =DOPFLD STORE ADDR. OF PREVIOUS DO RECORD
STW,XT2 DOLOC
B FREESPC GO FREE SPACE FOR THIS RECORD
PAGE
*
* D E L E T E X P
* THIS SUBROUTINE 'DELETES' ALL ENTRIES FROM BOTH EXPRESSION
* TABLES. THE DELETE IS PERFORMED BY SETTING THE ECT AND
* EVT POINTERS TO THE START OF THEIR RESPECTIVE TABLES.
*
* INPUT: PROCREF CONTAINS THE PROCEDURE REFERENCE LEVEL.
* LVL CONTAINS THE ADDRESS OF THE CURRENT PROCEDURE
* LEVEL TABLE
*
* OUTPUT: ECT ENTRY IN THE CURRENT PROCEDURE LEVEL TABLE
* CONTAINS AN OFFSET TO THE START OF THE EXPRESSION
* CONTROL TABLE
* EVT ENTRY IN THE CURRENT PROCEDURE LEVEL TABLE
* CONTAINS AN OFFSET TO THE START OF THE EXPRESSION
* VALUE TABLE.
*
* CALL: BAL,RL DELETEXP
*
* USES REGISTERS
* XT, XT1, XT2, ER, RL
*
DELETEXP RES 0
LW,XT ECTORG,LVL
STW,XT ECT,LVL STORE OFFSET TO START OF ECT
LW,XT LVL DETERMINE THE END OF THE CURRENT
SW,XT KLINE PROCEDURE LEVEL TABLE
AI,XT LVLSIZE
STW,XT EVT,LVL STORE OFFSET TO START OF EVT
EXIT RL
PAGE
*
* D I S P
* PROCESS THE DISPLAY DIRECTIVE.
*
* AF CONTAINS THE VALUE(S) TO BE PRINTED
*
DISP RES 0
BAL,RL MV:LIST MOVE DUMMY LIST TO ECT AND EVT
MTW,1 TCORFLG DON'T REPORT 'U' ERRORS
CALL EV%CLN%OPRND EVALUATE THE OPERAND FIELD
MTW,-1 TCORFLG RESET TCOR FLAG
MTW,0 PASS
BEZ GENR RETURN IF IN THE DEF PASS
LW,XT LSTBF+4
CW,XT BLANC
BE DISP1 NOTHING GENERATED IN LIST BUFFER
BAL,RL PRINT
DISP1 RES 0
MTW,-1 LSTCT BRANCH IF MORE THAN ONE
BGZ DISP2 ITEM IN OPERAND FIELD
LV,XT1 ETFLD MASK FOR ET FIELD
LW,XT 0,XS GET NEXT ECT ENTRY
CS,XT =LISTET
BNE DISP3 BRANCH IF ECT ENTRY IS NOT A LIST
DISP2 RES 0
BAL,RL CTELEMENTS COMPLETE THE LIST STRUCTURE
AI,XS 1 ADDRESS OF NEXT LIST ENTRY IN ECT
DISP3 RES 0
LI,XT 0
STW,XT LSTCT ZERO LIST COUNT
LW,XT 0,XS
AW,XT KLINE
STW,XT ARG ADDRESS OF FIRST EXPRESSION
DISP4 RES 0
BAL,RL EDITV1 EDIT AND PRINT THE VALUE
BAL,RL PRINT
LW,XT DD%TYPE
CV,XT LISTET BRANCH IF CURRENT ECT ITEM
BNE DISP6 IS NOT A LIST
LI,XT LSTCT
LI,XT1 1
BAL,RL SCPUSH SAVE LSTCT IN ECT AND EVT
LW,XT ARG
LW,XT 1,XT GET NUMBER OF ELEMENTS
STW,XT LSTCT IN THIS LIST
MTW,2 ARG SKIP THE LIST CONTROL ITEM
B DISP4
DISP5 RES 0
LI,LBX 18 END
LI,NBYTES 4 OF
LI,XT1 BA(ASTMSG)+1 LIST
BAL,RL AEDIT EDIT '****' INTO THE LIST BUFFER
BAL,RL PRINT
BAL,RL SCPULL
LW,XT *KLINE,XT RESTORE LIST COUNT SAVED WHEN
STW,XT LSTCT LIST ITEM WAS PROCESSED
DISP6 RES 0
MTW,-1 LSTCT DECREMENT LIST COUNT
BLZ GENR NEGATIVE MEANS DONE
BEZ DISP5 ZERO MEANS END OF LIST
LW,XT ARG ADDRESS OF CURRENT ITEM
BAL,RL LENGTH GET LENGTH OF CURRENT ITEM
AWM,XT1 ARG SET ARG TO ADDRESS OF NEXT
B DISP4 ITEM IN THE LIST
PAGE
* D O
* PROCESS THE DO DIRECTIVE
* THE LABEL IS RE-DEFINEABLE. IT IS SET TO 0 IF EXP NG 0, OR 1
*
* FORM OF THE DIRECTIVE:
* LBL DO EXP
* IF EXP NG 0, SKIP TO ELSE OR FIN AND ASSEMBLE TO FIN
* IF EXP GT 0, ASSEMBLE TO ELSE OR FIN EXP TIMES;
* THEN SKIP TO FIN
*
LOCAL %1,%2,%3,%4,%5
DO RES 0
BAL,RL NOTDO1
LI,XT 0
BAL,RL SETLABEL SET LABEL TO ZERO
CALL EV1OPRNDEXP EVALUATE ONE OPERAND EXPRESSION
BAL,RL EDITV EDIT THE OPERAND VALUE
LW,XT TEMP SKIP TO 'ELSE' OR 'FIN' IF EXP NG 0
BLEZ %5
STW,XT TEMPO SAVE IN CASE SCAN IS CALLED
LI,XT 1 SET VALUE OF LABEL TO ONE
BAL,RL SETLABEL
LW,XT TEMPO TEST EXPRESSION SIZE
CI,XT X'8000'
BL %1
BAL,ER TERR TRUNCATION
LI,XT 1
* GENERATE THE 'DO' TABLE RECORD
%1 RES 0
LI,T2 1 SET DOC FIELD TO 1
STH,XT T2 DOC AND DOI FIELDS
LW,T1 TEXTCT
LW,XT CMND,LVL COMPUTE SIZE OF
SW,XT LBL,LVL LABEL FIELD (IN HALFWORDS)
%2 RES 0
STW,XT T3 SAVE COUNT IN REG. T3
SLS,XT -1 CONVERT TO WORDS
AI,XT 4 ADD NO. WDS. IN FIXED PART
STW,XT LARG STORE LENGTH OF DO RECORD
BAL,RL FINDSPC FIND SPACE
LW,XT2 FND
STW,T2 DOCWD,XT2 STORE DOI AND DOC
SHIFT,T1 31,TXTCTLOB
STW,T1 TXTCTWD,XT2 STORE EFLD & TXTCTFLD
LW,T1 LARG
SHIFT,T1 31,DOSLOB
AW,T1 DOLOC
STW,T1 DOPWD,XT2 LABEL SIZE & PREV. DO ADDR.
STW,XW DOOWD,XT2 ORIGIN OF THIS DO LOOP
STW,XT2 DOLOC SET ORIGIN OF THIS DO RECORD
SLS,XT2 1 COMPUTE HALFWORD OFFSET
AI,XT2 7 OF LABEL
LW,XS LBL,LVL
BAL,RL LOADXM SET TO LABEL FIELD, THIS LINE
%3 RES 0
LH,XT *XMBASE,XS MOVE NEXT LABEL
AI,XS 1 FIELD ITEM
STH,XT 0,XT2 TO THE SYMBOL TABLE
AI,XT2 1
BDR,T3 %3 DECREASE COUNT AND RETURN
MTW,1 DOCT,LVL
B GENR
%5 RES 0
BAL,RL DOSKIP SKIP TO 'ELSE' OR 'FIN'
LW,XT DOCOUNT WAS 'FIN' SKIPPED
BLZ GENR YES
LI,T1 X'8000' SET EFLD TO 1
LI,T2 X'10001' SET DOI & DOC TO 1
B %2
PAGE
*
* D O S K I P
* SKIP LINES WITHIN A 'DO/ELSE/FIN' RANGE
*
* LINES ARE SKIPPED UNTIL THE ELSE OR FIN IS SKIPPED
* WHICH IS ON THE SAME LEVEL AS THE DO
*
LOCAL %1,%2,%3,%4,%5
DOSKIP RES 0
STW,RL DOSKIPXIT
BAL,RL SKIPINIT INITIALIZE FOR SKIPPING LINES
LI,XT 0 CLEAR GOTOARG SO THAT SPECDIR
STW,XT GOTOARG WILL NOT FIND ERRONEOUS LABEL
DOSKP10 RES 0
BAL,RL SKIPGETLF1 SKIP TO LF(1) ENCODED ENTRY
CI,XT BEGINLIST
BNE %1
BAL,RL SKIPLABEL SKIP THE REST OF THE LABEL
%1 RES 0
BAL,RL SPECDIR CHECK COMMAND FOR SPECIAL DIRECTIVE
CI,XT ELSEDIR CHECK FOR 'ELSE'
BE %4
LW,XT DOCOUNT DONE IF 'FIN' LINE FOR THIS 'DO'
BL DOSKP20
%3 RES 0
BAL,RL LINESKIP SKIP THE REST
B DOSKP10
%4 RES 0
LW,XT DOCOUNT DONE IF 'ELSE' IS ON THIS DO LEVEL
BNEZ %3 NOT ON THIS 'DO' LEVEL
DOSKP20 RES 0
LW,XT PROCCOUNT
BEZ %5
BAL,ER KERR EXTRA 'PROC' OR 'PEND' ERROR
%5 RES 0
LI,XT 0
STW,XT SKIPTRIG
BAL,RL LINESKIP SKIP THE REST OF THIS LINE
B *DOSKIPXIT
PAGE
*
* D O 1
* PROCESS THE DO1 DIRECTIVE
* LABEL IS DEFINED DEFINED NORMALLY
*
* FORM OF THE DIRECTIVE:
* LBL DO1 EXP
* IF EXP NG 1, THE NEXT LINE IS SKIPPED
* IF EXP EQ 1, THE DO1 LINE IS IGNORED
* IF EXP GT 1, THE NEXT LINE IS ASSEMBLED EXP TIMES
*
* TESTS FOR REPEATING A LINE ILLEGALLY ARE MADE BY THE
* INDIVIDUAL DIRECTIVES (E.G., DO1,PROC,PEND,OPEN,LOCAL,CLOSE)
* VIA A CALL TO NOTDO1
*
LOCAL %1,%2,%3,%4,%5,%6,%7
DO1 RES 0
*
CALL DEFHEXLBL DEFINE THE LABEL IF THERE IS ONE
BAL,RL NOTDO1 ERROR IF PRECEEDED BY A 'DO1'
CALL EV1OPRNDEXP EVALUATE ONE OPERAND EXPRESSION
STW,XW DO1LBL SAVE POINTER TO NEXT LINE
AI,XT -1
BL %3 SKIP THE NEXT LINE IF EXP LT 1
STW,XT DO1CT,LVL SAVE EXP AS DO1CT IN LEVEL TABLE
B GENR1
* HERE NEXT LINE IS SKIPPED. MAKE SURE IT'S NOT ILLEGAL TO SKIP IT.
%3 RES 0
BAL,RL SKIPINIT PRESET FOR SKIPPING NEXT LINE
BAL,RL SKIPGETLF1 GET LF(1) ENTRY AND SET SKIPTRIG
CI,XT BEGINLIST
BNE %4
BAL,RL SKIPLABEL SKIP NON-STANDARD LABEL FIELD
%4 RES 0
NXTENC GET CF(1) ENTRY
CI,XT BEGINLIST
BNE %5 THIS IS THE COMMAND
NXTENC GET THE COMMAND
%5 RES 0
CV,XT ENDDIR IF LINE FOLLOWING THE DO1 IS A
BG LINE5 CLOSE, LOCAL, OPEN, SYSTEM,
CV,XT CLOSEDIR PROC, PEND, OR END DIRECTIVE;
BGE SPCD20 MARK A 'K' ERROR AND ASSEMBLE
B LINE5 THE LINE. OTHERWISE, OK TO SKIP IT
PAGE
*
* D S E C T
* THIS ROUTINE PROCESSES THE DSECT DIRECTIVE. THE LABEL SYMBOL
* NUMBER IS SAVED IN DSNUM OF THE NEW CONTROL SECTION TABLE
* ENTRY. THE LABEL (REQUIRED) IS DEFINED AND MADE AN EXTERNAL
* DEFINITION BY OR-ING A ONE INTO THE EXT FIELD OF THE SYMBOL
* TABLE ENTRY.
*
* USES REGISTERS
* RL
* XT
* XT2
* XW
* ER
* LVL
* XT1
*
DSECT RES 0
LW,XW LBL,LVL INDEX TO LABEL FIELD ENCODED TEXT
NXTENC GET LABEL FIELD ENCODED ITEM
LI,XT1 TFLD
CS,XT =ENCSYM
BE DSECT1 LABEL FIELD CONTAINS A SYMBOL
BAL,ER LERR LABEL ERROR
B CSECT PROCESS AS A CSECT
DSECT1 RES 0
STW,XT CSNAME SAVE SYMBOL NUMBER
BAL,RL EVALPT EVALUATE PROTECTION TYPE
LI,XT DSTYPE
STW,XT CS SET CONTROL SECTION TYPE TO DSECT
BAL,RL NEWCSECT ASSIGN A NEW CONTROL SECTION
LW,XT CSNAME
SHIFT,XT 31,DSNUMLOB SYMBOL NUMBER OF DSECT LABEL
LV,XT1 DSNUMFLD
STS,XT DSNUM,XT2 SAVE LABEL AS CONTROL SECTION NAME
CALL DEFHEXLBL DEFINE LABEL FIELD
LV,XT1 DEFEXT VALUE FOR AN EXTERNAL DEFINITION
STW,XT1 TEMP SAVE VALUE FOR EXT FIELD
LW,XT CSNAME LABEL FIELD SYMBOL NUMBER
BAL,RL DEFSUB MAKE SYMBOL A DEF
LV,XT DEFEXT VALUE FOR AN EXTERNAL DEFINITION
LV,XT1 EXTFLD MASK FOR EXT FIELD
STS,XT *FND FORCE ASSIGNMENT TO DEF
B GENR BACK TO MAIN CONTROL
PAGE
*
* E L S E A N D F I N
* PROCESS THE ELSE AND FIN DIRECTIVES
*
* FORM OF BOTH DIRECTIVES:
* ELSE/FIN
*
* THE LABEL AND OPERAND FIELDS ARE IGNORED
*
LOCAL %1,%2,%3,%4,%5,%6,%7
ELSE RES 0
LI,XT 1
B %1
FIN RES 0
LI,XT 0
%1 RES 0
STW,XT ELSEFLG SAVE ELSE/FIN FLAG
BAL,RL NOTDO1 ERROR IF PRECEEDED BY A 'DO1'
BAL,RL LINESKIP SKIP THE REST OF ELSE/FIN LINE
LW,XT DOCT,LVL IS THERE AN ACTIVE 'DO', THIS LEVEL
BLEZ FIN1 NO
LW,XT DOLOC ADDRESS OF CURRENT DO-TABLE RECORD
LW,XT1 ELSEFLG IF THIS IS 'ELSE', IT MAY BE
BEZ %3 ILLEGAL
LW,XT1 EWD,XT ELSE-FOUND FLAG
BFZ,XT1 EFLD,%3 OKAY IF ELSE WAS NOT YET SEEN
FIN1 RES 0
BAL,ER KERR ILLEGAL INSTRUCTION
B GENR
%3 RES 0
LW,XT1 DOCWD,XT
SH,XT1 XT1 SUBT DOI FIELD FROM DOC
AND,XT1 =DOCFLD CLEAN DOC FIELD
BEZ %5 DOI = DOC
* HERE NOT END OF ALL ITERATIONS. BUMP LABEL AND RE-EXECUTE ENTIRE LOOP
BAL,RL PRINTC1 PRINT IF THERE IS A SOURCE LINE AND
LW,XT1 DOLOC IT'S NOT IN A PROC
MTW,+1 DOCWD,XT1 BUMP ITERATION COUNT
LW,XT DOCWD,XT1
AND,XT =DOCFLD CLEAN COUNT FOR CALL TO SETLABEL
SW,XT1 SYMT CONVERT ADDRESS TO THE
SLS,XT1 1 HALFWORD OFFSET
AV,XT1 SYMTBASE+7 OF THE SAVED LABEL
STW,XT1 LBL,LVL ORIGIN OF DO LABEL IN SYMT
BAL,RL SETLABEL REDEFINE LABEL (IF PRESENT)
LW,XT DOLOC RESET ORIGIN OF THIS DO RECORD
LW,XT1 PROCREF IS DO ON THE SOURCE LEVEL
BNEZ ELSE2 NO
XW,XT1 SF CLEAR SF. TEST OLD SF
BEZ ELSE1 IT WAS OFF. SMPRCD AND SMPWD ARE OK
* DETERMINE WHETHER SMPRCD AND SMPWD HAVE TO BE UPDATED
LW,XT1 TEXTCT
CW,XT1 SMPRCD
BL ELSE1 NO UPDATE REQUIRED
BG %4 YES, UPDATE THEM.
CW,XW SMPWD
BLE ELSE1
%4 RES 0
STW,XT1 SMPRCD
STW,XW SMPWD UPDATE SMPWD
* DETERMINE WHETHER THE ENCODED TEXT FILE HAS TO BACKSPACED TO RESTART
ELSE1 RES 0
LW,IOSIZE TXTCTWD,XT
AND,IOSIZE =TXTCTFLD
SHIFT,IOSIZE TXTCTLOB,31 RIGHT JUSTIFY TEXT RECORD NUMBER
SW,IOSIZE TEXTCT CURRENT RECORD NUMBER
BEZ ELSE2 NO BACKSPACING REQUIRED
AI,IOSIZE -1
AWM,IOSIZE TEXTCT
LH,IORL RD%STD
BEZ %2 PROCESSING X1 FILE
BAL,IORL POSITIONSTD BACKSPACE THE STD FILE
B %7
%2 RES 0
BAL,IORL POSITIONX1 POSITION THE X1 FILE. BACKSPACE IT
%7 RES 0
BAL,RL NXTRECRD READ THE REQUIRED X1 RECORD
ELSE2 RES 0
LW,XW DOOWD,XT RESET THE ORIGIN TO START OF DO
BAL,RL LOADXW
B GENR
* HERE DO COUNT IS EXHAUSTED. TERMINATE THE DO
%5 RES 0
BAL,RL DELETE%DO DELETE THE DO RECORD
BAL,RL SET%SF
LW,XT ELSEFLG
BEZ GENR THIS IF 'FIN'. DON'T SKIP
%6 RES 0
BAL,RL DOSKIP SKIP TO A DO/FIN
BAL,RL SET%SF
LW,XT DOCOUNT WHAT TERMINATED THE SKIPPING
BLZ GENR FIN. THAT'S WHAT WE WERE LOOKING FOR
MTW,1 SKIPTRIG ELSE FOUND, SET SKIP FLAG ON
B %6
PAGE
*
* E N D
* THIS ROUTINE PROCESSES THE END DIRECTIVE.
*
* AT THE END OF THE DEFINITION PASS, THE EBCDIC SYMBOL NAMES ARE
* READ AND EACH ENTRY IN THE SYMBOL TABLE IS INSPECTED FOR
* BEING A DEF, REF, OR SREF. WHEN FOUND, THE APPROPIATE
* DECLARATION IS OUTPUT TO THE OBJECT MODULE, AND A NEW
* DECLARATION NUMBER IS ASSIGNED. THIS NEW NUMBER IS ALSO
* USED TO REPLACE ANY EXTERNAL SYMBOL ENTRIES FOUND IN THE
* LITERAL TABLE. ANY UNDEFINED VALUES FOUND IN THE LITERAL
* TABLE ARE DELETED. THE CONTROL SECTION TABLE IS ACCESSED
* TO OUTPUT NON-STANDARD CONTROL SECTION DECLARATIONS TO THE
* OBJECT MODULE. FINALLY, INITIALIZATION FOR THE GENERATION
* PASS IS PERFORMED, AND THE GENERATION PASS IS BEGUN.
*
END%ERR RES 0
MTW,+1 SYSLEVEL BUMP SYSTEM LEVEL
END%ERR1 RES 0
BAL,ER KERR PROGRAM STRUCTURE ERROR
LI,XT1 0
STW,XT1 SKIPTRIG RESET SKIP INDICATOR
LI,XT1 -2
AW,XT1 XW BACKUP 2 ENCODED TEXT ENTRIES
NXTENC XT1,NOINC ITEM PRECEEDING END
CI,XT BEGINLIST
BNE %+2 NO LIST IN COMMAND FIELD
BAL,RL SKIPCMND SKIP COMMAND FIELD
STW,XW OPRND,LVL
END RES 0
BAL,RL NOTDO1 ERROR IF PRECEEDED BY A DO1
BAL,RL SYSEND DECREMENT SYSTEM LEVEL
BGE LINE5 STILL WITHIN A SYSTEM
* HERE FOR END OF SOURCE PROGRAM
MTW,+1 SYSLEVEL SET SYSTEM LEVEL BACK TO SOURCE
MTH,0 RD%STD BRANCH IF NOT PROCESSING A
BEZ END0 PRE-ENCODED SYSTEM FILE
MTH,-1 RD%STD SET INPUT FLAG FOR X1 FILE
MTW,-4 NOLIST CLEAR PRE-ENCODED LIST FLAG
LI,XT 0
STW,XT SKIPTRIG
STW,XT MAJLINE
STW,XT SUBLINE
XW,XT TEXTCT CLEAR RECORD COUNT
LCW,IOSIZE XT BACKSPACE THE STD FILE BY THE
BAL,IORL POSITIONSTD NUMBER OF RECORDS READ
MTW,1 SF SET SOURCE FLAG
B DEFGEN2
END0 RES 0
LW,XT PASS
IF,NZ
* HERE FOR GENERATION PASS
*
LW,XT DOCT,LVL NO DO'S SHOULD BE ACTIVE
BEZ %+2
BAL,ER KERR REPORT A STRUCTURE ERROR
LI,XT 0
STW,XT SKIPTRIG
STW,XT SOURCEONLY SET TO NORMAL FOR PRINTING LITERALS
LI,XT 8 RESET ALL LISTING CONTROL BITS
AND,XT NOLIST (EXCEPT 'NO LO' REQUEST BIT) TO
STW,XT NOLIST TURN LISTING ON FOR END LINE
MTW,1 SOURCE
LW,XT ENDADDR SET % TO ADDRESS ASSIGNED TO THE
XW,XT DLRVAL END LABEL
STW,XT TEMPO AND SAVE %
CALL DEFHEXLBL DEFINE END LABEL FOR GEN PASS
LD,XT BLANC
STW,XT LSTBF+3 BLANK OUT LOCATION FIELD
STD,XT LSTBF+4 LISTING POSITIONS
LW,XT TEMPO
STW,XT DLRVAL RESTORE %
FI
CALL EV%CLN%OPRND EVALUATE THE OPERAND FIELD
B *ROOTRTN RETURN TO ROOT FOR END%GEN OVERLAY
PAGE
*
* E N T E R 1
* STORES A VALUE IN THE SYMBOL TABLE IF THE VALUE FITS IN THE
* CURRENT SPACE OCCUPIED BY THE SYMBOL.
* INPUT: FND CONTAINS A POINTER TO THE FIXED ENTRY IN THE
* SYMBOL TABLE (LOCAL OR NON-LOCAL)
* ARG CONTAINS A POINTER TO THE DEFINITION VALUE.
*
* OUTPUT: ENTERED CONTAINS A ONE IF THE VALUE WAS ENTERED INTO
* THE SYMBOL TABLE, A ZERO IF NO ENTRY WAS MADE.
*
* USES REGISTERS
* RL, XT, XT1, ER
*
ENTER1 RES 0
STW,RL ENTEXIT SAVE RETURN
LI,XT1 1
LW,XT *ARG
BFNZ,XT SPAFLD,ENT1 BRANCH IF VALUE IS A 1 WORD ITEM
LW,XT ARG
BAL,RL LENGTH GET LENGTH OF VALUE
ENT1 RES 0
STW,XT1 LARG STORE LENGTH OF VALUE
LI,XT1 1 PRE-SET ITEM LENGTH TO ONE
LW,XT *FND
BFNZ,XT SPAFLD,ENT2 FND IS A SPECIAL ADDRESS ITEM
LW,XT FND
BAL,RL LENGTH GET LENGTH OF SYMBOL ENTRY
ENT2 RES 0
STW,XT1 LFND STORE LENGTH OF ENTRY
LW,XT *FND LOAD DEFINE FIELD OF FND
BFZ,XT SPAFLD,ENT4 BRANCH IF NOT A 1 WORD ITEM
BFZ,XT DEFFLD,ENT5 SYMBOL NOT DEFINED
ENT4 RES 0
BFZ,XT SETFLD,ENT7 SYMBOL NOT REDEFINEABLE
LW,XT1 *ARG LOAD SET FIELD OF VALUE
BFZ,XT1 SETFLD,ENT7 VALUE NOT REDEFINABLE
BFZ,XT,1 DUPFLD,ENT5 REDEFINE SYMBOL UNLESS DUPLICATE
ENT7 RES 0
LV,XT1 DEFFLD MASK FOR DEF FIELD
CS,XT PASSDEF
BNE ENT8 NOT YET DEFINED FOR CURRENT PASS
OR,XT =DUPFLD SET DUPLICATE DEFINITION BIT
STW,XT *FND AND STORE IT BACK INTO SYMBOL
BAL,ER DERR REPORT DUPLICALE DEFINITION ERROR
B DFNE1
ENT8 RES 0
BFZ,XT,1 DUPFLD,ENT5 REDEFINE SYMBOL FOR CURRENT PASS
BAL,ER DERR REPORT DUPLICATE DEFINITION ERROR
ENT5 RES 0
LV,XT1 DUPFLD+EXTFLD MOVE DUP AND EXT FIELDS OF SYMBOL
STS,XT *ARG TO DUP AND EXT FIELDS OF VALUE
LW,XT LARG
CW,XT LFND
BNE *ENTEXIT EXIT IF ITEMS NOT SAME LENGTH
LW,XT *ARG BRANCH IF ARG IS
BFNZ,XT SPAFLD,ENT3 A ONE WORD ITEM
LW,XT FND PREVENT STORING A ONE WORD
CW,XT MAIN 'NON-SPECIAL' ITEM INTO THE
BE *ENTEXIT FIXED WORD SYMBOL TABLE
ENT3 RES 0
BAL,RL NEWENTRY MOVE VALUE TO SYMBOL TABLE
B DFNE1
PAGE
*
* E Q U
* THIS ROUTINE PROCESSES THE EQU DIRECTIVE. SETVALUE IS SET TO
* NOT RE-DEFINABLE(0) AND THIS ROUTINE BRANCHES TO SET1.
*
* USES REGISTERS
* XT
*
EQU RES 0
LI,XT 0 SET TO NOT RE-DEFINABLE
B SET1
PAGE
*
* E R R O R
* PROCESS THE ERROR DIRECTIVE.
* CF(2) CONTAINS THE SEVERITY. IF '*', SEVERITY IS ZERO, AND
* THE MESSAGE IS COMMENTARY (NO '****' IS PUT IN THE LISTING)
* CF(3) CONTAINS THE CONDITION. IF NOT GREATER THAN ZERO, THE
* ERROR IS NOT PRODUCED
* AF CONTAINS THE MESSAGE TO BE PRINTED
*
LOCAL %1,%2,%3,%4,%5,%6,%7
ERROR RES 0
LI,XT 0
STW,XT ERRSEV
STW,XT ASTRIG
CW,XT CMNDLIST ARE THERE COMMAND FIELD EXPRESSIONS
BEZ ERRD30 NO
BAL,RL EVALUATE%AND%CLEAN EVALUATE COMMAND FIELD EXP'S
LW,XT LISTCT TEST NUMBER OF COMMAND EXPRESSIONS
CI,XT 2
BE %1 TWO
BL ERRD20 ZERO OR ONE
BAL,ER EERR TOO MANY EXPRESSIONS
%1 RES 0
LW,XT ECTEXPR2,XS
AW,XT KLINE CONTROL WORD FOR CF(3) EXPRESSION
BAL,RL EXTRACTCON
AI,XT1 0
BLEZ LINE5 CONDITION EXPRESSION NEGATIVE OR 0
ERRD20 RES 0
LW,XT ECTEXPR1,XS
AW,XT KLINE
BFZ,XT,1 ASTFLD,%2 CF(2) WAS NOT PRECEEDED BY '*'
MTW,1 ASTRIG SET COMMENT FLAG TO ONE
%2 RES 0
BAL,RL EXTRACTCON STORE VALUE OF CF(2) AS
STW,XT1 ERRSEV ERROR SEVERITY
ERRD30 RES 0
BAL,RL EVALUATE%AND%CLEAN EVALUATE AF AND RESET STACK PTRS
MTW,0 PASS
BEZ GENR DON'T PRINT IN THE DEFINITION PASS
BAL,RL TEXTMRGE PROCESS THE TEXT STRING
LI,XT 108
CW,XT TOTALCT
BGE %3
STW,XT TOTALCT
BAL,ER TERR
* SET A TRUNCATION ERROR IF SEVERITY IS NOT IN RANGE 0-15
%3 RES 0
LW,XT ERRSEV
IF,ANZ -16,XT MUST BE 0 - 15 /25342/*D-DG
BAL,ER TERR
ELS /25342/*D-DG
CB,XT MAXSEV UPDATE SEVERITY IF NEW HIGH/25342/*D-DG
IF,G /25342/*D-DG
STB,XT MAXSEV /25342/*D-DG
FI /25342/*D-DG
FI /25342/*D-DG
* /25342/*D-DG
* SET FOR ERROR OR COMMENT PRINTING /25342/*D-DG
* /25342/*D-DG
MTW,0 ERRSEV /25342/*D-DG
IF,NZ OR /25342/*D-DG
MTW,0 ASTRIG /25342/*D-DG
IF,EZ ONLY *0 IS COMMENT /25342/*D-DG
MTW,+1 ERRTRIG HAVE ERROR /25342/*D-DG
LI,XT 1 /25342/*D-DG
ELS /25342/*D-DG
LI,XT -1 /25342/*D-DG
FI /25342/*D-DG
STW,XT ERRSEV (ERRTRIG FOR MESSAGE) /25342/*D-DG
* /25342/*D-DG
* PRINT IF EITHER THERE IS A SOURCE LINE OR IF ANY ERRORS ARE SET
%7 RES 0
BAL,RL PRINTC2
* IF NOT A COMMENT, SET TO INCLUDE IN ERROR COUNT, AND MARK LINE
* /25342/*D-DG
LW,LBX ASTRIG
IF,EZ /25342/*D-DG
LI,NBYTES 6
LI,XT1 BA(ASTMSG)
BAL,RL AEDIT
FI /25342/*D-DG
LW,XT ERRSEV SET FOR ERROR/COMMENT /25342/*D-DG
STH,XT ERRTRIG /25342/*D-DG
LW,XT DESTIN WORD ADDRESS OF THE TEXT MESSAGE
SLS,XT 2 CONVERT TO A BYTE ADDRESS
LW,NBYTES TOTALCT NO. OF BYTES IN ERROR MESSAGE
BEZ ERRD50
* MOVE THE TEXT ERROR MESSAGE FROM THE EVT TO THE LISTING IMAGE
ERRD40 RES 0
LB,XT1 0,XT
STB,XT1 LSTBF,LBX
AI,XT 1
AI,LBX 1
BDR,NBYTES ERRD40
* PRINT THE TEXT ERROR MESSAGE AND RETURN
ERRD50 RES 0
BAL,RL PRINT
B GENR
PAGE
*
* E V A L A R
* THIS SUBROUTINE EVALUATES THE RESOLUTION (CF2) FIELD OF THE
* LOC, ORG, REF, AND SREF DIRECTIVES. THE CF(2) FIELD IS
* EVALUATED AND THE VALUE (1,2,4,OR8) IS MAPPED INTO A
* RESOLUTION VALUE (0,1,2,OR3). IF CF(2) IS BLANK OR INVALID,
* A RESOLUTION VALUE OF 2 IS RETURNED.
*
* INPUT: CMNDLIST INDICATES WHETHER A CF(2) FIELD EXISTS OR NOT
* XW CONTAINS AN INDEX TO THE ENCODED TEXT ITEM TO BE
* EVALUATED
*
* OUTPUT: XT CONTAINS THE RESOLUTION (0,1,2,OR3)
*
* CALL: BAL,RL EVALAR
*
* USES REGISTERS
* RL
* XT
* ER
*
EVALAR RES 0
STW,RL EVALARXIT SAVE RETURN
MTW,0 CMNDLIST
BEZ EVALAR2 NO CF(2) FIELD, USE A VALUE OF 4
BAL,RL EVAL1EXP EVALUATE THE CF(2) FIELD
LW,XT TEMP
BLEZ EVALAR1 NEGATIVE VALUE OR ZERO IS ERROR
CI,XT 3
BL EVALAR3 VALUE IS 1 OR 2
CI,XT 4
BE EVALAR3 VALUE IS 4
AI,XT -1
CI,XT 7
BE EVALAR3 VALUE WAS 8
EVALAR1 RES 0
BAL,ER EERR INVALID CF(2) ENTRY
EVALAR2 RES 0
LI,XT 4 USE A VALUE OF 4
EVALAR3 RES 0
SLS,XT -1 MAPS 1,2,4,OR 8 INTO 0,1,2, OR 3
B *EVALARXIT RETURN
PAGE
*
* E V A L P T
* EVALUATES THE PROTECTION TYPE FIELD OF A CSECT, DSECT, OR PSECT
* DIRECTIVE.
*
* INPUT: OPRND ENTRY IN THE PROCEDURE LEVEL TABLE CONTAINS AN
* INDEX TO THE OPERAND FIELD ENCODED TEXT
*
* OUTPUT: PROTYPE CONTAINS THE PROTECTION TYPE
*
* CALL: BAL,RL EVALPT
*
* USES REGISTERS
* ER
* XT
* LVL
* XW
* RL
*
EVALPT RES 0
STW,RL EVALPTXIT
CALL EV1OPRNDEXP EVALUATE ONE OPERAND EXPRESSION
LW,XT TEMP VALUE SPECIFIED FOR PROTECTION TYPE
BLZ EVALPT1 NEGATIVE IS ERROR
CI,XT 3
BLE EVALPT2 3 OR LESS IS OK
EVALPT1 RES 0
BAL,ER TERR TRUNCATION ERROR
LI,XT 0 USE PROTECTION TYPE OF ZERO
EVALPT2 RES 0
STW,XT PROTYPE
B *EVALPTXIT EXIT
PAGE
*
* E V A L 1 E X P
* THIS SUBROUTINE EVALUATES A FIELD AND TESTS THE RESULTS FOR
* CONTAINING ONE SINGLE PRECISION CONSTANT. IF MORE THAN ONE
* VALUE IS FOUND, AN ERROR IS REPORTED. IF THE FIRST (OR ONLY)
* VALUE IS NOT A SINGLE PRECISION CONSTANT, AN ERROR IS
* REPORTED AND THE VALUE IS SET TO ZERO. IF NO VALUE IS FOUND
* (E.G., THE FIELD IS BLANK), THE VALUE IS SET TO ZERO.
*
* OUTPUT: LSTCT CONTAINS THE NUMBER OF VALUES PROCESSED.
* XT & TEMP CONTAIN THE SINGLE PRECISION CONSTANT
* THE EXPRESSION TABLES HAVE BEEN DELETED.
*
* CALL: BAL,RL EVAL1EXP
*
* USES REGISTERS
* XT
* XT1
* RL
*
LOCAL %1,%2,%4,%5
*
EV1OPRNDEXP RES 0
*
LW,XW OPRND,LVL GET INDEX TO OPERAND FIELD
*
EVAL1EXP RES 0
STW,RL EVEXPXIT
BAL,RL EVALUATE%AND%CLEAN EVALUATE EXPRESSIONS
LW,XT LSTCT
BEZ %5 FIELD WAS BLANK
CI,XT 1
BE %1 FIELD CONTAINED ONE EXPRESSION
* HERE IF MORE THAN ONE EXPRESSION
BAL,ER EERR EXPRESSION ERROR
%1 RES 0
* DETERMINE IF 1ST VALUE IS A SINGLE PRECISION CONSTANT
LW,XT 0,XS EXPRESSION CONTROL WORD
LW,RL *KLINE,XT LOAD VALUE CONTROL WORD
AND,RL =DEFFLD GET DEFINITION
CW,RL PASSDEF
BNE %2 NOT DEFINED FOR CURRENT PASS
LV,XT1 ETFLD MASK FOR ET FIELD
CS,XT =SPINTET
BE %4 VALUE IS A SMALL INTEGER
CS,XT =INTET
BNE %2 VALUE IS NOT AN INTEGER CONSTANT
AI,XT 1
LW,XT *KLINE,XT GET WORD FOLLOWING CONTROL WORD
B %5
%2 RES 0
* HERE FOR ILLEGAL VALUE
BAL,ER EERR EXPRESSION ERROR
LW,XT EVT,LVL REPLACE ILLEGAL VALUE
LV,RL 1**(31-SPALOB)+1**(31-SPINTLOB) IN EVT TABLE WITH A
AW,RL PASSDEF VALUE OF ZERO
STW,RL *KLINE,XT
AV,XT SPINTET REPLACE ET FIELD VALUE WITH SPECIAL
STW,XT 0,XS INTEGER TYPE VALUE IN ECT
%4 RES 0
* HERE TO GET VALUE FROM SPECIAL INTEGER ENTRY
LW,XT *KLINE,XT CONTROL WORD
AND,XT =VALFLD RETAIN VALUE
%5 RES 0
STW,XT TEMP
B *EVEXPXIT
PAGE
*
* E V A L 1 I N T
* THIS SUBROUTINE CALLS EVAL1EXP AND REPORTS AN ERROR IF THE
* FIELD WAS BLANK
*
* CALL: BAL,RL EVAL1INT
*
* USES REGISTERS
* ER
* RL
*
EVAL1INT RES 0
STW,RL E1INTXIT
BAL,RL EVAL1EXP EVALUATE ONE EXPRESSION
MTW,0 LSTCT
BNEZ *E1INTXIT FIELD WAS NOT BLANK, RETURN
BAL,ER EERR EXPRESSION ERROR
B *E1INTXIT
PAGE
*
* E X T R A C T C O N
* EXTRACT A SINGLE PRECISION CONSTANT AND MARK ERRORS
*
* INPUT: ADDRESS OF CONTROL WORD IS IN REG. XT
*
* OUTPUT: CONSTANT IS IN REGISTER XT1. IF THE ITEM IS NOT A
* SINGLE PRECISION CONSTANT, AN ERROR IS SET
*
*
EXTRACTCON RES 0
LW,XT1 0,XT
BFZ,XT1 SPAFLD,EXTRC1 BRANCH IF NOT SPECIAL 1-WD ITEM
BFZ,XT1 SPINTFLD,EXTRC3 BRANCH IF NOT A SPECIAL INTEGER
AND,XT1 =VALFLD SAVE THE VALUE
EXIT RL
EXTRC1 RES 0
AND,XT1 =TYPEFLD+CTYPEFLD TEST FOR A SINGLE PRECISION INTEGER
CV,XT1 CONSTANT+SPI
BNE EXTRC2
LW,XT1 1,XT
EXIT RL
EXTRC2 RES 0
CV,XT1 BLANK TEST FOR A BLANK ITEM
BE EXTRC4
EXTRC3 RES 0
BAL,ER EERR
EXTRC4 RES 0
LI,XT1 0 EXIT WITH VALUE ZERO
EXIT RL
PAGE
FINDLSPC RES 0
STW,RL FINDSPCXIT
LCW,XT LARG DECREASE END OF LOCAL SYMBOL TABLE
AWM,XT NXTLOCAL ADDRESS BY NUMBER OF WORDS REQ'D
BAL,RL HILIMIT MAKE SURE THERE IS ROOM
B FINDSPC7
PAGE
*
* F I N D S P C
* FIND SPACE IN THE FREE LIST
*
* INPUT: VARIABLE LARG CONTAINS NUMBER OF WORDS REQUIRED
* VARIABLE FREELIST CONTAINS ADDRESS OF 1ST ENTRY
* IN THE THREADED FREE SPACE LIST. EACH ENTRY
* POINTS TO THE NEXT AVAILABLE ENTRY, IN ASCENDING
* ORDER. THE LAST ENTRY POINTS TO VARIABLE FREELIST.
*
* OUTPUT: FND CONTAINS FOUND ADDRESS. THE APPROPRIATE WORD
* IN THE THREADED FREE SPACE LIST HAS BEEN CHANGED
* TO REFLECT THE REMOVAL OF LARG WORDS FROM
* THE FREE SPACE LIST.
*
*
* REGISTERS USED: XT,XT1,XT2,R8,R9,R10
*
*
FINDSPC RES 0
STW,RL FINDSPCXIT
LI,XT FREELIST
LW,LARGR LARG SHIFT REQUIRED SIZE
SHIFT,LARGR 31,FREELLOB TO LENGTH FIELD
LV,LOWD 8192**(31-FREELLOB) PRESET SMALLEST DELTA TO 8192
FINDSPC1 RES 0
LW,XT1 0,XT GET NEXT FREE SPACE ENTRY
AND,XT1 =FREEAFLD SAVE THE CLEAN ADDRESS
LW,XT2 0,XT1
AND,XT2 =FREELFLD SAVE THE LENGTH FIELD
BEZ FINDSPC2 NO MORE FREE SPACE. END OF FREE LIST
SW,XT2 LARGR SUBT. SIZE REQUIRED
BNEZ FINDSPC3 BRANCH IF NOT REQUIRED SIZE
STW,XT1 FND STORE ADDRESS OF FOUND AREA
LV,R9 FREEAFLD DELETE THE FOUND ENTRY,
LW,R8 0,XT1 SINCE AN EXACT FIT
STS,R8 0,XT WAS FOUND.
B *FINDSPCXIT
FINDSPC3 RES 0
BL FINDSPC4 BRANCH IF THIS AREA IS TOO SMALL
CW,XT2 LOWD TEST FOR CLOSEST FIT
BGE FINDSPC4 NOT CLOSEST
LW,LOWD XT2 REPLACE CLOSEST FIT
STW,XT1 FND ADDRESS AND SIZE
FINDSPC4 RES 0
LW,XT XT1 MOVE TO NEXT FREE LIST ENTRY
B FINDSPC1
FINDSPC5 RES 0
LW,XT FND ADDRESS OF CLOSEST FIT
LV,LOWD+1 FREELFLD
STS,LOWD 0,XT STORE REMAINING SPACE IN THIS ENTRY
SHIFT,LOWD FREELLOB,31 BUMP ADDRESS OF FND TO POINT TO
AWM,LOWD FND THE FOUND LARG WORDS
B *FINDSPCXIT
FINDSPC2 RES 0
CV,LOWD 8192**(31-FREELLOB) BRANCH IF AN ENTRY
BNE FINDSPC5 WAS FOUND
LW,XT NXTSYMT
STW,XT FND SAVE CURRENT END OF SYMBOL TABLE
AW,XT LARG INCREASE END OF SYMBOL TABLE
STW,XT NXTSYMT ADDRESS BY NUMBER OF WORDS REQ'D
BAL,RL LOLIMIT MAKE SURE THERE IS ROOM
FINDSPC7 RES 0
LW,XT NXTLOCAL
AW,XT NXTSYMT
SLS,XT -1 MID-POINT OF TOTAL SPACE
LW,XT1 NXTLOCAL
SW,XT1 NXTSYMT
SLS,XT1 -3 ONE/EIGHTH OF TOTAL SPACE
LW,ER XT
AW,ER XT1 KLINE SHOULD BE MOVED DOWN IF IT
CW,ER KLINE EXCEEDS THE MID-POINT BY MORE THAN
BL FINDSPC8 1/8 OF THE SPACE REMAINING
SW,XT XT1 OR, IF IT IS LESS THAN THE
CW,XT KLINE MID-POINT BY MORE THAN 1/8 OF
BLE *FINDSPCXIT THE TOTAL SPACE REMAINING
FINDSPC8 RES 0
LI,XT 1
STB,XT FINDSPCXIT INDICATE ADJUSTMENT NEEDED
B *FINDSPCXIT
PAGE
FNAME RES 0
LV,XT FUNCNAME+LNGTH2 FUNCTION NAME CONTROL WORD
B CNAME2
PAGE
*
* F R E E S P C
* RELEASE SYMBOL TABLE STORAGE BY ADDING THE RELEASED STORAGE
* TO THE FREE SPACE LIST. IF THE FREED SPACE IS AT THE
* END OF THE SYMBOL TABLE, IT'S ADDED TO THAT TABLE INSTEAD
* OF THE FREE SPACE LIST.
*
* THE FREE SPACE LIST IS IN ASCENDING ORDER (CORE ADDRESSES).
* IF THIS AREA IS CONTIGUOUS TO ANOTHER ENTRY, IT IS APPENDED
* TO THAT ENTRY; NO NEW ENTRY IS CREATED.
*
* INPUT: FND CONTAINS THE ADDRESS OF THE ENTRY TO BE RELEASED.
* LFND CONTAINS IT'S LENGTH.
*
* OUTPUT: FREELIST, NXTSYMT, AND/OR THE CONTENTS OF THE
* APPROPRIATE FREE SPACE LIST ENTRY(S) MODIFIED
* TO REFLECT THE RELEASED STORAGE.
*
* REGISTERS USED: XT,XT1,XT2,R8,R9,R10
*
*
FREESPC RES 0
STW,RL FINDSPCXIT
LW,XT FND IS SPACE AT THE END
AW,XT LFND OF SYMT
CW,XT NXTSYMT
BNE FREESPC1 NOT AT END OF SYMT
LCW,XT LFND SUBT. LENGTH OF ARGUMENT
AWM,XT NXTSYMT FROM NXTSYMT
B FINDSPC7
FREESPC1 RES 0
LI,LOWD FREELIST PRESET LOW ADDRESS
LW,LARGR FREELIST PRESET HIGH ADDRESS
FREESPC2 RES 0
LW,XT *LARGR FIND THE LOW AND HIGH ADDRESSES
AND,XT =FREELFLD THAT BOUND THE AREA TO BE RELEASED
BEZ FREESPC3 BRANCH IF END OF FREE SPACE LIST
CW,LARGR FND
BG FREESPC3 BRANCH IF BOUNDING ADDRESSES FOUND
LW,LOWD LARGR MOVE HIGH TO LOW
LW,LARGR *LARGR AND ADDRESS AT HIGH
AND,LARGR =FREEAFLD TO HIGH
B FREESPC2 TRY AGAIN
FREESPC3 RES 0
LW,XT FND MAKE THE ENTRY
LV,XT1 FREEAFLD TO REFLECT
STS,XT *LOWD THE RELEASED STORAGE
LW,XT LFND LINK LOW ADDRESS TO THIS ENTRY
SHIFT,XT 31,FREELLOB LINK THIS ENTRY TO HIGH ADDRESS
AW,XT LARGR
STW,XT *FND
FREESPC4 RES 0
LW,XT *LOWD ELIMINATE CONTIGUOUS AREAS
AND,XT =FREELFLD
SHIFT,XT FREELLOB,31
AW,XT LOWD
CS,XT *LOWD
BNE FREESPC5 AREAS NOT CONTIGUOUS
LW,XT *XT
STS,XT *LOWD
AND,XT =FREELFLD ADD LENGTHS OF
AWM,XT *LOWD CONTIGUOUS AREAS
B FREESPC4
FREESPC5 RES 0
LW,XT *FND
AND,XT =FREELFLD
SHIFT,XT FREELLOB,31
AW,XT FND
CS,XT *FND
BNE *FINDSPCXIT
LW,XT *XT
STS,XT *FND
AND,XT =FREELFLD
AWM,XT *FND
B *FINDSPCXIT
PAGE
*
* G E N
* THIS ROUTINE PROCESSES THE GEN DIRECTIVE. IT CALLS GENORCOM
* AND THEN RETURNS TO GENR.
*
*
GEN RES 0
BAL,RL GENORCOM
B GENR BACK TO MAIN CONTROL
PAGE
*
* G E N O R C O M
* THIS ROUTINE PROCESSES THE LOGIC COMMON TO BOTH THE GEN
* DIRECTIVE AND A COM REFERENCE. THE LABEL FIELD IS DEFINED.
* THEN SCAN IS CALLED TO EVALUATE A FIELD LIST. THE FIELD LIST
* MUST CONSIST OF SMALL POSITIVE INTEGER VALUES WHOSE SUM MAY
* NOT EXCEED 128. IF NECESSARY, A DUMMY FIELD IS ADDED TO PAD
* THE TOTAL TO A MULTIPLE OF 8. SCAN IS THEN CALLED TO
* EVALUATE THE VALUE LIST SPECIFIED IN THE OPERAND FIELD.
* IN THE DEFINITION PASS BOTH LOCATION COUNTERS ARE INCREASED
* BY THE NUMBER OF BYTES TO BE GENERATED. IN THE GENERATION
* PASS, GENERATE IS CALLED TO PRODUCE THE BINARY CODE.
*
* INPUT: CMNDLIST IS ZERO IF NO FIELD SIZE ENTRIES HAVE BEEN
* SPECIFIED
*
* OUTPUT: BOTH DLRVAL AND DDLRVAL HAVE BEEN INCREASED BY THE
* NUMBER OF BYTES GENERATED.
*
* USES REGISTERS
* XT, XT1, XT2, RL, XS, ER
*
GENORCOM RES 0
STW,RL GENCOMXIT
CALL DEFHEXLBL DEFINE THE LABEL
MTW,0 CMNDLIST
BEZ GENCOM5 NO COMMAND FIELD ENTRIES
BAL,RL SCAN EVALUATE COMMAND FIELD ENTRIES
LW,XT LSTCT SAVE NUMBER OF FIELD SIZE ENTRIES
STW,XT FLDCNT FOR GENERATE
STW,XS FLDPTR SAVE POINTER TO FIELD SIZE LIST
LI,XT 0
STW,XT TEMPO INITIALIZE TOTAL FIELD SIZE TO ZERO
GENCOM1 RES 0
LW,XT2 0,XS INDEX TO EVT ENTRY
AW,XT2 KLINE ADDRESS OF EVT ENTRY
LW,XT 0,XT2 CONTROL WORD OF EVT ENTRY
BFZ,XT SPAFLD,GENCOM6 NOT A SPECIAL ONE WORD ITEM
BFZ,XT SPINTFLD,GENCOM6 NOT A SPECIAL INTEGER
LV,XT1 DEFFLD
CS,XT PASSDEF BRANCH IF INTEGER NOT DEFINED
BNE GENCOM8 FOR CURRENT PASS
AND,XT =VALFLD
AWM,XT TEMPO ACCUMULATE TOTAL FIELD SIZE
LI,XT1 128
CW,XT1 TEMPO
BGE GENCOM2 TOTAL FIELD SIZE IS 128 OR LESS
SW,XT1 TEMPO NUMBER OF UNITS IN EXCESS OF 128
AWM,XT1 TEMPO SET TOTAL FIELD SIZE TO 128
AWM,XT1 0,XT2 DECREASE VAL BY THE AMOUNT THAT
BAL,ER TERR TRUNCATION ERROR
GENCOM2 RES 0
AI,XS -1 DECREMENT ADDRESS OF ECT ENTRY
MTW,-1 LSTCT DECREMENT LIST COUNT
BGZ GENCOM1 MORE ENTRIES TO PROCESS
LW,XT1 TEMPO
BEZ GENCOM7 TOTAL FIELD SIZE IS ZERO
AND,XT1 =7
BEZ GENCOM3 TOTAL FIELD SIZE IS A MULTIPLE OF 8
LI,XT 8
SW,XT XT1 DUMMY FIELD SIZE USED TO PAD TOTAL
AWM,XT TEMPO FIELD SIZE TO A MULTIPLE OF 8
BAL,RL STACKSPI APPEND SPEC. INT. TO EXP STACK
MTW,1 FLDCNT INCREMENT COUNT OF FIELD SIZE ENTRYS
BAL,ER EERR
GENCOM3 RES 0
BAL,RL EVALUATE%AND%CLEAN EVALUATE OPERAND FIELD ENTRIES
STW,XS VALPTR SAVE POINTER TO VALUE(S)
LW,XT LSTCT SAVE NUMBER OF VALUE ENTRIES FOR
STW,XT VALCNT GENERATE
LW,XT TEMPO CONVERT TOTAL FIELD SIZE FROM
SLS,XT -3 NUMBER OF BITS TO NUMBER OF BYTES
BAL,RL GENERATE PRODUCE BINARY CODE IN GEN PASS
B *GENCOMXIT
GENCOM5 RES 0
LI,XT 32
STW,XT TEMPO SET TOTAL FIELD SIZE TO 32
LW,XS ECT,LVL
AW,XS KLINE ADDRESS OF EXPRESSION ENTRY
BAL,RL STACKSPI APPEND SPEC.INT. 32 TO EXP STACK
LI,XT 1
STW,XT FLDCNT SET COUNT OF FIELD SIZE ENTRIES TO 1
STW,XS FLDPTR POINTER TO FIELD SIZE ENTRY
B GENCOM3
GENCOM6 RES 0
LV,XT 1**(31-SPALOB)+1**(31-SPINTLOB)
AW,XT PASSDEF STORE A SPECIAL INTEGER ZERO ENTRY
STW,XT 0,XT2 OVER THE 'ILLEGAL' EVT ENTRY.
LV,XT SPINT%ET CHANGE THE ECT ENTRY TO INDICATE
LV,XT1 ETFLD+EXPFLD THAT THE EVT ENTRY IS A SPECIAL
STS,XT 0,XS INTEGER
BAL,ER EERR
B GENCOM2
GENCOM7 RES 0
BAL,RL LINESKIP SKIP THIS LINE
B *GENCOMXIT
GENCOM8 RES 0
BAL,ER UERR UNDEFINED
B GENCOM2
PAGE
*
* G E T P L O C
* RE-INSTATE THE PREVIOUS PROCEDURE LEVEL TABLE
*
* INPUT: LVL CONTAINS THE ADDRESS OF THE CURRENT PROCEDURE
* LEVEL TABLE
*
* OUTPUT: LVL CONTAINS THE ADDRESS OF THE PREVIOUS PROCEDURE
* LEVEL TABLE
*
* USES REGISTERS
* RL, LVL
*
GETPLOC RES 0
MTW,-1 PROCREF DECREMENT PROCEDURE REFERENCE LEVEL
GETPLOC1 RES 0
LW,LVL PLOC,LVL FORM ADDRESS OF PREVIOUS PROCEDURE
AW,LVL KLINE LEVEL TABLE AND
AND,LVL =PLOCFLD CLEAN IT
EXIT RL
PAGE
* G L B L A D D
* FIND THE SYMBOL TABLE ADDRESS OF A GLOBAL SYMBOL
* IF THE SYMBOL REQUIRES ADDITIONAL SYMT SPACE, THAT SPACE
* IS OBTAINED, AND AN UNDEFINED ITEM IS STORED IN IT.
*
* ALTERNATE ENTRY POINT IS GLBLADD0, WHICH FUNCTIONS
* THE SAME, BUT DOES NOT SET THE UNDEFINED FLAG.
*
* INPUT: THE SYMBOL NUMBER IN XT.
*
* OUTPUT: FND CONTAINS THE (FULL) ADDRESS OF THE SYMBOL
* MAIN CONTAINS THE FIXED SYMT ADDRESS
*
GLBLADD0 RES 0
MTB,+1 RL SET FLAG
*
GLBLADD RES 0
STW,RL GLBLAXIT SAVE EXIT
AND,XT =VFLD SAVE THE CLEAN SYMBOL NUMBER
AW,XT SYMT
STW,XT MAIN MAIN SYMT ADDRESS
LW,XT1 0,XT GET MAIN SYMT ENTRY
BLZ GLBLADD1 SPECIAL ADDR. OR INTEGER
AND,XT1 =LPTRFLD IS THERE AN LPTR FIELD
BEZ GLBLADD2 NO
LW,XT XT1
AW,XT SYMT
GLBLADD1 RES 0
STW,XT FND FULL ADDRESS
B *GLBLAXIT
GLBLADD2 RES 0
LI,XT 1 FIND DYNAMIC TABLE
STW,XT LARG SPACE FOR THE SYMBOL
BAL,RL FINDSPC
LW,XT1 FND LINK TO THE FOUND LOCATION
SW,XT1 SYMT
STS,XT1 *MAIN
LV,XT1 SPAFLD
MTB,0 GLBLAXIT
IF,EZ
AV,XT1 SPINTFLD SET UNDEFINED FLAG
FI
STW,XT1 *FND UNDEFINED ITEM TYPE
B *GLBLAXIT
PAGE
*
* G O T O
* PROCESS THE GOTO DIRECTIVE
* THE LABEL IS IGNORED.
*
* FORM OF THE DIRECTIVE:
* GOTO,EXP SYM1,...,SYMN
*
* IF EXP IS MISSING, USE 1
* IF EXP NG 0, ASSEMBLE THE NEXT LINE
* IF EXP GT N, MARK AN ERROR AND ASSEMBLE NEXT LINE
*
LOCAL %1,%2,%3,%4
GOTO RES 0
BAL,RL NOTDO1
LI,XT 1
STW,XT TEMP
LW,XT CMNDLIST IS THERE A COMMAND FIELD EXPRESSION
BEZ GOTO10 NO, USE A VALUE OF ONE
BAL,RL EVAL1INT EVALUATE CF(2) FIELD
LW,XT1 TEMP VALUE OF THE EXP
BLEZ LINE5 SKIP THE REST OF THE LINE
BAL,RL EDITV EDIT THE CF(2) FIELD
GOTO10 RES 0
LI,XT 0 CLEAR GOTO SEARCH ARGUMENT
GOTO15 RES 0
STW,XT GOTOARG
GOTO20 RES 0
NXTENC NEXT ENCODED ENTRY TO REG XT
LI,XT1 TFLD MASK FOR ENCODED TYPE FIELD
CS,XT =ENCSYM GLOBAL SYMBOL
BE %2 YES
CS,XT =LOCALSYM LOCAL SYMBOL
BE %2 YES
CI,XT ENDLINE END-OF-LINE
BE %3 YES
LI,XT 0
STW,XT GOTOARG
%3 RES 0
AI,XW -1
BAL,RL LINESKIP SKIP THE REST OF THIS LINE
LW,XT GOTOARG WAS GOTO SEARCH ARGUMENT
BNEZ GOTO30 YES
BAL,ER SERR
B GENR
%2 RES 0
MTW,-1 TEMP DECREASE SYMBOL COUNT
BNEZ GOTO20 NOT THE N'TH ONE
B GOTO15 SAVE GOTO ARGUMENT
GOTO30 RES 0
BAL,RL SKIPINIT INITIALIZE FOR THE GOTO SEARCH
* HERE TO SKIP LINES UNTIL ARGUMENT OF THE GOTO IS FOUND
LOCAL %1,%2,%3,%4,%5,%6,%7
GOSRCH RES 0
BAL,RL SKIPGETLF1 GET LF(1)ENTRY IN REG XT
CI,XT BLANKEXP IS LABEL FIELD BLANK
BE GOSRCH20 YES
CI,XT BEGINLIST TEST FOR NON-STANDARD LABEL FIELD
BE GOSRCH1 YES
BAL,RL GOARG TEST FOR GOTO SRCH ARG /11243/B-13473
* LABEL NOT FOUND. INSPECT THE COMMAND AND SKIP THE REST OF THE LINE
GOSRCH20 RES 0
BAL,RL SPECDIR TEST FOR SPECIAL DIRECTIVES
* IF THIS LINE IS 'FIN' ON THIS LEVEL, DELETE A 'DO' TABLE ENTRY
LW,XT DOCOUNT IS THIS LINE 'FIN' ON THIS LEVEL
BGEZ %3
MTW,1 DOCOUNT RESET DOCOUNT TO ZERO
LW,XT DOCT,LVL IS THERE AN ACTIVE 'DO'
BGZ %2 YES
BAL,ER KERR ILLEGAL INSTRUCTION ERROR
B %3
%2 RES 0
BAL,RL DELETE%DO DELETE THE DO RECORD
%3 RES 0
BAL,RL LINESKIP SKIP THE REST OF THIS LINE
BAL,RL SET%SF
B GOSRCH
GOSRCH1 RES 0
LI,XT 1
STW,XT LISTCT PRESET DEPTH OF LIST NESTING
GOSRCH10 RES 0
NXTENC NEXT LABEL FIELD ENTRY
BAL,RL GOARG TEST FOR GOTO SRCH ARG /11243/B-13473
CI,XT ENDLIST
BNE %5
MTW,-1 LISTCT
BEZ GOSRCH20
%5 RES 0
CI,XT BEGINLIST
BNE %6
MTW,1 LISTCT
%6 RES 0
AV,XT ENCTYPE1 TEST FOR LARGE INTEGER
BCR,8 GOSRCH10 NO
AND,XT =LFLD CLEAN THE LENGTH FIELD
AW,XW XT
B GOSRCH10
GOSRCH30 RES 0
LW,XW LBL,LVL RESET XW TO THE LABEL FIELD
LI,XT 0 TERMINATE THE GOTO SEARCH
STW,XT SKIPTRIG
B LINE2
LOCAL
* /11243/B-13473
* G O A R G /11243/B-13473
* /11243/B-13473
GOARG RES 0 /11243/B-13473
LV,XT1 TFLD MASK FOR T FIELD /11243/B-13473
CS,XT =ENCLSYM COMPARE FOR LOCAL SYMBOL /11243/B-13473
BNE GOARG%1 ENCODED ITEM NO A LOCAL SYMBOL/11243/B-13473
LW,XT1 PROCREF MERGE PROC LEVEL INTO /11243/B-13473
SHIFT,XT1 31,PLVLLOB ENCODED LOCAL SYMBOL /11243/B-13473
OR,XT XT1 /11243/B-13473
GOARG%1 RES 0 /11243/B-13473
CW,XT GOTOARG /11243/B-13473
EXIT,NE RL NOT GOTO SEARCH ARGUMENT /11243/B-13473
LW,XT1 PROCCOUNT IGNORE MATCH IF NOT /11243/B-13473
OR,XT1 DOCOUNT AT SAME PROC, DO, AND /11243/B-13473
OR,XT1 SYSCOUNT SYS LEVEL /11243/B-13473
BEZ GOSRCH30 FOUND, TERMINATE SEARCH /11243/B-13473
EXIT RL /11243/B-13473
PAGE
*
* L C L D L T E
* DELETES THE LOCAL SYMBOL TABLE AT THE CURRENT PROCEDURE LEVEL
*
* INPUT: LOCALORG CONTAINS INDEX TO ORIGIN OF THE LOCAL SYMBOL
* TABLE
* LOCALCT CONTAINS THE NUMBER OF ENTRIES CURRENTLY IN
* THE LOCAL TABLE
*
* OUTPUT: NXTLOCAL IS SET TO THE ORIGIN OF THE LOCAL SYMBOL
* TABLE.
*
* CALL: BAL,RL LCLDLTE
*
* USES REGISTERS
* RL
* XT
* XT1
* LVL
* ER
*
LCLDLTE RES 0
STW,RL LCLDLXIT
LW,XT LOCALORG,LVL INDEX TO LOCAL TABLE ORIGIN + (SYMT)
AW,XT SYMT IS ADDRESS OF LOCAL TABLE ORIGIN
STW,XT MAIN
AND,XT =LOCALORGFLD
STW,XT NXTLOCAL NEXT AVAILABLE LOCAL SYMBOL ADDRESS
LB,ER MAIN NUMBER OF LOCALS
BEZ *LCLDLXIT EXIT, IF NONE
LCLDLTE1 RES 0
LW,XT *MAIN
BFNZ,XT SPAFLD,LCLDLTE3 BRANCH IF SPEC. ADDR.
AW,XT SYMT
STW,XT FND
BAL,RL SRCLCLFD TEST FOR FORWARD REFERENCED LOCAL
CI,XT1 0
BNE LCLDLTE2 ANY FOUND ARE UNDEFINED
LCLDLTE3 RES 0
MTW,-1 MAIN BUMP ADDRESS TO NEXT LOCAL
BDR,ER LCLDLTE1 CONTINUE UNTIL ALL SYMBOLS PROCESSED
B *LCLDLXIT EXIT
LCLDLTE2 RES 0
BAL,ER UERR UNDEFINED ERROR
B *LCLDLXIT EXIT
PAGE
*
* L E N G T H
* DETERMINES THE LENGTH OF A SYMBOL TABLE OR EXPRESSION TABLE
* ITEM.
*
* INPUT: XT CONTAINS A POINTER TO THE ARGUMENT
*
* OUTPUT: XT1 CONTAINS THE LENGTH OF THE ITEM
* XT CONTAINS A POINTER TO THE ARGUMENT
*
* CALL: BAL,RL LENGTH
*
* USES REGISTERS
* XT
* XT1
*
LENGTH RES 0
LW,XT1 0,XT LOAD SPA FIELD OF ITEM
BFZ,XT1 SPAFLD,LENGTH2 ITEM IS NOT A SPECIAL ADDRESS ITEM
LENGTH1 RES 0
LI,XT1 1 RETURN A LENGTH OF ONE
EXIT RL
LENGTH2 RES 0
AND,XT1 =TYPEFLD LOAD TYPE FIELD
CV,XT1 SYMBOL
BNE LENGTH3 ITEM IS NOT A SYMBOL ENTRY
LV,XT1 STYPEFLD MASK FOR SYMBOL TYPE FIELD
LS,XT1 0,XT LOAD SYMBOL TYPE FIELD
CV,XT1 CMPLXSUM
BG LENGTH1 SINGLE WORD ITEM
LENGTH3 RES 0
LV,XT1 LENGTHFLD MASK FOR LENGTH FIELD
LS,XT1 0,XT LOAD ITEM LENGTH
EXIT RL
PAGE
*
* L I N E **** M A I N C O N T R O L ****
* PROCESSES THE NEXT LINE FOR BOTH PASSES
* XW IS AN INDEX TO THE NEXT ENCODED TEXT ITEM AND POINTS TO
* THE BEGINNING OF A LINE WHEN THIS ROUTINE IS ENTERED.
* XWBASE CONTAINS THE BASE ADDRESS OF THE ENCODED TEXT, WHICH
* MAY BE EITHER THE ADDRESS OF THE ENCODED TEXT INPUT BUFFER
* (INBUF), THE BASE ADDRESS OF THE SAMPLE TABLE(SYMT), OR THE
* BASE ADDRESS OF THE PARTICULARIZATION BUFFER(KLINE).
* LVL CONTAINS A POINTER TO THE PROCEDURE LEVEL TABLE
*
* XT AND XT1 ARE TEMPORARY INDEX REGISTERS
*
*
* USES REGISTER
* RL
* XT
* XT1
* XW
* LVL
* ER
*
GENR1 RES 0
LW,XT PROCREF BRANCH IF WITHIN
BNEZ LINE3 A PROCEDURE REFERENCE
*
CALL PRINTC PRINT IF THERE IS A SOURCE LINE
*
LINE RES 0
*
LW,XT SF
STW,XT SOURCE
BAL,RL LINENUM PROCESS LINE NUMBER
LINE%1 RES 0
BAL,RL DELETEXP DELETE THE EXPRESSION TABLES
BAL,RL ADJKLINE ADJUST KLINE IF NEEDED
LI,XT 0
STW,XT SAMP,LVL INITIALIZE SAMPLE TABLE INDEX
LINE%2 RES 0
BAL,RL LINE%FLDS SET LBL, CMND, OPRND POINTERS
LW,XT1 PROCLV
BNE SAMPLIN BRANCH IF STORING A PROC DEFINITION
MTW,1 LOCALFLG
LI,XT1 TFLD MASK FOR ITEM TYPE FIELD
AND,XT1 XT TYPE OF ITEM TO XT1
AND,XT =VFLD VALUE OF ITEM TO XT
*
* FIRST COMMAND FIELD MUST BE A SIMPLE SYMBOL
*
CI,XT1 ENCSYM
BNE LINE10 COMMAND IS NOT A SYMBOL
*
* IF DIRECTIVE, BREAK OUT HERE
*
CI,XT HI%DIR
IF,LE -10- DOIF DIRECTIVE
LH,XT DIRTBL,XT
B DIRBASE,XT BRANCH TO DIRECTIVE
FI -10-
*
* PROGRAM SYMBOL -- SEE IF COMMAND IS DEFINED
*
LW,XT *SYMT,XT INDEX TO SYMBOL TABLE FOR COMMANDS
SHIFT,XT CPTRLOB,31 RIGHT JUSTIFY CPTR
CI,XT 1
BLE LINE10 SYMBOL NOT DEFINED AS A COMMAND
AW,XT SYMT ADDRESS OF COMMAND ENTRY
STW,XT REFADD SAVE ADDRESS OF COMMAND ENTRY
LW,XT2 0,XT PICK UP COMMAND NAME ENTRY
AND,XT2 =COMTFLD MASK FOR COMMAND TYPE FIELD
SHIFT,XT2 COMTLOB,31 RIGHT JUSTIFY COMMAND TYPE
LH,XT1 COMTABLE,XT2
B COMBASE,XT1 BRANCH TO COMMAND PROCESSOR
LINE10 RES 0
BAL,ER IERR UNKNOWN COMMAND ERROR
CALL DEFHEXLBL DEFINE THE LABEL FIELD
LW,XW OPRND,LVL LOAD INDEX TO OPERAND FIELD
B DATA2 PROCESS COMMAND AS DATA
COMMENT RES 0
MTW,-1 LOCALFLG
CLOSE RES 0
OPEN RES 0
LINE5 RES 0
BAL,RL LINESKIP SKIP REMAINDER OF THIS LINE
GENR RES 0
LW,XT DO1CT,LVL PICK UP DO1 COUNT
BEZ GENR1 DON'T REPEAT THE CURRENT LINE
MTW,-1 DO1CT,LVL DECREMENT THE DO' COUNT
LW,XW DO1LBL INDEX TO LABEL FIELD OF LINE
* FOLLOWING THE DO1 LINE.
BAL,RL PRINTC1 PRINT IF THERE IS A SOURCE LINE
LINE2 RES 0
LW,XT PROCREF
BNEZ LINE3 BRANCH IF WITHIN A PROC REFERENCE
LW,XW LBL,LVL GET INDEX TO THE LABEL FIELD
B LINE%1
*
LINE3 RES 0
NXTENC GET NEXT ENCODED ITEM
AND,XT =VFLD SAVE PARTIC FLAG
BEZ LINE%1 NO PARAMETER SUBSTITUTION
BAL,RL PARTIC PARTICULARIZE
B LINE%2
*
* TABLE OF OFFSETS TO DIRECTIVE PROCESSORS
*
DIR COM,16 AF-DIRBASE
DIRTBL RES 0
DIR COMMENT
DIR CLOSE
DIR LOCAL
DIR OPEN
DIR SYSTEM
DIR PROC
DIR PEND
DIR END
DIR DATA
DIR ASECT
DIR SOCW
DIR ELSE
DIR FIN
DIR PAGE
DIR PCC
DIR DEF
DIR REF
DIR SREF
DIR PSR
DIR BOUND
DIR CNAME
DIR COM
DIR CSECT
DIR DISP
DIR DO
DIR DO1
DIR DSECT
DIR EQU
DIR ERROR
DIR FNAME
DIR GEN
DIR GOTO
DIR LIST
DIR LOC
DIR ORG
DIR PSECT
DIR PSYS
DIR RES
DIR S:SIN
DIR SET
DIR SPACE
DIR TEXT
DIR TEXTC
DIR TITLE
DIR USECT
BOUND 4
*
* TABLE OF OFFSETS TO COMMAND TYPE PROCESSORS
*
COMT COM,16 AF-COMBASE
COMTABLE RES 0
COMT COMREF4 COM REFERENCE (WITH BOUND 4)
COMT COMREF COM REFERENCE (WITHOUT BOUND 4)
COMT S:SINREF S:SIN REFERENCE
COMT CNAMEREF CNAME REFERENCE
BOUND 4
PAGE
*
* L I N E % F L D S
* THIS SUBROUTINE STORES POINTERS TO THE BEGINNING OF THE LABEL,
* COMMAND, AND OPERAND FIELDS OF THE CURRENT LINE. THE
* POINTERS ARE STORED IN THE LBL, CMND, AND OPRND ENTRIES
* OF THE CURRENT PROCEDURE LEVEL TABLE.
*
* INPUT: XW POINTS TO THE FIRST ENCODED TEXT ITEM FOR THE LINE
*
* OUTPUT: LBL,LVL POINTS TO THE LABEL FIELD OF THE LINE
* CMND,LVL POINTS TO THE COMMAND FIELD OF THE LINE
* OPRND,LVL POINTS TO THE OPERAND FIELD OF THE LINE
* XT CONTAINS THE CF(1) ENTRY
*
* USES REGISTERS
* RL, XT, XW
*
LINE%FLDS RES 0
STW,RL LINEXIT SAVE RETURN
STW,XW LBL,LVL STORE INDEX TO THE LABEL FIELD
NXTENC GET NEXT ENCODED ITEM
CI,XT BEGINLIST BRANCH IF LABEL FIELD DOES
BNE %+2 NOT CONTAIN A 'STANDARD LABEL'
BAL,RL SKIPLABEL SKIP THE LABEL FIELD
STW,XW CMND,LVL STORE INDEX TO THE COMMAND FIELD
LI,XT 0
STW,XT CMNDLIST INITIALIZE TO NO COMMAND LIST
NXTENC GET NEXT ENCODED ITEM
STW,XW OPRND,LVL INDEX TO OPERAND OR CF(1) FIELD
CI,XT BEGINLIST EXIT IF COMMAND FIELD DOES
BNE *LINEXIT NOT CONTAIN A LIST
MTW,1 CMNDLIST INDICATE A COMMAND LIST
BAL,RL SKIPCMND SKIP THE COMMAND FIELD
XW,XW OPRND,LVL STORE INDEX TO OPERAND FIELD,
* AND LOAD INDEX TO CF(1) FIELD
NXTENC GET CF(1) ENTRY
B *LINEXIT RETURN
PAGE
*
* L I N E N U M
* PROCESS LINE NUMBER FIELD. THE LINE NUMBER IS OBTAINED FROM
* THE ENCODED TEXT. IF IT IS ZERO, THE LINE IS A SUB LINE.
* SUBLINE IS INCREMENTED AND MAJLINE IS UNCHANGED. IF THE
* LINE NUMBER IS NON-ZERO, SUBLINE IS CLEARED AND MAJLINE
* IS REPLACED WITH THE LINE NUMBER. IF THE NEXT ENCODED ITEM
* IS ANOTHER LINE NUMBER, THE CURRENT LINE IS PRINTED AND
* LINENUM IS REPEATED.
*
* INPUT: XW CONTAINS AN INDEX TO THE ENCODED LINE NUMBER.
*
* OUTPUT: XW CONTAINS AN INDEX TO THE ENCODED LABEL FIELD.
* MAJLINE CONTAINS THE CURRENT MAJOR LINE NUMBER.
* SUBLINE CONTAINS THE CURRENT SUB LINE NUMBER.
*
* CALL: BAL,RL LINENUM
*
* USES REGISTERS
* RL
* XT
* XW
*
LINENUM RES 0
STW,RL LINENUMXIT SAVE RETURN ADDRESS
LINENUM1 RES 0
NXTENC GET NEXT ENCODED ITEM
CI,XT ENDBUF IS IT END OF BUFFER?
BE LINENUM6 YES, GET ANOTHER RECORD
AND,XT =ENCITEM REMOVE SIGN EXTENSION
CI,XT ENC0 IS IT A SUB LINE NUMBER
BNE LINENUM2 NO, MUST BE A MAJOR LINE NUMBER
*
LW,XT SOURCE DON'T BUMP SUB-LINE IF NO SOURCE
BEZ LINENUM5
*
MTW,1 SUBLINE INCREMENT SUB LINE NUMBER
B LINENUM5
LINENUM2 RES 0
CI,XT MULTINT+1
BNE LINENUM3 BRANCH IF LINE NUMBER < 8192
NXTENC GET LINE NUMBER
B LINENUM4
LINENUM3 RES 0
AND,XT =VFLD MASK FOR VALUE FIELD
LINENUM4 RES 0
STW,XT MAJLINE SET MAJOR LINE NUMBER
LI,XT 0
STW,XT SUBLINE CLEAR SUB LINE NUMBER
LINENUM5 RES 0
NXTENC ,NOINC PICK UP NEXT ENCODED TEXT ITEM
AI,XT ENCTYPE2 LINE IS CONTINUED IF NEXT ITEM IS
BCR,8 *LINENUMXIT AN INTEGER (LINE NUMBER)
LW,ER SKIPTRIG SAVE SKIP TRIG
STW,ER OPER
BAL,RL PRINTC PRINT SOURCE LINE
LW,ER OPER RESTORE SKIP TRIG
STW,ER SKIPTRIG
LW,XT SF
STW,XT SOURCE RESTORE SOURCE FLAG
B LINENUM1 AND CONTINUE
LINENUM6 RES 0
BAL,RL NXTRECRD READ NEXT ENCODED TEXT RECORD
B LINENUM1
PAGE
*
* L I N E S K I P
* MOVES ENCODED TEXT POINTER (XW) TO THE BEGINNING OF THE NEXT
* LINE. IT EITHER SKIPS ITEMS UNTIL THE END-OF-LINE ITEM HAS
* BEEN SKIPPED, OR IT OBTAINS THE ORIGIN FROM THE PROCEDURE
* LEVEL TABLE.
*
* OUTPUT: XW CONTAINS THE ADDRESS OF THE NEXT ENCODED TEXT ITEM
* TO BE PROCESSED
*
* CALL: BAL,RL LINESKIP
*
* USES REGISTER
* LVL
* RL
* XT
* ER
* XW
*
LINESKIP RES 0
MTW,0 SAMP,LVL
BE LNSKP1 SKIP ITEMS IN CURRENT LINE
LW,XW SAMP,LVL GET ORIGIN FROM PROC LEVEL TABLE
B LOADXW LOAD XWBASE AND EXIT
*
LNSKP5 RES 0
LI,XT TERR-SERR+SYNERR INDEX FOR 'T' ERROR
LNSKP4 RES 0
MTW,0 PROCREF BRANCH IF WITHIN
BNEZ LNSKP1 A PROCEDURE REFERENCE
*
BAL,ER SERR-SYNERR,XT REPORT AN 'S' OR 'T' ERROR
LNSKP1 RES 0
NXTENC GET NEXT ENCODED ITEM
CI,XT ENDLINE
EXIT,EQ RL EXIT IF END-LINE
CI,XT SYNERR
BE LNSKP4 SYNTAX ERROR
CI,XT TRUNERR
BE LNSKP5 TRUNCATION ERROR
AI,XT ENCTYPE1 ADD 1 TO ENCODED TYPE FIELD
BCR,8 LNSKP1 NOT A LARGE INTEGER
AND,XT =LFLD MASK FOR LENGTH FIELD
AW,XW XT SKIP PAST LARGE INTEGER
B LNSKP1
PAGE
*
* L I S T
* THIS ROUTINE PROCESSES THE LIST DIRECTIVE. LISTSUB IS CALLED
* TO EVALUATE THE OPERAND FIELD. IF ZERO, THE LIST FIELD OF
* VARIABLE NOLIST IS SET TO ONE TO SUPPRESS THE LISTING;
* OTHERWISE THE FIELD IS SET TO ZERO.
*
* INPUT: XW CONTAINS AN INDEX TO THE ENCODED TEXT ITEM
* FOLLOWING THE LIST COMMAND.
*
* OUTPUT: XW CONTAINS AN INDEX TO THE BEGINNING OF THE LINE
* FOLLOWING THE LIST LINE.
*
* USES REGISTERS
* XT
* XT1
* RL
*
LIST RES 0
MTW,0 CMNDLIST
IF,NZ -10- DOIF CF(2) PRESENT
CALL EVAL1EXP EVALUATE CF(2)
STW,XT SOURCEONLY NON-ZERO SUPRESSES NON-SOURCE LINES
FI -10-
BAL,RL LISTSUB EVALUATE OPERAND
STW,XT TEMP SAVE RESULT
BAL,RL PCCSUB PRINT UNDER PCC CONTROL
CALL PRINTC PRINT SOURCE IF WITHIN A PROC
LW,XT TEMP
SHIFT,XT 31,LISTLOB POSITION OPERAND RESULT
LV,XT1 LISTFLD
STS,XT NOLIST STORE LISTING CONTROL FIELD
B GENR
PAGE
*
* L I S T S U B
* THIS ROUTINE PROCESSES THE OPERAND FIELD OF DIRECTIVES WHICH
* CONTROL THE LISTING OUTPUT. EVAL1EXP IS CALLED TO EVALUATE
* THE OPERAND FIELD. IF ZERO, A ONE IS RETURNED IN XT; IF
* NON-ZERO, A ZERO IS RETURNED IN XT.
*
* OUTPUT: XT CONTAINS A ZERO IF THE VALUE OF THE OPERAND FIELD
* IS NON-ZERO; OTHERWISE XT CONTAINS A ONE.
*
* CALL: BAL,RL LISTSUB
*
* USES REGISTERS
* XT
* RL
*
LISTSUB RES 0
STW,RL LISTXIT
CALL EV1OPRNDEXP EVALUATE ONE OPERAND EXPRESSION
LI,XT 1
MTW,0 TEMP IF OPERAND IS ZERO, EXIT WITH A
BEZ *LISTXIT ONE IN XT
LI,XT 0 OTHERWISE,
B *LISTXIT EXIT WITH A ZERO
PAGE
*
* L I T S R C H
* THIS ROUTINE SEARCHES FOR A VALUE IN THE LITERAL TABLE
*
* INPUT: ARG CONTAINS A POINTER TO THE VALUE TO BE SEARCHED FOR
* LITTABLE CONTAINS AN INDEX TO THE FIRST ENTRY IN THE
* LITERAL TABLE
* NLITS CONTAINS THE NUMBER OF ENTRIES IN THE LITERAL
* TABLE
*
* OUTPUT: XT CONTAINS A ZERO IF THE VALUE IS NOT FOUND IN THE
* LITERAL TABLE; IT IS NON-ZERO IF THE VALUE WAS FOUND
*
* USES REGISTERS
* XT, XT1, RL, TR0, TR1
*
LITSRCH RES 0
STW,RL LITSRCHXIT
LI,XT LITTABLE ADDRESS OF WORD CONTAINING OFFSET
STW,XT LFND TO FIRST LITERAL TABLE ENTRY
LI,XT 0
STW,XT OFFSET NUMBER OF ENTRIES SEARCHED
LW,XT ARG
BAL,RL LENGTH GET LENGTH OF ITEM POINTED TO BY ARG
STW,XT1 LARG STORE LENGTH OF ARG
LV,TR1 SPAFLD+SPINTFLD+ARFLD+EXTFLD; MASK FOR ADDRESS
+CSFLD+ADDFLD+1**(31-DEFLOB) ITEMS
LW,XT 0,XT
CI,XT1 1
BNE LITSRCH5 LENGTH IS NOT ONE WORD
BFZ,XT,1 SPAFLD,LITSRCH1 BRANCH IF ARGUMENT IS
BFZ,XT SPINTFLD,LITSRCH1 NOT A SPECIAL INTEGER
LV,TR1 SPAFLD+SPINTFLD+VALFLD; MASK FOR SPECIAL
+1**(31-DEFLOB) INTEGER ITEMS
LITSRCH1 RES 0
LW,XT *LFND INDEX TO NEXT LITERAL ENTRY
BEZ *LITSRCHXIT END OF LITERAL CHAIN, EXIT
AW,XT SYMT
STW,XT LFND STORE ADDRESS OF LITERAL ENTRY
AI,XT 1
BAL,RL LENGTH GET LENGTH OF LITERAL ENTRY
CW,XT1 LARG
BNE LITSRCH3 ITEMS ARE OF DIFFERENT LENGTHS
BDR,XT1 LITSRCH4 NOT SINGLE WORD ITEMS
LITSRCH2 RES 0
LW,TR0 *ARG COMPARE FINAL WORD OF ARGUMENT
CS,TR0 0,XT TO LITERAL TABLE WORD MASKED
BE *LITSRCHXIT ITEMS MATCH, EXIT
LITSRCH3 RES 0
MTW,1 OFFSET INCREMENT SEARCH COUNT
B LITSRCH1
LITSRCH4 RES 0
LW,TR0 *ARG,XT1 COMPARE ARGUMENT TO LITERAL
CS,TR0 *XT,XT1 TABLE ENTRY MASKED
BNE LITSRCH3 ITEMS ARE NOT EQUAL
BDR,XT1 LITSRCH4 CONTINUE FOR ENTIRE ARGUMENT
CW,TR0 1,XT ENTIRE 2ND WORDS MUST COMPARE
BNE LITSRCH3 OR ITEMS ARE NOT EQUAL
B LITSRCH2
LITSRCH5 RES 0
LV,RL CTYPEFLD
AND,RL XT
AND,XT =TYPEFLD
CV,XT CONSTANT
BNE LITSRCH1 ARG IS NOT A CONSTANT
CV,RL CHSTR
BNE LITSRCH8 ARG IS NOT A CHARACTER CONSTANT
* HERE TO CONVERT A CHARACTER CONSTANT TO AN INTEGER CONSTANT
MTW,1 ARG POINT TO WORD FOLLOWING CONTROL WORD
LI,XT 0
STW,XT LVAL+1
LB,XT *ARG LOAD CHARACTER COUNT
BEZ LITSRCH7 NO CHARACTERS TO CONVERT
LW,XT1 XT
AI,XT1 7
SLS,XT1 -2 (BYTE COUNT+7)/4 IS NUMBER OF WORDS
STW,XT1 LARG INCLUDING CONTROL WORD
SLS,XT1 2
AI,XT1 -5 (#WORDS*4)-5 IS LAST CHAR POSTION
LITSRCH6 RES 0
LB,RL *ARG,XT CONVERT CHARACTER CONSTANT TO AN
STB,RL LVAL+1,XT1 INTEGER CONSTANT IN A NEW AREA
AI,XT1 -1
BDR,XT LITSRCH6
LITSRCH7 RES 0
LV,XT DEFFLD+CONSTANT+SPI
AW,XT LARG
STW,XT LVAL CONTROL WORD FOR INTEGER CONSTANT
LI,XT LVAL
STW,XT ARG POINTER TO INTEGER CONSTANT
LW,XT1 LARG
LITSRCH8 RES 0
LV,TR1 SPAFLD+SPINTFLD+TYPEFLD; MASK FOR CONSTANTS
+LENGTHFLD+1**(31-DEFLOB)
CI,XT1 3
BL LITSRCH1 CONSTANT IS 32 BITS OR LESS
LV,XT DPI-SPI CHANGE CONTROL WORD FROM AN SPI
AWM,XT LVAL CONSTANT TO A DPI CONSTANT
BAL,ER TERR TRUNCATION ERROR
B LITSRCH1
PAGE
*
* L O A D X M
* LOADS XM WITH INDEX TO NEXT ENCODED TEXT ITEM AND XMBASE
* WITH THE BASE ADDRESS OF THE ENCODED TEXT.
*
* CALL: BAL,RL LOADXM
*
* USES REGISTER
* XM XT
*
LOADXM RES 0
LI,XT XMBASE SET BASE TO XMBASE
LC XM
B LOADXW1
PAGE
*
* L O A D X W
* LOADS XW WITH INDEX TO NEXT ENCODED TEXT ITEM AND XWBASE WITH
* THE BASE ADDRESS OF THE ENCODED TEXT. THE BASE MAY BE ONE
* OF THREE ADDRESSES AS DETERMINED BY BITS 0 AND 1 OF XW.
* 00 INDICATES THE ADDRESS OF INBUF
* 01 INDICATES THE ADDRESS CONTAINED IN SYMT
* 10 INDICATES THE ADDRESS CONTAINED IN KLINE
*
* CALL: BAL,RL LOADXW
*
* USES REGISTER
* XT
* XW
*
LOADXW LI,XT XWBASE SET BASE TO XWBASE
LC XW
LOADXW1 STW,RL LOADXWRTN SAVE RETURN LINK
LI,RL INBUF
BCR,12 LOADXW2 BASE ADDRESS IS INBUF
LW,RL SYMT
BCS,4 LOADXW2 BASE ADDRESS IS SYMT
LW,RL KLINE BASE ADDRESS IS PARTIC BUF
LOADXW2 STW,RL *XT SET APPROPRIATE BASE ADDRESS
B *LOADXWRTN RETURN
PAGE
*
* L O C
* THIS ROUTINE PROCESSES THE LOC DIRECTIVE. ORGORLOC IS CALLED
* TO PROCESS THE COMMAND AND OPERAND FIELDS, STORE DLRVAL,
* DLRCS, AND DLRRS, AND DEFINE THE LABEL. LOC THEN EDITS BOTH
* LOCATION COUNTERS INTO THE LISTING LINE IMAGE AND RETURNS
* TO GENR.
*
* USES REGISTERS
* XT
* RL
*
LOC RES 0
BAL,RL ORGORLOC PROCESS COMMAND AND OPERAND FIELDS
LOC1 RES 0
CALL DEFHEXLBL DEFINE THE LABEL
MTW,0 PROCREF
BNEZ GENR DON'T PRINT WITHIN A PROC REFERENCE
BAL,RL EDITDLR EDIT % LOCATION COUNTER
BAL,RL PRINT PRINT % VALUE,LINE NUMBER,& SOURCE
BAL,RL EDITDDLR EDIT %% LOCATION COUNTER
BAL,RL PRINT PRINT %% VALUE ONLY
B GENR
PAGE
*
* L O C A L
* PROCESSES THE LOCAL DIRECTIVE. THIS IS AN OPEN ROUTINE
* WHICH IS BRANCHED TO FROM MAIN CONTROL.
*
*
*
*
*
*
LOCAL RES 0
BAL,RL LOCALSTA
B LINE5
PAGE
*
* L O C A L A D D
* FINDS THE ADDRESS OF A SYMBOL IN THE LOCAL SYMBOL TABLE.
*
* INPUT: XT CONTAINS THE ENCODED LOCAL SYMBOL NUMBER.
* PROCREF CONTAINS THE PROCEDURE REFERENCE LEVEL
*
* OUTPUT: PLVL CONTAINS THE PROCEDURE LEVEL OF THE LOCAL SYMBOL
* FND CONTAINS THE ADDRESS OF THE LOCAL SYMBOL
*
* CALL: BAL,RL LOCALADD
*
* USES REGISTERS
* LVL
* LVLT
* XT
* CT
* RL
* XT1
*
LOCALADD RES 0
LI,XT1 LFLD MASK FOR ENCODED LENGTH FIELD
AND,XT1 XT SYMBOL NUMBER TO XT1
AND,XT =CTFLD
SHIFT,XT CTLOB,31 RIGHT JUSTIFY CT FIELD
STW,XT PLVL LOCAL SYMBOLS PROCEDURE LEVEL
LW,LVLT LVL
LW,CT PROCREF DETERMINE THE NUMBER OF LEVELS TO
SW,CT PLVL SKIP TO GET CORRECT PROC. LVL. TAB
BEZ LCLADD2 CORRECT PROCEDURE LEVEL TABLE
SW,LVLT KLINE
LCLADD1 RES 0
LW,LVLT *KLINE,LVLT INDEX TO PREVIOUS PROC. LVL TABLE
BDR,CT LCLADD1 CONTINUE UNTIL CORRECT ONE
AW,LVLT KLINE
LCLADD2 RES 0 PROCEDURE LEVEL TABLE FOR LOCAL SYM
LW,XT LOCALORG,LVLT ORIGIN OF LOCAL SYMBOL TABLE
AND,XT =LOCALORGFLD
AW,XT SYMT
SW,XT XT1 LESS LOCAL SYMBOL NUMBER
STW,XT MAIN IS ADDRESS OF LOCAL SYMBOL
LW,XT1 0,XT FIXED TABLE ENTRY
BFNZ,XT1 SPAFLD,LCLADD3 SPEC. ADDR.
LW,XT XT1
AW,XT SYMT
LCLADD3 RES 0
STW,XT FND ADDRESS OF THE LOCAL
EXIT RL
PAGE
*
* L O C A L S T A
* DOES THE ACTUAL PROCESSING OF THE LOCAL DIRECTIVE. THIS IS A
* CLOSED SUBROUTINE BECAUSE LOCAL DIRECTIVES ARE PROCESSED
* EVEN WHEN XAP IS SKIPPING LINES.
*
* INPUT: LOCALFLG IS ZERO IF THE PREVIOUS LINE WAS A LOCAL
* NXTLOCAL CONTAINS THE ADDRESS OF THE NEXT AVAILABLE
* LOCAL SYMBOL.
*
* OUTPUT: NXTLOCAL IS DERREASED BY THE NUMBER OF SYMBOLS
* APPEARING ON THE LOCAL DIRECTIVE.
* LOCALCT IS INCREASED BY THE NUMBER OF SYMBOLS
* APPEARING ON THE LOCAL DIRECTIVE
* THE LOCAL SYMBOL TABLE IS SET TO SPECIAL ADDRESS
* TYPE, UNDEFINED.
*
* CALL: BAL,RL LOCALSTA
*
* USES REGISTERS
* XT
* XW
* LVL
* XT1
*
LOCALSTA RES 0
STW,RL LOCALXIT
LW,XT LOCALFLG
BEZ LCLSTA1 PREVIOUS STATEMENT WAS LOCAL
BAL,RL LCLDLTE DELETE LOCAL SYMBOL TABLE
LI,XT 0
LV,XT1 LOCALCTFLD
STS,XT LOCALCT,LVL SET LOCAL SYMBOL COUNT TO ZERO
LCLSTA1 RES 0
NXTENC ,NOINC GET NUMBER OF LOCAL SYMBOLS
AND,XT =VFLD NUMBER OF LOCAL SYMBOLS
BEZ LCLSTA3 NO LOCAL SYMBOLS
LW,XT1 LOCALCT,LVL
LB,RL XT1 COUNT OF LOCAL SYMBOLS
AW,RL XT ADD NUMBER OF LOCAL SYMBOLS FOR THIS
STB,RL XT1 LOCAL STATEMENT TO ACCUMULATED
STW,XT1 LOCALCT,LVL COUNT
STW,XT LARG
BAL,RL FINDLSPC FIND SPACE IN LOCAL TABLE
LW,XT LARG
LV,RL SPAFLD
LCLSTA2 RES 0
STW,RL *NXTLOCAL,XT INITIALIZE THE LOCAL SYMBOL TABLE
BDR,XT LCLSTA2 FOR NUMBER OF ENTRIES ADDED
LCLSTA3 RES 0
LI,XT1 -1
STW,XT1 LOCALFLG SET FLAG FOR MAIN CONTROL
B *LOCALXIT EXIT
PAGE
*
* L O L I M I T
* THIS ROUTINE CHECKS FOR TABLE OVERLAP AT THE LOW END OF CORE.
* IF THE END OF THE NON-LOCAL TABLES OVERLAPS THE END OF THE
* EXPRESSION CONTROL TABLE, KLINE IS MOVED TO A HIGHER CORE
* ADDRESS. IF THIS CAUSES THE END OF THE EXPRESSION VALUE
* TABLE TO OVERLAP THE END OF THE LOCAL SYMBOL TABLE, XAP WILL
* ABORT. OTHERWISE, KLINE WILL BE ADJUSTED SUCH THAT AN EQUAL
* AMOUNT OF SPACE IS AVAILABLE TO TABLES CONVERGING AT BOTH
* ENDS OF KLINE.
*
* INPUT: NXTSYMT CONTAINS THE ADDRESS OF THE NEXT AVAILABLE
* GLOBAL SYMBOL TABLE WORD
* NXTLOCAL CONTAINS THE ADDRESS OF THE NEXT AVAILABLE
* LOCAL SYMBOL TABLE WORD
* ECT CONTAINS AN OFFSET FROM KLINE TO THE NEXT
* EXPRESSION CONTROL TABLE WORD
* EVT CONTAINS AN OFFSET FROM KLINE TO THE NEXT
* EXPRESSION VALUE TABLE WORD
*
* OUTPUT: THE AMOUNT OF ADJUSTMENT TO KLINE IS IN REGISTER XT1
*
* CALL: BAL,RL LOLIMIT
*
* USES REGISTERS
* XT
* XT1
* RL
* ER
PAGE
* * ORIGIN OF LOCAL SYMBOL TABLE AREA HIGH CORE
* *
* * * *
* * *
* * END OF LOCAL SYMBOL TABLE AREA
*
*
* * END OF EXPRESSION VALUE TABLE
* * *
* * * *
* *
* * KLINE
* *
* * * *
* * *
* * END OF EXPRESSION CONTROL TABLE
*
*
* * END OF NON-LOCAL TABLE AREA
* * *
* * * *
* *
* * ORIGIN OF NON-LOCAL TABLE AREA LOW CORE
LOLIMIT RES 0
LW,XT NXTSYMT IF THE GLOBAL SYMBOL TABLE DOES NOT
SW,XT KLINE OVERLAP THE EXPRESSION CONTROL
SW,XT ECT,LVL TABLE, KLINE DOES NOT NEED TO BE
EXIT,LE RL ADJUSTED TO A HIGHER CORE ADDRESS
B HILIMIT4
PAGE
*
* L S R C H
* SEARCHES FOR A VALUE IN THE LITERAL TABLE AND ENTERS THE VALUE
* IF IT IS NOT FOUND.
*
* INPUT: THE TOP ENTRY IN THE EXPRESSION CONTROL TABLE CONTAINS
* AN INDEX TO THE VALUE OF THE LITERAL.
* LITTABLE CONTAINS AN INDEX TO THE FIRST ENTRY IN THE
* LITERAL TABLE
* NLITS CONTAINS THE NUMBER OF ENTRIES IN THE LITERAL
* TABLE.
*
* OUTPUT: FND CONTAINS THE ADDRESS OFFSET FOR THE LITERAL.
* LITCS CONTAINS THE CONTROL SECTION NUMBER FOR THE
* LITERAL
*
* CALL: BAL,RL LSRCH
*
* USES REGISTERS
* RL
* XT
* XT1
* LVL
*
LSRCH RES 0
STW,RL LSRCHXIT
LW,XT ECT,LVL INDEX TO EXPRESSION CONTROL TABLE
AI,XT 1
LW,XT *KLINE,XT LOAD EXPRESSION CONTROL TABLE ENTRY
AW,XT KLINE
STW,XT ARG ADDRESS OF ENTRY IN EXP VALUE TABLE
MTW,0 PASS
BGZ LSRCH1 IN GENERATION PASS
LV,XT1 ETFLD+EXPFLD DON'T SEARCH FOR UNDEFINED OR
CS,XT =UGLBLET+EXPFLD LOCAL FORWARD EXPRESSIONS DURING
BE LSRCH2 THE DEFINITION PASS
LSRCH1 RES 0
BAL,RL LITSRCH SEARCH THE LITERAL TABLE
CI,XT 0
BNE LSRCH3 ARG FOUND IN LITERAL TABLE
MTW,1 LARG LENGTH OF ARG +1 FOR LITERAL LINK
BAL,RL FINDSPC FIND SPACE FOR NEW LITERAL VALUE
MTW,-1 LARG RESTORE LENGTH OF ARG
LI,XT 0
STW,XT *FND ZERO THIS ENTRY'S LINK
LW,XT FND
SW,XT SYMT
STW,XT *LFND LINK PREVIOUS LITERAL TO THIS ENTRY
MTW,1 FND
BAL,RL NEWENTRY STORE ARGUMENT IN LITERAL TABLE
LSRCH2 RES 0
MTW,1 NLITS INCREMENT NUMBER OF LITERAL ENTRIES
LSRCH3 RES 0
LW,XT LITORG ORIGIN FOR LITERAL ASSIGNMENT
AW,XT OFFSET
STW,XT FND LITERAL'S ASSIGNED ADDRESS
B *LSRCHXIT
PAGE
*
* M A X L O C
* MAINTAINS THE MAXIMUM VALUE OF THE LOAD LOCATION COUNTER IN
* THE CONTROL SECTION TABLE
*
* INPUT: DDLRCS CONTAINS THE CURRENT CONTROL SECTION NUMBER.
* DDLRVAL CONTAINS THE OFFSET AT BYTE RESOLUTION.
*
* OUTPUT: MAXDD CONTAINS THE MAXIMUM OFFSET FOR THIS CONTROL
* SECTION AT BYTE RESOLUTION
*
* CALL BAL,RL MAXLOC
*
* USES REGISTERS
* XT
* XT1
* XT2
* RL
*
MAXLOC RES 0
STW,RL MAXLOCXIT
LW,XT2 DDLRCS %% CONTROL SECTION NUMBER
BAL,RL GETCSADD GET CONTROL SECTION TABLE ADDRESS
LV,XT1 MAXDDFLD MASK FOR MAXDD FIELD
LW,XT DDLRVAL %% OFFSET
CS,XT MAXDD,XT2
BLE *MAXLOCXIT CURRENT %% OFFSET NOT MAXIMUM
STS,XT MAXDD,XT2 UPDATE MAXIMUM %% OFFSET
B *MAXLOCXIT
PAGE
*
* M V : L I S T
* MOVE A DUMMY LIST CONTROL WORD TO THE ECT, AND A
* LIST CONTROL ITEM TO THE EVT
*
MV:LIST RES 0
LV,XT DLISTET SET DD%TYPE TO
STW,XT DD%TYPE DUMMY LIST
LV,XT LISTS CREATE A TWO-WORD
AW,XT PASSDEF EVT LIST ITEM
LI,XT1 1 IN TEMP
STD,XT LVAL
LI,XT LVAL ADDRESS -> XT
LI,XT1 2 SIZE -> XT1
B SCPUSH BRANCH TO PUSH AND EXIT MV:LIST
*
* M O V E B L A N K
* MOVE A BLANK EXPRESSION ONTO EVT,ECT
*
MOVEBLANK RES 0
LV,XT BLANKET
STW,XT DD%TYPE
AV,XT2 BLANKITM
LI,XT1 1 SIZE OF THIS ITEM
LI,XT XT2 ADDRESS OF THIS ITEM
B SCPUSH BRANCH TO PUSH TMP AND EXIT MOVEBLNK
*
* M O V E S Y M I T E M
* MOVE N ITEMS FROM THE SYMBOL TABLE TO THE EVT.
*
* INPUT: ADDRESS OF THE FIRST SYMT ITEM IN FND.
* NUMBER OF ITEMS IS IN XT (MAY BE ZERO)
*
* OUTPUT: SYMT ITEMS ARE IN THE EVT.
* FND POINTS TO THE WORD AFTER THE LAST SYMT ITEM MOVED
*
MOVESYMITEM RES 0
STW,RL MOVESYMXIT
STW,XT TEMP SAVE NUMBER OF ITEMS
MVSYM1 RES 0
MTW,-1 TEMP DECREASE COUNT AND
BLZ *MOVESYMXIT EXIT WHEN DONE
LW,XT FND FIND LENGTH
BAL,RL LENGTH OF THIS ITEM
AWM,XT1 FND
BAL,RL SCPSHV INSERT IN THE EVT
B MVSYM1
PAGE
*
* N E W C S E C T
* SAVES THE LOCATION COUNTERS AND GENERATES A NEW CONTROL
* SECTION TABLE IF REQUIRED.
*
* INPUT: CS CONTAINS THE CONTROL SECTION TYPE.
* PROTYPE CONTAINS THE PROTECTION TYPE
* DATAGEN CONTAINS A NON-ZERO VALUE IF A NEW CONTROL
* SECTION IS TO BE OPENED.
*
* OUTPUT: MAXCSECT CONTAINS THE NUMBER OF CONTROL SECTIONS OPEN.
*
* USES REGISTERS
* XT, XT1, XT2, RL, ER
*
NEWCSECT RES 0
STW,RL NEWCSXIT
CALL SOCW%CHK SOCW AND RELOC SECTIONS DON'T MIX
LW,XT2 CS0LOC ADDRESS OF CONTROL SECTION ZERO
LW,XT DATAGEN BRANCH IF DATA HAS BEEN GENERATED,
BNEZ NEWCS1 OR IF % OR %% WERE REFERENCED
* FROM A RELOCATABLE SECTION
MTW,1 DATAGEN
B NEWCS7
NEWCS1 RES 0
LW,XT MAXCSECT NUMBER OF CONTROL SECTIONS OPEN
CI,XT 127
BL NEWCS2
BAL,ER IERR MORE THAN 127 CONTROL SECTIONS
B *NEWCSXIT
NEWCS2 RES 0
CI,XT 15
BL NEWCS6 USE CS TABLE FOR SECTIONS 0-15
BG NEWCS4 USE CS TABLE FOR SECTIONS 16-127
MTW,0 PASS
BNEZ NEWCS4 GENERATION PASS
* CREATE AN ADDITIONAL TABLE FOR CONTROL SECTIONS 16-127 IN THE
* DEFINITION PASS ONLY.
LI,XT CSTBLSIZE*112
STW,XT LARG ROOM FOR 112 CONTROL SECTIONS
BAL,RL FINDSPC FIND TABLE SPACE FOR DYNAMIC
LW,XT FND CONTROL SECTION TABLE
STW,XT CS16LOC ADDRESS OF CONTROL SECTION 16
NEWCS4 RES 0
LW,XT2 CS16LOC ADDRESS OF CONTROL SECTION 16
AI,XT2 -16*CSTBLSIZE
NEWCS6 RES 0
MTW,1 MAXCSECT INCREMENT NUMBER OF CONTROL SECTIONS
NEWCS7 RES 0
LW,XT1 MAXCSECT COMPUTE ADDRESS OF CONTROL
MI,XT1 CSTBLSIZE SECTION'S TABLE ENTRY
AW,XT2 XT1 AND PUT IT IN XT2
LI,XT 0 INITIALIZE CONTROL SECTION TABLE
STW,XT MAXDD,XT2 ENTRY WORD ONE
LW,XT PROTYPE
SHIFT,XT 31,PTLOB-CSTLOB-1 PROTECTION TYPE TO PT FIELD
AW,XT CS
SHIFT,XT 31,CSTLOB CONTROL SECTION TYPE TO CST FIELD
AV,XT WDRS**(31-RSLOB) WORD RESOLUTION TO RS FIELD
STW,XT SAVDLR,XT2 AND CLEAR SAVDLR FIELD
BAL,RL OLDCSECT SAVE LOCATION COUNTERS FOR OLD
* CONTROL SECTION
LW,XT2 MAXCSECT
STW,XT2 DLRCS CURRENT CONTROL SECTION TO % C S
BAL,RL GETCSADD GET ADDRESS OF CONTROL TABLE ENTRY
BAL,RL SETDLRS SET CONTROL SECTION, RESOLUTION, AND
B *NEWCSXIT CLEAR VALUE OF % AND %%, THEN EXIT
PAGE
*
* N E W E N T R Y
* MOVES AN ENTRY TO THE SYMBOL TABLE
*
* INPUT: ARG CONTAINS A POINTER TO THE NEW VALUE TO BE STORED
* FND CONTAINS THE ORIGIN FOR THE VALUE
* LARG CONTAINS THE NUMBER OF WORDS IN THE VALUE
*
* CALL: BAL,RL NEWENTRY
*
* USES REGISTERS
* XT
* XT1
*
NEWENTRY RES 0
LW,XT LARG NUMBER OF WORDS TO MOVE
B NEWENT2
NEWENT1 LW,XT1 *ARG,XT MOVE NEW VALUE TO SYMBOL TABLE
STW,XT1 *FND,XT MOVING FROM LAST WORD TO FIRST
NEWENT2 RES 0
BDR,XT NEWENT1 CONTINUE UNTIL ALL BUT 1ST ARE MOVED
LW,XT *ARG MOVE FIRST WORD OF NEW VALUE
STW,XT *FND TO SYMBOL TABLE
EXIT RL
PAGE
*
* N O T D O 1
* MARK AN ERROR IF THERE'S AN ACTIVE 'DO1' DIRECTIVE
* ON THIS PROCEDURE LEVEL
*
NOTDO1 RES 0
LW,XT DO1CT,LVL
EXIT,EQ RL
BAL,ER KERR
LI,XT 0
STW,XT DO1CT,LVL
EXIT RL
PAGE
*
* N X T R E C R D
* READ THE NEXT ENCODED TEXT RECORD (FROM X1) INTO INBUF
*
NXTRECRD RES 0
MTW,1 TEXTCT BUMP ENCODED TEXT RECORD NUMBER
LI,IOADD INBUF
STW,IOADD XWBASE
LI,XW 0 SET XW TO BEGINNING OF INBUF
MTH,0 RD%STD
BEZ NXTRCRD1 PROCESSING X1 FILE
BAL,IORL READSTD READ FROM THE STD FILE
EXIT RL
NXTRCRD1 RES 0
BAL,IORL READX1
EXIT RL
PAGE
*
* O L D C S E C T
* SAVES THE CURRENT LOCATION COUNTER VALUE IN THE CONTROL
* SECTION TABLE.
*
* INPUT: DLRVAL CONTAINS THE OFFSET FOR % AT BYTE RESOLUTION
* DLRCS CONTAINS THE CONTROL SECTION NUMBER FOR %
* DLRRS CONTAINS THE RESOLUTION FOR %
* DDLRVAL CONTAINS THE OFFSET FOR %% AT BYTE RESOLUTION
* DDLRCS CONTAINS THE CONTROL SECTION NUMBER FOR %%
*
* OUTPUT: DLRVAL HAS BEEN SAVED IN SAVDLR FIELD OF THE CONTROL
* SECTION TABLE
* DLRRS HAS BEEN SAVED IN THE RS FIELD OF THE CONTROL
* SECTION TABLE
* XT2 CONTAINS ADDRESS OF THE CONTROL SECTION
*
* USES REGISTERS
* XT, XT1, XT2, RL
*
OLDCSECT RES 0
STW,RL OLDCSXIT
BAL,RL MAXLOC SAVE MAX DDLRVAL
LW,XT2 DLRCS % CONTROL SECTION NUMBER
BAL,RL GETCSADD GET CONTROL SECTION TABLE ADDRESS
LW,XT DLRRS % RESOLUTION
SHIFT,XT 31,RSLOB POSITION IT
LV,XT1 MAXDDFLD
LS,XT DLRVAL % OFFSET
LV,XT1 RSFLD+SAVDLRFLD
STS,XT SAVDLR,XT2 SAVE DLRRS AND DLRVAL IN CONTROL
B *OLDCSXIT SECTION TABLE AND EXIT
PAGE
*
* O R G
* THIS ROUTINE PROCESSES THE ORG DIRECTIVE. ORGORLOC IS CALLED
* TO PROCESS THE COMMAND AND OPERAND FIELDS, STORE DLRVAL,
* DLRCS, AND DLRRS, AND DEFINE THE LABEL. ORG THEN STORES
* DDLRVAL, DDLRCS, AND DDLRRS. ORG EXITS TO LOC1 WHERE BOTH
* LOCATION COUNTERS ARE EDITED INTO THE LISTING LINE IMAGE
* AND AN EXIT TO GENR IS PERFORMED.
*
* USES REGISTERS
* XT
* RL
*
ORG RES 0
BAL,RL ORGORLOC PROCESS COMMAND AND OPERAND FIELDS
LW,XT DLRCS
STW,XT DDLRCS
LW,XT DLRVAL
STW,XT DDLRVAL
LW,XT DLRRS
STW,XT DDLRRS
B LOC1
PAGE
*
* O R G O R L O C
* THIS ROUTINE PROCESSES THE COMMAND AND OPERAND FIELDS OF THE
* LOC AND ORG DIRECTIVES. THE COMMAND FIELD IS EVALUATED AND
* THE VALUE (1,2,4,OR8) IS MAPPED INTO A RESOLUTION VALUE
* (0,1,2,OR3) AND STORED INTO DLRRS. THE OPERAND FIELD IS THEN
* EVALUATED. AN ADDRESS WILL BE CONVERTED TO BYTE RESOLUTION
* AND STORED INTO DLRVAL AND IT'S CONTROL SECTION NUMBER IS
* STORED INTO DLRCS. A CONSTANT WILL BE CONVERTED TO A BYTE
* OFFSET AND STORED INTO DLRVAL WITH DLRCS UNCHANGED.
*
* INPUT: CMNDLIST INDICATES WHETHER A CF(2) FIELD EXISTS OR NOT
* XW CONTAINS AN INDEX TO THE ENCODED TEXT ITEM TO BE
* EVALUATED.
*
* OUTPUT: DLRVAL, DLRCS, AND DLRRS HAVE BEEN SET.
* XT CONTAINS THE RESOLUTION FOR DDLRCS (FOR ORG)
*
* CALL: BAL,RL ORGORLOC
*
* USES REGISTERS
* XT
* RL
* XT1
* XT2
* ER
*
ORGORLOC RES 0
STW,RL ORGLOCXIT
BAL,RL OLDCSECT SAVE BOTH LOCATION COUNTERS
BAL,RL EVALAR EVALUATE ADDRESS RESOLUTION
STW,XT TEMPO SAVE RESOLUTION
BAL,RL EVALUATE%AND%CLEAN EVALUATE OPERAND AND CLEAR STACKS
LW,XT TEMPO
STW,XT DLRRS STORE RESOLUTION
MTW,0 LSTCT
BEZ ORGLOC4 BLANK OPERAND FIELD, USE 0 VALUE
LW,XT2 0,XS INDEX TO EVT ENTRY
AW,XT2 KLINE ADDRESS OF EVT ENTRY
LW,XT 0,XT2 CONTROL WORD OF EVT ENTRY
AND,XT =DEFFLD
CW,XT PASSDEF
BNE ORGLOC6 ITEM NOT DEFINED FOR THIS PASS
LW,XT 0,XT2
BFNZ,XT SPAFLD,ORGLOC8 BRANCH IF SPECIAL ONE WORD ENTRY
AND,XT =(TYPEFLD+STYPEFLD+LENGTHFLD)
CV,XT SYMBOL+SIMPADD+LNGTH2
BNE ORGLOC6 SYMBOL IS NOT A SIMPLE ADDRESS
LW,XT 1,XT2 GET LOB, FCS,AND OFFSET
AND,XT =FCSFLD
SHIFT,XT FCSLOB,31 RIGHT JUSTIFY FCS
STW,XT DLRCS STORE CONTROL SECTION
LW,XT 1,XT2 GET LOB,FCS,AND OFFSET
ORGLOC5 RES 0
LW,XT1 0,XT2 GET AR
AND,XT1 =ARFLD
SHIFT,XT1 ARLOB,31 RIGHT JUSTIFY AR
SCS,XT 0,XT1 OFFSET TO BYTE RESOLUTION
AND,XT =OFFSETFLD
B ORGLOC7
ORGLOC8 RES 0
BFNZ,XT SPINTFLD,ORGLOC10 BRANCH IF SPECIAL INTEGER ENTRY
AND,XT =CSFLD
SHIFT,XT CSLOB,31
STW,XT DLRCS STORE CONTROL SECTION
LW,XT 0,XT2
AND,XT =ADDFLD
B ORGLOC5
ORGLOC10 RES 0
AND,XT =VALFLD INTEGER VALUE
LW,XT1 DLRRS
SLS,XT 0,XT1 INTEGER VALUE AT BYTE RESOLUTION
CV,XT X'7FFFF'
BLE ORGLOC7 OFFSET IS 19 BITS OR LESS
ORGLOC6 RES 0
BAL,ER EERR ILLEGAL EXPRESSION
ORGLOC4 RES 0
LI,XT 0 0 FOR EXECUTION LOCATION COUNTER
ORGLOC7 RES 0
STW,XT DLRVAL STORE EXECUTION LOCATION COUNTER
B *ORGLOCXIT
PAGE
*
* P A G E
* PROCESS THE PAGE DIRECTIVE
*
* CAUSE THIS LINE TO BE PRINTED AT THE TOP OF FORM
*
PAGE RES 0
BAL,RL LINESKIP
PAGE1 RES 0
LV,XT PSTRIGFLD|LISTFLD|4 DON'T GO TO TOP OF FORM IF
AND,XT NOLIST LISTING IS OFF DUE TO PRE-ENCODED
BNEZ PCC1 SYSTEM OR SYSTEM NOT BEING LISTED
*
STW,XT PGLINES
B PCC1
PAGE
*
* P C C
* THIS ROUTINE PROCESSES THE PCC DIRECTIVE. LISTSUB IS CALLED
* TO EVALUATE THE OPERAND FIELD. IF THE VALUE IS ZERO, PCCTRIG
* IS SET TO 1; OTHERWISE PCCTRIG IS SET TO ZERO. THIS VALUE
* WILL BE STORED IN THE PCCTRIG FIELD OF VARIABLE NOLIST WHEN
* A LIST, PAGE, PCC, PSR, PSYS, SPACE, OR TITLE DIRECTIVE
* IS PROCESSED.
*
* OUTPUT: XW CONTAINS AN INDEX TO THE BEGINNING OF THE LINE
* FOLLOWING THE PCC DIRECTIVE.
*
* USES REGISTERS
* XT
* RL
*
PCC RES 0
BAL,RL LISTSUB EVALUATE OPERAND
SHIFT,XT 31,PCCTRIGLOB
STW,XT PCCTRIG STORE RESULT
CI,XT 0 IF OPERAND IS NON-ZERO,
BNE GENR GO BACK TO MAIN CONTROL
PCC1 RES 0
BAL,RL PCCSUB PRINT UNDER PCC CONTROL
B GENR
PAGE
*
* P C C S U B
* THIS SUBROUTINE CONTROLS PRINTING OF THE DIRECTIVES WHICH
* CONTROL LISTING OUTPUT; I.E., THE LIST, PAGE, PCC, PSR,
* PSYS, SPACE, AND TITLE DIRECTIVES.
*
* CALL: BAL,RL PCCSUB
*
* USES REGISTERS
* XT
* XT1
* RL
*
PCCSUB RES 0
STW,RL PCCXIT SAVE RETURN ADDRESS
LW,XT PCCTRIG
LV,XT1 PCCTRIGFLD
STS,XT NOLIST STORE LISTING CONTROL
BAL,RL PRINTC1 PRINT THE DIRECTIVE
LI,XT 0
LV,XT1 PCCTRIGFLD
STS,XT NOLIST RESET LISTING CONTROL
B *PCCXIT
PAGE
*
* P E N D
* THIS ROUTINE PROCESSES THE PEND DIRECTIVE. NOTDO1 IS CALLED
* TO REPORT AN ERROR IF PEND WAS PRECEEDED BY A DO1 DIRECTIVE.
* IF PEND IS ON THE SOURCE LEVEL, AN ERROR IS REPORTED, THE
* REST OF THE LINE IS SKIPPED, AND PEND BRANCHES TO GENR.
* OTHERWISE, THE LOCAL SYMBOL TABLE IS DELETED AND ANY
* UNTERMINATED DO'S ARE DELETED FROM THE DO TABLE AND AN ERROR
* IS REPORTED. IF ANY ERRORS HAVE BEEN REPORTED AND NOT
* PRINTED, PRINT IS CALLED. FINALLY PEND BRANCHES TO COMREF3
* WHERE THE CURRENT PROCEDURE LEVEL TABLE IS DELETED; PROCREF
* IS DECREASED BY ONE; THE ADDRESS OF THE NEXT OUTER LEVEL
* PROCEDURE LEVEL TABLE IS MOVED TO LVL; AND THE ORIGIN OF THE
* NEXT LINE TO PROCESS IS MOVED FROM THE PROCEDURE LEVEL TABLE
* TO XW.
*
* INPUT: LVL CONTAINS THE ADDRESS OF THE CURRENT PROCEDURE
* LEVEL TABLE
*
* OUTPUT: LVL CONTAINS THE ADDRESS OF THE NEXT OUTER LEVEL
* PROCEDURE LEVEL TABLE.
* PROCREF HAS BEEN DECREASED BY ONE
* XW CONTAINS AN INDEX TO THE BEGINNING OF THE NEXT
* ENCODED LINE TO PROCESS.
*
* USES REGISTERS
* RL
* ER
* XT1
* LVL
*
PEND RES 0
BAL,RL NOTDO1 ERROR IF PRECEEDED BY A DO1
MTW,0 PROCREF PROCEDURE REFERENCE LEVEL
BEZ SPCD1 ERROR IF PEND IS ON SOURCE LEVEL
MTW,+0 SYSLVL,LVL ERROR IF SYSTEM 'END' NOT FOUND
BNEZ SPCD1
MTB,0 *LVL+PLOC BRANCH IF THIS IS A PEND OF
BEZ PEND1 A CNAME REFERENCE
*
CALL EV%CLN%OPRND EVALUATE THE OPERAND FIELD
PEND1 RES 0
BAL,RL LCLDLTE DELETE THE LOCAL SYMBOL TABLE
PEND3 RES 0
LW,XT DOCT,LVL
BEZ PEND2 NO DO'S REMAINING
BAL,ER KERR UNTERMINATED DO'S
BAL,RL DELETE%DO DELETE UNTERMINATED DO RECORD
B PEND3
PEND2 RES 0
MTB,0 *LVL+PLOC BRANCH IF THIS IS A PEND OF
BNEZ PEND4 AN FNAME REFERENCE
MTW,0 ERRTRIG
BEZ COMREF3 NO UNLISTED ERRORS
BAL,RL PRINT
B COMREF3
PEND4 RES 0
BAL,RL GETPLOC RE-INSTATE PREVIOUS PROC LVL TBL
BAL,RL SCPULL PULL SAVED VARIABLES FROM ECT & EVT
AW,XT KLINE
LI,XT1 NSAVES NUMBER OF SAVED VARIABLE
PEND5 RES 0
LW,RL NSAVES-1,XT RESTORE ALL VARIABLES SAVED IN THE
STW,RL SAVEORG-1,XT1 EVT FOR FNAME REFERENCE
AI,XT -1
BDR,XT1 PEND5 CONTINUE UNTIL ALL RESTORED
LW,XT OPRNDORG RESTORE POINTER TO OPERAND FIELD
STW,XT OPRND,LVL OF THE REFERENCE LINE
LW,XW NEXTXW RESTORE POINTER TO NEXT ENCODED ITEM
BAL,RL LOADXW SET XW BASE
PEND6 RES 0
LW,XT 0,XS PUSH RESULT OF OPERAND EXPRESSIONS
AW,XT KLINE EVALUATED FOR THE PEND LINE
LV,XT1 ~LOCFLD ONTO THE ECT AND EVT
STS,XT DD%TYPE AND THEN RETURN TO SCAN
BAL,RL LENGTH
BAL,RL SCPUSH
AI,XS -1
MTW,-1 LSTCT
BGZ PEND6
B SCLOOP
PAGE
*
* P R O C
* PROCESS THE PROC DIRECTIVE
*
* IF NAMELINK = 0, THE ENTIRE PROCEDURE BODY WILL BE DISCARDED
* IF NAMELINK NE 0, THE PROCEDURE BODY (AND PEND LINE) WILL BE
* SAVED STARTING AT THE NEXT AVAILABLE SYMT LOCATIONS.
* IN THIS CASE, NAMELINK CONTAINS THE ADDRESS OF A CHAIN
* OF SYMBOL TABLE 'NAME' ENTRIES. THE CHAIN IS TERMINATED BY
* A ZERO LINK. THE STO WORD OF EACH NAME ENTRY IS SET TO
* POINT TO THE NEXT SYMT LOCATION, AND PASSDEF IS STORED IN
* EACH DEF FIELD. THE DEF FIELD IS USED TO FLAG REFERENCES
* BEFORE THE PROC IS ENCOUNTERED.
*
LOCAL %10,%20,%30
PROC RES 0
BAL,RL NOTDO1 ERROR IF PRECEEDED BY 'DO1'
BAL,RL LINESKIP SKIP THE REST OF THE 'PROC'
LW,XT PROCREF ERROR IF THIS LINE IS WITHIN
BEZ %10 A PROC
BAL,ER KERR
B SET%SKIP%TRIG
%10 RES 0
LW,XT1 SYSLEVEL STORE 'SYSLEVEL'+1 IN
AI,XT1 1 'STORE-IN-SAMPLE' FLAG
STW,XT1 PROCLV
STW,XT STORESAMP CLEAR INDEX TO SAMPLE (ALSO A FLAG)
XW,XT NAMELINK ARE THERE ANY SAVED 'NAME' LINES
BNEZ %20 YES
SET%SKIP%TRIG RES 0
MTW,1 SKIPTRIG
B GENR
%20 RES 0
LW,XT1 NXTSYMT
SW,XT1 SYMT SUBT. ORIGIN OF SYMBOL TABLE
LW,RL PASSDEF MUST BE AN ODD REGISTER (FOR STS)
LW,ER XT1 CONVERT NXTSYMT TO
SLS,ER 1 A HALFWORD INDEX
STW,ER STORESAMP AND SAVE IT IN STORESAMP
LW,ER PASS PUT SAMPLE TABLE INDEX IN XT1.
BEZ %30 IN THE DEF PASS, USE NXTSYMT;
LW,XT1 PROCLOC IN GEN, USE PROCLOC (CNAME SAVED)
%30 RES 0
AW,XT SYMT CONVERT INDEX TO AN ADDRESS
LW,XT2 STO,XT GET NEXT LINK FROM STO FIELD
STS,RL 0,XT STORE DEF FIELD
STW,XT1 STO,XT STORE NXTSYMT OR PROCLOC AS SAMPLE
* TABLE INDEX
LW,XT XT2 NEXT NAME LINK
BEZ GENR
B %30
PAGE
*
* P S E C T
* PROCESSES THE PSECT DIRECTIVE
*
* USES REGISTER
* XT
*
PSECT RES 0
LI,XT PSTYPE
B CSECT1
PAGE
*
* P S R
* THIS ROUTINE PROCESSES THE PSR DIRECTIVE. LISTSUB IS CALLED
* TO EVALUATE THE OPERAND FIELD. IF THE VALUE IS ZERO, PSRTRIG
* IS SET TO A 1; OTHERWISE PSRTRIG IS SET TO ZERO. THIS VALUE
* IS USED TO INHIBIT (PSRTRIG=0) OR ALLOW (PSRTRIG=1) SKIPPED
* RECORDS TO BE PRINTED.
*
* OUTPUT: XW CONTAINS AN INDEX TO THE BEGINNING OF THE LINE
* FOLLOWING THE PSR LINE.
*
* USES REGISTERS
* XT
* RL
*
PSR RES 0
BAL,RL LISTSUB EVALUATE OPERAND
STW,XT PSRTRIG
B PCC1
PAGE
*
* P S Y S
* THIS ROUTINE PROCESSES THE PSYS DIRECTIVE. LISTSUB IS CALLED
* TO EVALUATE THE OPERAND FIELD. IF THE VALUE IS ZERO, PSTRIG
* IS SET TO 1; OTHERWISE PSTRIG IS SET TO ZERO. THIS VALUE WILL
* BE STORED IN THE PSTRIG FIELD OF VARIABLE NOLIST WHEN A
* SYSTEM DIRECTIVE IS PROCESSED.
*
* INPUT: XW CONTAINS AN INDEX TO THE ENCODED TEXT ITEM
* FOLLOWING THE PSYS COMMAND.
*
* OUTPUT: XW CONTAINS AN INDEX TO THE BEGINNING OF THE LINE
* FOLLOWING THE PSYS LINE.
*
* USES REGISTERS
* XT
* RL
*
PSYS RES 0
BAL,RL LISTSUB EVALUATE OPERAND
SHIFT,XT 31,PSTRIGLOB
STW,XT PSTRIG STORE SYSTEM LISTING CONTROL
B PCC1
PAGE
*
* P U T 1
* STORE A HALFWORD IN THE SAMPLE TABLE AND BUMP THE
* SAMPLE TABLE INDEX.
*
* INPUT: XT CONTAINS THE HALF-WORD TO STORE
* ECTHW CONTAINS HALFWORD INDEX OF EXP CONTROL TABLE
* STORESAMP CONTAINS THE SAMPLE TABLE (HALFWORD) INDEX
*
* OUTPUT: XT STORED AND STORESAMP INCREASED BY ONE.
*
* USES REGISTER XT1
* REGISTER XT IS UNCHANGED
*
* CALL: BAL,RL PUT1
*
LOCAL %10
PUT1 RES 0
LW,XT1 PASS EXIT IF NOT IN DEF. PASS
EXIT,NE RL
LW,XT1 STORESAMP IS THE ROOM
CW,XT1 ECTHW BELOW THE EXPRESSION CONTROL TBL
BG HILIMIT4 NO, WE'RE OUT OF ROOM
STH,XT *SYMT,XT1 STORE THE HALFWORD IN SAMPLE
MTW,1 STORESAMP BUMP STORESAMP
EXIT RL
PAGE
*
* R E F
* THIS ROUTINE PROCESSES THE REF DIRECTIVE. REF SETS AN
* ASSIGNMENT VALUE FOR REF AND BRANCHES TO DEF1.
*
* OUTPUT: XT CONTAINS A VALUE FOR REF.
*
* USES REGISTER
* XT
*
REF RES 0
LV,XT REFEXT
* HERE FROM REF, SREF. XT CONTAINS THE EXTERNAL TYPE
REF1 RES 0
STW,XT TEMPO SAVE EXTERNAL TYPE
BAL,RL EVALAR EVALUATE ADDRESS RESOLUTION
SHIFT,XT 31,ARLOB POSITION RESOLUTION
AW,XT TEMPO EXTERNAL TYPE AND RESOLUTION
B DEF1 COMMON CODE FOR DEF, REF, AND SREF
PAGE
*
* R E S
* THIS ROUTINE PROCESSES THE RES DIRECTIVE. THE MAXIMUM LOAD
* LOCATION COUNTER OFFSET IS SAVED AND THE LABEL IS DEFINED.
* THE PRODUCT OF THE CF(2) AND AF(1) FIELDS IS THEN ADDED TO
* BOTH LOCATION COUNTER OFFSETS. RES BRANCHES BACK TO GENR.
*
* INPUT: CMNDLIST IS ZERO IF THERE IS NO CF(2) ENTRY, AND IS
* NON-ZERO IF A CF(2) ENTRY EXISTS.
*
* OUTPUT: DLRVAL AND DDLRVAL HAVE BEEN INCREASED BY THE NUMBER
* OF BYTES RESERVED.
*
* USES REGISTERS
* XT
* RL
* XT1
*
RES RES 0
BAL,RL MAXLOC SAVE MAXIMUM %% OFFSET
CALL DEFHEXLBL DEFINE LABEL
MTW,0 CMNDLIST
BEZ RES0 NO CF(2) FIELD, USE VALUE OF 4
BAL,RL EVAL1EXP EVALUATE CF(2) FIELD
LW,XT TEMP
BGZ RES1
BAL,ER EERR ILLEGAL CF(2) VALUE
RES0 RES 0
LI,XT 4 USE A CF(2) VALUE OF 4
RES1 RES 0
STW,XT TEMPO VALUE OF CF(2) FIELD
BAL,RL EVAL1EXP EVALUATE AF(1) FIELD
LW,XT1 TEMPO
MW,XT TEMP
RES2 RES 0
AWM,XT1 DLRVAL INCREASE BOTH LOCATION COUNTERS BY
AWM,XT1 DDLRVAL THE NUMBER OF BYTES RESERVED.
B GENR
PAGE
*
* S : S I N
* THIS ROUTINE PROCESSES THE S:SIN DIRECTIVE. CMNDDEF IS CALLED
* TO INSURE THAT A LABEL IS PRESENT AND THAT IT IS REFERENCED
* AND IS DEFINED ONLY ONCE. NEXT EVAL1EXP IS CALLED TO PROCESS
* CF(2) WHICH MUST BE PRESENT AND EQUAL TO INTEGER 0,1, OR 2.
* IF IT IS NOT, LINESKIP IS CALLED AND THIS ROUTINE EXITS TO
* GENR. THE CF(2) VALUE IS USED TO CONSTRUCT THE COMMAND
* CONTROL WORD. THEN EVAL1EXP IS CALLED TO EVALUATE THE
* ARGUMENT FIELD (OP-CODE). THE COMPLETE COMMAND DEFINITION IS
* NOW CONSTRUCTED AND NEWENTRY IS CALLED TO STORE IT IN THE
* SYMBOL TABLE.
*
* INPUT: XW CONTAINS AN INDEX TO THE ENCODED TEXT ITEM
* FOLLOWING THE S:SIN DIRECTIVE.
*
* OUTPUT: THE COMMAND DEFINITION SPECIFIED BY THE S:SIN
* DIRECTIVE IS PLACED IN THE SYMBOL TABLE.
*
* USES REGISTERS
* XT
* XT1
* ER
* RL
*
S:SIN RES 0
LV,XT S:SINCOMT+CMNDNAME+LNGTH2+1**(31-DEFLOB)
BAL,RL CMNDDEF CHECK COMMAND DEFINITION
MTW,0 CMNDLIST
BE S:SIN2 NO SIN FORMAT SPECIFIER
BAL,RL EVAL1INT EVALUATE SIN FORMAT
LW,XT TEMP
BL S:SIN2 NEGATIVE VALUE IS ERROR
CI,XT 2
BLE S:SIN3 VALUE OF 0, 1, OR 2 IS OK
S:SIN2 RES 0
BAL,ER EERR REPORT ILLEGAL VALUE
LI,XT 0 USE A VALUE OF ZERO
S:SIN3 RES 0
SHIFT,XT 31,SINTLOB SHIFT VALUE TO SINT FIEDL
AWM,XT CMNDCW STORE SINT FIELD VALUE
BAL,RL EVAL1EXP EVALUATE OP CODE
AND,XT =VALFLD TRIM THE OP CODE VALUE
CW,XT TEMP
BE S:SIN0 VALUE FITS IN A SPECIAL INTEGER
BAL,ER TERR TRUNCATION ERROR
S:SIN0 RES 0
BAL,RL STACKSPI STORE OP CODE IN ECT AND EVT
BAL,RL CMNDASN MAKE COMMAND ASSIGNMENT
* CMNDASN RETURNS HERE DURING THE GENERATION PASS
B S:SIN1 RETURN HERE FOR GENERATION PASS
* CMNDASN RETURNS HERE DURING THE DEFINITION PASS
LW,XT1 SPITEMP STORE OP CODE (DEFINED FOR THE
OR,XT1 =3**(31-DEFLOB) GEN PASS) AS THE 2ND WORD
STW,XT1 STO,XT OF THE COMMAND ENTRY
BAL,RL LOLIMIT MAKE SURE THERE'S ROOM FOR ENTRY
B GENR
S:SIN1 RES 0
LW,XT1 PASSDEF
STS,XT1 0,XT DEFINE COMMAND FOR CURRENT PASS
BAL,RL EDITV
B GENR
PAGE
*
* S : S I N R E F
* THIS ROUTINE PROCESSES A REFERENCE TO A COMMAND DEFINED BY THE
* S:SIN DIRECTIVE. THE COMMAND MUST BE DEFINED FOR THE CURRENT
* PASS OR AN ERROR IS REPORTED. THE LOCATION COUNTERS ARE
* ADVANCED TO A WORD BOUNDARY AND THE LABEL IS DEFINED. IN THE
* DEFINITION PASS, THE FIRST OPERAND IS EVALUATED TO DEFINE A
* POSSIBLE LITERAL. THE LOCATION COUNTERS ARE ADVANCED BY 4
* BYTES, LINESKIP IS CALLED, AND THIS ROUTINE BRANCHES TO GENR.
* IN THE GENERATION PASS, THE SINT FIELD OF THE COMMAND
* DEFINITION IS USED TO SELECT THE NEXT PROCESSING ROUTINE.
*
* INPUT: REFADD AND XT CONTAIN THE SYMBOL TABLE ADDRESS OF THE
* COMMAND DEFINITION BEING REFERENCED.
*
* OUTPUT: IN DEFINITION PASS, THE LOCATION COUNTERS HAVE BEEN
* ADVANCED BY 4 BYTES AND CONTROL BRANCHES TO GENR.
* IN GENERATION PASS, A BRANCH IS MADE TO THE NEXT
* PROCESSING ROUTINE SELECTED BY THE COMMAND
* DEFINITION.
*
* USES REGISTERS
* XT
* XT1
* RL
* ER
*
S:SINREF RES 0
LW,XT1 0,XT GET DEFINITION FIELD OF STANDARD
AND,XT1 =DEFFLD INSTRUCTION BEING REFERENCED
CW,XT1 PASSDEF
BNE LINE10 REFERENCE OCCURRED BEFORE DEFINITION
* HERE IF COMMAND IS DEFINED FOR CURRENT PASS
BAL,RL BOUND4 LOCATION COUNTERS TO WORD BOUNDARY
LV,XT SDINSTC SET SD TYPE TO 'INSTRUCTION'
STW,XT SD%TYPE
BAL,RL DEFLBL DEFINE LABEL
MTW,0 PASS
BNEZ SINREF2 GENERATION PASS
*
CALL SCANOPRND EVALUATE THE OPERAND FIELD
LI,XT1 4 ADVANCE BOTH LOCATION COUNTERS
B RES2 BY 4 BYTES
SINREF2 RES 0
LW,XT *REFADD LOAD SINT FIELD OF STANDARD
AND,XT =SINTFLD INSTRUCTION BEING REFERENCED
SHIFT,XT SINTLOB,31 RIGHT JUSTIFY SINT FIELD
LW,XT1 ECT,LVL
AW,XT1 KLINE ADDRESS OF ORIGIN OF EXPRESSION
STW,XT1 VALPTR CONTROL VALUE TABLE
LB,XT1 SINTABLE,XT
B SINBASE,XT1
*
SINT COM,8 AF-SINBASE
SINTABLE RES 0
SINT SIN0 STANDARD INSTRUCTION TYPE 0
SINT SIN1 STANDARD INSTRUCTION TYPE 1
SINT SIN2 STANDARD INSTRUCTION TYPE 2
SINCOUNT EQU BA(%)-BA(SINTABLE) NUMBER OF ENTRIES IN SINTABLE
BOUND 4
PAGE
*
* S A M P L I N
* STORE A LINE IN THE SAMPLE TABLE.
*
* EACH ENCODED ENTRY IS STORED IN SAMPLE STORAGE. IF THE LINE
* WILL REQUIRE PARTICULARIZATION, THE PARTICULARIZATION FLAG
* IS SET TO ONE (AT THE BEGINNING OF THE LINE IN SAMPLE).
* AN ERROR IS MARKED IF AN EQU OR SET DIRECTIVE IS STORED WITH
* A BLANK LABEL.
* IF A PEND DIRECTIVE IS STORED, PROCLV IS CLEARED SO THE NEXT
* LINE WON'T BE STORED IN SAMPLE.
*
* SAMPL20 IS AN ALTERNATE ENTRY (FOR COM) WHERE THE FIRST
* ENCODED ITEM IS IN LABELLOC INSTEAD OF INBUF.
*
LOCAL %10,%11,%80,%90
*
SAMPLIN RES 0
LW,XW LBL,LVL RESET XW BACK TO LABEL
LW,XT1 STORESAMP
BNEZ SAMPL10
MTW,1 SKIPTRIG
CV,XT SYSTEMDIR
BE SAMPL1 BRANCH IF 'SYSTEM' BEING SKIPPED
CV,XT ENDDIR
BE SAMPL2 BRANCH IF 'END' IS BEING SKIPPED
AV,XT -PENDDIR CLEAR PROCLV IF THE 'PEND'
BNEZ LINE5 IS BEING SKIPPED
STW,XT PROCLV
B LINE5
SAMPL1 RES 0
BAL,RL SYSSUB INCREMENT SYSTEM LEVEL
B LINE5
SAMPL2 RES 0
BAL,RL SYSEND DECREMENT SYSTEM LEVEL
BGEZ LINE5 END OF A SYSTEM FILE
B END%ERR ATTEMPTING TO SKIP END OF PROGRAM
SAMPL10 RES 0
NXTENC,XT2
SAMPL20 STW,XT2 LABELLOC
STW,XT1 LINEORG SAVE ORIGIN OF THIS LINE
LW,XT ECT,LVL COMPUTE HALFWORD INDEX
AW,XT KLINE
SW,XT SYMT OF KLINE (FOR TESTING BY PUT1)
SLS,XT 1
STW,XT ECTHW
CI,XT1 0 DON' STORE A PARTICULARIZATION
BEZ %10 FLAG FOR THIS LINE
LV,XT SMINT ENCODED INTEGER ZERO
BAL,RL PUT1 STORE PARTICULARIZATION FLAG
LW,XT LABELLOC
B %11
%10 NXTENC GET NEXT ENCODED ITEM
%11 RES 0
CALL PUT1 STORE IT IN SAMPLE TABLE
IF,EQ ENDLINE,XT DOIF FINISHED WITH LINE
LW,XT1 CMND,LVL
AW,XT1 CMNDLIST
NXTENC XT1 GET CF(1)
IF,EQ SYSTEMDIR,XT - SYSTEM -
NXTENC XT1,NOINC
AND,XT L(SYSTYPEFLD)
IF,G 1**(31-SYSTYPELOB),XT DOIF NORMAL INCLUDED SYSTEM
CALL SYSSUB
FI
ELSF,EQ ENDDIR,XT - END -
CALL SYSEND
IF,LZ
LW,XW XT1 (END%ERR PLAYS GAMES)
B END%ERR END OF PROGRAM
*
FI
ELSF,EQ PENDDIR,XT - PEND -
*
* CLEAR PROCLV TO INDICATE THIS IS THE LAST LINE TO STORE.
* MAKE SURE THE 'PEND' IS AT THE SAME 'SYSLEVEL' AS THE 'PROC'.
*
LW,XT SYSLEVEL
AI,XT 1
SW,XT PROCLV
STW,XT PROCLV
IF,NZ
BAL,ER KERR
FI
ELSF,EQ PROCDIR - PROC -
BAL,ER KERR
FI
LW,XT PROCLV IS THIS THE LAST LINE TO STORE
BNEZ GENR NO
XW,XT STORESAMP CLEAR STORESAMP
AI,XT 1 CHANGE STORESAMP FROM A HALFWORD
SLS,XT -1 INDEX TO A FULLWORD ADDRESS
AW,XT SYMT AND STORE IT
STW,XT NXTSYMT IN NXTSYMT
BAL,RL LOLIMIT TEST NXTSYMT FOR OVERFLOW
LI,RL GENR NO OVERFLOW, BUT THINGS
STW,RL FINDSPCXIT MIGHT NEED SHIFTING.
B FINDSPC7
*
FI
AND,XT =ENCITEM TRIM TO 16 BITS
CV,XT AFSYM IS THIS ITEM AF,AFA,CF, OR LF
BL %80 NO
CV,XT NAMESYM OR NAME
BLE SET%PARTIC%FLAG YES
CV,XT AFSSYM TEST FOR SUBSCRIPTED AF,AFA,CF, LF
BL %80 NO
CV,XT NAMESSYM OR NAME
BLE SET%PARTIC%FLAG BRANCH IF SUBSCIPTED AF,AFA,CF, LF
%80 RES 0
CV,XT SYNERR
BNE %+2
BAL,ER SERR SYNTAX ERROR
LV,XT1 TFLD TYPE FIELD
CS,XT =LOCALSYM IS THIS A LOCAL SYMBOL
BE SET%PARTIC%FLAG YES
CS,XT =LCLSBSYM IS THIS A LOCAL SUBSCRIPTED SYMBOL
BE SET%PARTIC%FLAG YES
CS,XT =MULTINT MULTI-WORD INTEGER
BNE %10 NO
LV,XT2 LFLD SAVE NO. HALFWORDS IN THE INTEGER
AND,XT2 XT
%90 RES 0
NXTENC STORE EACH HALFWORD
BAL,RL PUT1 OF THE MULTI-WORD INTEGER
BDR,XT2 %90
B %10
SET%PARTIC%FLAG RES 0
LW,XT1 LINEORG SET PARTICULARIZATION
BEZ %10
LV,XT2 SMINT+1 FLAG TO ONE
STH,XT2 *SYMT,XT1
B %10
PAGE
LOCAL %50,%60,%70
LOCAL %80,%90,%100,%110,%120,%130
LOCAL %112,%114,%140
OPEN TX1,TX2,TX3,TX4
OPEN TMP
TMP EQU 9
TX1 EQU 10
TX2 EQU 11
TX3 EQU 12
TX4 EQU 13
*
SCANOPRND RES 0
*
EV%CLN%OPRND RES 0
*
LW,XW OPRND,LVL GET INDEX TO OPERAND FIELD
*
SCAN RES 0
EVALUATE%AND%CLEAN RES 0
LI,XT 0 SERIES OF EXPRESSIONS
B SCAN2
SCAN1 LI,XT 1 SINGLE EXPRESSION
SCAN2 STW,XT 1ARG
STW,RL SCANEXIT SAVE EXIT
LW,XS ECT,LVL SET XS TO FIRST ECT ENTRY
STW,XS SCANXS
LI,XT 0
STW,XT SCLVL
STW,XT SCARG
STW,XT LFWDFLG
STW,XT LITFLAG
SCLOOP RES 0
MTW,0 SCLVL LEVEL
BLZ SCRET
NXTENC GET NEXT ENCODED ITEM
AND,XT =ENCITEM TRIM TO 16 BITS
CI,XT BLANKEXP BLANK EXPRESSION
BE SCLOOP25 YES
BFZ,XT TFLD,SCCON BRANCH IF CONTROL ITEM
SCLOOP25 MTW,0 SCLVL SCAN LEVEL = 0
BGZ SCLOOP35
MTW,0 1ARG YES, SINGLE EXP ENTRY
BLEZ SCLOOP30 NO
MTW,0 SCARG YES, ARG PROCESSED
BGZ SCLOOP40 YES
SCLOOP30 RES 0
MTW,+1 SCARG NO. SET ARG PROCESSED FLAG
SCLOOP35 LV,XT2 TFLD
AND,XT2 XT
SHIFT,XT2 TLOB,31
LB,XT1 SC1%JUMP,XT2
B SC1%BASE,XT1
SC1%BASE RES 0
SC1%JUMP RES 0
BYTE,SC1%BASE SCBLNK BLANK EXPRESSION
BYTE SCUNDSYM DIRECTIVE
BYTE SCGSYM GLOBAL SYMBOL
BYTE SCLSYM LOCAL SYMBOL
BYTE SCGSSYM GLOBAL SUBSCRIPTED SYMBOL
BYTE SCLSSYM LOCAL SUBSCRIPTED SYMBOL
BYTE SCSINT SMALL INTEGER
BYTE SCINT INTEGER
BOUND 4
SCUNDSYM RES 0
B SCMAPU1 MARK DIRECTIVE AS UNDEFINED
*
* S C B L N K
*
SCBLNK RES 0
LW,XT2 PASSDEF
BAL,RL MOVEBLANK
B SCLOOP
*
* S C G S S Y M
*
SCGSSYM RES 0
STW,XT TEMP SAVE SUBSCRIPTED SYMBOL NUMBER
CLM,XT RNG%STD%FUNC
IF,IL DON'T SET UNDEF FOR STD FUNCTIONS
CALL GLBLADD0
ELS
CALL GLBLADD FIND ITS SYMT ADDRESS
FI
LW,XT1 *FND
IF,FNZ DUPFLD,XT1 DOIF DUPLICATE
BAL,ER DERR
FI
LW,XT TEMP RESTORE SUBSCRIPTED SYMBOL NUMBER
CLM,XT RNG%PREFIX%FUNC
IF,IL
AI,XT -(LO%PREFIX%FUNC+ENCSSYM)
LH,XT1 SC6%JUMP,XT
B SC6%BASE,XT1
*
FI
BAL,RL TYPE
CV,XT2 FUNCET
BE SSYMFUNC
LW,XT TEMP RESTORE SUB-SYMBOL NUMBER
*
* S C L S S Y M
*
SCLSSYM RES 0
LV,XT2 SUBSYMET
LW,TMP XT
MTW,+1 SCLVL
B %55
*
SC6%JUMP RES 0
HALF,SC6%BASE SCLITF LITERAL FUNCTION
HALF SCLITF '=' OPERATOR
HALF SCS:KEYS S:KEYS
HALF SCSCOR SCOR
HALF SCTCOR TCOR
BOUND 4
*
* S C S I N T
*
SCSINT RES 0
STW,XT TMP BUILD SMALL INTEGER
AND,TMP L(VFLD) VALUE
SCSINT1 RES 0
OR,TMP PASSDEF DEF
SCSINT3 RES 0
OR,TMP L(SPINT) ITEM IDENTIFIER
LV,XT2 SPINTET SET UP SPECIAL INTEGER TYPE
B %55
*
* S C G S Y M
*
SCGSYM RES 0
CLM,XT RNG%LOC%CTR IS SYMBOL % OR %%?
BIL %1000 BRIF YES.
*
BAL,RL GLBLADD
SCGSYM2 RES 0
LW,XT FND ADDRESS OF SYMBOL
LW,XT1 0,XT SYMBOL CONTROL WORD
SCGSYM1 RES 0
LW,TMP XT1
CV,XT1 DUPFLD MARK A DUP ERROR
BAZ %+2 IF THE DUP FIELD
BAL,ER DERR
BAL,RL TYPE EVALUATE TYPE FIELD
SHIFT,XT2 ETLOB,31
LB,RL SC2%JUMP,XT2 BRANCH TO APPROPRIATE ROUTINE
B SC2%BASE,RL FOR THIS TYPE
SC2%BASE RES 0
*
* S C L S Y M
*
SCLSYM RES 0
BAL,RL LOCALADD
LW,XT1 *FND GET VALUE OF LOCAL ENTRY
CV,XT1 SPAFLD BRANCH IF THIS IS NOT THE FIRST
BNE SCLSYM1 REFERENCE TO THIS LOCAL SYMBOL
LV,XT1 LCLFWD+SYMBOL+WDRES ASSIGN THE LOCAL SYMBOL A
AW,XT1 FWDNUM FORWARD REFERENCE NUMBER WITH
STW,XT1 LVAL WORD RESOLUTION
MTW,1 FWDNUM BUMP FORWARD NUMBER
MTW,1 LFWDFLG SET LOCAL FORWARD FLAG
LI,XT2 LVAL SET UP PARAMETERS FOR 'DEFLOC'
STW,XT2 ARG
LI,XT2 1
STW,XT2 LARG
BAL,RL DEFLOC ASSIGN FORWARD REF NUMBER
LW,XT1 *FND
SCLSYM1 RES 0
MTW,0 LITFLAG IS THIS THE ARG OF A LIT
BEZ SCGSYM1 NO
BAL,RL TYPE GET TYPE OF VALUE
CV,XT2 LFWDHET IS IT A LOCAL FORWARD AND HOLD
BE SCLSYM7 YES
CV,XT2 LCLFWDET IS IT A LOCAL FORWARD
BNE SCGSYM1 NO
AV,XT1 1**(31-STYPELOB) YES, MAKE INTO A LOCAL FWD & HOLD
STW,XT1 *FND PUT IN SYMT
SCLSYM7 RES 0
OR,XT1 =1**(31-DEFLOB) SET TO DEFINED
B SCGSYM1
*
* UNDEFINED
*
SCUNDGLBL RES 0
MTW,0 TCORFLG DON'T SET SYMBOL TABLE ENTRY IF
BNEZ %45 THIS IS A TCOR REFERENCE
LV,TMP SPINTFLD SET SYMBOL TABLE
STS,TMP *FND ENTRY TO 'UNDEFINED,USED'
%45 RES 0
LW,TMP MAIN GET SYMBOL NUMBER
SW,TMP SYMT
OR,TMP L(SPAFLD)
SCUND RES 0
BAL,ER UERR MARK A 'U' ERROR
%50 LW,XT2 L(UGLBLET)
%55 RES 0
STW,XT2 DD%TYPE SET UP ECT TYPE
%60 LI,XT1 1 LENGTH OF EVT ENTRY
LI,XT TMP ADDRESS OF EVT ENTRY
AND,TMP =~EXTFLD CLEAR EXT FIELD
V%C%3 RES 0
BAL,RL SCPUSH MOVE TO EVT,ECT TABLES
B SCLOOP
%70 AND,XT1 L(LENGTHFLD) GET LENGTH OF EVT ENTRY
B V%C%3
%75 RES 0
AND,TMP L(DUPFLD+SETFLD+DEFFLD+ARFLD+EDNFLD)
OR,TMP L(SYMBOL+EXTREF)
LV,XT2 EXTET EXTERNAL TYPE
B %55
SYMLIST RES 0
BAL,RL LITERROR ERROR IF =LIST
LW,XT FND
LW,TR0 ELEM,XT NO. OF LIST ELEMENTS
MTW,+2 FND SKIP LIST CONTROL ITEM
LI,TX2 0 CLEAR * INDICATOR FOR FIRST THING
NXTENC,XT1 XW,NOINC SET * INDICATOR IF LIST
CV,XT1 ASTFLG SYMBOL WAS PRECEEDED BY *
BNE SCSYML1
LV,TX2 ASTFLD
AI,XW 1 SKIP ENCODED *
SCSYML1 RES 0
LW,XT FND
LW,XT1 0,XT NEXT THING IN SYMT
BAL,RL TYPE TYPE IT
AWM,TX2 DD%TYPE ADD * INDICATOR TO FIRST THING
BAL,RL LENGTH FIND ITS LENGTH
AWM,XT1 FND ADD LENGTH TO FND
BAL,RL SCPUSH PUSH IT ONTO EVT AND ECT
BAL,RL 1ELEMENT%TEST
LI,TX2 0 CLEAR * INDICATOR FOR THE REST
BDR,TR0 SCSYML1 DECREASE LIST ELEMENTS AND RETURN
B SCLOOP
*
* HERE WHEN A BLANK IS FOUND IN THE SYMBOL TABLE
*
SCBLNKSYM RES 0
AND,TMP =~DEFFLD MOVE PASSDEF TO DEF FIELD IN CASE
OR,TMP PASSDEF THIS IS AN IMPLICIT BLANK
B %60
*
* 1 E L E M E N T % T E S T
* TEST FOR A ONE-ELEMENT LIST AS THE LAST THING IN THE ECT & EVT
* AND DELETE THE LIST DESIGNATIONS.
*
* INPUT: ECT,LVL POINTS ONE WORD BEYOND THE ITEM TO TEST
* THAT ITEM MUST BE THE LAST THING IN ECT,EVT
*
* OUTPUT: IF ALL ONE-ELEMENT LISTS ARE FOUND, THE ECT
* ENTRY, AND THE 2-WORD LIST CONTROL ITEMS ARE
* REMOVED FROM THE ECT AND EVT.
* REGISTER XT CONTAINS ET FIELD OF LAST ECT ENTRY.
*
1ELEMENT%TEST RES 0
STW,RL 1ELEMXIT
1ELEM%1 RES 0
LW,XT ECT,LVL LOCATE THE ECT ENTRY
AW,XT KLINE
LW,XT 1,XT
LV,XT1 ETFLD
CS,XT =LISTET
BNE *1ELEMXIT EXIT IF NOT A LIST
AW,XT KLINE
1ELEM%2 RES 0
LW,XT1 ELEM,XT
CI,XT1 1
BNE *1ELEMXIT EXIT IF NOT ONE ELEMENT
*
AI,XT 2
LW,XT1 0,XT GET NEXT CONTROL WORD
IF,FZ SPAFLD,XT1 DOIF NOT ONE WORD ENTRY
AND,XT1 =TYPEFLD
CV,XT1 LISTS
BE 1ELEM%2 KEEP LOOKING IF THIS IS A LIST
*
FI
STW,XT DD%TYPE SAVE LOC OF ITEM REMAINING
BAL,RL SCPULL REMOVE ECT AND EVT ENTRIES
LW,XT DD%TYPE RESTORE LOC OF REMAINING ITEM
LW,XT1 0,XT
BAL,RL TYPE TYPE IT
BAL,RL LENGTH FIND ITS LENGTH
BAL,RL SCPUSH RE-INSERT IT IN ECT,EVT
B 1ELEM%1
SC2%JUMP RES 0
BYTE,SC2%BASE SCUNDGLBL UNDEFINED GLOBAL
BYTE %60 SPECIAL ADDRESS
BYTE %75 SPECIAL EXTERNAL
BYTE %70 ADDRESS
BYTE %70 SUM
BYTE %60 EXTERNAL
BYTE %60 LOCAL FORWARD
BYTE %60 LOCAL FORWARD AND HOLD
BYTE %60 ONE-WD ADDRESS
BYTE %60 SPECIAL INTEGER
BYTE SCBLNKSYM BLANK
BYTE %70 INTEGER
BYTE %70 DECIMAL
BYTE %70 TEXT
BYTE %70 FX
BYTE %70 FS
BYTE %70 FL
BYTE %70 DPI
BYTE SYMLIST LIST
BYTE SYMFUNC FUNCTION
BOUND 4
*
* S C I N T
*
SCINT RES 0
LV,XT2 LFLD SAVE ENC LENGTH FIELD
AND,XT2 XT IN XT2
LW,TMP XT2 COMPUTE NUM WORDS
AI,TMP 1 IN THE
SLS,TMP -1 EVT ENTRY
AI,TMP 1 ADD 1 FOR THE CONTROL WORD
AND,XT =CTFLD SAVE CONSTANT TYPE
SHIFT,XT CTLOB,31 RT ADJUST
LW,RL XT SAVE FOR BRANCH
AI,XT 11 ADD ET OFFSET CONSTANT
SHIFT,XT 31,ETLOB
STW,XT DD%TYPE SAVE AS ECT ENTRY TYPE
LW,XT1 RL CT FIELD OF ENC ENTRY
SHIFT,XT1 31,CTYPELOB
AW,TMP XT1
AV,TMP CONSTANT CONSTANT TYPE IN CTYPE FIELD
AW,TMP PASSDEF
NXTENC,TR0 NEXT ENCODED ENTRY TO TR0
CI,RL 2 2=TEXT
BE %100 TEXT
BG %110 FX, FS, OR FL TYPES
CI,RL 1
BE %90 DECIMAL
*
* INTEGER
*
%80 CI,XT2 2 CONSTANT LENGTH = 2
BL %140 LENGTH = 1
BG %84 LENGTH > 2
CV,TR0 ENCITEM&((~VALFLD)**(-16)) WILL CONST FIT IN VAL FLD
BAZ %120
CI,TR0 ENCHOB IS THIS CONSTANT A DPI
BAZ %110 NO
%84 RES 0
AV,TMP DPI-SPI CHANGE CTYPE FROM INTEGER TO DPI
LV,TX1 DPIET MOVE DPI TO DD%TYPE
STW,TX1 DD%TYPE
B %110
%120 RES 0
NXTENC,TMP NEXT ENC ITEM TO TMP
STH,TR0 TMP INSERT HIGH ORDER 6 BITS
B SCSINT1
%90 CI,XT2 1 CONSTANT CONSIST OF AN EVEN # WDS
BAZ %110 YES
AI,XT2 1 NO, ADD 1 TO COUNT TO MAKE EVEN
AI,XW -1 BACK UP ENCODED TEXT POINTER
LI,TR0 0 SET CURRENT ENCODED TEXT WD TO 0
%110 RES 0
LI,XT1 1 NUMBER OF WORDS TO PUSH
LI,XT TMP ADDRESS OF ITEM TO PUSH
BAL,RL SCPUSH PUSH THE CONTROL WORD ONTO STACK
%112 RES 0
STH,TR0 TMP
LI,XT ' '
AI,XT2 -1 DECREMENT NUMBER OF ENCODED ITEMS
BEZ %114 BRANCH IF NO MORE ENCODED ITEMS
NXTENC GET NEXT ENCODED ITEM
%114 RES 0
LI,XT1 1 NUMBER OF WORDS TO PUSH
STH,XT TMP,XT1 STORE 2ND HALFWORD
LI,XT TMP ADDRESS OF ITEM TO PUSH
BAL,RL SCPSHV PUSH ITEM ONTO EVT
AI,XT2 -1 DECREMENT NUMBER OF ENCODED ITEMS
BLEZ SCLOOP BRANCH IF DONE
NXTENC,TR0 GET NEXT ENCODED ITEM IN TR0
B %112
%100 RES 0
CV,TR0 1**(31-BYTE2LOB)
BL %110 ZERO TEXT CHARACTERS
CV,TR0 3**(31-BYTE2LOB) MORE THAN TWO CHARACTERS
BGE %110 YES
LV,TMP BYTE2FLD CONSTRUCT BEGINNING OF SPECIAL
AND,TMP TR0 INTEGER ITEM
SHIFT,TMP BYTE2LOB,CCLOB
CI,XT2 1 IS ENC ENTRY LENGTH = ONE
BE %130 YES. RT ADJUST THE ONE CHARACTER
STB,TR0 TMP,RL FIRST CHARACTER TO BYTE2FLD
NXTENC,TR0 SECOND CHARACTER TO TR0
SHIFT,TR0 BYTE2LOB,BYTE3LOB POSITION SECOND CHARACTER
%130 RES 0
AND,TR0 =BYTE3FLD
OR,TMP TR0 STORE LAST CHARACTER IN BYTE3FLD
B SCSINT1
%140 RES 0
LV,TMP ENCITEM
AND,TMP TR0
B SCSINT1
* HERE FOR A SYMBOL TYPED AS A FUNCTION
SYMFUNC RES 0
LW,XS XW
SYMFUNC1 RES 0
BAL,RL ADV%ITM LOCATE THE END-LINE
BEZ SYMFUNC2 FOUND
SW,XS CT BUMP XM BY 1 IF END-SUB-SYMBOL
B SYMFUNC1
* HERE WHEN A SUBSCRIPTED SYMBOL IS TYPED AS A FUNCTION
SSYMFUNC RES 0
LW,XS XW
SSYMFUNC1 RES 0
BAL,RL ADV%ITM LOCATE THE END-SUBSCRIPTED-SYMBOL
CV,TX3 ENDSBSYM
BNE SSYMFUNC1
AI,XS 1 SKIP THE END-SUBSCRIPTED-SYMBOL
XW,XW XS
SYMFUNC2 RES 0
LW,TMP *FND ERROR IF FUNC IS NOT DEFINED
AND,TMP =DEFFLD FOR THE CURRENT PASS
CW,TMP PASSDEF
BNE SCMAPU1 GO OUTPUT A ZERO AND AN ERROR
LI,XT1 SCSINT3 RETURN IF TOO MANY PROCS
BAL,RL CK%PREF CHECK PROCS NESTED TOO DEEPLY
XW,XS OPRND,LVL REPLACE WITH LOCATION OF PARAMETERS
STW,XS OPRNDORG SAVE ORIGINAL OPRND LOCATION
STW,XW NEXTXW SAVE LOCATION OF ARG. END
LI,XT SAVEORG ORIGIN OF SAVED WORDS
LI,XT1 NSAVES NUMBER OF SAVED WORDS
BAL,RL SCPUSH SAVE VOLATILE DATA
LW,XT FND GET ADDRESS OF FUNCTION ENTRY
BAL,RL BLDPLT BUILD A NEW PROC LEVEL TABLE
MTB,+1 *LVL+PLOC SET 'FUNC' FLAG IN PLOC WORD
B LINE3 GO PROCESS THE FUNCTION REFERENCE
*
* HERE IF GLOBAL SYMBOL = % OR %%
*
%1000 RES 0
LW,XT2 XT MAP % TO 0, %% TO 1, FOR INPUT
AI,XT2 -ENC% TO ASDLR.
BAL,RL ASDLR ASSEMBLE % OR %%
LW,TMP TEMP IS RESULT A SPECIAL ADDRESS
BLZ V%C%6 YES, SET TYPE = SPA
LV,TX1 ADDRET SET TYPE = SIMPLE ADDRESS
STW,TX1 DD%TYPE
LI,XT TEMP POINTER TO ITEM
LI,XT1 2 SIZE
B V%C%3
*
SC6%BASE RES 0
*
* S C L I T F
*
SCLITF RES 0 LITERAL FUNCTION OR '=' OPERATOR
MTW,+1 LITFLAG GUYS INSIDE MAY BE INTERESTED
LW,XT TEMP RESTORE THE ENCODED SUB-SYM NUMBER
B SCLSSYM (XT MUST HAVE CLEAN SYMBOL NUMBER)
*
* S C S C O R
*
SCSCOR RES 0
LI,TMP 0
LW,XS XW MOVE ORIGIN OF TEST ITEM
BAL,RL ADV%ITM ADVANCE ITEM (USES XM WHICH IS XS)
LW,TX1 XS CALCULATE SIZE OF TEST ITEM
SW,TX1 XW
STW,TX1 LVAL
SCSCOR3 AI,TMP 1
CV,TX3 ENDSBSYM FINISHED WITH ALL ITEMS
BE SCSCOR10 YES
STW,XS RVAL NO, SAVE OFFSET TO NEXT ITEM
BAL,RL ADV%ITM ADVANCE ITEM
LW,TX1 XS CALCULATE SIZE OF NTH ITEM
SW,TX1 RVAL
CW,TX1 LVAL DOES SIZE 1 = SIZE N
BNE SCSCOR3 NO
LW,RL XW YES, DOES ITEM MATCH
LW,XT1 RVAL
SCSCOR5 RES 0
LH,TX2 *XWBASE,RL
CH,TX2 *XWBASE,XT1
BNE SCSCOR3 NO
AI,RL 1
AI,XT1 1
BDR,TX1 SCSCOR5
SCSCOR9 RES 0
CV,TX3 ENDSBSYM
BE SCSCOR11
SCSCOR7 RES 0
BAL,RL ADV%ITM
B SCSCOR9
SCSCOR10 LI,TMP 0 NOT FOUND, RESULT = 0
SCSCOR11 LW,XW XS
AI,XW 1 SKIP END SCOR ITEM
B SCSINT1
LOCAL %10,%14,%16,%20,%24,%26,%28
LOCAL %32,%34,%38,%44,%46,%48
LOCAL %32A,%18,%19,%29,%30,%31,%33
*
* S C C O N
*
SCCON RES 0
MTW,0 1ARG ONE ARG ONLY
BEZ SCCON5 NO, CONTINUE
MTW,0 SCLVL YES, IS NESTING LEVEL = 0
BNEZ SCCON5 NO, CONTINUE
MTW,0 SCARG ARG PROCESSED
BEZ SCCON5 NO
CV,XT ASTFLG YES, IS IT PREFIX OPERATOR
BL SCLOOP40 NO
SCCON5 RES 0
CI,XT X'20'
BGE V%OPERATOR
LH,XT1 SC3%JUMP,XT
B SC3%BASE,XT1
SC3%BASE RES 0
SC3%JUMP RES 0
HALF,SC3%BASE V%0 END LINE
HALF SCDIR IGNORE LIST
HALF SCENDLIST END LIST
HALF SCENDSSYM END SUBSCRIPTED SYMBOL
HALF SCENDEXP END EXPRESSION
HALF SCDIR BLANK EXPRESSION
HALF V%8 BEGIN LIST
HALF SCBEGINEXP BEGIN EXPRESSION
HALF V%B '*' FLAG
HALF V%14 ENCODER DETECTED TRUNCATION ERROR
HALF V%15 ENCODER DETECTED SYNTAX ERROR
BOUND 4
*
* END LINE
*
V%0 RES 0
MTW,0 SAMP,LVL
BEZ V%01
LW,XW SAMP,LVL
BAL,RL LOADXW
LV,XT ENDLINE SET XT TO SHOW ENDLINE
V%01 B SCRET
*
* END EXPRESSION
*
V%4 RES 0
BAL,ER EERR REPORT AN EXPRESSION ERROR
SCENDEXP RES 0
MTW,1 ECT,LVL
LW,XT1 ECT,LVL
AW,XT1 KLINE
LW,XT 0,XT1 SET EXPRESSION BIT
OR,XT =EXPFLD IN LAST ECT ENTRY
XW,XT 1,XT1 AND EXCHANGE IT WITH PRIOR ENTRY
AND,XT =ETFLD IF PRIOR ENTRY IS NOT AN EXPRESSION
CV,XT EXPET ET, REPORT AN EXPRESSION ERROR
BNE V%4 E.G. RESULT SHOULD BE SINGLE ITEM
MTW,-1 SCLVL
B SCLOOP
*
* BEGIN LIST
*
V%8 RES 0
BAL,RL MV:LIST
B V%9
*
* BEGIN EXPRESSION
*
SCBEGINEXP RES 0
LV,XT EXPET PUSH AN EXPRESSION ET
STW,XT DD%TYPE ONTO THE ECT TO MARK THE
BAL,RL SCPSHC BEGINNING OF EXPRESSION
V%9 RES 0
LI,XT1 1 SET ARGUMENT PROCESSED FLAG
STW,XT1 SCARG
MTW,1 SCLVL INCR SCAN LEVEL
B SCLOOP
*
* '*' FLAG
*
V%B RES 0
LW,XT ECT,LVL
AI,XT 1
LV,XT1 ASTFLD STORE A ONE IN ASTERISK FIELD
STS,XT1 *KLINE,XT OF LAST ECT ENTRY
B SCLOOP
*
SC7%BASE RES 0
*
* '=' FLAG (OR L INTRINSIC)
*
V%C RES 0
LI,XT 0
STW,XT LITFLAG RESET LITERAL FLAG
XW,XT LFWDFLG WAS THERE A LOCAL FORWARD
IF,NZ DOIF THERE WAS
LW,XT ECT,LVL YES, GET ECT FOR LITERAL
AI,XT 1
LW,XT1 *KLINE,XT
CV,XT1 EXPFLD IS IT AN EXPRESSION
IF,ANZ DOIF IT IS
AND,XT1 L(ETFLD||X'FFFFFFFF') YES, SET ET TO UNDEFINED
STW,XT1 *KLINE,XT
FI
FI
CALL SCNOLIST RECOVER FROM LIST IN AF *D-DG
BAL,RL LSRCH SEARCH LITERAL TABLE
BAL,RL SCPULL PULL LITERAL VALUE FROM STACK
MTW,+1 ECT,LVL DELETE SUBSCRIPTED SYMBOL CONTROL
MTW,-1 EVT,LVL '' '' '' NUMBER
LV,XT2 UGLBLET+EXPFLD
LV,TMP UNDITM
MTW,0 PASS LSRCH RETURNS A FORWARD (UNDEFINED)
BEZ %55 ADDRESS DURING THE DEF PASS
LW,TMP FND GET OFFSET OF LITERAL
LW,TX3 LITCS GET CONTROL SECTION OF LITERAL
CV,TMP ADDFLD WILL OFFSET FIT IN SPA TYPE
BG V%C%5 NO
CV,TX3 CSFLD**(-(31-CSLOB)) YES, WILL C.S. FIT IN SPA TYPE
BG V%C%5 NO
OR,TMP =SPAFLD+WDRES+1**(31-DEFLOB) YES, BUILD SPA
SLS,TX3 31-CSLOB
OR,TMP TX3
V%C%6 RES 0
LV,XT2 SPADDRET SPECIAL ADDRESS TYPE
B %55
V%C%5 RES 0
LV,TX1 WDRES+SYMBOL+SIMPADD+1**(31-DEFLOB) FORM CONTROL WORD
STW,TX1 LVAL
SLS,TX3 31-FCSLOB FORM 2ND WD
OR,TX3 TMP
STW,TX3 LVAL+1
V%C%7 RES 0
LV,TX3 ADDRET SIMPLE ADDRESS TYPE
V%C%4 RES 0
STW,TX3 DD%TYPE
LI,XT1 2
LI,XT LVAL
B V%C%3
*
* TRUNCATION ERROR
*
V%14 RES 0
BAL,ER TERR
B SCLOOP
*
* SYNTAX ERROR
*
V%15 RES 0
BAL,ER SERR
B SCLOOP
*
* END LIST
*
SCENDLIST RES 0
MTW,-1 SCLVL DECREASE LEVEL COUNT
BLZ SCRET BRANCH IF THERE'S NO LIST
BAL,RL CTELEMENTS
BAL,RL 1ELEMENT%TEST
AND,XT =ETFLD
CV,XT LISTET DON'T CALL LITERROR IF THERE
IF,EQ IS NO LIST IN THE ECT.
BAL,RL LITERROR ERROR IF =(LIST)
B SCLOOP
*
FI
LW,XT ECT,LVL MOVE THE EXPRESSION BIT
AW,XT KLINE FROM THE ONE ELEMENT THAT WAS
LW,XT1 0,XT DELETED BECAUSE OF THE
AND,XT1 =EXPFLD REDUNDANT 'LIST' PARENTHESES
AWM,XT1 1,XT
B SCLOOP
*
LITERROR RES 0
MTW,0 LITFLAG
EXIT,EQ RL
BAL,ER EERR
EXIT RL
*
* END SUBSCRIPTED SYMBOL
*
SCENDSSYM RES 0
MTW,-1 SCLVL
BLZ SCRET RETURN. END OF SUBSCRIPT COMPUTATION
LW,XT ECT,LVL
LV,XT3 ETFLD
ENDSSYM1 RES 0
AI,XT 1
LW,XT2 *KLINE,XT FIND THE SUBSCRIPTED SYMBOL
CS,XT2 =SUBSYMET ET FIELD IN THE ECT
BNE ENDSSYM1
LW,TMP XT COMPUTE AND STORE
SW,TMP ECT,LVL THE NUMBER OF
AI,TMP -1 SUBSCRIPTS
STW,TMP LSTCT IN LSTCT
AND,XT2 =LOCFLD SAVE EVT OFFSET
LW,XT1 *KLINE,XT2 GET ENCODED SUBSCRIPTED SYM FROM EVT
CLM,XT1 RNG%VAL%FUNC
IF,IL
AI,XT1 -(LO%VAL%FUNC+ENCSSYM)
LH,RL SC7%JUMP,XT1
B SC7%BASE,RL
*
FI
STW,XT ECT,LVL DELETE THE ECT ENTRIES
STW,XT2 EVT,LVL DELETE THE EVT ENTRIES
LW,XT XT1
CI,XT1 ENCLSSYM-ENCSSYM
IF,AZ DOIF GLOBAL SUBSCRIPTED SYMBOL
BAL,RL GLBLADD FIND GLOBAL SYMT ADDRESS (IN FND)
ELS IS LOCAL SUBSCRIPTED SYMBOL
BAL,RL LOCALADD FIND LOCAL SYMT ADDRESS (IN FND)
FI
LW,XT ECT,LVL PRESET ADDRESS
AI,XT -1 OF FIRST SUBSCRIPT
AW,XT KLINE
STW,XT SUBLOC
ENDSSYM4 RES 0
LW,XT1 *FND
BAL,RL TYPE TYPE THE NEXT SYMT ITEM
ENDSSYM5 RES 0
BAL,RL SUBVAL NEXT SUBSCRIPT NUMBER -> SUB#
LW,XT1 DD%TYPE BRANCH IF THIS SYMT ENTRY IS
BEZ SCUNDGLBL UNDEFINED
*
CV,XT1 LISTET BRANCH IF THIS ENTRY IS
BNE ENDSSYM7 NOT A LIST
LW,XT2 FND NUMBER OF ELEMENTS
MTW,+2 FND SKIP LIST CONTROL ITEM
CW,XT ELEM,XT2 BRANCH TO STORE BLANK IF
BG SCBLNK NOT ENOUGH ELEMENTS
*
LW,XT2 SUB#
B SSYMA2
*
SSYMA1 RES 0
LW,XT FND SKIP SUB#-1 SYMT ITEMS,
CALL LENGTH AND ADD LENGTH OF
AWM,XT1 FND SKIPPED ITEM TO FND
SSYMA2 RES 0
BDR,XT2 SSYMA1
*
MTW,-1 LSTCT DECREASE # SUBSCRIPTS
BGZ ENDSSYM4 RETURN IF MORE SUBSCRIPTS
B SCGSYM2
* HERE THE ELEMENT IS NOT A LIST
ENDSSYM7 RES 0
MTW,-1 SUB# USE THE SYMT ITEM IF ALL
BNEZ SCBLNK
MTW,-1 LSTCT
BEZ SCGSYM2
B ENDSSYM5
*
SC7%JUMP RES 0
HALF,SC7%BASE V%F BA
HALF V%10 HA
HALF V%11 WA
HALF V%12 DA
HALF V%13 ABSVAL
HALF V%E CS
HALF NUMINTRINSIC NUM
HALF UFVINTRINSIC S:IFR
HALF NUMCINTRINSIC S:NUMC
HALF SCS:PT S:PT
HALF UFVINTRINSIC S:UFV
HALF SCS:UT S:UT
HALF V%C L
HALF V%C '=' OPERATOR
BOUND 4
*
NUMINTRINSIC RES 0
STW,XT ECT,LVL DELETE THE ECT ENTRIES
STW,XT2 EVT,LVL DELETE THE EVT ENTRIES
LW,TX4 PASSDEF
AI,XT -1
CI,TMP 1 IS THE ONE ITEM
BNE NUMINT1 NO, USE THE ITEM COUNT
*
LV,XT3 ETFLD
LW,XT2 *KLINE,XT USE ZERO IF THE SINGLE ITEM
CS,XT2 =BLANKET IS A BLANK EXPR.
BNE NUMINT1
MTW,-1 LSTCT ZERO -> LSTCT
NUMINT1 RES 0
LW,XT1 *KLINE,XT NEXT ECT WORD
AND,TX4 *KLINE,XT1 SAVE LOWEST DEF FIELD
AI,XT -1
BDR,TMP NUMINT1
LW,TMP TX4 LOWEST DEF FIELD
OR,TMP LSTCT INSERT NUMBER OF THINGS
B SCSINT3 GO TO PUSH SPEC. INTEGER
*
* S:NUMC INTRINSIC
*
NUMCINTRINSIC RES 0
STW,XT ECT,LVL DELETE THE ECT ENTRIES
STW,XT2 EVT,LVL DELETE THE EVT ENTRIES
BAL,RL S:PTSETUP SET IN TO ECT ADDRESS
LW,TMP PASSDEF PRESET CHAR CT & DEF FIELD
NUMCSS1 RES 0
BAL,ER NEXT%TEXT TEST NEXT ITEM FOR TEXT
B NUMCSS2 HERE FOR NO TEXT ITEM
AW,TX4 CT ADD TO CHAR COUNT
AND,TMP TR0 RETAIN LOWEST DEF FIELD
NUMCSS2 RES 0
MTW,-1 LSTCT COUNT AND
BGZ NUMCSS1 RETURN
AW,TMP TX4 INSERT CHAR COUNT
B SCSINT3
*
* CS INTRINSIC
*
V%E RES 0
CALL SCNOLIST RECOVER FROM LIST IN AF *D-DG
BAL,RL SCCS GET CONTROL SECTION NUMBER
%10 RES 0
BAL,RL SCPULL REMOVE LAST EXPRESSION FROM STACK
MTW,+1 ECT,LVL DELETE SUBSCRIPTED SYMBOL CONTROL
MTW,-1 EVT,LVL '' '' '' NUMBER
LV,XT2 SPINTET
B %55 FINISH BUILDING SPECIAL INTEGER
SCCS RES 0
STW,RL SCRSRTN SAVE RETURN
BAL,RL SCSETUPR SET UP RIGHT OPERAND
LW,TMP *RPTR SET UP SKELETON WORD FOR
AND,TMP =DEFFLD RESULT USING THE 'DEF' FIELD
OR,TMP =SPAFLD+SPINTFLD FROM THE CURRENT ITEM
CV,XT SPADDRET IS ITEM A SPECIAL ADDRESS
BE %14 YES
CV,XT ADDRET NO, IS ITEM AN ADDRESS
BE %16 YES
CV,XT SUMET NO, IS ITEM A SUM
BNE %19 NO
LW,XT2 *RPTR YES, IS LENGTH OF ENTRY = 3
AND,XT2 =LENGTHFLD
CV,XT2 LNGTH3
BNE %19 NO
MTW,2 RPTR POINT TO WORD FOLLOWING SVAL
LW,XT2 *RPTR LOAD 3RD WORD OF SUM
LV,RL STYPEFLD
CS,XT2 =ONEWDADD IS IT A ONE WORD ADDRESS
BNE %19 NO
AND,XT2 =ECSFLD YES, GET CONTROL SECTION NUMBER
SHIFT,XT2 ECSLOB,31 RIGHT JUSTIFY IT
B %18
%14 RES 0
LW,XT2 *RPTR
AND,XT2 =CSFLD GET CONTROL SECTION NUMBER
SHIFT,XT2 CSLOB,31 RIGHT JUSTIFY IT
B %18
%16 RES 0
MTW,1 RPTR POINT TO WORD FOLLOWING CONTROL WORD
LW,XT2 *RPTR
AND,XT2 =FCSFLD GET CONTROL SECTION NUMBER
SHIFT,XT2 FCSLOB,31 RIGHT JUSTIFY IT
%18 RES 0
AW,TMP XT2
B *SCRSRTN RETURN
%19 RES 0
LI,XT2 -1 NOT AN ADDRESS
B *SCRSRTN RETURN
*
* BA INTRINSIC
* HA INTRINSIC
* WA INTRINSIC
* DA INTRINSIC
*
V%F RES 0 BA INTRINSIC
V%10 RES 0 HA INTRINSIC
V%11 RES 0 WA INTRINSIC
V%12 RES 0 DA INTRINSIC
STW,XT1 DDRS SAVE 0,1,2,3 FOR BA,HA,WA,DA
CALL SCDEL1 DELETE THE SUB-SYM CONTROL
BAL,RL SCRS
B SCLOOP
SCRS RES 0
STW,RL SCRSRTN SAVE RETURN LINK
BAL,RL SCSETUPR SET UP RIGHT OPERAND
IF,EQ EXTET,XT,OR DOIF EXTERNAL, *D-DG
IF,EQ LCLFWDET,XT,OR LOCAL FORWARD, *D-DG
IF,EQ LFWDHET,XT OR LOCAL FORWARD & HOLD. *D-DG
%24 LW,TX1 DDRS YES, SET ADDRESS RESOLUTION
SHIFT,TX1 31,ARLOB TO BA,HA,WA,DA DEPENDING ON
LV,TX2 ARFLD INTRINSIC
STS,TX1 *RPTR
B *SCRSRTN RETURN
* *D-DG
FI *D-DG
%26 CV,XT SPADDRET IS OPERAND A SPECIAL ADDRESS
BNE %28 NO
LW,XT *RPTR YES, MODIFY OFFSET ACCORDING TO
AND,XT L(ADDFLD) ADDRESS RESOLUTION FUNCTION
SHIFT,XT ADDLOB,31
LW,TX1 *RPTR
AND,TX1 =CSFLD
LV,RL SIMPADD+SYMBOL+LNGTH2
B %29
%28 CV,XT ADDRET IS OPERAND AN ADDRESS
BNE %32 NO
LI,XT1 1
LW,XT *RPTR,XT1 MODIFY ADDRESS ACCORDING TO
AND,XT =LOBFLD+OFFSETFLD ADDRESS RESOLUTION FUNCTION
SHIFT,XT OFFSETLOB,31
LW,TX1 *RPTR,XT1
AND,TX1 =FCSFLD
SHIFT,TX1 FCSLOB,CSLOB
LW,RL *RPTR
%29 RES 0
LW,XT1 *RPTR
AND,XT1 L(ARFLD)
SHIFT,XT1 ARLOB,31
SW,XT1 DDRS
SCS,XT 0,XT1
LI,XT1 0
STB,XT1 XT CLEAR THE LOB PORTION OF ADDRESS
CV,XT ADDFLD
BG %30 ADDRESS TOO LARGE FOR SPECIAL ADDR
CV,TX1 CSFLD
BG %30 CONTROL SECTION TOO LARGE
BFNZ,RL,1 ADFLD,%30 ADDRESS IS NEGATIVE
AW,XT TX1
AV,XT SPAFLD SKELETON FOR A SPECIAL ADDRESS
B %31
%30 RES 0
SHIFT,TX1 CSLOB,FCSLOB
AW,XT TX1
STW,XT RVAL+1 STORE OFFSET WORD OF SIMPLE ADDRESS
LW,XT RL SKELETON FOR A SIMPLE ADDRESS
AND,XT =ADFLD+STYPEFLD+TYPEFLD+LENGTHFLD
%31 RES 0
LV,XT1 DUPFLD+SETFLD+DEFFLD+ARFLD
LS,XT *RPTR
STW,XT RVAL STORE CONTROL WORD
BAL,RL SCPULL PULL ITEM FROM EXPRESSION TABLES
LI,XT RVAL ADDRESS OF ITEM TO PUSH
LI,XT1 1 NUMBER OF WORDS TO PUSH
LV,RL SPADDRET SPECIAL ADDRESS TYPE
LW,TX1 0,XT LOAD CONTROL WORD
BFNZ,TX1 SPAFLD,%33 BRANCH IF ITEM IS A SPECIAL ADDRESS
LV,RL ADDRET SIMPLE ADDRESS TYPE
LI,XT1 2 NUMBER OF WORDS TO PUSH
%33 RES 0
STW,RL DD%TYPE STORE TYPE
BAL,RL SCPUSH PUSH ITEM ONTO EXPRESSION STACKS
B %24
%32 CV,XT SUMET IS OPERAND A SUM
BE %32A YES
CV,XT UGLBLET NO, IS ITEM UNDEFINED
BNE *SCRSRTN NO RETURN
LW,XT1 ECT,LVL YES, GET ECT ENTRY FOR ITEM
AW,XT1 KLINE
LW,TX1 1,XT1 LOAD CONTROL WORD
OR,TX1 =EXPFLD
STW,TX1 1,XT1 SET EXP BIT IN CONTROL WORD
B *SCRSRTN RETURN
%32A RES 0
LW,XT *RPTR YES
LV,XT1 LENGTHFLD
CS,XT L(3)
BNE %34
LI,XT 2
LW,XT1 *RPTR,XT LOAD WORD FOLLOWING SVAL
AND,XT1 =ARFLD
SHIFT,XT1 ARLOB,31
SW,XT1 DDRS
BE *SCRSRTN RETURN
LW,TX1 *RPTR,XT LOAD WORD FOLLOWING SVAL
AND,TX1 =STYPEFLD
CV,TX1 ONEWDADD
BNE %34
MTW,1 RPTR POINT TO WORD FOLLOWING CONTROL WORD
LW,TX1 *RPTR LOAD SVAL WORD
SAS,TX1 0,XT1
STW,TX1 *RPTR STORE BACK ADJUSTED SVAL
MTW,1 RPTR POINT TO WORD FOLLOWING SVAL
B %24
%34 RES 0
LW,XT DDRS POSITION SPECIFIED RESOLUTION
SHIFT,XT 31,ARLOB TO AR FIELD
XW,XT RPTR AND SAVE IT
STW,XT ARG
LW,XT FWDNUM
AV,XT LCLFWDHD
BAL,RL GENERATE2
BAL,RL SCPULL
LW,TMP FWDNUM BUILD LOCAL FWD AND HOLD ITEM
OR,TMP L(SYMBOL+LCLFWDHD)
OR,TMP PASSDEF
OR,TMP RPTR SPECIFIED RESOLUTION
LI,XT TMP
LI,XT1 1
LV,TX1 LFWDHET
STW,TX1 DD%TYPE
BAL,RL SCPUSH
MTW,1 FWDNUM
B *SCRSRTN RETURN
*
* ABSVAL
*
V%13 RES 0
CALL SCDEL1 DELETE SUB-SYM JUNK
BAL,RL SCSETUPR SET UP RIGHT OPERAND
LW,XT2 RPTR ADDR OF EVT CONTROL WD
LW,XT 0,XT2 FIRST WORD IS CONTROL
BFZ,XT SPAFLD,%44 BRANCH IF NOT A SPEC ADDR OR INT
BFNZ,XT SPINTFLD,SCLOOP DONE IF A SPECIAL INT
CV,XT REFORSREF DON'T CHANGE EXTERNALS
BANZ SCLOOP
AND,XT =~(ARFLD+CSFLD) CLEAR AR & CS FIELDS
LW,TMP XT
B %38
%44 RES 0
LV,XT1 TYPEFLD
CS,XT =SYMBOL IT MAY BE A CONST OR BLANK
BNE SCLOOP
LV,TMP DEFFLD
AND,TMP XT
LV,XT1 STYPEFLD SYMBOL SUB-TYPE FIELD
CS,XT SIMPADD TEST FOR A SIMPLE ADDR
BNE %48 NO
LW,TX4 1,XT2
AND,TX4 =OFFSETFLD SAVE OFFSET FIELD
%20 RES 0
CV,TX4 VALFLD WILL IT FIT AS A SPECIAL INT
BG %46 NO, BUILD A TWO-WD INT
AW,TMP TX4 FINISH SPECIAL INT
%38 RES 0
BAL,RL SCPULL REMOVE PREV ITEM
B SCSINT3
%48 RES 0
CS,XT =CMPLXSUM
BNE SCLOOP
AND,XT =LENGTHFLD
LW,RL XT MOVE LENGTH
V%13%1 RES 0
AI,RL -1 DECREASE LENGTH
LW,XT *XT2,RL IS NEXT WORD A 1 WORD ADDRESS
CS,XT =ONEWDADD
BNE SCLOOP
CI,RL 2 TEST FOR FINISHED
BG V%13%1 NOT DONE
LW,TX4 1,XT2 GET OFFSET WORD
BGEZ %20 IT MIGHT FIT AS A SPEC INT
%46 RES 0
LW,TX3 TMP BUILD A TWO-WD INT
AV,TX3 CONSTANT+2
STD,TX3 LVAL
BAL,RL SCPULL REMOVE THE LAST THING
LV,TX3 INTET
B V%C%4
*
* S:UFV
*
UFVINTRINSIC RES 0
MTW,-1 EVT,LVL DECREASE FOR S:UFV (OR S:IFR) WORD
LW,TX1 EVT,LVL COMPUTE FINAL EVT ADDRESS
AW,TX1 KLINE
MTW,+1 ECT,LVL ELIMINATE SUBSYMBOL CONTROL WORD
LW,XS XT
AW,XS KLINE
LW,XT XT2 COMPUTE INITIAL EVT ADDRESS
AW,XT KLINE
UFVINT2 RES 0
CW,XT TX1 TEST FOR FINISHED
BE SCLOOP
LW,XT1 -1,XS PRECESS ECT ENTRIES ONE WORD
AI,XT1 -1 AND DECREASE LOC FIELD
STW,XT1 0,XS TO ELIMINATE THE DUMMY
AI,XS -1 S:UFV SUBSCRIPTED SYMBOL
LW,XT1 1,XT GET NEXT EVT CONTROL WORD
BAL,RL TYPE
CV,XT2 UGLBLET IS ITEM UNDEFINED
BNE UFVINT1
LV,RL SPINTET-UGLBLET
AWM,RL 1,XS CHANGE UNDEF TO SPEC. INTEGER
LV,XT1 SPAFLD+SPINTFLD
UFVINT1 RES 0
OR,XT1 PASSDEF
STW,XT1 0,XT STORE NEW CONTROL WORD
BAL,RL LENGTH FIND ITS LENGTH
CV,XT2 LISTET USE 2 FOR THE LENGTH OF A LIST
BNE UFVINT3 SO EACH LIST ELEMENT'S DEF FIELD
LI,XT1 2 IS INSPECTED
UFVINT3 RES 0
AI,XT 1 BUMP ADDRESS OF LAST EVT WORD
BDR,XT1 %+2 MOVE THE REST OF THE ITEM,
B UFVINT2 BUT DON'T CHANGE THE DEF FIELD
LW,XT2 1,XT
STW,XT2 0,XT
B UFVINT3
*
* S:UT INTRINSIC
*
SCS:UT RES 0
BAL,RL S:PTSETUP SET IN,INBASE, AND OUTBASE
SCS:UT1 RES 0 GET THE NEXT ITEM AND INSPECT IT
BAL,ER NEXT%TEXT FOR BEING A TEXT STRING
B SCS:UT4 NOT FOUND RETURN
CI,CT 0
BE SCS:UT3 NULL TEXT STRING
SCS:UT6 RES 0 TEXT FOUND. XT2 HAS BA. CT HAS COUNT
LB,TMP 0,XT2 NEXT TEXT CHAR.
OR,TMP TR0 DEF FIELD FOR THIS ITEM
AV,TMP SPINTFLD+SPAFLD+1**(31-CCLOB)
LI,XT TMP ADDRESS -> XT
LI,XT1 1 SIZE -> XT1
BAL,RL SCPUSH PUSH ONTO ECT,EVT
AI,XT2 1 BUMP BYTE ADDRESS TO NEXT CHAR.
BDR,CT SCS:UT6 DECREASE CHAR. COUNT AND RETURN
SCS:UT2 RES 0
MTW,-1 LSTCT DECREASE ITEM COUNT
BGZ SCS:UT1 AND RETURN
B SCS:PT%JOIN
SCS:UT4 RES 0
BAL,RL LENGTH COPY NON-TEXT ITEM
BAL,RL SCPUSH TO ECT,EVT
B SCS:UT2
SCS:UT3 RES 0
BAL,RL TEXT%ITEM PUSH 2-WORD TEXT ITEM
B SCS:UT2
*
* S:PT INTRINSIC
*
SCS:PT RES 0
BAL,RL S:PTSETUP SET OUTBASE, INBASE, AND IN
LI,CHCT 0 CLEAR CHARACTER COUNT
SCS:PT1 RES 0 GET NEXT ITEM AND INSPECT IT
BAL,ER NEXT%TEXT FOR BEING A TEXT STRING
B SCS:PT10 NOT FOUND.
CI,TX4 0 IS THIS 1ST STRING ITEM
BNE SCS:PT4 NO
BAL,RL TEXT%ITEM PUSH 2-WORD TEXT ITEM ON EVT,ECT
SCS:PT4 RES 0
LV,TR1 DEFFLD REPLACE DEF FIELD
CS,TR0 *TX4 IF THIS
BGE %+2 ONE IS
STS,TR0 *TX4 SMALLER
LW,TR0 TX4 PUT THE ADDRESS OF THE EVT
AI,TR0 1 TEXT STRING IN REG TR0
SCS:PT2 RES 0
CI,CT 0 TEST FOR NULL TEXT STRING
BE SCS:PT3 YES
CI,CHCT 255 TEST FOR TOO MANY CHARACTERS
BL SCS:PT5 NO.
BAL,ER TERR
B SCS:PT3
SCS:PT5 RES 0
AI,CHCT 1 BUMP CHAR. COUNT FOR THIS STRING
CI,CHCT 3 IS ANOTHER WORD REQ'D
BANZ SCS:PT6 NO
MTW,+1 *TX4 ADD 1 TO LENGTH OF EVT CONTROL WORD
LI,XT1 1 PUSH A BLANK
LI,XT =' ' ONTO THE EVT
BAL,RL SCPSHV
SCS:PT6 RES 0
LB,XT 0,XT2 GET THE NEXT BYTE
STB,XT *TR0,CHCT STORE IT IN THE TEXT STRING
STB,CHCT *TR0 STORE THE NEW CHARACTER COUNT
AI,XT2 1 BUMP INPUT BYTE ADDRESS
BDR,CT SCS:PT2 COUNT AND RETURN FOR N
SCS:PT3 RES 0
MTW,-1 LSTCT NUMBER OF ITEMS
BGZ SCS:PT1
BAL,RL SPEC%TEXT%ITEM
SCS:PT%JOIN RES 0
LW,XT INBASE
LW,XT1 *KLINE,XT
AND,XT1 =LOCFLD
STW,XT1 EVT,LVL DELETE EVT ENTRIES
LW,TR0 OUTBASE
SW,TR0 ECT,LVL
STW,XT ECT,LVL DELETE ECT ENTRIES
BEZ SCBLNK BRANCH IF ALL ITEMS BLANK, S:PT ONLY
LI,TX2 0
B SCSYML1 BRANCH TO MOVE ITEMS TO ECT,EVT
SCS:PT10 RES 0
CV,XT2 BLANKET IS IT A BLANK
BE SCS:PT3
BAL,RL SPEC%TEXT%ITEM CHANGE TO SPEC INT TEXT IF REQ'D
BAL,RL LENGTH FIND LENGTH OF NON-TEXT ITEM
BAL,RL SCPUSH PUSH IT ONTO ECT AND EVT
LI,TX4 0 CLEAR 1ST STRING ITEM FLAG
B SCS:PT3
*
* T C O R
* INTRINSIC FUNCTION
*
SCTCOR RES 0
BAL,RL SCSAVE SAVE SCAN VARIABLES FOR RECURSION
MTW,1 TCORFLG INCREMENT TCOR FLAG
SCTCOR1 RES 0
NXTENC ,NOINC GET NEXT ENCODED HALFWORD
CV,XT ENDSBSYM
BE SCTCOR7 BRANCH IF END OF SUBSCRIPTED SYMBOL
AND,XT =ENCITEM
CLM,XT RNG%TCOR%SYM
IF,OL -20- DOIF NOT SPECIAL 'TYPE' SYMBOL
BAL,RL SCAN1 EVALUATE NEXT EXPRESSION
BAL,RL CLN%EXP REMOVE RESULT
LW,XT 0,XS GET ECT ENTRY
AW,XT KLINE
LW,XT1 0,XT GET CONTROL WORD FROM EVT
LV,XT2 S:LISTSYM-ENCSYM
MTW,-1 LSTCT
BGZ SCTCOR4 BRANCH IF ITEM IS A LIST
BAL,RL TYPE GET TYPE OF ITEM
SHIFT,XT2 ETLOB,31
LB,XT3 SCTCOR%JMP,XT2
B SCTCOR%BASE,XT3 BRANCH TO APPROPRIATE ROUTINE
*
FI -20-
*
* HAVE A SPECIAL 'TYPE' SYMBOL IN TCOR ARGUMENT LIST
*
LW,XT2 XT
LW,XT EVT,LVL GET ADDRESS OF NEXT
AW,XT KLINE EVT ENTRY
AV,XT2 -ENCSYM
AI,XW 1 ADVANCE XW
SCTCOR4 RES 0
MTW,0 -2,XT
BEZ SCTCOR8 BRANCH IF 1ST ARGUMENT
CW,XT2 -1,XT BRANCH IF CURRENT ITEM'S TYPE DOES
BNE SCTCOR9 NOT MATCH 1ST ITEM'S TYPE
LW,TMP -2,XT GET ARGUMENT NUMBER FOR RESULT
SCTCOR5 RES 0
BAL,RL SCRESTORE RESTORE SCAN VARIABLES
MTW,-1 TCORFLG DECREMENT TCOR FLAG
LW,XS XW
NXTENC,TX3 ,NOINC
B SCSCOR9
SCTCOR7 RES 0
LW,XT EVT,LVL
AW,XT KLINE
MTW,-1 -2,XT BRANCH IF TCOR HAD MORE
BGZ %+2 THAN ONE ARGUMENT
BAL,ER SERR ILLEGAL # OF ARGUMENTS FOR TCOR
LI,TMP 0 SET RESULT TO ZERO
B SCTCOR5
SCTCOR8 RES 0
STW,XT2 -1,XT SAVE TCOR VALUE OF 1ST ARGUMENT
SCTCOR9 RES 0
MTW,1 -2,XT INCREMENT ARGUMENT COUNT
B SCTCOR1
SCTCOR%BASE RES 0
*
SCTCOR10 RES 0
LW,XT1 PASSDEF
SCTCOR20 RES 0
LB,XT2 SCTCOR%TBL,XT2 GET TCOR VALUE FOR ITEM'S TYPE
SCTCOR25 RES 0
AND,XT1 =DEFFLD
CW,XT1 PASSDEF BRANCH IF ITEM IS DEFINED
BE SCTCOR4 FOR THE CURRENT PASS
LV,XT2 S:FRSYM-ENCSYM ITEM IS A FORWARD REFERENCE
B SCTCOR4
SCTCOR30 RES 0 SPECIAL ADDRESS
BFNZ,XT1,1 CSFLD,SCTCOR20 BRANCH IF ADDRESS IS RELOCATABLE
LV,XT2 S:AADSYM-ENCSYM VALUE FOR ABSOLUTE ADDRESS
B SCTCOR25
SCTCOR40 RES 0 SIMPLE ADDRESS
LW,RL 1,XT LOAD WORD FOLLOWING CONTROL WORD
BFZ,RL FCSFLD,SCTCOR20 BRANCH IF ADDRESS IS ABSOLUTE
LV,XT2 S:RADSYM-ENCSYM VALUE FOR RELOCATABLE ADDRESS
B SCTCOR25
SCTCOR50 RES 0 SPECIAL INTEGER
BFZ,XT1,1 CCFLD,SCTCOR20 BRANCH IF SPECIAL INTEGER IS INT
LV,XT2 S:CSYM-ENCSYM VALUE FOR CHARACTER STRING CONSTANT
B SCTCOR25
SCTCOR60 RES 0 ONE WORD ADDRESS OR FUNCTION
B SCDIR ASSEMBLER ERROR
SCTCOR%JMP RES 0
BYTE,SCTCOR%BASE SCTCOR10 UNDEFINED
BYTE SCTCOR30 SPECIAL ADDRESS
BYTE SCTCOR20 SPECIAL EXTERNAL
BYTE SCTCOR40 SIMPLE ADDRESS
BYTE SCTCOR20 SUM
BYTE SCTCOR20 EXTERNAL
BYTE SCTCOR10 LOCAL FORWARD
BYTE SCTCOR10 LOCAL FORWARD AND HOLD
BYTE SCTCOR60 ONE WORD ADDRESS
BYTE SCTCOR50 SPECIAL INTEGER
BYTE SCTCOR20 BLANK FIELD
BYTE SCTCOR20 INTEGER
BYTE SCTCOR20 PACKED DECIMAL
BYTE SCTCOR20 TEXT
BYTE SCTCOR20 FX
BYTE SCTCOR20 FS
BYTE SCTCOR20 FL
BYTE SCTCOR20 DPI
BYTE SCTCOR20 LIST
BYTE SCTCOR60 FUNCTION
BOUND 4
*
SCTCOR%TBL RES 0
BYTE,ENCSYM S:FRSYM
BYTE S:RADSYM
BYTE S:EXTSYM
BYTE S:AADSYM
BYTE S:SUMSYM
BYTE S:EXTSYM
BYTE S:LFRSYM
BYTE S:LFRSYM
BYTE ENCSYM NOT LEGAL
BYTE S:INTSYM
BYTE S:INTSYM
BYTE S:INTSYM
BYTE S:DSYM
BYTE S:CSYM
BYTE S:FXSYM
BYTE S:FSSYM
BYTE S:FLSYM
BYTE S:DPISYM
BYTE S:LISTSYM
BYTE ENCSYM NOT LEGAL
BOUND 4
PAGE
*
* S C D E L 1
*
* REMOVE A ONE-WORD 'VALUE' AND ITS ASSOCIATED ECT POINTER.
* (USED TO DELETE THE DUMMY SYMBOL FOR INTRINSIC FUNCTIONS.)
*
* INPUT: XT IS INDEX TO ECT WORD TO BE DELETED
* XT2 IS INDEX TO 'VALUE' WORD TO DELETE
*
* USES: XS
* XT
* XT1
* XT2
*
LOCAL %10,%20
*
SCDEL1 RES 0
*
* FIRST, MOVE ECT ENTRIES UP OVER THE ONE TO BE DELETED
* (ADJUSTING THE 'LOC' FIELD AS WE GO, FOR LATER EVT MOVE).
*
MTW,+1 ECT,LVL TO NEW VALUE
LW,XS ECT,LVL
AW,XS KLINE FORM ADDRESS
SW,XT ECT,LVL NUMBER OF ENTRIES (WORDS) TO MOVE
LW,XT1 0,XS PRIME THE PUMP
%10 RES 0
AI,XS +1
AI,XT1 -1 ADJUST 'LOC'
XW,XT1 0,XS
BDR,XT %10
*
* NOW, MOVE EVT DOWN OVER THE WORD WE'RE DELETING
*
MTW,-1 EVT,LVL TO NEW VALUE
LW,XS EVT,LVL
AW,XS KLINE FORM ADDRESS
SW,XT2 EVT,LVL - NUMBER OF WORDS TO MOVE
LW,XT1 0,XS READY - SET -
%20 RES 0
AI,XS -1
XW,XT1 0,XS
BIR,XT2 %20
*
EXIT RETURN
PAGE *D-DG
* *D-DG
* S C N O L I S T *D-DG
* *D-DG
* ENSURE THAT ECT IS CLEANED UP PROPERLY FOR AN INTRINSIC *D-DG
* FUNCTION THAT EXPECTS, AND RETURNS, ONLY A SINGLE VALUE. *D-DG
* CURRENT EXAMPLES ARE CS & L. *D-DG
* *D-DG
* (BA, ABSVAL, ETC, DO NOT USE THIS, AS THEY SIMPLY HAVE *D-DG
* NO EFFECT WHEN THE ARG IS IMPROPER.) *D-DG
* *D-DG
* INPUT: TMP IS THE NUMBER OF ARGUMENTS (CALCULATED *D-DG
* IN ENDSSYM ROUTINE). *D-DG
* *D-DG
* OUTPUT: IF NOT A SINGLE ARG - *D-DG
* ECT BUMPED DOWN TO FIRST ARG *D-DG
* 'E' DIAGNOSTIC *D-DG
* *D-DG
* USES: TMP *D-DG
* ER *D-DG
* *D-DG
SCNOLIST RES 0 *D-DG
AI,TMP -1 *D-DG
IF,GZ TOO MANY ARGS *D-DG
AWM,TMP ECT,LVL DELETE ALL BUT 1ST ARG *D-DG
BAL,ER EERR *D-DG
FI *D-DG
EXIT *D-DG
PAGE
*
* S C S A V E
*
SCSAVE RES 0
LI,XT 0 PUSH SCANEXIT, 1ARG, SCLVL, SCARG,
STW,XT DD%TYPE LFWDFLG, LITFLAG, & SCANXS ONTO
LI,XT1 9 EXPRESSION STACKS. ALSO PUSH
LI,XT SCANEXIT TWO WORDS USED BY TCOR
B SCPUSH ONTO THE EXPRESSION STACKS
*
* S C R E S T O R E
*
SCRESTORE RES 0
STW,RL SCRESTOREXIT
BAL,RL SCPULL PULL SCAN VARIABLES FROM STACKS
AW,XT KLINE
LI,XT1 7
SCRESTORE1 RES 0
LW,RL 6,XT RESTORE SCANEXIT,
STW,RL SCANEXIT-1,XT1 1ARG, SCLVL,
AI,XT -1 SCARG, LFWDFLG,
BDR,XT1 SCRESTORE1 LITFLAG, AND SCANXS
B *SCRESTOREXIT
SCRESTOREXIT EQU 1ELEMXIT
*
EVTLOC EQU LVAL
INDICWD EQU LVAL+1
PRESENCE EQU LVAL+2
LSTLVL EQU LVAL+3
MAXX EQU LVAL+4
MATCHES EQU LVAL+5
PARWD EQU LVAL+6
COUNT EQU LVAL+7
FLAGWD EQU DPIFLAG
*
* S : K E Y S
*
SCS:KEYS RES 0
LW,XT PROCREF ERROR IF NOT
BEZ KEYERR WITHIN A PROC
BAL,RL SCSAVE SAVE SCAN VARIABLES FOR RECURSION
BAL,RL SCAN1 EVALUATE MODE FIELD
BAL,RL CLN%EXP REMOVE RESULT
BAL,RL SCRESTORE RESTORE SCAN VARIABLES
LW,XT 0,XS GET EVT ADDRESS FOR
AW,XT KLINE MODE FIELD RESULT
BAL,RL EXTRACTCON TEST RESULT OF MODE FIELD
CI,XT1 0 FOR BEING
BL KEYERR AN INTEGER
CI,XT1 7 BETWEEN
BG KEYERR ZERO AND SEVEN
STW,XT1 FLAGWD SAVE MODE
MTW,+3 EVT,LVL LEAVE ROOM FOR MATCHES AND PRESENCE
LW,XT EVT,LVL SAVE ORIGIN -1
AW,XT KLINE OF EVT FOR
AI,XT -1 KEYWORDS
STW,XT EVTLOC
LW,XT =X'80000000' SET INDICATOR BIT
STW,XT INDICWD TO BIT ZERO
LI,XT 0
LI,XT1 6
S:KEYS10 RES 0
STW,XT PRESENCE-1,XT1 CLEAR PRESENCE,LSTLVL,MAXX,
BDR,XT1 S:KEYS10 MATCHES,PARWD,AND COUNT
MTW,+1 PARWD 1 -> PARWD
LW,XT PLOC,LVL LOCATE
AW,XT KLINE THE
LW,XS OPRND,XT PARAMETER LIST
BAL,RL LOADXM SET XMBASE
* MOVE KEYWORDS FROM AF TO THE EVT AND COUNT THEM IN MAXX
S:KEYS20 RES 0
LH,TMP *XMBASE,XS
CI,TMP BEGINLIST
BNE S:KEYS30
AI,XS 1
LH,TMP *XMBASE,XS
AI,XS -1
B S:KEYS40
S:KEYS30 RES 0
CI,TMP ENDLINE END OF KEYWORD LIST
BE S:KEYS50 IF ENDLINE OR
CI,TMP ENDSBSYM END SUBSCRIPTED SYMBOL
BE S:KEYS50 IS FOUND
S:KEYS40 RES 0
LI,XT1 1 PUSH THE
LI,XT TMP KEYWORD
BAL,RL SCPSHV ONTO EVT
MTW,1 MAXX BUMP NUMBER OF KEYWORDS
S:KEYS41 RES 0
BAL,RL ADV%ITM
B S:KEYS20
S:KEYS50 RES 0
LI,XT 1
CW,XT MAXX IF THE ARGUMENT FIELD IS BLANK,
IF,EQ DECREASE NO. OF PARAMETERS
LW,XT1 *EVTLOC,XT (TO ZERO), AND DELETE THE
CI,XT1 BLANKEXP BLANK EXPRESSION ON THE EVT.
IF,EQ DOIF SINGLE BLANK EXPRESSION
MTW,-1 MAXX CLEAR NUMBER OF ARG'S
MTW,-1 EVT,LVL DISCARD EVT EXPRESSION
FI
FI
AND,XT FLAGWD SET AF(1) KEYWORD TO ZERO
BEZ SKEYS1 IF MODE REQUESTS
LI,XT1 0 AF(1) IS NOT
STW,XT1 *EVTLOC,XT TO BE COMPARED
SKEYS1 RES 0
NXTENC ,NOINC
LI,XT1 TFLD IF THE NEXT ENC ITEM IS
CS,XT =SMINT A SMALL INTEGER,
BNE S:KEYS70 IT'S A
LI,XT2 0 PARAMETER NUMBER
STW,XT2 PARWD
AND,XT =VFLD
CI,XT 31 IF PARAMETER NUMBER IS
BG S:KEYS60 GREATER THAN 31, PRESENCE
LW,XT2 =X'80000000' WORD WON'T BE AFFECTED.
LCW,XT XT OTHERWISE SET UP INDICATOR
SLS,XT2 0,XT IN CASE PARAMETER IS FOUND
S:KEYS60 RES 0
STW,XT2 INDICWD
AI,XW 1 IF NEXT ENC ITEM IS AN ASTERISK,
NXTENC ,NOINC PARAMETERS ARE REQUIREDD
IF,EQ ASTFLG,XT *D-DG
MTW,+1 PARWD SET PARAMETER REQUIRED FLAG
AI,XW 1
NXTENC ,NOINC
FI *D-DG
IF,EQ ENDSBSYM MUST HAVE KEYWORD HERE, *D-DG
BAL,ER EERR OR IT IS IN ERROR. *D-DG
B S:KEYS69 *D-DG
FI *D-DG
SKEYS20 RES 0
CI,XT BEGINLIST ARE KEYWORDS ENCLOSED
BNE S:KEYS21 IN PARENS
MTW,+1 LSTLVL SET LIST-OF-PARAMETERS ON
AI,XW 1
S:KEYS21 RES 0
LW,CT INDICWD INDICWD -> INDICTMP
SKEYS4 RES 0
NXTENC ,NOINC GET A KEYWORD
LW,XS MAXX NO. KEYWORDS IN REFERENCE LINE
LI,XT1 TFLD
CS,XT =ENCSYM
IF,EQ OR DOIF GLOBAL SYMBOL, *D-DG
CS,XT =ENCLSYM
IF,EQ ORIF LOCAL SYMBOL *D-DG
AI,XW 1
S:KEYS22 RES 0
CW,XT *EVTLOC,XS COMPARE TO NEXT REFERENCE KEYWORD
BE S:KEYS23 FOUND
BDR,XS S:KEYS22
ELS *D-DG
* *D-DG
* HAVE NON-SYMBOL IN KEYWORD STRING. DIAGNOSE, SKIP, AND *D-DG
* THEN TREAT AS UNMATCHED KEYWORD. *D-DG
* *D-DG
BAL,ER EERR DIAGNOSE *D-DG
LW,XS XW *D-DG
CALL ADV%ITM SKIP (ONLY ADVANCES XS) *D-DG
LW,XW XS *D-DG
FI *D-DG
SKEYS3 RES 0 HERE THE KEYWORD WASN'T FOUND
NXTENC ,NOINC
LW,XT1 LSTLVL TEST WITHIN A LIST OF PARAMETERS
BEZ S:KEYS31 NO
MTW,0 PARWD IF THIS IS NOT
BNEZ %+2 A PARAMETER,
LI,CT 0 CLEAR INDTMP
CI,XT ENDLIST
BNE SKEYS4
* *D-DG
LI,XS 0 *D-DG
STW,XS LSTLVL CLEAR LIST-OF-PARAMETERS FLAG
AI,XW 1
B SKEYS3
S:KEYS31 RES 0
CI,XT ASTFLG ASTERISK HERE MEANS KEYWORD
BNE %+2 IS REQUIRED
BAL,ER EERR
LW,XS MAXX SET DEFAULT INDEX INTO XS
AI,XS 1
LI,XT 2 ARE DEFAULT INDEXES REQUIRED
AND,XT FLAGWD
BEZ SKEYS6 NOT REQUIRED
B SKEYS5
S:KEYS70 RES 0
CI,XT ENDSBSYM TEST FOR END OF S:KEYS LIST
BNE SKEYS20
* *D-DG
S:KEYS69 RES 0 *D-DG
* *D-DG
* HERE THE ENTIRE S:KEYS LIST HAS BEEN SCANNED. NOW OUTPUT THE LIST
AI,XW 1 SKIP FINAL END SUBSCRIPTED SYMBOL
LI,XT 4 SHOULD MISSING KEYWORDS
AND,XT FLAGWD BE REPORTED
BNEZ S:KEYS72 NO, THEY SHOULDN'T
LW,XT MAXX NUMBER OF KEYWORDS IN S:KEYS LIST
BEZ S:KEYS72 NO KEYWORDS
S:KEYS71 RES 0
LW,XT1 *EVTLOC,XT SEARCH FOR
BEZ %+2 A KEYWORD
BAL,ER UERR THAT WAS NOT MATCHED
BDR,XT S:KEYS71
S:KEYS72 RES 0
LW,XT EVTLOC
AWM,XT MAXX LOCATE FIRST AF(N)
AI,XT -2
SW,XT KLINE
STW,XT EVT,LVL DELETE ALL OF EVT EXCEPT LIST ITEM
LW,XT MATCHES PUSH NUMBER OF
BAL,RL STACKSPI MATCHES ONTO ECT,EVT
LW,XT PRESENCE PUSH PARAMETER PRESENCE WORD
CW,XT =~VALFLD ONTO ECT,EVT
BAZ S:KEYS76 BRANCH IF A SPEC. INT. CAN BE MADE
LW,XT PASSDEF
AV,XT CONSTANT+SPI+LNGTH2
STW,XT PRESENCE-1 BUILD A TWO-WORD
LI,XT PRESENCE-1 INTEGER ITEM
LV,XT1 INTET
STW,XT1 DD%TYPE
LI,XT1 2
BAL,RL SCPUSH
S:KEYS74 RES 0
MTW,+1 MAXX BUMP ADDRESS OF NEXT PARAMETER INDEX
MTW,-1 COUNT DECREASE PARAMETER COUNT
BLZ SCLOOP BRANCH IF DONE
LW,XT *MAXX GET NEXT PARAMETER INDEX
S:KEYS76 RES 0
BAL,RL STACKSPI PUSH IT
B S:KEYS74
KEYERR RES 0
BAL,ER EERR MARK AN ERROR
LW,XS XW
LI,TMP 0
B SCSCOR7
S:KEYS23 RES 0
OR,CT PRESENCE SET PARAMETER PRESENT
STW,CT PRESENCE BIT AS REQUIRED
MTW,+1 MATCHES BUMP NUMBER OF MATCHED KEYWORDS
LI,XT 0 SET FOUND AF TO ZERO, SO IT
STW,XT *EVTLOC,XS WON'T BE FOUND AGAIN
LW,XT LSTLVL SKIP THE REST OF THE
BEZ SKEYS5 KEYWORDS IF WITHIN A
BAL,RL SKIPLABEL KEYWORD LIST
MTW,-1 LSTLVL
SKEYS5 RES 0
LW,XT PARWD IS THIS KEYWORD A PARAMETER
BEZ SKEYS6 NO
MTW,+1 COUNT BUMP NUMBER OF PARAMETERS STORED
LI,XT XS PUSH THE
LI,XT1 1 PARAMETER INDEX
BAL,RL SCPSHV ONTO EVT
SKEYS6 RES 0
LW,XT INDICWD SHIFT TO NEXT INDICATOR
SLS,XT -1 BIT
STW,XT INDICWD
NXTENC ,NOINC SKIP THE ASTERISK
CI,XT ASTFLG AFTER THE KEYWORD
BNE SKEYS1 IF IT'S THERE
AI,XW 1
B SKEYS1
S:PTSETUP RES 0
LW,TR0 ECT,LVL SAVE INDEX TO
STW,TR0 OUTBASE THE ECT
STW,XT INBASE SAVE INDEX TO ECT ORIGIN
AW,XT KLINE
STW,XT IN SAVE FULL ECT ADDRESS
LW,XT EVT,LVL SAVE FULL EVT ADDRESS
AW,XT KLINE IN FND
STW,XT FND
LI,TX4 0 CLEAR 1ST STRING FLAG
EXIT RL
*
* T E X T % I T E M
* BUILD A SKELETON TEXT ITEM AND PUSH IT ONTO THE EVT & ECT
*
* INPUT: REGISTER TR0 CONTAINS THE DEF FIELD
*
TEXT%ITEM RES 0
AV,TR0 CONSTANT+CHSTR+LNGTH2
LW,TR1 =X'404040' SET COUNT = 0 AND 3 BLANKS
LI,XT TR0
LI,XT1 2 SIZE = 2
LW,TX4 EVT,LVL ADDRESS OF THE ENTRY
AW,TX4 KLINE
B SCPUSH PUSH AND RETURN FROM TEXT%ITEM
*
* N E X T % T E X T
* INSPECT THE NEXT EVT ITEM FOR BEING TEXT.
*
* INPUT: IN CONTAINS ADDRESS ONE WORD PAST ECT ITEM
*
* OUTPUT: XT2 & DD%TYPE CONTAIN ITEM TYPE (IF NON-TEXT)
* IN IS BUMPED FOR NEXT CALL TO THIS ROUTINE
* FOR TEXT ITEMS, XT2 CONTAINS BA OF 1ST TEXT CHAR.,
* AND CT CONTAINS NUMBER OF CHARS.
* FOR NON-TEXT ITEMS, XT CONTAINS ADDRESS OF ITEM
*
* CALLING SEQUENCE: BAL,ER NEXT%TEXT
* NOT FOUND EXIT IS ALPHA+1
* FOUND EXIT IS ALPHA+2
*
NEXT%TEXT RES 0
MTW,-1 IN BUMP TO NEXT ECT ADDRESS
LW,XT *IN GET NEXT EVT ENTRY ADDRESS
AW,XT KLINE
AND,XT =LOCFLD
LV,TR0 DEFFLD SAVE DEF FIELD IN TR0
AND,TR0 0,XT
LW,XT1 0,XT GET EVT CONTROL WORD
BAL,RL TYPE TYPE IT
CV,XT2 SPINTET IS IT
BNE NXT%TXT1 A SPECIAL INTEGER
AND,XT1 =CCFLD TEXT CONSTANT
EXIT,EQ ER NO. TAKE NOT FOUND RETURN
SHIFT,XT1 CCLOB,31 PUT CHARACTER COUNT
LW,CT XT1 IN REGISTER CT
SLS,XT 2 CONVERT EVT ADDRESS TO THE
SW,XT CT BYTE ADDRESS
AI,XT 4 OF THE FIRST CHARACTER
B NXT%TXT2
NXT%TXT1 RES 0
CV,XT2 TEXTET IS IT A TEXT CONSTANT
EXIT,NE ER NO. TAKE NOT FOUND RETURN
AI,XT 1 BUMP XT PAST CONTROL WORD
LB,CT *XT GET CHARACTER COUNT
SLS,XT 2 CONVERT EVT ADDRESS TO THE BYTE
AI,XT 1 ADDR. OF THE 1ST CHARACTER
NXT%TXT2 RES 0
LW,XT2 XT MOVE BYTE ADDRESS TO
AI,ER 1
EXIT ER TAKE FOUND RETURN
*
* S P E C % T E X T % I T E M
* CONVERT THE LAST ITEM IN EVT TO A SPECIAL INTEGER TEXT
* ITEM IF IT WILL FIT.
*
* INPUT: TX4 CONTAINS ADDRESS OF THE TEXT ITEM (IN EVT)
* CHCT CONTAINS THE NUMBER OF CHARS. IN THAT ITEM.
*
* OUTPUT: IF CHCT IS ONE OR TWO, THE ITEM IS CHANGED TO
* A SPEC. INTEGER WITH CHCT IN THE CC FIELD,
* AND EVT,LVL IS DECREASED BY ONE.
* CHCT IS SET TO ZERO.
* REGISTER XT MUST BE LEFT INTACT.
*
SPEC%TEXT%ITEM RES 0
CI,CHCT 0 EXIT IF
EXIT,EQ RL A SPECIAL TEXT
CI,CHCT 2 INTEGER
BG SPEC%TEXT%2 ISN'T REQUIRED
LW,XT2 TX4 LOCATION OF TEXT CONTROL WORD
LW,TR0 1,XT2 GET COUNT AND 1 OR 2 CHARS
AND,TR0 =X'FFFFFF' CLEAR THE BYTE COUNT
SLS,TR0 -8 RIGHT-ADJUST
CI,CHCT 2 THE ONE
BE SPEC%TEXT%1 OR TWO
SLS,TR0 -8 CHARACTERS
AV,TR0 -1**(31-CCLOB)
SPEC%TEXT%1 RES 0
AV,TR0 2**(31-CCLOB)+SPAFLD+SPINTFLD
LV,TR1 ~DEFFLD REPLACE ALL BUT THE DEF FIELD
STS,TR0 0,XT2
MTW,-1 EVT,LVL DECREASE SIZE OF THE EVT BY 1 WORD
SPEC%TEXT%2 RES 0
LI,CHCT 0
EXIT RL
*
* SCOP
*
V%OPERATOR RES 0
MTW,1 ECT,LVL
STW,XT OPER STORE OPERATOR
LI,XT 0
STW,XT SUM%FLAG INITIALIZE BOTH OPERANDS AS INTEGERS
STW,XT DPIFLAG
LW,XT PASSDEF
STW,XT EXPR%DEF INITIALIZE DEF FIELD OF EXPRESSION
BAL,RL SCSETUPR SET UP OPERAND
BAL,RL SCMAP MAP OPERAND
LCI 4
LM,TX1 RVAL SET UP LEFT OPERAND
STM,TX1 LVAL VALUE AND POINTER
CI,TX4 RVAL
BNE SCOP1 BRANCH IF NOT POINTING TO RVAL
LI,TX4 LVAL USE ADDRESS OF LVAL, NOT RVAL
STW,TX4 LPTR AS POINTER TO LEFT OPERAND
SCOP1 RES 0
LW,XT SUM%FLAG STORE SUM%FLAG FOR LEFT OPERAND
AWM,XT SUM%FLAG AND ZERO RIGHT OPERAND SUM%FLAG
MTW,-1 ECT,LVL SET-UP RIGHT OPERAND
BAL,RL SCSETUPR
MTW,1 ECT,LVL
BAL,RL SCMAP MAP RIGHT OPERAND
LW,XT OPER
LW,XT2 SUM%FLAG IF BOTH OPERANDS ARE CONSTANTS,
BEZ SCOPPRC GO PROCESS OPERATOR
CI,XT PLUSOP
BE SCADDSUM BRANCH IF OPERATOR IS +
CI,XT MINUSOP
BNE SCOP4 BRANCH IF OPERATOR IS NOT -
CI,XT2 1
BANZ SCOP2 BRANCH IF RIGHT OPERAND IS A SUM
LCD,TX1 RVAL NEGATE INTEGER OPERAND
STD,TX1 RVAL
B SCADDSUM PROCESS AS BINARY PLUS
SCOP2 RES 0
LW,XT2 *RPTR GET SUM CONTROL WORD
AND,XT2 =LENGTHFLD GET LENGTH OF SUM
AI,XT2 -1
SCOP3 RES 0
LW,TX3 *RPTR,XT2
EOR,TX3 =ADFLD REVERSE AD FIELD
STW,TX3 *RPTR,XT2
AI,XT2 -1
CI,XT2 1
BG SCOP3
LCW,TX3 *RPTR,XT2 NEGATE THE OFFSET
STW,TX3 *RPTR,XT2
B SCADDSUM PROCESS AS A BINARY PLUS
SCOP4 RES 0
CI,XT EQUALOP
BL SCOP5 NOT A COMPARE OPERATOR
CI,XT LESSOP
BLE SCCMPSUM PROCESS COMPARE OPERATOR
SCOP5 RES 0
BAL,ER EERR EXPRESSION OPERATOR USAGE ERROR
SCOP6 RES 0
LD,TX1 ZERO SET RESULT TO ZERO
*
* S C O P E N D
*
SCOPEND RES 0
STD,TX1 LVAL STORE RESULT IN LVAL
BAL,RL SCPULL REMOVE EXPRESSION(S) FROM STACK
SCOPEND1 RES 0
LD,TX1 LVAL
BLZ SCOPEND3 BRANCH IF RESULT IS <0
CD,TX1 SMIUPBND X'400000'
BL SCOPSMI BRANCH IF RESULT IS A SMALL INTEGER
CD,TX1 SPIUPBND X'0000000080000000'
BL SCOPSPI BRANCH IF RESULT IS SINGLE PREC.
*
* S C O P D P I
* BUILD A DOUBLE PRECISION INTEGER FROM RESULT
SCOPDPI RES 0
LV,XT DPIET DOUBLE PREC. INTEGER ET
LV,TX3 DPIMASK DOUBLE PREC. INT. CONTROL WORD
LI,XT1 2 NUMBER OF WORDS TO PUSH
CI,TX1 0
BE SCOPEND2 BRANCH IF RESULT IS A 2 WORD DPI
AV,TX3 LNGTH1 CHANGE LENGTH TO 3 WORDS
STW,TX2 RVAL+2 STORE LEAST SIGNIFICANT WORD
LW,TX2 TX1 AND LOAD MOST SIGNIFICANT WORD
LI,XT1 3 NUMBER OF WORDS TO PUSH
SCOPEND2 RES 0
STW,TX2 RVAL+1
STW,XT DD%TYPE STORE TYPE
OR,TX3 EXPR%DEF INSERT COMPOSITE DEF FIELD
STW,TX3 RVAL STORE CONTROL WORD
LI,XT RVAL
B V%C%3 PUSH RESULT ON STACK
SCOPEND3 RES 0
CD,TX1 SPILWBND X'FFFFFFFF80000000'
BL SCOPDPI BRANCH IF RESULT IS DPI
*
* S C O P S P I
* BUILD A SINGLE PRECISION INTEGER FROM RESULT
SCOPSPI RES 0
LV,XT INTET SINGLE PREC. INTEGER ET
LV,TX3 SPIMASK SINGLE PREC. INT. CONTROL WORD
LI,XT1 2 NUMBER OF WORDS TO PUSH
B SCOPEND2
*
* S C O P S M I
* BUILD A SMALL INTEGER FROM RESULT
SCOPSMI RES 0
LV,XT SPINTET SPECIAL INTEGER ET
LV,TX3 SPAFLD+SPINTFLD
OR,TX3 TX2
LI,XT1 1 NUMBER OF WORDS TO PUSH
B SCOPEND2
*
* PROCESS OPERATOR
* BOTH OPERANDS ARE INTEGERS
*
SCOPPRC RES 0
LD,TX1 LVAL GET LEFT OPERAND
LB,XT SC4%JUMP-X'20'/4,XT BRANCH TO APPROPRIATE
B SC4%BASE,XT OPERATOR ROUTINE
SC4%JUMP RES 0
BYTE,SC4%BASE SCOPOR OR
BYTE SCOPEOR EXCLUSIVE OR
BYTE SCOPAND AND
BYTE SCOPEQ EQUAL
BYTE SCOPNE NOT EQUAL
BYTE SCOPGE GREATER OR EQUAL
BYTE SCOPLE LESS OR EQUAL
BYTE SCOPG GREATER
BYTE SCOPL LESS
BYTE SCOPMNS MINUS
BYTE SCOPPLS PLUS
BYTE SCOPDVD DIVIDE
BYTE SCOPCQ COVERED QUOTIENT
BYTE SCOPMLT MULTIPLY
BYTE SCOPSHFT SHIFT
BOUND 4
SC4%BASE RES 0
SCOPOR RES 0
OR,TX1 RVAL
OR,TX2 RVAL+1
B SCOPEND
SCOPEOR RES 0
EOR,TX1 RVAL
EOR,TX2 RVAL+1
B SCOPEND
SCOPAND RES 0
AND,TX1 RVAL
AND,TX2 RVAL+1
B SCOPEND
SCOPEQ RES 0
CD,TX1 RVAL
BNE SCOP6 RESULT IS FALSE
SCOPTRUE RES 0
LD,TX1 DBLONE RESULT IS TRUE
B SCOPEND
SCOPNE RES 0
CD,TX1 RVAL
BE SCOP6 RESULT IS FALSE
B SCOPTRUE
SCOPGE RES 0
CD,TX1 RVAL
BL SCOP6 RESULT IS FALSE
B SCOPTRUE
SCOPLE RES 0
CD,TX1 RVAL
BG SCOP6 RESULT IS FALSE
B SCOPTRUE
SCOPG RES 0
CD,TX1 RVAL
BLE SCOP6 RESULT IS FALSE
B SCOPTRUE
SCOPL RES 0
CD,TX1 RVAL
BGE SCOP6 RESULT IS FALSE
B SCOPTRUE
SCOPMNS SD,TX1 RVAL
SCOPMNS1 RES 0
BNOV SCOPEND
BAL,ER TERR
B SCOPEND
SCOPPLS AD,TX1 RVAL
B SCOPMNS1
SCOPCQ AD,TX1 RVAL
BNOV %+2
BAL,ER TERR
SD,TX1 DBLONE
BNOV %+2
BAL,ER TERR
SCOPDVD RES 0
DW,TX1 RVAL+1
BNOV %+2
BAL,ER TERR
LW,TX1 TX2 EXTEND THE SIGN
SAD,TX1 -32 OF THE QUOTIENT
B SCOPEND
SCOPMLT MTW,0 DPIFLAG
BEZ %+2
BAL,ER TERR
MW,TX1 RVAL+1
B SCOPEND
SCOPSHFT LW,XT2 RVAL+1
SLD,TX1 0,XT2
LAW,XT2 RVAL+1 GET ABSOLUTE VALUE OF SHIFT COUNT
CI,XT2 63
BLE SCOPEND SHIFT WAS LESS THAN 64 BITS
B SCOP6 SET RESULT TO ZERO
*
* S C P U S H
*
SCPUSH RES 0
STW,RL SCPPRTN SAVE RETURN ADDRESS
BAL,RL SCPSHC PUSH ENTRY ON ECT
BAL,RL SCPSHV PUSH ENTRY ON EVT
B *SCPPRTN RETURN
*
* S C P S H C
*
SCPSHC RES 0
LW,TX2 ECT,LVL
AW,TX2 KLINE
CW,TX2 NXTSYMT BRANCH IF THERE IS NOT ENOUGH
BL HILIMIT4 ROOM FOR THIS ECT ENTRY
LW,TX1 EVT,LVL BUILD POINTER TO EVT ENTRY
AW,TX1 DD%TYPE BUILD TYPE FIELD
STW,TX1 *TX2 STORE IN ECT TABLE
MTW,-1 ECT,LVL BUMP ECT OFFSET
EXIT RL RETURN
*
* S C P S H V
*
SCPSHV RES 0
LW,TX2 EVT,LVL
AW,TX2 KLINE
AW,TX2 XT1
CW,TX2 NXTLOCAL BRANCH IF THERE IS NOT ENOUGH
BG HILIMIT4 ROOM FOR THIS EVT ENTRY
AWM,XT1 EVT,LVL BUMP EVT BY ITEM'S SIZE
SW,TX2 XT1
SCPSHV1 RES 0
LW,TX3 0,XT GET NEXT WORD OF ITEM
STW,TX3 *TX2 AND STORE INTO NEXT EVT WORD
AI,XT 1 INCREMENT ITEM ADDRESS
AI,TX2 1 INCREMENT EVT ADDRESS
BDR,XT1 SCPSHV1 DECREMENT COUNT AND CONTINUE
EXIT RL
*
* S C P U L L
* REMOVE AN EXPRESSION FROM THE EXPRESSION TABLES
*
SCPULL RES 0
MTW,1 ECT,LVL DELETE ECT ENTRY AND
LW,XT ECT,LVL CREATE POINTER TO LAST EVT ENTRY
LW,XT *KLINE,XT
AND,XT =LOCFLD CLEAN EVT INDEX
STW,XT EVT,LVL
EXIT RL
*
* S C S E T U P R
*
SCSETUPR RES 0
LW,XT2 ECT,LVL GET CURRENT ECT OFFSET
AW,XT2 KLINE GET CURRENT ECT ADDRESS
LW,TX1 1,XT2 GET ECT ENTRY
STW,TX1 XT GET ET ENTRY FOR THIS ECT
AND,XT L(ETFLD)
AND,TX1 L(LOCFLD)
AW,TX1 KLINE CONVERT POINTER TO ADDRESS
STW,TX1 RPTR
EXIT RL
*
* S C M A P
*
SCMAP RES 0
LW,XT2 RPTR ADDRESS OF ITEM TO BE MAPPED
LW,TX1 0,XT2
AND,TX1 EXPR%DEF UPDATE THE LOWEST VALUE OF THE
STW,TX1 EXPR%DEF DEF FIELD
LW,TX4 0,XT2 GET CONTROL WORD
SHIFT,XT ETLOB,31 RIGHT ADJUST ITEM'S TYPE
LB,XT SC5%JUMP,XT LOAD OFFSET TO ITEM PROCESSOR
B SC5%BASE,XT BRANCH TO APPROPRIATE PROCESSOR
SC5%JUMP RES 0
BYTE,SC5%BASE SCMAPU UNDEFINED
BYTE SCMAPSPA SPECIAL ADDRESS
BYTE SCMAPAB SPECIAL EXTERNAL
BYTE SCMAPADD ADDRESS
BYTE SCMAPSUM SUM
BYTE SCMAPEXT EXTERNAL
BYTE SCMAPLF LOCAL FORWARD
BYTE SCMAPLF LOCAL FORWARD AND HOLD
BYTE SCMAPAB ONE WORD ADDRESS
BYTE SCMAPSPI SPECIAL INTEGER
BYTE SCMAPBL BLANK
BYTE SCMAPI INTEGER
BYTE SCMAPD DECIMAL
BYTE SCMAPTXT TEXT
BYTE SCMAPFX FX
BYTE SCMAPFS FS
BYTE SCMAPFL FL
BYTE SCMAPDPI DPI
BYTE SCMAPERR LIST
BYTE SCMAPAB FUNCTION
BOUND 4
SC5%BASE RES 0
SCMAPU RES 0
BAL,RL SCPULL REMOVE EXPRESSION(S) FROM STACK
SCMAPU1 RES 0
LV,TMP UNDITM LOAD UNDEFINED ITEM
B SCUND PUSH AN UNDEFINED ITEM ONTO STACK
SCMAPSPI RES 0
AND,TX4 =VALFLD GET VALUE OF SPECIAL INTEGER
SCMAP1 RES 0
LI,TX3 0 ZERO FOR MOST SIGNIFICANT WORD
SCMAP2 RES 0
STD,TX3 RVAL STORE RESULT OF CONSTANT
EXIT RL
SCMAPERR RES 0
BAL,ER EERR ILLEGAL ITEM
SCMAPBL RES 0
LD,TX3 ZERO SET UP ZERO CONSTANT
B SCMAP2
*
SCMAP3 RES 0
LW,TX4 1,XT2 GET CONSTANT
B SCMAP1
SCMAPDPI RES 0
CI,TX4 1
BAZ SCMAP3 BRIF 2-WORD DPI
*
SCMAPFL RES 0
LW,TX3 1,XT2 GET MOST SIGNIFICANT PART
LW,TX4 2,XT2 GET LEAST SIGNIFICANT PART
MTW,1 DPIFLAG INCREMENT NUMBER OF DPI ITEMS
B SCMAP2
*
SCMAPFS RES 0
SCMAPFX RES 0
SCMAPI RES 0
LW,TX4 1,XT2 GET CONSTANT
BGEZ SCMAP1 BRANCH IF POSITIVE
LI,TX3 -1 EXTEND THE MINUS SIGN
B SCMAP2
SCMAPD RES 0
LW,XT TX4
AND,XT =LENGTHFLD GET LENGTH OF DECIMAL CONSTANT
CI,XT 3
BLE %+2 BRANCH IF 64 BITS OR LESS
BAL,ER TERR TRUNCATION ERROR
AI,XT -1
LW,TX4 *XT2,XT GET LEAST SIGNIFICANT PART
AI,XT -1
BLEZ SCMAP1 USE ZERO FOR MOST SIGNIFICANT PART
LW,TX3 *XT2,XT GET MOST SIGNIFICANT PART
B SCMAP2
SCMAPTXT RES 0
AI,XT2 1
LB,XT *XT2 GET NUMBER OF CHARS IN CONSTANT
CI,XT 8
BLE %+2 BRANCH IF 8 CHARS OR LESS
BAL,ER TERR TRUNCATION ERROR
LD,TX3 ZERO
LI,XT1 7
SCMAPTX2 RES 0
CI,XT 0
BEZ SCMAP2 BRANCH IF NO CHARS LEFT IN STRING
LB,TX1 *XT2,XT MOVE LOW ORDER CHAR FROM STRING
STB,TX1 TX3,XT1 TO LOW ORDER POSITION IN TX3,TX4
AI,XT1 -1 DECREMENT 'STORE' INDEX
BLZ SCMAP2 BRANCH IF TX3,TX4 FULL
AI,XT -1 DECREMENT 'LOAD' INDEX
B SCMAPTX2
SCMAPEXT RES 0
SCMAPLF RES 0
LI,TX3 0 USE ZERO FOR OFFSET WORD
LW,TX1 TX4 USE CONTROL WORD FOR 3RD WORD OF SUM
SCMAP4 RES 0
STW,TX3 RVAL+1 STORE OFFSET AS 2ND WORD OF SUM
STW,TX1 RVAL+2 STORE 3RD WORD OF SUM
LV,TX4 3WDSUM
STW,TX4 RVAL STORE CONTROL WORD FOR 3 WORD SUM
LV,TX2 DEFFLD STORE ITEM'S DEF FIELD AS
STS,TX1 RVAL DEF FOR SUM CONTROL WORD
LI,TX2 RVAL
STW,TX2 RPTR STORE POINTER TO NAPPED ITEM
SCMAPSUM RES 0
MTW,1 SUM%FLAG INDICATE ITEM IS A SUM
EXIT RL
SCMAPSPA RES 0
LW,TX3 TX4
AND,TX3 =ADDFLD GET ADD FIELD FOR OFFSET
LW,TX1 TX4
AND,TX4 =CSFLD GET CONTROL SECTION
SHIFT,TX4 CSLOB,ECSLOB POSITION CONTROL SECTION
AND,TX1 =SPAFLD+CSFLD+ADDFLD||X'FFFFFFFF' RESET SPA,CS, ADD
AV,TX1 ONEWDADD+SYMBOL SET STYPE AND TYPE FIELDS
AW,TX1 TX4
B SCMAP4
SCMAPADD RES 0
LW,TX1 1,XT2
LW,TX3 TX1
AND,TX3 =OFFSETFLD GET OFFSET
AV,TX4 ONEWDADD-SIMPADD CHANGE STYPE FIELD TO 1 WD ADDRESS
AND,TX4 =~LENGTHFLD RESET LENGTH FIELD
AND,TX1 =FCSFLD GET CONTROL SECTION
SHIFT,TX1 FCSLOB,ECSLOB POSITION CONTROL SECTION
AW,TX1 TX4
B SCMAP4
SCMAPAB RES 0
SCDIR RES 0
ABORT ABORT2 BAD ENCODED TEXT
*
* S C A D D S U M
*
SCADDSUM RES 0
LW,XT SUM%FLAG IS ONE OPERAND
CI,XT 3 A CONSTANT
BNE SCADSM70 BRANCH IF YES
LW,XT2 EVT,LVL CREATE POINTER TO NEXT AVAILABLE
AW,XT2 KLINE WORD IN EVT
STW,XT2 TMP SAVE START OF RESULT
LW,TX1 *RPTR GET LENGTH OF RIGHT SUM
AND,TX1 L(LENGTHFLD)
STW,TX1 RTSUMSZ
LW,TX1 *LPTR GET LENGTH OF LEFT SUM
AND,TX1 L(LENGTHFLD)
STW,TX1 LFSUMSZ
LV,TX1 SYMBOL+CMPLXSUM MOVE CONTROL WORD
OR,TX1 EXPR%DEF SET DEF FIELD TO LEAST VALUE
BAL,RL SCPUSHTX1 PUSH TX1 ONTO EVT
LI,XT 1 INDEX TO RT SUM
LI,XT1 1 INDEX TO LF SUM
LW,TX1 *RPTR,XT ADD OFFSETS
AW,TX1 *LPTR,XT
BAL,RL SCPUSHTX1 PUSH TX1 ONTO EVT
LV,TX2 ~(ADFLD+2**(31-DEFLOB)+DUPFLD+SETFLD)
LV,TX4 ADFLD
SCADSM40 RES 0
AI,XT 1 BUMP INDEX TO RT OPERAND
AI,XT1 1 BUMP INDEX TO LEFT OPERAND
CW,XT RTSUMSZ ANY MORE IN RT SUM
BGE SCADSM25 NO, GO MOVE LEFT SUM
B SCADSM31
SCADSM3 LW,TX1 *RPTR,XT GET NEXT ITEM FROM RT SUM
LW,TX3 *LPTR,XT1 GET NEXT ITEM FROM LF SUM
CS,TX1 TX3 COMPARE
BL SCADSM20 RT < LF
BG SCADSM30 LF < RT
CS,TX3 TX1 RT = LF, CHECK AD BIT
BNE SCADSM40 AD BIT DIFFERS, ITEMS CANCEL
SCADSM20 RES 0
BAL,RL SCPUSHTX1 PUSH TX1 ONTO EVT
AI,XT 1
CW,XT RTSUMSZ ANY MORE IN RT SUM
BL SCADSM3 YES
SCADSM23 RES 0
LW,TX1 *LPTR,XT1 NO, MOVE REST OF LF SUM
BAL,RL SCPUSHTX1 PUSH TX1 ONTO EVT
AI,XT1 1
SCADSM25 CW,XT1 LFSUMSZ FINISHED
BL SCADSM23 NO
B SCADSM50 YES
SCADSM30 RES 0
STW,TX3 TX1 MOVE LF ITEM
BAL,RL SCPUSHTX1 PUSH TX1 ONTO EVT
AI,XT1 1
SCADSM31 RES 0
CW,XT1 LFSUMSZ ANY MORE IN LF SUM
BL SCADSM3 YES
SCADSM33 LW,TX1 *RPTR,XT NO, MOVE REST OF RT SUM
BAL,RL SCPUSHTX1 PUSH TX1 ONTO EVT
AI,XT 1
CW,XT RTSUMSZ FINISHED
BL SCADSM33 NO
SCADSM50 RES 0
SW,XT2 TMP CALCULATE SIZE OF SUM
AWM,XT2 *TMP PUT SIZE IN SUM CONTROL WORD
SCADSM60 RES 0
BAL,RL SCPULL
B SCSQESUM SQUEEZE SUM TO SMALLEST FORM
* HERE IF ONE OPERAND IS A CONSTANT AND THE OTHER IS AN
* ADDRESS OR SUM
SCADSM70 MTW,0 DPIFLAG IS CONSTANT SINGLE PRECISION
BEZ %+2 YES
BAL,ER TERR NO, ERROR
LI,XT1 1
CI,XT 2
BANZ SCADSM80 BRANCH IF LEFT OPERAND IS A SUM
LW,TX1 LVAL+1 ADD OFFSET TO RIGHT OPERAND
AWM,TX1 *RPTR,XT1
LW,TMP RPTR ADDRESS OF SUM
B SCADSM60
SCADSM80 RES 0
LW,TX1 RVAL+1 ADD OFFSET TO LEFT OPERAND
AWM,TX1 *LPTR,XT1
LW,TMP LPTR ADDRESS OF SUM
B SCADSM60
SCPUSHTX1 RES 0 PUSH REG TX1 ONTO EVT
CW,XT2 NXTLOCAL XT2 HAS EVT ADDRESS TO STORE INTO
BG HILIMIT4 BRANCH IF NO ROOM
STW,TX1 0,XT2 STORE IN EVT
AI,XT2 1 BUMP TO NEXT ADDRESS
EXIT RL
*
* S C C M P S U M
*
SCCMPSUM RES 0
CI,XT2 3 IF BOTH OPERANDS ARE NOT SUMS,
BNE SCOP6 GO SET RESULT TO ZERO
LV,RL LENGTHFLD
LS,XT2 *RPTR ARE THEY BOTH THE SAME SIZE
CS,XT2 *LPTR
BNE SCOP6 BRANCH IF THEY ARE UNEQUAL
*
LV,TX2 TYPEFLD+STYPEFLD+LENGTHFLD+ARFLD
SCCMPSM3 RES 0
AI,XT2 -1
CI,XT2 1
BE SCCMPSM1 FINISHED WITH ITEM COMPARISON
LW,TX1 *RPTR,XT2 COMPARE NEXT WORD OF SUM
CS,TX1 *LPTR,XT2
BE SCCMPSM3 EQUAL, SO FAR
B SCOP6 NOT EQUAL, ANSWER IS FALSE
SCCMPSM1 RES 0
LW,TX1 *LPTR,XT2 EXTEND SIGN OF OFFSET WORD
SAD,TX1 -32
STD,TX1 LVAL
LW,TX1 *RPTR,XT2 EXTEND SIGN OF RPTR OFFSET WORD
SAD,TX1 -32
STD,TX1 RVAL
B SCOPPRC RETURN TO PROCESS OPERATOR
*
* S C S Q E S U M
* THIS ROUTINE COMPRESSES THE RESULTING SUM OF 'SCADDSUM'
* INTO ITS SMALLEST FORM. IF LENGTH = 2, THE RESULT IS A
* CONSTANT AND A BRANCH TO 'SCOPEND' IS MADE WHICH COMPRESSES
* CONSTANTS. IF LENGTH = 3 AND STYPE = ONE WORD ADDR,
* RESULT IS COMPRESSED TO SPECIAL ADDRESS OR SIMPLE ADDRESS
* IF POSSIBLE. IN ALL OTHER CASES BRANCH TO PUSH
* THE SUM ONTO THE EVT & ECT.
*
* INPUT: REGISTER TMP CONTAINS THE ADDRESS OF THE SUM
*
SCSQESUM RES 0
LW,XT TMP MOVE ADDRESS OF SUM (FOR SCPUSH)
LW,XT1 0,XT
AND,XT1 =LENGTHFLD CLEAN THE LENGTH OF THE SUM
CI,XT1 2 DOES LENGTH = 2 (RESULT = CONSTANT)
BNE SCSQSM3 NO
LI,TX1 0
LW,TX2 1,XT GET OFFSET
BGEZ %+2 IS IT NEGATIVE, NO
LI,TX1 -1 YES, EXTEND SIGN
STD,TX1 LVAL
B SCOPEND1 GO MAP CONSTANT
SCSQSM3 LV,TX1 SUMET SET TYPE = SUM
STW,TX1 DD%TYPE
CI,XT1 3 DOES LENGTH = 3
BNE V%C%3 NO
LW,TX1 2,XT
LV,TX2 STYPEFLD
CS,TX1 L(ONEWDADD) DOES SUM REPRESENT AN ADDRESS
BNE V%C%3 NO
LW,TX2 1,XT GET OFFSET
BLZ V%C%3 IF NEGATIVE, LEAVE AS A 3-WD SUM
LW,TX3 2,XT SAVE THE ECS FIELD
AND,TX3 =ECSFLD
CV,TX1 ADFLD IS ADDRESS NEGATIVE
BANZ SCSQSM5 YES
CV,TX2 ADDFLD WILL OFFSET FIT IN SPA TYPE
BG SCSQSM5 NO
CV,TX3 CSFLD**(-(31-CSLOB)) WILL CS FIT IN SPA TYPE
BG SCSQSM5 NO
LV,TMP ARFLD
AND,TMP TX1 SAVE ADDRESS RESOLUTION
SHIFT,TX3 ECSLOB,CSLOB
OR,TMP TX3 INSERT CONTROL SECTION
OR,TMP EXPR%DEF INSERT LOWEST DEF FIELD
OR,TMP TX2 INSERT OFFSET
OR,TMP =SPAFLD INSERT SPA BIT
B V%C%6 BRANCH TO STORE SPECIAL ADDRESS
SCSQSM5 RES 0
CV,TX2 OFFSETFLD WILL OFFSET FIT IN SIMP ADDR TYPE
BG V%C%3 NO, BRANCH TO STORE SUM
AND,TX1 =~(STYPEFLD+LENGTHFLD+DEFFLD)
AV,TX1 SIMPADD+LNGTH2 SET SIMPLE ADDR & LENGTH = 2
OR,TX1 EXPR%DEF INSERT LOWEST DEF FIELD
SHIFT,TX3 ECSLOB,FCSLOB SHIFT TO FCS FIELD
OR,TX2 TX3 INSERT CONTROL SECTION
STD,TX1 LVAL
B V%C%7 GO INSERT SIMPLE ADDR & RETURN
*
* HERE TO EXIT AFTER ONE ARG HAS BEEN PROCESSED
* BACK UP XW UNLESS END-LINE HAS BEEN FOUND
*
SCLOOP40 RES 0
CI,XT ENDLINE
BE V%0
AI,XW -1
*
* S C R E T
*
SCRET RES 0
LW,XS SCANXS
AW,XS KLINE
LW,TX1 SCANXS
SW,TX1 ECT,LVL EVALUATED BY THIS CALL
CI,TX1 1 IS COUNT = 1
BNE SCRET3 NO
LB,TX2 *XS YES, IS ITEM = BLANK
SLS,TX2 -3
CV,TX2 BLANKET**(-(31-ETLOB))
BNE SCRET3 NO
AI,TX1 -1 YES, SET COUNT = 0
SCRET3 STW,TX1 LSTCT SAVE COUNT
B *SCANEXIT EXIT FROM SCAN
*
CLOSE TX1,TX2,TX3,TX4
CLOSE TMP
PAGE
*
* S E T
* THIS ROUTINE PROCESSES THE SET DIRECTIVE. SETVALUE IS SET TO
* RE-DEFINABLE (1). AN ERROR IS REPORTED IF THE LABEL FIELD IS
* BLANK AND THE DIRECTIVE IS ON THE SOURCE LEVEL. THE EVALUATED
* OPERAND, IN THE EXPRESSION VALUE TABLE, IS SET RE-DEFINABLE
* OR NOT ACCORDING TO THE CONTENTS OF SETVALUE. IF THE
* EXPRESSION IS EXTERNAL, THE CS FIELD IS SET TO NOW-ZERO. THE
* LABEL IS THEN DEFINED AND THE VALUE IS EDITED INTO THE
* LISTING. SET THEN RETURNS TO GENR.
*
* INPUT: SETVALUE CONTAINS A ONE IF THE LABEL IS RE-DEFINEABLE
* (FOR SET) OR A ZERO IF IT IS NOT (FOR EQU).
*
* USES REGISTERS
* XT
* XT1
* XT2
* RL
* ER
*
SET RES 0
LV,XT 1**(31-SETLOB) SET TO RE-DEFINABLE
* HERE FROM EQU OR SET.
SET1 RES 0
STW,XT SETVALUE
*
* IF PRESENT, EVALUATE CF(2) FOR POSSIBLE 'SD' TYPE CODE.
* USE DEFAULT TYPE, HEX, IF NO CF(2). DON'T MAKE THIS EVALUATION
* CONDITIONAL ON EITHER PASS-NO. OR SD-OPTION (POSSIBLE FUNCTION
* SIDE-EFFECTS).
*
LV,XT SDHEXC DEFAULT CODE IS HEX
MTW,0 CMNDLIST
IF,NE -10- DOIF CF(2) PRESENT
CALL EVAL1EXP
LW,XT TEMP
SHIFT,XT 31,SDTLOB
FI -10-
STW,XT SD%TYPE SAVE FOR 'DEFINE'
BAL,RL MV:LIST MOVE A DUMMY LIST TO ECT AND EVT
CALL EV%CLN%OPRND EVALUATE THE OPERAND FIELD
MTW,-1 LSTCT BRANCH IF MORE THAN ONE
BGZ SET2 ITEM IN OPERAND FIELD
LV,XT1 ETFLD MASK FOR ET FIELD
LW,XT 0,XS
CS,XT =LISTET BRANCH IF ECT ENTRY
BNE SET4 IS NOT A LIST
SET2 RES 0
BAL,RL CTELEMENTS COMPLETE THE LIST STRUCTURE
AI,XS 1 ADDRESS OF LIST ENTRY IN ECT
SET4 RES 0
LW,XT2 0,XS GET INDEX TO EXPRESSION VALUE TABLE
LV,XT1 SETFLD MASK FOR SET FIELD
LW,XT SETVALUE MAKE ITEM RE-DEFINABLE IF PROCESSING
STS,XT *KLINE,XT2 SET, NOT RE-DEFINABLE FOR EQU
LW,XT *KLINE,XT2 GET VALUE CONTROL WORD FROM EVT
AND,XT =DEFFLD
CW,XT PASSDEF
BE SET3 ITEM IS DEFINED FOR CURRENT PASS
BAL,ER EERR ILLEGAL OPERAND
SET3 RES 0
BAL,RL EDITV EDIT VALUE INTO THE LISTING
BAL,RL DEFINE ASSIGN EXPRESSION VALUE TO LABEL
B GENR
PAGE
*
* S E T % S F
*
SET%SF RES 0
LW,XT PROCREF
EXIT,NE RL EXIT IF NOT ON SOURCE LEVEL
* SET SF IF THIS IS AS FAR AS WE'VE GONE ON THE ENCODED TEXT FILE
LW,XT TEXTCT
CW,XT SMPRCD
EXIT,NE RL
CW,XW SMPWD
EXIT,NE RL
MTW,1 SF SET SF TO RESUME LISTING
EXIT RL
PAGE
*
* S E T D L R S
* SETS CONTROL SECTION AND RESOLUTION, AND CLEARS THE OFFSETS
* FOR BOTH LOCATION COUNTERS.
*
* OUTPUT: RESOLUTION FOR % AND %% IS SET TO 'WORD'
* OFFSETS FOR % AND %% ARE SET TO ZERO
* DLRCS IS STORED IN DDLRCS.
*
* CALL: BAL,RL SETDLRS
*
* USES REGISTER
* XT
*
SETDLRS RES 0
LW,XT DLRCS SET LOAD LOCATION COUNTER (%%) TO
STW,XT DDLRCS SAME CONTROL SECTION AS %
LI,XT 0
STW,XT DLRVAL INITIALIZE BOTH OFFSETS TO ZERO
STW,XT DDLRVAL
LI,XT WDRS
STW,XT DLRRS INITIALIZE BOTH RESOLUTIONS TO
STW,XT DDLRRS WORD RESOLUTION.
EXIT RL
PAGE
*
* S E T L A B E L
* THIS ROUTINE CAUSES A REDEFINABLE SPECIAL INTEGER DEFINITION
* TO BE ENTERED INTO THE SYMBOL TABLE. A SPECIAL INTEGER IS
* CREATED WITH THE SET FIELD CONTAINING A ONE, AND THE VAL
* FIELD CONTAINING THE VALUE IN XT. DEFINE IS THEN CALLED TO
* DEFINE THE VALUE.
*
* INPUT: XT CONTAINS THE VALUE TO BE ASSIGNED TO THE LABEL.
* LBL ENTRY OF THE CURRENT PROCEDURE LEVEL TABLE
* CONTAINS AN INDEX TO THE ENCODED LABEL.
*
* OUTPUT: FND CONTAINS THE ADDRESS OF THE LABEL ENTRY IN THE
* SYMBOL TABLE.
*
* CALL: BAL,RL SETLABEL
*
* USES REGISTERS
* XT
SETLABEL RES 0
AV,XT 1**(31-SPALOB)+1**(31-SPINTLOB)+1**(31-SETLOB)
AW,XT PASSDEF DEFINE IT FOR CURRENT PASS
STW,XT SETVALUE REDEFINABLE SPEC. INTEGER
LI,XT SETVALUE
STW,XT ARG ADDRESS OF ARGUMENT
LV,XT SDHEXC SET SD TYPE TO HEX
STW,XT SD%TYPE
B DEFINE DEFINE LABEL AND EXIT SETLABEL
PAGE
*
* S I N O P
* THIS ROUTINE EXTRACTS THE OP CODE FROM THE COMMAND DEFINITION
* AND MOVES IT TO THE EXPRESSION STACKS
*
* INPUT: REFADD CONTAINS THE ADDRESS OF THE COMMAND DEFINITION.
*
* OUTPUT: THE OP CODE FROM THE COMMAND DEFINITION HAS BEEN
* MOVED TO THE EXPRESSION TABLES.
*
* CALL: BAL,RL SINOP
*
* USES REGISTERS
* XT
* XT1
*
SINOP RES 0
LW,XT REFADD ADDRESS OF COMMAND ENTRY
AI,XT 1 ADDRESS OF OP CODE VALUE
LV,XT1 SPINTET
STW,XT1 DD%TYPE SET TYPE TO SPECIAL INTEGER
LI,XT1 1
B SCPUSH PUSH OP CODE VALUE TO TOP OF
* EXPRESSION STACKS AND EXIT
PAGE
*
* S I N S U B
* THIS ROUTINE PROCESSES THE OP CODE AND REGISTER FIELDS OF THE
* SIN0 AND SIN2 TYPE OF STANDARD INSTRUCTIONS. SINOP IS CALLED
* TO MOVE THE OP CODE VALUE FROM THE COMMAND DEFINITION TO THE
* EXPRESSION TABLES. IF A REGISTER FIELD EXISTS, EVAL1EXP IS
* CALLED TO PROCESS IT; OTHERWISE, AN ERROR IS REPORTED AND A
* ZERO IS USED AS THE REGISTER VALUE. FINALLY, THE INDEX TO
* THE ENCODED TEXT FOR THE OPERAND FIELD IS SAVE IN THE CURRENT
* PROCEDURE LEVEL TABLE.
*
* INPUT: CMNDLIST CONTAINS A ZERO IF NO REGISTER FIELD EXISTS,
* OR A NON-ZERO IS IT DOES.
*
* OUTPUT: XW CONTAINS THE INDEX TO THE ENCODED TEXT FOR THE
* OPERAND FIELD
* CALL: BAL,RL SINSUB
*
* USES REGISTER
* RL
* XT
* XW
* LVL
* ER
*
SINSUB RES 0
STW,RL SINSUBXIT
BAL,RL SINOP OP CODE VALUE TO EXPRESSION STACK
MTW,0 CMNDLIST
BEZ SINSUB1 NO CF(2) ENTRY
BAL,RL EVALUATE%AND%CLEAN EVALUATE THE REGISTER FIELD
LW,XT LSTCT NUMBER OF COMMAND EXPRESSIONS
AI,XT -1
BLEZ *SINSUBXIT ONLY ONE ENTRY IS OK
AWM,XT ECT,LVL RETAIN CF(2) ENTRY ONLY
SINSUB2 RES 0
BAL,ER EERR ANYTHING ELSE IS ERROR
B *SINSUBXIT
SINSUB1 RES 0
LI,XT 0 BUILD SPECIAL INTEGER ZERO AND MOVE
BAL,RL STACKSPI IT TO EXPRESSION STACKS
B SINSUB2 REPORT REGISTER FIELD ERROR
PAGE
*
* S I N 0
* THIS ROUTINE PROCESSES THE 'LOAD/STORE' INSTRUCTIONS OF THE
* STANDARD INSTRUCTION SET. FIRST, SINAFA IS CALLED TO PROCESS
* A POSSIBLE INDIRECT FLAG IN THE ADDRESS FIELD. THEN SINSUB
* IS CALLED TO OBTAIN THE OP CODE, AND TO PROCESS THE REGISTER
* FIELD. NEXT THE INPUT ARGUMENTS FOR GENERATE ARE SET UP.
* AT SIN01 (AN ENTRY POINT BRANCHED TO FROM THE SIN1 ROUTINE),
* THE ITEM FOLLOWING THE ADDRESS FIELD IS EXAMINED. IF AN ENTRY
* EXISTS, SCAN1 IS CALLED TO PROCESS IT AS THE INDEX FIELD;
* OTHERWISE IS ZERO INDEX VALUE IS BUILT. NEXT SCAN1 IS CALLED
* TO PROCESS THE ADDRESS FIELD WHICH IS CONVERTED TO WORD
* RESOLUTION BY CALLING SCRS. IF ANY OPERANDS FOLLOW THE INDEX
* FIELD, AN ERROR IS REPORTED. FINALLY GENERATE IS CALLED TO
* PRODUCE THE OBJECT CODE FOR THE STANDARD INSTRUCTION AND THIS
* ROUTINE BRANCHES TO GENR.
*
* INPUT: XW CONTAINS AN INDEX TO THE ENCODED TEXT ITEM
* FOLLOWING THE CF(1) FIELD.
*
* OUTPUT: XW CONTAINS AN INDEX TO THE BEGINNING OF THE ENCODED
* TEXT FOR THE LINE FOLLOWING THE STANDARD INSTRUCTION
* REFERENCE
*
SINBASE RES 0 BASE ADDRESS FOR SIN0, SIN1, AND
* SIN2 ROUTINES
SIN0 RES 0
BAL,RL STACKSPI INITIALIZE AFA(1) TO ZERO
BAL,RL SINSUB PROCESS OP AND REGISTER
LI,XT SIN0FLDCT
LI,RL SIN0FLDS+SIN0FLDCT-1 POINTER TO FIELD LIST
SIN01 RES 0
STW,XT VALCNT SET NUMBER OF VALUE ITEMS AND
STW,XT FLDCNT FIELD ITEMS FOR GENERATE
STW,RL FLDPTR POINTER TO FIELD LIST
LI,XT 0
BAL,RL STACKSPI INITIALIZE INDEX TO ZERO
CALL SCANOPRND EVALUATE THE OPERAND FIELD
LW,XT 0,XS BRANCH IF FIRST OPERAND ENTRY IS
BFZ,XT ASTFLD,SIN02 NOT PRECEEDED BY *
LW,XT1 *VALPTR
MTW,1 *KLINE,XT1 SET AFA(1) TO ONE
SIN02 RES 0
LW,XT1 LSTCT NUMBER OF OPERAND FIELD ENTRIES
BNEZ %+2 NO ADDRESS OR INDEX
BAL,ER EERR IS AN ERROR
CI,XT1 2
BL SIN04 BRANCH IF 0 OR 1 OPERAND
BE SIN03 BRANCH IF 2 OPERANDS
BAL,ER EERR TOO MANY OPERANDS
SIN03 RES 0
AWM,XT1 ECT,LVL DELETE OPERAND ENTRIES FROM ECT
LW,XT1 -1,XS MOVE ECT ENTRY FOR SECOND OPERAND
STW,XT1 1,XS INTO INDEX POSITION
AW,XT KLINE ADDRESS OF EVT ENTRY FOR AF(1)
LV,XT1 ETFLD MASK FOR ET FIELD
STS,XT DD%TYPE TYPE OF FIRST OPERAND
BAL,RL LENGTH GET LENGTH OF AF(1)
BAL,RL SCPUSH STORE AF(1) AS LAST EXP ENTRY
SIN04 RES 0
LV,XT WDRS
STW,XT DDRS SET TO WORD RESOLUTION
BAL,RL SCRS CONVERT ADDRESS TO WORD RESOLUTION
BAL,RL GENERATE1 GENERATE OBJECT CODE
B GENR
*
SIN0FLDS RES 0
SPIECT SINADDR ADDRESS OF ADDRESS FIELD SIZE
SPIECT SININDEX ADDRESS OF INDEX FIELD SIZE
SPIECT,1 SINREG ADDRESS OF REGISTER FIELD SIZE
SPIECT SINOPCODE ADDRESS OF OP CODE FIELD SIZE
SPIECT SINAST ADDRESS OF ASTERISK FIELD SIZE
SIN0FLDCT EQU %-SIN0FLDS NUMBER OF FIELD SIZES FOR SIN0
PAGE
*
* S I N 1
* THIS ROUTINE PROCESSES THE 'BRANCH' INSTRUCTIONS OF THE
* STANDARD INSTRUCTION SET. FIRST, SINAFA IS CALLED TO PROCESS
* A POSSIBLE INDIRECT FLAG IN THE AF(1) FIELD. THEN SINOP IS
* CALLED TO MOVE THE OP CODE FROM THE COMMAND DEFINITION TO
* THE EXPRESSION VALUE TABLE. THEN THE INPUT ARGUMENTS FOR
* GENERATE ARE SET UP AND THIS ROUTINE BRANCHES TO SIN01 TO
* PROCESS THE INDEX AND ADDRESS FIELDS.
*
* INPUTI XW CONTAINS AN INDEX TO THE ENCODED TEXT ITEM
* FOLLOWING THE CF(1) ENTRY.
*
* OUTPUT: EVT CONTAINS VALUES FOR THE INDIRECT AND OP CODE
* FIELDS.
* VALPTR CONTAINS THE ADDRESS IN EVT CORRESPONDING TO
* THE INDIRECT FLAG VALUE
* FLDPTR CONTAINS THE ADDRESS OF THE ORIGIN OF A LIST
* OF FIELD SIZES FOR THE INDIRECT, OP CODE, INDEX,
* AND ADDRESS FIELDS.
* VALCNT AND FLDCNT EACH CONTAIN A FOUR.
*
* USES REGISTERS
* XT
* RL
*
SIN1 RES 0
MTW,0 CMNDLIST
BEZ %+2 NO EXPRESSIONS IN THE COMMAND FIELD
BAL,ER EERR TOO MANY COMMAND FIELD ENTRIES
LI,XT 0
BAL,RL STACKSPI INITIALIZE AFA(1) TO ZERO
BAL,RL SINOP PROCESS OP
LI,XT SIN1FLDCT
LI,RL SIN1FLDS+SIN1FLDCT-1 POINTER TO FIELD LIST
B SIN01
*
SIN1FLDS RES 0
SPIECT SINADDR ADDRESS OF ADDRESS FIELD SIZE
SPIECT SININDEX ADDRESS OF INDEX FIELD SIZE
SPIECT SINBROP ADDRESS OF BRANCH OP CODE FIELD SIZE
SPIECT SINAST ADDRESS OF ASTERISK FIELD SIZE
SIN1FLDCT EQU %-SIN1FLDS NUMBER OF FIELD SIZES FOR SIN1
PAGE
*
* S I N 2
* THIS ROUTINE PROCESSES THE 'IMMEDIATE' INSTRUCTIONS OF THE
* STANDARD INSTRUCTION SET. FIRST IT CALLS SINSUB TO OBTAIN
* THE OP CODE, AND TO PROCESS THE REGISTER FIELD. THEN SCAN1
* IS CALLED TO EVALUATE THE ADDRESS. IF ANY MORE OPERANDS
* FOLLOW THE ADDRESS AN ERROR IS REPORTED. FINALLY, THE INPUT
* ARGUMENTS FOR GENERATE ARE SET UP BY BRANCHING TO SIN04.
*
* INPUT: XW CONTAINS AN INDEX TO THE ENCODED TEXT ITEM
* FOLLOWING THE CF(1) ENTRY.
*
* OUTPUT: EVT CONTAINS VALUES FOR THE OP CODE, REGISTER, AND
* ADDRESS FIELDS.
* VALPTR CONTAINS THE ADDRESS OF THE ENTRY IN EVT
* CORRESPONDING TO THE OP CODE
* FLDPTR CONTAINS THE ADDRESS OF THE ORIGIN OF A LIST
* OF FIELD SIZES FOR THE OP CODE, REGISTER, AND
* ADDRESS FIELDS.
* VALCNT AND FLDCNT EACH CONTAIN A THREE.
*
* USES REGISTERS
* XT
* RL
* ER
*
SIN2 RES 0
BAL,RL SINSUB PROCESS OP AND REGISTER
BAL,RL SCAN EVALUATE ADDRESS FIELD /10771/B-08773
LW,XT 0,XS
BFNZ,XT ASTFLD,SIN20 BRANCH IF AF(1) IS PRECEEDED BY AN *
MTW,-1 LSTCT /10771/B-08773
BEZ SIN21 BRANCH IF ONE OPERAND /10771/B-08773
SIN20 RES 0
BAL,ER EERR SET 'E' FOR NOT ONE OPERAND /10771/B-08773
SIN21 RES 0
LI,XT SIN2FLDS+SIN2FLDCT-1 POINTER TO FIELD LIST
STW,XT FLDPTR POINTER TO FIELD LIST
LI,XT SIN2FLDCT
STW,XT VALCNT SET NUMBER OF VALUE ITEMS AND NUMBER
STW,XT FLDCNT OF FIELD ITEMS FOR GENERATE
BAL,RL GENERATE1 GENERATE OBJECT CODE
B GENR
*
SIN2FLDS RES 0
SPIECT,1 SINIMVAL ADDRESS OF IMMEDIATE VALUE FLD SIZE
SPIECT,1 SINREG ADDRESS OF REGISTER FIELD SIZE
SPIECT SINIMOP ADDRESS OF IMMEDIATE OP CODE FLD SIZ
SIN2FLDCT EQU %-SIN2FLDS NUMBER OF FIELD SIZES FOR SIN2
*
* FIELD SIZES FOR STANDARD INSTRUCTION FIELDS
*
SINAST SPECINT 1 ASTERISK FIELD SIZE
SINOPCODE SPECINT 7 OP CODE FIELD SIZE
SINREG SPECINT 4 REGISTER FIELD SIZE
SININDEX SPECINT 3 INDEX FIELD SIZE
SINADDR SPECINT 17 ADDRESS FIELD SIZE
SINBROP SPECINT 11 BRANCH OP CODE FIELD SIZE
SINIMOP SPECINT 8 IMMEDIATE OP CODE FIELD SIZE
SINIMVAL SPECINT 20 IMMEDIATE VALUE FIELD SIZE
PAGE
*
* S K I P G E T L F 1
* GET THE LF(1) ENCODED ENTRY WHILE SKIPPING LINES
* THE CURRENT LINE IS EITHER ON THE SOURCE LEVEL OR IN
* SAMPLE STORAGE; NOT IN THE PARTICULARIZATION BUFFER.
* THE LOCATION OF THE PARTIC. FLAG IS SAVED IN CASE THIS
* LINE WILL BE ASSEMBLED (GOTO DIRECTIVE ONLY).
*
LOCAL %1,%2,%3
SKIPGETLF1 RES 0
STW,RL SKGLF1XIT SAVE EXIT
LW,XT PROCREF IS THE LINE ON SOURCE LEVEL
BNEZ %1
BAL,RL PRINTC PRINT IF THERE IS A SOURCE LINE
LW,XT SF RESET SOURCE FLAG
STW,XT SOURCE
LW,XT SYSCOUNT
STB,XT NOLIST TURN OFF PRINTING IF WITHIN A SYSTEM
MTW,1 SKIPTRIG SET SKIP TRIGGER
BAL,RL LINENUM GET LINE NUMBER
STW,XW LBL,LVL SAVE XW
B %3
%1 RES 0
STW,XW LBL,LVL SAVE XW
AI,XW 1 SKIP PARTICULARIZATION FLAG
%3 RES 0
NXTENC GET LF(1) ENTRY
B *SKGLF1XIT
PAGE
*
* S K I P I N I T
* INITIALIZE COUNTERS AND FLAGS IN PREPARATION FOR SKIPPING
* LINES UNDER A DO OR GOTO DIRECTIVE.
*
SKIPINIT RES 0
LI,XT 0
STW,XT DOCOUNT DO/FIN PAIR COUNTER
STW,XT PROCCOUNT PROC/PEND PAIR COUNTER
STW,XT SYSCOUNT SYTEM/END PAIR COUNTER
STW,XT LOCALFLG
STW,XT SAMP,LVL
EXIT RL
PAGE
*
* S K I P L A B E L
* SKIPS A NON-STANDARD LABEL FIELD
* S K I P C M N D
* SKIPS A COMMAND FIELD
*
* ENCODED TEXT ITEMS ARE SKIPPED UNTIL AN END-OF-LIST ITEM
* IS ENCOUNTERED.
*
* INPUT: XW CONTAINS THE ADDRESS OF THE NEXT ENCODED TEXT
* ITEM.
*
* OUTPUT: XW CONTAINS THE ADDRESS OF THE NEXT ENCODED ITEM
* FOLLOWING AN ENDLIST ITEM.
*
* CALL: BAL,RL SKIPLABEL
* BAL,RL SKIPCMND
* USES REGISTERS
* XT
* XT1
* XW
* RL
*
SKIPLABEL RES 0
SKIPCMND RES 0
LI,XT1 1 NUMBER OF BEGINLIST ITEMS
SKPCMND1 RES 0
NXTENC GET NEXT ENCODED ITEM
CI,XT ENDLIST
BNE SKPCMND2 NOT AN END-OF-LIST ITEM
BDR,XT1 SKPCMND1 DECREMENT NUMBER OF BEGINLIST ITEMS
EXIT RL EXIT, 'FINAL' END-OF-LIST
SKPCMND2 RES 0
CI,XT BEGINLIST
BNE SKPCMND3 NOT A BEGINLIST ITEM
AI,XT1 1 INCREMENT NUMBER OF BEGINLIST ITEMS
SKPCMND3 RES 0
AI,XT ENCTYPE1 ADD 1 TO ENCODED TYPE FIELD
BCR,8 SKPCMND1 TYPE IS NOT A LARGE INTEGER
AND,XT =LFLD MASK FOR LENGTH FIELD
AW,XW XT ADVANCE XW PAST LARGE INTEGER
B SKPCMND1
PAGE
*
* S O C W
* THIS ROUTINE PROCESSES THE SOCW DIRECTIVE.
*
LOCAL %10,%20
*
SOCW RES 0
MTW,0 PASS
IF,EZ DOIF PASS 1
*
* IF THERE WAS A PREVIOUS SOCW DIRECTIVE, OR IF THERE WAS A PRIOR
* DIRECTIVE WHICH INHIBITS SOCW (REF, CSECT, ETC.), JUST IGNORE
* THIS CALL ON SOCW (PASS 1).
*
LW,XT SOCW%FLG
OR,XT SOCW2LAT
BNEZ LINE5 CANNOT ACCEPT
*
* NOTE OCCURRENCE OF SOCW, CHANGE BINARY PARAMETERS TO USE
* ENTIRE RECORD, AND TREAT AS ASECT DIRECTIVE.
*
MTW,+1 SOCW%FLG NOTE SOCW
STH,XT BO%FLAG CLEAR 'SB' FIELD
STW,XT BOCT 0 STARTS AT BEGINNING OF CARD
LI,XT 120
STW,XT BO%SIZE
STW,XT BOMAX MAX # ACTIVE BYTES / BINARY RECORD
ELS IS PASS 2
*
* IF PASS 1 DID NOT ACCEPT SOCW, OR IF THIS IS NOT FIRST SOCW
* DIRECTIVE IN THIS PASS, DIAGNOSE AND IGNORE.
*
MTW,0 SOCW%FLG
IF,EZ
%10 RES 0
BAL,ER IERR
B LINE5 SKIP
*
FI
MTW,0 SOCW2LAT
BNEZ %10 DIAGNOSE & IGNORE
*
MTW,+1 SOCW2LAT SET FOR NO MORE THIS PASS
*
* IF DATA HAS BEEN GENERATED, DIAGNOSE, BUT CONTINUE ON.
* THIS CONDITION WAS NOT DETECTED DURING PASS 1.
*
LI,XT 1
LB,XT1 BOBUF,XT BINARY SEQUENCE NUMBER
CI,XT1 X'FF'
BNE %20 (ALWAYS ONE LESS THAN ACTUAL)
*
MTW,0 BOCT
IF,NZ (PASS 1 SET THIS ONE UP)
%20 RES 0
BAL,ER IERR
FI
FI
*
* (BOTH PASSES) TREAT AS ASECT DIRECTIVE, EXCEPT FOR DEFINING
* THE LABEL.
*
CALL OLDCSECT
LI,XT 0
STW,XT DLRCS
CALL SETDLRS
B LINE5
PAGE
*
* S O C W % C H K
* TEST THE VALIDITY OF A DIRECTIVE UNDER SOCW CONTROL. IF THE
* DIRECTIVE APPEARS PRIOR TO SOCW, THEN SET TO INHIBIT
* LATER ACCEPTANCE OF SOCW.
*
SOCW%CHK RES 0
MTW,0 SOCW2LAT
IF,EZ DOIF CHECK NOT YET PERFORMED
MTW,0 SOCW%FLG
IF,NZ
BAL,ER IERR THIS DIRECTIVE ILLEGAL UNDER SOCW
B LINE5 SKIP
*
FI
MTW,+1 SOCW2LAT SET SO SOCW WILL NOT BE ACCEPTED
FI
EXIT
PAGE
* S P A C E
* THIS ROUTINE PROCESSES THE SPACE DIRECTIVE. THE OPERAND
* SPECIFIES THE NUMBER OF BLANK LINES TO BE PRINTED. IF THE
* OPERAND VALUE IS LESS THAN ONE, ONE IS USED; IF IT IS GREATER
* THAN 16, 16 IS USED. IF THE VALUE IS THEN GREATER THAN THE
* LINES REMAINING ON THE PAGE, LINES REMAINING IS CLEARED AND
* SPACE BRANCHES TO GENR. OTHERWISE, PRINT IS CALLED 'VALUE'
* TIMES TO PRODUCE BLANK LINES.
*
* USES REGISTERS
* XT, RL
*
SPACE RES 0
*
CALL EV1OPRNDEXP EVALUATE ONE OPERAND EXPRESSION
CI,XT 1
BGE SPACE1 IF OPERAND VALUE IS LESS THAN ONE,
LI,XT 1 USE A VALUE OF ONE
SPACE1 RES 0
CI,XT 16
BLE SPACE2 IF OPERAND VALUE IS GREATER THAN 16,
LI,XT 16 USE A VALUE OF 16
SPACE2 RES 0
STW,XT TEMP STORE VALUE
BAL,RL PCCSUB PRINT SPACE DIRECTIVE UNDER PCC
CALL PRINTC PRINT SOURCE IF WITHIN A PROC
LW,XT TEMP IF NUMBER OF LINES TO UPSPACE IS
CW,XT PGLINES NOT LESS THAN NUMBER OF LINES
BGE PAGE1 REMAINING, GO TO TOP OF PAGE
*
LV,XT PSTRIGFLD|LISTFLD|4 DON'T SPACE IF LISTING OFF
AND,XT NOLIST TO PRE-ENCODED SYSTEM OR A
BNEZ GENR SYSTEM NOT BEING LISTED
*
SPACE5 RES 0
BAL,RL PRINT TEMP SPECIFIES THE
MTW,-1 TEMP NUMBER (1-16) OF
BG SPACE5 BLANK LINES TO BE PRINTED
B GENR
PAGE
*
* S P E C D I R
* TEST THE COMMAND FOR BEING A SPECIAL DIRECTIVE AND PROCESS.
*
* SPECIAL DIRECTIVES ARE: DO,FIN,LOCAL,SYSTEM,END,PROC,PEND,
* OPEN, AND CLOSE
*
* INPUT: REG. XW CONTAINS A POINTER TO THE COMMAND ENTRY
*
* OUTPUT: XT STILL CONTAINS THE COMMAND.
* IF A SPECIAL DIRECTIVE IS FOUND, THE APPROPRIATE
* COUNTER IS INCREASED OR DECREASED
* LOCAL DIRECTIVES ON THE CURRENT LEVEL ARE PROCESSED
* BY THIS ROUTINE
*
LOCAL %1,%2,%3,%4,%5,%6,%7,%10
SPECDIR RES 0
NXTENC
CI,XT BEGINLIST
BE SPECDIR GET ITEM FOLLOWING A BEGIN LIST
*
CI,XT SYSTEMDIR
BNE %4
NXTENC,XT1 ,NOINC LOOK AT THE FLAG
AND,XT1 =SYSTYPEFLD TO SEE WHETHER
CI,XT1 1**(31-SYSTYPELOB) ENCODED TEXT IS INCLUDED
EXIT,LE RL EXIT IF IT ISN'T
MTW,1 SYSCOUNT BUMP SYSTEM COUNT
%7 RES 0
LI,XT 0 CLOBBER XT SO COMMAND IS IGNORED
EXIT RL
%4 RES 0
CI,XT ENDDIR
BNE %3
MTW,-1 SYSCOUNT DECREASE SYSTEM COUNT
BL END%ERR1 ERROR IF ON SOURCE LEVEL
%3 RES 0
LW,XT1 SYSCOUNT DON'T LOOK FOR OTHER DIRECTIVES
BNEZ %7 IF SKIPPING LINES IN A SYSTEM
CI,XT DODIR TEST FOR 'DO'
BNE %1
MTW,1 DOCOUNT
EXIT RL
%1 RES 0
CI,XT FINDIR TEST FOR 'FIN'
BNE %2
MTW,-1 DOCOUNT
EXIT RL
%2 RES 0
CI,XT LOCALDIR TEST FOR 'LOCAL'
BNE SPCD5
*
LW,XT1 PROCCOUNT PROCESS 'LOCAL' ON THIS PROC LEVEL
EXIT,NE RL NOT THE SAME LEVEL
STW,RL SKIPTRIG
BAL,RL LOCALSTA
LI,RL 0
XW,RL SKIPTRIG
LW,XT1 GOTOARG
SLS,XT1 -13
CI,XT1 3 LOCAL SYMBOL
BNE %7
*
SPCD1 RES 0
BAL,ER KERR
B LINE5
SPCD5 RES 0
CI,XT PROCDIR TEST FOR 'PROC'
BNE %5
MTW,1 PROCCOUNT
EXIT RL
%5 RES 0
CI,XT PENDDIR TEST FOR 'PEND'
BNE SPCD10
MTW,-1 PROCCOUNT
EXIT,EQ RL
SPCD20 RES 0
BAL,ER KERR
B GOSRCH30 TO RE-START LINE AT LABEL FIELD
SPCD10 RES 0
CI,XT OPENDIR TEST FOR 'OPEN'
BE %6
CI,XT CLOSEDIR TEST FOR 'CLOSE'
EXIT,NE RL
%6 RES 0
LI,XT1 0
STW,XT1 SKIPTRIG
EXIT RL
LOCAL
PAGE
*
* S R C L C L F D
* DETERMINES WHETHER A SYMBOL IS A FORWARD LOCAL.
*
* INPUT: FND POINTS TO ENTRY TO BE INSPECTED.
*
* OUTPUT: XT1 IS ZERO IF THE ENTRY IS NOT A FORWARD LOCAL, OR
* CONTAINS THE SYMBOL TABLE ADDRESS IF IT IS.
*
* CALL: BAL,RL SRCLCLFD
*
* USES REGISTERS
* XT
* XT1
*
SRCLCLFD RES 0
LW,XT1 FND ADDRESS OF LOCAL
LW,XT 0,XT1
BFNZ,XT SPAFLD,SRCLCL1 SPEC. ADDR.
AND,XT =(SPAFLD+STYPEFLD+TYPEFLD)
CV,XT LCLFWD+SYMBOL
EXIT,EQ RL ENTRY IS A FORWARD LOCAL
CV,XT LCLFWDHD+SYMBOL
EXIT,EQ RL ENTRY IS A FORWARD & HOLD LOCAL
SRCLCL1 RES 0
LI,XT1 0 INDICATE NOT A FORWARD LOCAL
EXIT RL
PAGE
*
* S R E F
* THIS ROUTINE PROCESSES THE SREF DIRECTIVE. SREF SETS AN
* ASSIGNMENT VALUE FOR SREF AND BRANCHES TO DEF1.
*
* OUTPUT: XT CONTAINS A VALUE FOR SREF.
*
* USES REGISTER
* XT
*
SREF RES 0
LV,XT SREFEXT
B REF1 COMMON CODE FOR REF AND SREF
PAGE
*
* S T A C K S P I
* THIS ROUTINE BUILDS A SPECIAL INTEGER ITEM AND ADDS IT TO THE
* END OF THE ECT AND EVT TABLES.
*
* INPUT: XT CONTAINS THE INTEGER VALUE OF THE ITEM.
*
* OUTPUT: NONE
*
* CALL: BAL,RL STACKSPI
*
* USES REGISTERS
* XT
* XT1
*
STACKSPI RES 0
AV,XT 1**(31-SPALOB)+1**(31-SPINTLOB) BUILD A SPECIAL INT
AW,XT PASSDEF ITEM WHOSE VAL FIELD IS CONTAINED
STW,XT SPITEMP IN XT
LI,XT SPITEMP ADDRESS OF SPECIAL INTEGER
LV,XT1 SPINT%ET
STW,XT1 DD%TYPE VALUE FOR ET FIELD IS SPECIAL INT
LI,XT1 1 NUMBER OF WORDS TO PUSH
B SCPUSH PUSH VALUE INTO EXP STACKS AND EXIT
PAGE
*
* S U B V A L
* GET A SUBSCRIPT VALUE FROM THE EVT AND TEST ITS VALIDITY.
*
* INPUT: SUBLOC CONTAINS THE (FULL) ECT ADDRESS OF THE VALUE
*
* OUTPUT: THE SUBSCRIPT IN SUB#.
* SUBLOC IS DECREASED BY 1.
*
*
LOCAL %1,%2
SUBVAL RES 0
LW,XT *SUBLOC GET OFFSET TO THE EVT
MTW,-1 SUBLOC
LW,XT *KLINE,XT GET SUBSCRIPT
BFZ,XT SPAFLD,%1 TEST FOR A SPECIAL INTEGER
BFZ,XT SPINTFLD,%1 WITH CC FIELD = ZERO
BFNZ,XT CCFLD,%1
AND,XT =VALFLD SAVE VALUE
BEZ %1 VALUE IS LESS THAN 1
CI,XT 255
BLE %2 BRANCH IF VALUE OKAY
%1 RES 0
BAL,ER EERR
LI,XT 1 USE 1
%2 RES 0
STW,XT SUB#
EXIT RL
PAGE
*
* S Y S E N D
* THIS SUBROUTINE DECREMENTS SYSTEM LEVEL WHEN AN END
* DIRECTIVE IS ENCOUNTERED, AND RESTORES LISTING CONTROL
* TO THE CONDITIONS IN EFFECT AT THE TIME THE SYSTEM
* DIRECTIVE WAS ENCOUNTERED
*
SYSEND RES 0
STW,RL SYSEXIT SAVE RETURN ADDRESS
MTW,0 SYSLEVEL
BEZ SYSEND1 BRANCH IF END OF PROGRAM
BAL,RL PRINTC1 PRINT THE END LINE
MTW,-1 SYSLVL,LVL
SYSEND1 RES 0
MTW,-1 SYSLEVEL DECREMENT SYSTEM LEVEL
BNEZ *SYSEXIT EXIT IF NOT BACK TO SOURCE LEVEL
LI,XT 0 RESET SYSTEM LISTING CONTROL BIT
LV,XT1 PSTRIGFLD MASK FOR PSTRIG FIELD
STS,XT NOLIST RESET 'SYSTEM' LIST CONTROL BIT
B *SYSEXIT
PAGE
*
* S Y S S U B
* THIS SUBROUTINE INCREMENTS SYSTEM LEVEL WHEN A SYSTEM
* DIRECTIVE IS ENCOUNTERED, AND ESTABLISHES LISTING
* CONTROL FOR ALL LINES WITHIN THE SYSTEM/END PAIR
*
SYSSUB RES 0
STW,RL SYSEXIT SAVE RETURN ADDRESS
BAL,RL PRINTC2 PRINT IF THERE IS A SOURCE LINE
LW,XT PSTRIG VALUE FOR SYSTEM LISTING CONTROL
LV,XT1 PSTRIGFLD MASK FOR PSTRIG FIELD
STS,XT NOLIST STORE SYSTEM LISTING CONTROL BIT
MTW,1 SYSLVL,LVL
MTW,1 SYSLEVEL INCREMENT SYSTEM LEVEL
B *SYSEXIT
PAGE
*
* S Y S T E M
* THIS ROUTINE PROCESSES THE SYSTEM DIRECTIVE. IF THE SYSTEM TYPE
* FIELD (SYSTYPE)IS ZERO, THIS IS A PRE-ENCODED SYSTEM;
* LINESKIP IS CALLED AND SYSTEM RETURNS TO GENR. IF SYSTYPE IS
* ONE, THE SYSTEM WAS NOT FOUND. THE SYSTEM NAME IS COPIED FROM
* THE ENCODED TEXT FILE TO AN ABORT MESSAGE, AND XAP ABORTS.
* IF SYSTYPE IS GREATER THAN ONE, THE SYSTEM IS IN SOURCE
* FORMAT. SYSLEVEL IS INCREASED, AND PSTRIG IS STORE IN THE
* PSTRIG FIELD OF NOLIST. THEN, IF SYSLEVEL IS ONE, THE SYSTEM
* NAME IS COPIED FROM THE ENCODED TEXT FILE TO AN ABORT MESSAGE
* FOR LATER POSSIBLE USE.
*
* INPUT: XW CONTAINS AN INDEX TO THE ENCODED TEXT ITEM
* CONTAINING SYSTYPE
*
* OUTPUT: XW CONTAINS AN INDEX TO THE BEGINNING OF THE NEXT
* ENCODED LINE.
*
* USES REGISTERS
* XT
* XT1
* XT2
* RL
* XW
*
SYSTEM RES 0
BAL,RL NOTDO1 ERROR IF PRECEEDED BY A DO1
NXTENC GET SYSTYPE
AND,XT =SYSTYPEFLD
BEZ LINE5 PRE-ENCODED SYSTEM FILE
CI,XT 1**(31-SYSTYPELOB)
BE SYSTEM4 SOURCE FILE NOT FOUND
LW,XT SYSLEVEL
BNEZ SYSTEM3 NOT FIRST LEVEL OF SYSTEM DIRECTIVES
AI,XW 1 SKIP THE MULTI-INTEGER CONTROL WORD
SLS,XW 1 CHANGE HALFWORD INDEX TO BYTE INDEX
LB,RL *XWBASE,XW LOAD CHARACTER COUNT
STB,RL SYSNAME # OF CHARS IN SYSTEM NAME
SYSTEM2 RES 0
AI,XW 1 INCREMENT 'FROM' INDEX
LB,XT2 *XWBASE,XW MOVE SYSTEM NAME FROM ENCODED TEXT
AI,XT 1 INCREMENT 'TO' INDEX
STB,XT2 SYSNAME,XT TO SYSNAME
BDR,RL SYSTEM2 CONTINUE UNTIL ALL CHARS MOVED
SLS,XW -1 CHANGE BYTE INDEX TO HALFWORD INDEX
AI,XW 1
SYSTEM3 RES 0
BAL,RL SYSSUB INCREMENT SYSTEM LEVEL
B LINE5 SKIP REST OF SYSTEM DIRECTIVE
SYSTEM4 RES 0
LW,XT XWBASE BASE ADDRESS OF ENCODED TEXT
ABORT ABORT0 UNABLE TO FIND SYSTEM
PAGE
*
* T E X T
* THIS ROUTINE PROCESSES THE TEXT DIRECTIVE. TXTFLG IS SET TO
* INDICATE TEXT PROCESSING AND A BRANCH IS MADE TO TEXTC1.
*
*
* USES REGISTERS
* XT
*
TEXT RES 0
LI,XT 0 IDENTIFY TEXT DIRECTIVE
B TEXTC1
PAGE
*
* T E X T C
* THIS ROUTINE PROCESSES THE TEXTC DIRECTIVE. TXTFLG IS SET TO
* INDICATE TEXTC PROCESSING.
* PROCESSING WHICH IS COMMON TO BOTH TEXT AND TEXTC BEGINS AT
* TEXTC1. THE EXECUTION LOCATION COUNTER IS ADVANCED TO A WORD
* BOUNDARY AND THE LABEL IS DEFINED. THE OPERAND FIELD IS THEN
* EVALUATED AND TEXTGEN IS CALLED TO PROCESS THE TEXT
* CHARACTERS. THEN,IN THE DEFINITION PASS, BOTH LOCATION
* COUNTERS ARE INCREASED BY THE NUMBER OF CHARACTERS PROCESSED.
* IN THE GENERATION PASS, THE TEXT CHARACTERS ARE OUTPUT, FOUR
* CHARACTERS AT A TIME, TO BOTH THE BINARY AND LISTING FILES.
*
* USES REGISTERS
* XT
* RL
* XT2
* TX1
*
TEXTC RES 0
LI,XT 1 IDENDIFY TEXTC DIRECTIVE
TEXTC1 RES 0
STW,XT TXTFLG
BAL,RL BOUND4 ADVANCE % TO A WORD BOUNDARY
LV,XT SDTEXTC SET SD TYPE TO 'EBCDIC TEXT'
STW,XT SD%TYPE
BAL,RL DEFLBL DEFINE THE LABEL
CALL EV%CLN%OPRND EVALUATE THE OPERAND FIELD
BAL,RL TEXTGEN PROCESS THE TEXT CHARACTERS
MTW,0 PASS
BNEZ TEXTC2 GENERATION PASS
AWM,XT2 DLRVAL ADVANCE BOTH LOCATION COUNTERS BY
AWM,XT2 DDLRVAL THE NUMBER OF CHARACTERS GENERATED
B GENR BACK TO MAIN CONTROL
TEXTC2 RES 0
CI,XT2 0
BE GENR NO TEXT STRING
BAL,RL ORIGIN PRODUCE ORIGIN CONTROL
LI,XT 4
STW,XT NOBYTES NUMBER OF BYTES TO OUTPUT
LI,XT 'A'
STW,XT CODE
TEXTC3 RES 0
LW,XT *DESTIN
STW,XT HEXVAL LOAD NEXT 4 BYTES TO OUTPUT
BAL,RL LOADABS OUTPUT AS ABSOLUTE TO BINARY FILE
LI,XT1 BA(HEXVAL)
BAL,RL EDIT LIST % LOC COUNTER AND 4 CHARS
MTW,1 DESTIN ADDRESS OF NEXT 4 BYTES TO OUTPUT
MTW,-4 TOTALCT REDUCE TOTAL BYTE COUNT BY 4
BGZ TEXTC3 MORE TO OUTPUT
B GENR BACK TO MAIN CONTROL
PAGE
*
* T E X T G E N
* THIS ROUTINE PROCESSES THE CHARACTER STRING(S) APPEARING IN
* THE TEXT AND TEXTC DIRECTIVES.
*
* T E X T M R G E
* THIS IS AN ALTERNATE ENTRY TO TEXTGEN TO PROCESS THE CHARACTER
* STRING(S) APPEARING IN THE TITLE AND ERROR DIRECTIVES.
* IN EITHER CASE, THE CHARACTERS ARE
* EXTRACTED FROM THE EVT ENTRIES AND CONCATINATED TO FORM ONE
* CONTINUOUS CHARACTER STRING WHICH OVERLAYS THE ORIGINAL EVT
* AREA. EVT ENTRIES WHICH ARE NOT CHARACTER CONSTANTS ARE
* FLAGGED AS AN ERROR AND SKIPPED. IF THE PROCESSING IS FOR
* TEXTC THE FINAL CHARACTER STRING IS PRECEEDED BY A CHARACTER
* COUNT TRUNCATED TO 255. TEXT AND ERROR CHARACTER STRINGS
* MAY BE OF ANY LENGTH. IF THE FINAL CHARACTERS DO NOT FILL A
* WORD, THE LAST WORD IS PADDED WITH BLANK CHARACTERS.
*
* INPUT: TXTFLG INDICATES THE TYPE OF CHARACTER STRING TO
* GENERATE (TEXT OR TEXTC)
* THE EXPRESSION TABLES (ECT AND EVT) CONTAIN THE
* CHARACTER CONSTANTS TO PROCESS.
*
* OUTPUT: TOTALCT AND REGISTER XT2 CONTAIN THE NUMBER OF CHARS
* IN THE FINAL STRING, INCLUDING TRAILING BLANKS.
* DESTIN CONTAINS THE ADDRESS OF THE FIRST WORD OF
* THE CHARACTER STRING GENERATED.
*
* CALL: BAL,RL TEXTGEN ( TEXT AND TEXTC )
* BAL,RL TEXTMRGE (TITLE AND ERROR)
*
* USES REGISTERS
* XT
* XT1
* XT2
* RL
*
TEXTMRGE RES 0
LI,XT 0
STW,XT TXTFLG PRODUCE 'TEXT' FORMAT
TEXTGEN RES 0
STW,RL TEXTEXIT
LW,XT2 LSTCT
BEZ TEXTGEN6
LW,XT 0,XS
AW,XT KLINE ADDRESS OF FIRST EVT ENTRY
STW,XT DESTIN DESTINATION WORD ADDRESS
LW,XT2 TXTFLG BYTE INDEX TO DESTINATION
TEXTGEN1 RES 0
LW,XT 0,XS
AW,XT KLINE ADDRESS OF NEXT EVT ENTRY
LW,XT1 0,XT
LV,RL DEFFLD
AND,RL XT1
CW,RL PASSDEF
BNE TEXTGEN9 NOT DEFINED FOR CURRENT PASS
BFZ,XT1,1 SPAFLD,TEXTGEN7 BRANCH IF NOT A ONE WORD ITEM
BFZ,XT1 SPINTFLD,TEXTGEN8 BRANCH IF NOT A SPECIAL INTEGER
AND,XT1 =CCFLD
BEZ TEXTGEN8 SPEC. INT. IS NOT A CHAR CONSTANT
SHIFT,XT1 CCLOB,31 RIGHT JUSTIFY CHARACTER COUNT
SLS,XT 2
AI,XT 3 GET BYTE ADDRESS-1 OF THE FIRST
SW,XT XT1 CHARACTER TO LOAD
TEXTGEN2 RES 0
AI,XT 1 INCREMENT THE LOAD INDEX
LB,RL 0,XT CONCATINATE THIS CHARACTER INTO
STB,RL *DESTIN,XT2 A SINGLE CHARACTER STRING.
AI,XT2 1 INCREMENT THE DESTINATION INDEX
BDR,XT1 TEXTGEN2 MORE TO MOVE
TEXTGEN3 RES 0
AI,XS -1 POINTER TO NEXT ECT ENTRY
MTW,-1 LSTCT DECREMENT LIST COUNT
BGZ TEXTGEN1 MORE VALUES IN EVT
LW,RL XT2 CHARACTER COUNT FOR TEXTC
TEXTGEN4 RES 0
LI,XT 3
AND,XT XT2
BEZ TEXTGEN5 NO MORE BLANKS TO PAD
LI,XT X'40'
STB,XT *DESTIN,XT2 PAD THE LAST WORD WITH BLANKS
AI,XT2 1 INCREMENT THE DESTINATION INDEX
B TEXTGEN4 CONTINUE PADDING BLANKS
TEXTGEN5 RES 0
MTW,0 TXTFLG
BEZ TEXTGEN6 PROCESSING TEXT DIRECTIVE
AI,RL -1
STB,RL *DESTIN STORE TEXTC CHARACTER COUNT
CI,RL 255
BLE TEXTGEN6
BAL,ER TERR TOO MANY CHARACTERS IN STRING
LI,XT2 256
TEXTGEN6 RES 0
STW,XT2 TOTALCT NUMBER OF CHARACTERS IN STRING
B *TEXTEXIT INCLUDING TRAILING BLANKS
TEXTGEN7 RES 0
AND,XT1 =(TYPEFLD+CTYPEFLD)
CV,XT1 CONSTANT+CHSTR
BNE TEXTGEN8 ITEM IS NOT A CHARACTER CONSTANT
SLS,XT 2 GET THE BYTE ADDRESS OF THE CHAR
AI,XT 4 COUNT WHICH PRECEDES THE STRING
LB,XT1 0,XT LOAD THE STRING COUNT
BEZ TEXTGEN3 NO CHARACTERS TO PROCESS
B TEXTGEN2 BYTE ADDRESS OF 1ST CHARACTER
TEXTGEN8 RES 0
BAL,ER CERR EVT ENTRY IS NOT A CHAR CONSTANT
B TEXTGEN3 SKIP THIS VALUE
TEXTGEN9 RES 0
BAL,ER UERR UNDEFINED
B TEXTGEN3 SKIP THIS ENTRY
PAGE
*
* T I T L E
* PROCESS THE TITLE DIRECTIVE
* THE FIRST TITLE IN THE DEFINITION PASS IS RETAINED FOR
* THE GENERATION PASS
*
LOCAL %1,%2,%3,%4,%5
TITLE RES 0
*
CALL EV%CLN%OPRND EVALUATE THE OPERAND FIELD
LW,XT TITLENUM SAVE THE FIRST TITLE LINE IN
BEZ %1 THE DEFINITION PASS
LW,XT PASS
BEZ GENR
%1 RES 0
MTW,1 TITLENUM BUMP NUMBER OF TITLE DIRECTIVES
BAL,RL TEXTMRGE PROCESS TEXT STRING
LW,XT =' '
LI,XT1 -17 BLANK OUT THE TITLE LINE
%4 RES 0
STW,XT TITLEPG,XT1
BIR,XT1 %4
LW,XT TOTALCT NUMBER OF BYTES IN THE TITLE
CI,XT 68 USE 68 BYTES IF TOO MANY ARE THERE
BLE %2
LI,XT 68
%2 RES 0
SLS,XT -2 CONVERT BYTE COUNT TO WORDS
%3 RES 0
AI,XT -1
BLZ PAGE1 TO CLEAR NO. LINES ON THE PAGE
LW,XT1 *DESTIN,XT MOVE THE TITLE CHARACTERS
STW,XT1 TITLEBUF+7,XT TO THE TITLE
B %3
PAGE
*
* U S E C T
* PROCESSES THE USECT DIRECTIVE. THE CS NUMBER OF THE NAME
* SPECIFIED IN THE OPERAND FIELD IS USED TO LOCATE A CONTROL
* SECTION TABLE ENTRY, AND THE SAVED RESOLUTION AND OFFSET
* ARE STORED IN DLRRS, DLRVAL, DDLRRS, AND DDLRVAL. THE
* CONTROL SECTION NUMBER IS STORED IN DLRCS AND DDLRCS.
*
* USES REGISTERS
* RL
* XT
* XT1
* XT2
*
USECT RES 0
*
CALL DEFHEXLBL DEFINE THE LABEL
CALL SCANOPRND EVALUATE THE OPERAND FIELD
BAL,RL OLDCSECT SAVE DLRVAL AND MAX DDLRVAL
SW,XS KLINE
AI,XS -1
STW,XS ECT,LVL ADJUST POINTER FOR SCCS SUBROUTINE
BAL,RL SCCS GET CONTROL SECTION NUMBER
AND,TR1 =DEFFLD
CW,TR1 PASSDEF
BNE EXP%ERR ILLEGAL OPERAND
CI,XT2 0
BL EXP%ERR ILLEGAL OPERAND
STW,XT2 DLRCS STORE CONTROL SECTION NUMBER TO
STW,XT2 DDLRCS DLRCS AND DDLRCS
BAL,RL GETCSADD GET CONTROL SECTION TABLE ADDRESS
LW,XT 0,XT2 GET RESOLUTION AND SAVED % VALUE
LV,XT1 SAVDLRFLD
STS,XT DLRVAL SET DLRVAL AND DDLRVAL TO SAVED
STS,XT DDLRVAL VALUE OF %
SHIFT,XT RSLOB,31 RIGHT JUSTIFY RS
LV,XT1 RSFLD**(RSLOB-31)
STS,XT DLRRS SET DLRRS AND DDLRRS TO SAVED
STS,XT DDLRRS RESOLUTION
B GENR BACK TO MAIN CONTROL
END