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