 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

