 TITLE 'TELEFILE ASSEMBLY PROGRAM - APNCD'
         PCC      0
         SPACE    6
*   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
*   %%%%%     MODULE NAME:     APNCD                   %%%%%
*   %%%%%     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
NCDP     CSECT    1                 PROCEDURE & STATIC DATA
*
         SYSTEM   AP%IL
*
         DEF      NCDP              (FOR MAP)
         DEF      NCDR              ENTRY POINT
         DEF      NCDREND           END OF ENCODER PROCEDURE
         DEF      CNTERM
         DEF      LINK
         REF      ABORT
         REF      DC%FLAG
         REF      DEDIT             BINARY TO EBCDIC DECIMAL CONVERSION
         REF      HWX1SIZE
         REF      OPENX5            OPEN THE SYMT SPILL FILE
         REF      POSITIONX3
         REF      READX5
         REF      REWX3
         REF      SDFCON
         REF      WDX1SIZE
         REF      WRITELO
         REF      WRITEX3
         REF      WRITEX5
         REF      READX1,WRITEX1,REWX1,POSITIONX1
         REF      BYX3SIZE,HWX3SIZE,WDX3SIZE
         REF      READSTD,WRITESTD,REWSTD
         REF      NEXTST,NXSYMB
         REF      EOF%FLAG
         REF      MAJLINE,SUBLINE   ASSEMBLY LINE NUMBER
IM@MAJOR EQU      MAJLINE
IM@MINOR EQU      SUBLINE
         REF      ND%FLAG
         REF      PD%FLAG
         REF      LS%FLAG
         REF      ENDCORE
         REF      LOWCORE
         REF      SAVAREA
         REF      VAL%S:IVAL        VALUE OF S:IVAL (FROM SYSTEM)
         REF      BUFSI
         REF      FIN%X1
         REF      IM@READ
         REF      IM@NAME,IM@COPY
         REF      IM@SYS
         REF      IM@END
         REF      NIVO
         REF      READC
         REF      X1BUF,X3BUF
         REF      LSTBF,CLRLSTBF
         REF      ROOTRTN
         REF      CIREC#,#BLANKS,LAST%UPDATE,NEXT%UPDATE
         REF      SKIP%COUNT,UPDATE%LINE%COUNT,PLUS,COMPTE%CI
         REF      CIRDREGS,CO%BUF,CO%REGI
XAPD1    DSECT    0
*
*    'I S'   P R O C E D U R E
*
*        GENERATES THE SYNTAX TABLE, ONE STATEMENT (EQUATION) AT A TIME
*
*        ITEMS ARE SEPARATED BY COMMAS, AND MUST BE ONE OF THE FOLLOWING
*
*             (A)  A CHARACTER.  SPECIFIED AS A CHARACTER CONSTANT, OR
*                  A HEX OR INTEGER CONSTANT LESS THAN 256.
*
*             (B)  REFERENCE TO SYNTAX STATEMENT. WRITE THE NAME OF
*                  THE STATEMENT.
*
*             (C)  REFERENCE TO A SEMANTIC ROUTINE.  WRITE THE NAME OF
*                  THE SEMANTIC ROUTINE.
*
*        FORMAT OF EACH GENERATED SYNTAX ELEMENT:
*             TYPE: 2 BITS
*                00=CHARACTER
*                01=SEMANTIC ROUTINE REFERENCE
*                10=SYNTAX EQUATION REFERENCE
*             'OR' INCREMENT: 4 BITS
*                CONTAINS NO. OF SYNTAX ENTRIES FROM HERE TO THE
*                NEXT 'OR' OR 'ENDEQN' ENTRY
*
*             ADDRESS: 10 BITS
*                 FOR TYPE 00 - THE CHARACTER
*                 FOR TYPE 01 - OFFSET FROM LOCATION 'SEMANBAS' (WORDS)
*                 FOR TYPE 10 - OFFSET FROM LOCATION 'SYNTAX' (HALF-WDS)
*
*             EXCEPTION: THE ELEMENT FOLLOWING A 'WRITE' ELEMENT IS
*                 GENERATED AS A 16-BIT VALUE, SO THAT ALL 16 BITS
*                 MAY BE OUTPUT BY THE WRITE ROUTINE.
*
*             ALL OF THE SYNTAX STATEMENTS MUST RESIDE IN LOWER CORE
*                 THAN SEMANTIC ROUTINES, OR THE PROC WILL NOT GENERATE
*                 THE CORRECT RESULTS.
*
PASS     SET      S:UFV(PASS)+1     SET A PASS SWITCH
IS       CNAME
         PROC
         ERROR,0,NUM(LF)=0   'MISSING LABEL'
LF       RES,2    0                 DEFINE THE LABEL
         DO       PASS=1
         RES,2    NUM(AF)+1
         ELSE
IND      SET      1                 INDICATOR TO INDICATE 1ST GROUP
GNUM     SET      1                 TOTAL NUMBER OF GROUPS
GRPCT    SET      0                 SET ALL GROUP COUNTS TO ZERO
* NOW COUNT THE GROUPS, AND THE NUMBER OF ELEMENTS IN EACH
* A GROUP IS ZERO OR MORE SYNTAX ELEMENTS, TERMINATED BY AN 'OR'
*   ELEMENT OR THE END OF THE EQUATION.
I        DO       NUM(AF)
         DO       SCOR(AF(I),OR)
IND      SET      IND**4            SHIFT INDICATOR FOR NEXT GROUP
GNUM     SET      GNUM+1            BUMP NUMBER OF GROUPS
         ELSE
GRPCT    SET      GRPCT+IND         ADD TO COUNT IN CURRENT GROUP
         FIN
         FIN
* GROUPS ARE COUNTED, AND SO ARE THE ELEMENTS IN EACH GROUP
* NOW TO GENERATE FOR EACH ITEM
I        SET      1                 TO SEQUENCE THRU ARGUMENT FIELD
A        SET      0                 LAST-ELEMENT-IS-'WRITE',FLAG
         ERROR,3,GNUM>16  'TOO MANY ''OR'' ELEMENTS'
         DO       GNUM              GNUM CONTAINS NUMBER OF GROUPS
II       SET      GRPCT&15          II CONTAINS ELEMENTS IN EACH GROUP
GRPCT    SET      GRPCT**(-4)       SHIFT FOR NEXT GROUP
         DO       II
         DO       A
         DATA,2   AF(I)             PREVIOUS ELEMENT WAS 'WRITE'
         ELSE
         DO       CS(S:UFV(AF(I)))=0   IS ELEMENT A CHARACTER
         ISGEN    0,II,AF(I)        CHARACTER
         ELSE
         DO       S:UFV(WA(AF(I))<SEMANBAS)
         ISGEN    2,II,AF(I)-SYNTAX   SYNTAX EQUATION REFERENCE
         ELSE
         ISGEN    1,II,AF(I)-SEMANBAS SEMANTIC ROUTINE REFERENCE
         FIN
         FIN
         FIN
A        SET      SCOR(AF(I),WRITE)
II       SET      II-1
I        SET      I+1
         FIN
* THAT'S THE END OF A GROUP. NOW OUTPUT THE 'OR' OR 'ENDEQN' ELEMENT
*
         DO       I>NUM(AF)
         ISGEN    1,0,ENDEQN-SEMANBAS
         ELSE
         ISGEN    1,0,OR-SEMANBAS
I        SET      I+1
         FIN
         FIN
         FIN
         PEND
ISGEN    CNAME
         PROC
         GEN,2,4,10  AF(1),AF(2),AF(3)
         PEND
*
         CLOSE    A,GNUM,GRPCT,I,II,IND,PASS
*
*  EQUATES FOR ABORT
*
AR       EQU      0                 ABORT REGISTER
ABORT3   EQU      3
ABORT4   EQU      4
ABORT21  EQU      21                STATEMENT TOO LONG         /27493/*D-NCD
         PAGE
*
*  STORAGE
DRIVEREXIT  RES   1
LASTCMND RES      1                 COMMAND ON LAST LINE
LASTIN   RES      1                 INDEX TO LAST INPUT CHARACTER
LOCX     RES      1                 LOCATION FOR NEXT LOCAL SYMBOL
SDFCONNCDR  RES   1                 ADDRESS OF SYSTEM NAME TABLE
#SYSITEM RES      1                 NUMBER OF SYSTEM NAMES
PLOC     RES      1                 ORIGIN OF PROC LEVEL LOCAL TABLE
PROCLV   RES      1                 NON-ZERO BETWEEN PROC AND PEND
         RES      ABSVAL(%)&1       BOUND 4 WITH NO DATA GENERATED
HED      RES      20                ROOT OF BALANCED TREE SYM TAB
GET2REGS RES      8                 MUST BE ON DBL. WORD BOUND
NSRTR1   RES      2                 TEMP IN INSERT
NSRTR2   EQU      NSRTR1+1
ALFLAG   RES      1                 NON-ZERO WHEN IN A TEXT STRING
BUFPTR   RES      1
CARDADDR RES      1
CHARTEMP RES      1                 TEMP IN CHAR
CMPCHAR  RES      1                 TEMP IN READCARD
CNCTRL   RES      1                 NZ = READING CN CONTROLS
CONTIN%ERROR  RES 1                 NZ FOR ERROR IN CONTINUATION
CREATE1STV  RES   1                 ENTRY TO CREATE1ST
CRE8XIT  RES      1                 XTRA XIT IN SEARCH/CREATE1ST
CURRCMND RES      1                 COMMAND ON CURRENT LINE
CURLOCNT RES      1                 LOCALS ON CURRENT LINE
DIR      RES      1                 DIR FLAG IN SPILL MODE
DSLNCTRL RES      1                 FLAG FOR  LINE PRINT UNDER .DS CN CTL
FIRSTREC RES      1
FND      RES      1                 FOUND ADDRESS IN SEARCH
INBUF    RES      1                 ADDRESS OF INPUT BUFFER ORIGIN
INBUFLMT RES      1                 FIXED BUF START FOR DISK SPILL LOGIC
INCOREB# RES      1                 BLOCK # OF SPILLED SYMT IN CORE
INCOREBMAX  RES   1                 MAX BLOCK EVER WRITTEN
         RES      ABSVAL(%)&1
INCORELH RES      0                 VIRTUAL ADDRESS BOUNDS
INCOREL  RES      1                 LO VIRTUAL ADDR OF SPILLED PAGE
INCOREH  RES      1                 HI VIRTUAL ADDR OF SPILLED PAGE
INCORESF RES      1                 NZ = CORE PAGE STORED INTO
INSERTV  RES      1                 ENTRY TO INSERT ITEM IN SYMT
LVLBASE  RES      1
M0       RES      1                 TEMP IN SEARCH AND INSERT
M1SAVE   RES      1                 TEMP IN MAP%ADDR
NEWENTRYV   RES   1                 ENTRY TO NEWENTRY
NEXTLINE#  RES    1                 OUTBUF INDEX FOR NEXT LINE NUMBER
NUMRECX3 RES      1                 NUM REC IN X3
NXTLOC   RES      1                 NUMBER OF ACTIVE LOCALS
SEARCHV  RES      1                 ENTRY TO SEARCH SYMT
SIGFLAG  RES      1                 TEMP IN SYSTEM
SLOC     RES      1                 ORIGIN OF SOURCE LEVEL LOCAL TABLE
SPILLFLG RES      1                 NZ = SYMT-SPILL MODE
SRCHXIT  RES      1                 EXIT ADDRESS FOR VARIOUS SYMT RTNS.
SYMLMT   RES      1                 OFF SET OF SPILL PAGE
SYMLMTM1 RES      1                 OFFSET OF SPILL PAGE (-1)
SYMLMTM18   RES   1                 OFFSET OF SPILL PAGE (-18)
SYMTLMT  RES      1                 ADDRESS OF SPILLED SYMT PAGE
WDOUTRTN RES      1
NUMRECX1 RES      1                 NUM REC IN X1
FIRSTST  RES      1                 1ST SYMBOL TABLE LOC
XTSAVE   RES      1
OVFLAG   RES      1                 OVERFLOW FLAG
OUTSAVE  RES      1                 START OF ENCODED LINE
CMPOUTSV RES      1                 START OF COMP IMAGE
         PAGE
*
*   STATIC DATA
*
         USECT NCDP
*
         BOUND    8
ZERO     DATA     0,0
P1       DATA     1,2
RNG%DFN%DIR       ;
         DATA     CNAMEDIR,FNAMEDIR
RNG%SPC%DIR       ;                 SPECIAL DIRECTIVE #'S IN STLOOP
         DATA     PENDDIR,FNAMEDIR
RNG%SYN%DIR       ;
         DATA     CLOSEDIR,PAGEDIR
ACUMSPCH TEXTC    'BE..'
         PAGE
*
*   MISCELLANEOUS EQUATES
*
FFFSAVE  EQU      HED+2             12 WORDS OF TEMP IN FLT PT
ACUMLNK  EQU      M0                RETURN FROM ACUM
SIGNLNK  EQU      NSRTR1            RETURN FROM SIGN
FFFGNCLNK  EQU    NSRTR2            RETURN FROM FFFGNC
LVLTBL   EQU      0
OUTBUF   EQU      X1BUF             ENCODED OUTPUT BUFFER
OUTSIZE  EQU      HWX1SIZE          SIZE OF OUTBUF (IN HALFWORDS)
SIBUF    EQU      X3BUF             COMPRESSED SOURCE RECORD BUFFER
CF1BUF   EQU      SIBUF
SYMBUF   EQU      OUTBUF
FIRSTSTSDF  EQU   OUTBUF            STD DEF FILE FIRSTST
NEXTSTSDF   EQU   OUTBUF+1          STD DEF FILE NEXTST
NXSYMBSDF   EQU   OUTBUF+2          STD DEF FILE NXSYMB
HEDSDF      EQU   OUTBUF+3          STD DEF FILE HED
SDFCONSDF   EQU   OUTBUF+4          STD DEF FILE SDFCON
         PAGE
*
*  EQUATES FOR THE SYNTAX EQUATIONS FOLLOWING A 'WRITE'
*
ENDBUF     EQU    X'20FF'           END OF BUFFER
ENDLN      EQU    0                 END OF LINE
ENDLIST    EQU    2                 END LIST
ENDSBSYM   EQU    3                 END SUBSCRIPTED SYMBOL
ENDEXP     EQU    4                 END EXPRESSION
BLANKEXP   EQU    5                 BLANK EXPRESSION
BEGINLIST   EQU   X'6'              BEGIN LIST
BEGINEXP EQU      X'7'              BEGIN EXPRESSION
INDIROP  EQU      X'8'              INDIRECT OPERATOR
TRUNERR  EQU      X'9'              TRUNCATION ERROR
SYNERR   EQU      X'A'              SYNTAX ERROR
OROP       EQU    32
XOROP      EQU    33
ANDOP      EQU    34
EQUALOP    EQU    35
UNEQLOP    EQU    36
GTEQOP     EQU    37
LTEQOP     EQU    38
GRTROP     EQU    39
LESSOP     EQU    40
MINUSOP    EQU    41
PLUSOP     EQU    42
DIVOP      EQU    43
INCLDIV    EQU    44
MPYOP      EQU    45
SCALEOP    EQU    46
SYMTYPE    EQU    X'4000'           SYMBOL
SBSYM      EQU    X'8000'           SUBSCRIPTED SYMBOL
SMALLINT   EQU    X'C000'           SMALL INTEGER
LARGEINT   EQU    X'E000'
*  LARGE INTEGER CONVERSION TYPES
CT1      EQU      X'100'
CT2      EQU      X'200'
CT3      EQU      X'300'
CT4      EQU      X'400'
CT5      EQU      X'500'
ENCTLOB  EQU      2+16              ENCODED TYPE FIELD LOB
ENCTYPE    EQU    X'E000'           ENCODE TYPE FIELD
ENCVAL     EQU    X'1FFF'           VALUE FIELD
ADDRSIZE EQU      10
ADDRESS  EQU      1**ADDRSIZE-1
INCRSIZE EQU      4
INCR     EQU      (1**INCRSIZE-1)**ADDRSIZE
TYPESIZE EQU      2
TYPE     EQU      (1**TYPESIZE-1)**(INCRSIZE+ADDRSIZE)
NOTINCR  EQU      X'C3FF'
*
*   CN PROCESSING
*
CNFLGFLD EQU      X'00FE0000'       ALL INTERESTING CN FLAGS
CNDSFLG  EQU      X'020000'
CNDSMODE EQU      6
CNERR    EQU      2**(31-ENCTLOB)
CNIOFLG  EQU      X'00800000'       .IO
CNIOFLG1 EQU      X'00400000'       .IO NAME-LIST
CNIOMODE EQU      3
CNOSFLG  EQU      X'00080000'       .OS
CNOSMODE EQU      5
CNSSFLG  EQU      X'00200000'       .SS
CNSSFLG1 EQU      X'00100000'       .SS NAME-LIST
CNSSMODE EQU      4
*
*   MISCELLANEOUS
TAB      EQU      5
*
* REGISTER ASSIGNMENTS
*
XT       EQU      1                 TEMP
IN       EQU      2                 INDEX TO INBUF (BYTE)
OUT      EQU      3                 INDEX TO OUTBUF (HALFWORD)
SYN      EQU      4                 INDEX TO SYNTAX TBL (HALFWORD)
LVL      EQU      5                 INDEX TO SYNTAX LEVEL TBL (WORD)
N        EQU      6                 TEMP
LL       EQU      6                 SYMBOL TABLE LINK
CRG      EQU      7                 CONTAINS CURRENT INPUT CHARACTER
RT1      EQU      8                 TEMP
RT2      EQU      9                 TEMP
RT3      EQU      10                TEMP
RT4      EQU      11                TEMP
LINK     EQU      13                LINK REG FOR INPUT MODULE.
CT       EQU      14                TEMP
RL       EQU      15                LINK REG FOR SUBROUTINE CALLS
RT5      EQU      RL                TEMP IN SEARCH
U        EQU      N                 SEARCH AND INSERT
V        EQU      SYN               SEARCH AND INSERT
W        EQU      LVL               SEARCH AND INSERT
X        EQU      7                 SRCHIST
VWX      EQU      1                 SRCHIST
M1       EQU      7                 SRCHIST
SR1      EQU      8                 ************************************
SR2      EQU      9                 ************************************
SR3      EQU      10
X1       EQU      1
X2       EQU      2
X3       EQU      3
X4       EQU      4
X5       EQU      5
X6       EQU      6
X7       EQU      7
IOADD    EQU      8                 I/O BUFFER ADDRESS
IOSIZE   EQU      9                 I/O BUFFER SIZE
IORL     EQU      10                I/O RETURN LINK REGISTER
         PAGE
*
* FIELDS AND MASKS FOR THE BALANCED TREE SYMBOL TABLE
*
DIRFLD   EQU      X'40000'          DIRECTION FIELD
LLWD     EQU      HED               WORD CONTAINING LESSER LINK
GLWD     EQU      HED+1             WORD CONTAINING GREATER LINK
SYM1     EQU      HED+2             1ST WORD CONTAINING CHARACTERS
WDCTWD   EQU      HED               WORD CONTAINING WDCT FIELD
BALWD    EQU      HED               WORD CONTAINING BALANCE FIELD
DIRWD    EQU      HED               WORD CONTAINING DIRECTION FIELD
BALFLD   EQU      X'30000'          BALANCE FIELD
SNWD     EQU      HED+1             WORD CONTAINING SYMBOL NUMBER
PTRWD    EQU      HED               WORD CONTAINING PTR FIELD
PTRLOB   EQU      9                 PTR FIELD POSITION
PTRFLD   EQU      1**(31-PTRLOB)    PTR FIELD
CLOFLD   EQU      X'200000'         CLO FIELD
DSSYMBIT EQU      X'00100000'       SYMT FLAG FOR .DS CN NAME
CF1FLD   EQU      X'800000'         CF1 FIELD
GLFLD    EQU      X'FFFF'           GREATER LINK FIELD
LLFLD    EQU      X'FFFF'           LESSER LINK FIELD
SNFLD      EQU    X'FFFF0000'
BOFFSET    EQU    BALWD-HED
DOFFSET    EQU    DIRWD-HED
GLOFFSET   EQU    GLWD-HED
LLOFFSET   EQU    LLWD-HED
PTROFFSET  EQU    PTRWD-HED
SNOFFSET   EQU    SNWD-HED
         PAGE
*
*   D I R E C T I V E   B R A N C H   T A B L E
*
DIRBR    RES      0
         HALF,SYNTAX              0 COMMENT
         HALF     CLOSE           1
         HALF     LOCAL           2
         HALF     OPEN            3
         HALF     SYSTEM          4
         HALF     PROC            5
         HALF     0               6 PEND
         HALF     0               7 END
         HALF     0               8 DATA
         HALF     SKIP%OPERAND    9 ASECT
         HALF     SKIP%OPERAND    A SOCW
         HALF     SKIP%OPERAND    B ELSE
         HALF     SKIP%OPERAND    C FIN
         HALF     SKIP%OPERAND    D PAGE
         BOUND    8
*
*   I N T R I N S I C   S Y M B O L   T A B L E
*
I:#      SET      0                 INTRINSIC SYMBOL #
*
ISYM     CNAME
         PROC
I:#      SET      I:#+1             TO NEXT #
LF       EQU      I:#               DEFINE A POSSIBLE LABEL
         TEXTC    AF(1)
         PEND
*
         BOUND    4
INTBLO   RES      0
COMNT#   EQU      I:#               COMMENT 'DIRECTIVE'
CLOSE#   ISYM     'CLOSE'
LOCAL#   ISYM     'LOCAL'
OPEN#    ISYM     'OPEN'
SYSTEM#  ISYM     'SYSTEM'
PROC#    ISYM     'PROC'
PEND#    ISYM     'PEND'
END#     ISYM     'END'
DATA#    ISYM     'DATA'
ASECT#   ISYM     'ASECT'
SOCW#    ISYM     'SOCW'
ELSE#    ISYM     'ELSE'
FIN#     ISYM     'FIN'
PAGE#    ISYM     'PAGE'
PCC#     ISYM     'PCC'
DEF#     ISYM     'DEF'
REF#     ISYM     'REF'
SREF#    ISYM     'SREF'
PSR#     ISYM     'PSR'
BOUND#   ISYM     'BOUND'
CNAME#   ISYM     'CNAME'
COM#     ISYM     'COM'
CSECT#   ISYM     'CSECT'
DISP#    ISYM     'DISP'
DO#      ISYM     'DO'
DO1#     ISYM     'DO1'
DSECT#   ISYM     'DSECT'
EQU#     ISYM     'EQU'
ERROR#   ISYM     'ERROR'
FNAME#   ISYM     'FNAME'
GEN#     ISYM     'GEN'
GOTO#    ISYM     'GOTO'
LIST#    ISYM     'LIST'
LOC#     ISYM     'LOC'
ORG#     ISYM     'ORG'
PSECT#   ISYM     'PSECT'
PSYS#    ISYM     'PSYS'
RES#     ISYM     'RES'
S:SIN#   ISYM     'S:SIN'
SET#     ISYM     'SET'
SPACE#   ISYM     'SPACE'
TEXT#    ISYM     'TEXT'
TEXTC#   ISYM     'TEXTC'
TITLE#   ISYM     'TITLE'
USECT#   ISYM     'USECT'
*
S:AAD#   ISYM     'S:AAD'
S:C#     ISYM     'S:C'
S:D#     ISYM     'S:D'
S:DPI#   ISYM     'S:DPI'
S:EXT#   ISYM     'S:EXT'
S:FL#    ISYM     'S:FL'
S:FR#    ISYM     'S:FR'
S:FS#    ISYM     'S:FS'
S:FX#    ISYM     'S:FX'
S:INT#   ISYM     'S:INT'
S:LFR#   ISYM     'S:LFR'
S:LIST#  ISYM     'S:LIST'
S:RAD#   ISYM     'S:RAD'
S:SUM#   ISYM     'S:SUM'
*
S:IVAL#  ISYM     'S:IVAL'
%#       ISYM     '%'
%%#      ISYM     '%%'
*
AF#      ISYM     'AF'
AFA#     ISYM     'AFA'
CF#      ISYM     'CF'
LF#      ISYM     'LF'
NAME#    ISYM     'NAME'
*
BA#      ISYM     'BA'
HA#      ISYM     'HA'
WA#      ISYM     'WA'
DA#      ISYM     'DA'
ABSVAL#  ISYM     'ABSVAL'
CS#      ISYM     'CS'
NUM#     ISYM     'NUM'
S:IFR#   ISYM     'S:IFR'
S:NUMC#  ISYM     'S:NUMC'
S:PT#    ISYM     'S:PT'
S:UFV#   ISYM     'S:UFV'
S:UT#    ISYM     'S:UT'
*
L#       ISYM     'L'
I:#      SET      I:#+1             '=' OPERATOR
S:KEYS#  ISYM     'S:KEYS'
SCOR#    ISYM     'SCOR'
TCOR#    ISYM     'TCOR'
INTBLE   RES      0
*
*  MISCELLANEOUS PARAMETERIZATION OF INTRINSIC SYMBOLS
*
CLOSEDIR EQU      SYMTYPE+CLOSE#
CNAMEDIR EQU      SYMTYPE+CNAME#
COMNTDIR EQU      SYMTYPE+COMNT#
COMDIR   EQU      SYMTYPE+COM#
ENDDIR   EQU      SYMTYPE+END#
FNAMEDIR EQU      SYMTYPE+FNAME#
PAGEDIR  EQU      SYMTYPE+PAGE#
PENDDIR  EQU      SYMTYPE+PEND#
SBLSYM   EQU      L#+SBSYM          BEGIN LITERAL FUNCTION
         PAGE
*
*    C H A R A C T E R   C L A S S   T A B L E
*
*        THIS TABLE IS USED TO CLASSIFY INPUT CHARACTERS AS
*          HEX (BIT 0), OCTAL (BIT 1), DECIMAL (BIT 2),
*          AND ALPHABETIC (BIT 3).  BITS 4 THRU 7 CONTAIN THE
*          NUMERIC EQUIVALENT OF HEX CHARACTERS.
*
ALPH     EQU      16                BIT THREE
DEC      EQU      32                BIT TWO
HEX      EQU      128               BIT ZERO
OCT      EQU      64                BIT ONE
*
CONVTBL  RES      0
         DO1      X'58'/4
         DATA     0               00 THRU X'57'
         DATA     ALPH              X'5B' IS DOLLAR SIGN
         DO1      (X'6C'-X'5C')/4
         DATA     0
         DATA     ALPH**16          X'6D' IS BREAK
         DO1      (X'78'-X'70')/4
         DATA     0
         DATA     ALPH**8+ALPH      X'7A' IS COLON, X'7B' IS POUND
         DATA     ALPH**24          X'7C' IS AT SIGN
         DO1      (X'C0'-X'80')/4
         DATA     0
         DATA,1   0                 X'C0'
I        DO       6                 X'C1' THRU X'C7'  A THRU F
         DATA,1   ALPH+HEX+I+9
         FIN
         DO1      3
         DATA,1   ALPH              G,H,AND I
         DO1      X'D1'-X'CA'
         DATA,1   0
         DO1      X'DA'-X'D1'       J THRU R
         DATA,1   ALPH
         DO1      X'E2'-X'DA'
         DATA,1   0
         DO1      X'EA'-X'E2'       S THRU Z
         DATA,1   ALPH
         DO1      X'F0'-X'EA'
         DATA,1   0
I        DO       8                 0 THRU 7
         DATA,1   HEX+OCT+DEC+I-1
         FIN
         DATA,1   HEX+DEC+8,HEX+DEC+9
         DO1      X'100'-X'FA'
         DATA,1   0
         BOUND    4
CNERR1%MSG        ;
         TEXT     ' ** NO ''.'' IN COL 1 - CN SCAN TERMINATED'
SPILL%MSG         ;
         TEXT     ' ENCODER SPILL TO RAD STORAGE   '
SPILL%MSG%REQ     ;
         TEXT     ' TOTAL SPACE REQUIRED IS        '
SPILL%MSG%AVL     ;
         TEXT     ' TOTAL SPACE AVAILABLE IS       '
CIREGS   DATA     -20,'    ',0,0,0,0
INIT%CO%WORD DATA X'3800006C'
CO%REGS  DATA     32,-26,0
         PAGE
*
*   N C D R
*        THIS IS THE TRANSFER POINT TO BEGIN EXECUTION OF THE PROGRAM
*
NCDR     RES      0
         STW,10   ROOTRTN           SAVE RETURN ADDRESS TO ROOT
         BAL,IORL REWX1
         BAL,IORL REWX3
         LI,N     -(BYX3SIZE+1)     INITIALIZE
         STW,N    CMPOUTSV          COMPRESSED OUT INDEX
         LI,N     31                SET S:IVAL TO ALLOW SIG9P OPS
         STW,N    VAL%S:IVAL
*
*   INITIALIZE NON-SPILL SYMT MANAGEMENT ENTRY POINTS
*
         LI,N     CREATE1ST
         STW,N    CREATE1STV
         LI,N     INSERT
         STW,N    INSERTV
         LI,N     NEWENTRY
         STW,N    NEWENTRYV
         LI,N     SEARCH
         STW,N    SEARCHV
*
*        PRESET THE TEST LIMITS FOR POSSIBLE SPILL.  BASICALLY,
*        WE WANT TO HOLD OUT 4 PAGES FOR INBUF, LEVEL TABLE, LOCAL
*        TABLE, AND SYSTEM NAME TABLE.  IF NOT ENOUGH ROOM, HOWEVER,
*        LEAVE ONE FIXED PAGE FOR THE SYMBOL TABLE, AND HOLD OUT THE
*        REST.
*
         LW,XT    ENDCORE
         LW,N     ENDCORE
         SW,N     LOWCORE           AVAILABLE WORD COUNT
         AND,N    L(-512)           CONVERT TO INTEGRAL # PAGES
         AI,N     -512              RESERVE 1 PAGE FOR FIXED AREA
         IF,GZ
         IF,G     2048,N
         LI,N     2048
         FI
         SW,XT    N
         FI
         STW,XT   INBUFLMT
         AI,XT    -512
         CW,XT    LOWCORE
         IF,L
         LW,XT    LOWCORE
         FI
         STW,XT   SYMTLMT           ADDRESS OF SPILL PAGE
         AI,XT    -HED
         STW,XT   SYMLMT            OFF SET OF SPILL PAGE
         AI,XT    -1
         STW,XT   SYMLMTM1          OFFSET OF SPILL PAGE (-1)
         AI,XT    -17
         STW,XT   SYMLMTM18         OFFSET OF SPILL PAGE (-18)
         LI,N     0
         STW,N    HED               CLEAR ENTRY POINT TO SYMBOL TABLE
         STW,N    #SYSITEM          NUMBER OF SYSTEM NAMES
         STW,N    NUMRECX1          NUMBER OF RECORDS IN X1
         STW,N    CNCTRL            CN CONTROL CARD FLAG
         STW,N    FIRSTREC
         STW,N    NUMRECX3          NUMBER OF RECORDS IN X3
         STW,N    CURRCMND          CURRENT COMMAND
         STW,N    NXTLOC            NUMBER OF ACTIVE LOCAL SYMBOLS
         STW,N    ALFLAG            WITHIN A TEXT STRING FLAG
         STW,N    PROCLV            WITHIN A PROC DEFINITION FLAG
         STW,N    SPILLFLG          SYMT SPILL FLAG
*  PRESET STORAGE FOR THE INPUT MODULE
         STW,N    CIREC#            NEXT CI RECORD NUMBER
         STW,N    EOF%FLAG          END-OF-FILE FLAG
         STW,N    #BLANKS           # BLANKS FOR CI
         STW,N    IM@MAJOR          MAJOR PART OF LINE NUMBER
         STW,N    IM@MINOR          MINOR PART OF LINE NUMBER
         STW,N    LAST%UPDATE       FOR '+' CARDS
         STW,N    NEXT%UPDATE       FOR '+' CARDS
         STW,N    SKIP%COUNT        FOR '+' CARDS
         STW,N    UPDATE%LINE%COUNT FOR '+' CARDS
         LI,LVL   29
         STW,N    CO%BUF,LVL        CLEAR FIRST 'CO' RECORD
         BDR,LVL  %-1
         LW,LVL   INIT%CO%WORD
         STW,LVL  CO%BUF            I.D. WORD FOR 1ST CO RECORD
         LCI      +3
         LM,SR1   CO%REGS
         STM,SR1  CO%REGI           INITIAL CO REGISTERS
         LCI      +6
         LM,SR1   CIREGS
         STM,SR1  CIRDREGS          INITIAL CI READ REGISTERS
         LI,N     1
         STW,N    PLUS              '+' CARD REQUIRED FLAG
         STW,N    COMPTE%CI
         STW,N    DSLNCTRL          .DS CN CTRL LINE-PRINT TOGGLE
         STW,N    NXSYMB            NEXT SYMBOL NUMBER TO ASSIGN
*
         LW,SR1   ENDCORE           LAST CORE LOCATION (+1)
         AI,SR1   -2
         STW,SR1  SLOC
         STW,SR1  LOCX              ************************************
         STW,SR1  INBUF             SET FOR OVERFLOW TEST IN INSERT
         LW,SR2   LOWCORE
         AI,SR2   -HED
         STW,SR2  NEXTST
         STW,SR2  FIRSTST           SAVE FIRST SYM TAB LOC
         MTW,0    ND%FLAG           READ STANDARD DEF FILE
         BNEZ     INIT0             NO
         BAL,LVL  RDSDF             YES
         B        STLOOP
INIT0    RES      0
         LI,IN    INTBLO            ORIGIN OF INTRINSICS
INIT1    RES      0
         LB,XT    *IN
         AI,XT    3
         SLS,XT   -2                STORE WORD COUNT OF NAME AFTER
         STB,XT   HED                 ITS MOVED
         LW,RT1   *IN               GET CHAR COUNT & 1ST 3 CHARS
         AI,IN    1                 BUMP ADDRESS
         LW,RT2   ='    '
         LB,XT    RT1               COMPUTE WORD COUNT IN TEXTC FORMAT
         CI,XT    3                 IF TEXTC CONTAINS A SECOND WORD
         BLE      INIT2               GET THAT WORD
         LW,RT2   *IN               2ND WORD OF ANME
         AI,IN    1                 BUMP SOURCE ADDRESS
INIT2    RES      0
         SLD,RT1  8                 SHIFT OFF THE CHARACTER COUNT
         AI,RT2   ' '               INSERT A TRAILING BLANK
         STD,RT1  SYM1
         CALL     *SEARCHV
         CALL     *INSERTV          INSERT THE INTRINSIC SYMBOL
         CI,N     L#
         IF,EQ
         MTW,+1   NXSYMB            L#+1 IS DUMMY FOR '=' OPERATOR
         FI
         CI,IN    INTBLE            TEST FOR END OF INTRINSIC TABLE
         BL       INIT1
*
STLOOP   LI,OUT   0                 SET OUT TO ZERO 1ST TIME
         MTH,0    DC%FLAG
         BEZ      STLOOP1
*
*   'CN' OPTION WAS SPECIFIED - PROCESS CONCORDANCE CONTROLS
*        BEFORE GOING ON TO PROGRAM STATEMENTS.
         MTW,+1   CNCTRL            INDICATE CN CONTROLS TO BE READ
CNLOOP   RES      0
         LI,N     72
         STW,N    LASTIN
         STW,OUT  OUTSAVE           SAVE 1ST OUT LOCATION
         LI,SYN   CNSYN-SYNTAX
         CALL     DRIVER            ENCODE THE CN CONTROL
         MTW,0    CNCTRL
         BNEZ     CNLOOP            (TURNED OFF BY .END, EOF, ETC)
*
         LI,OUT   0                 SET OUT TO ZERO 1ST TIME
STLOOP1  LI,N     72
         STW,N    LASTIN
         CI,OUT   OUTSIZE-12        5 WDS LEFT IN OUTBUF
         BLE      STLOOP2           YES,
         BAL,RL   IO%X1             NO, WRITE OUTBUF
         LI,OUT   0                 RESET OUT
STLOOP2  STW,OUT  OUTSAVE           SAVE 1ST OUT LOCATION
         LI,SYN   LINE-SYNTAX       ENTRY TO PROGRAM SYNTAX EQUATIONS
         BAL,RL   DRIVER            ENCODE A STATEMENT.
         LW,XT    CURRCMND          TEST FOR A SPECIAL DIRECTIVE
         CLM,XT   RNG%SPC%DIR
         BOL      STLOOP1           BRIF NOT INTERESTING
*
         CI,XT    CNAMEDIR
         BE       STLOOP5
         CI,XT    FNAMEDIR
         BE       STLOOP5
         CI,XT    COMDIR            TEST FOR COM
         BE       STLOOP5
         CI,XT    ENDDIR            TEST FOR END
         BE       STLOOP4
         CI,XT    PENDDIR           TEST FOR PEND
         BNE      STLOOP1           NO.  IT'S NOT SPECIAL
         MTW,0    PROCLV            IGNORE PEND IF NOT
         BEZ      STLOOP6             WITHIN A PROC
         BAL,RL   LCLDL1            DELETE PROC LOCAL TABLE
         LI,XT    0
         STW,XT   PROCLV            RESET 'WITHIN PROC' FLAG
STLOOP5  RES      0
         BAL,RL   EXCHS1            RE-INSTATE SOURCE LEVEL LOCALS
STLOOP6  RES      0
         LI,XT    0
         STW,XT   CURRCMND          RESET COMMAND ON THIS LINE
         B        STLOOP1
STLOOP4  RES      0
         MTW,0    NIVO              WITHIN A SYSTEM
         BEZ      ENDIRCTV          NO, GO TO 'END' PROCESSING
         BAL,LINK IM@END            CLOSE CURRENT SYSTEM
         B        STLOOP6
         PAGE
*    XAP SYNTAX EQUATIONS
SYNTAX   ORG,2    %
CNSYN    IS       '.',CNCMND,OR,CNERR1,CNTERM
CNCMND   IS       'I','O',CNIOCMND,OR,;
                  'S','S',CNSSCMND,OR,;
                  'O','S',CNOSCMND,OR,;
                  'D','S',CNDSCMND,OR,;
                  'E','N','D',RESETOUT,CNTERM,OR,;
                  CNERR2
CNIOCMND IS       SETCNIO,OPTNLIST,ENDCNIO
CNSSCMND IS       SETCNSS,OPTNLIST,ENDCNSS
CNOSCMND IS       SETCNOS,CNLIST,WRITE,ENDLN,EXITSYN
CNDSCMND IS       SETCNDS,CNLIST,ENDCNDS
OPTNLIST IS       CNLIST,OR,BLANK,RESETOUT
CNLIST   IS       BLANK,SYMBOL,CNSYM,NTHCNSYM,REPEAT
NTHCNSYM IS       ',',SYMBOL,CNSYM
LINE     IS       LABEL,COMMAND,OPERAND
LABEL    IS       STDLABEL,OR,WRITE,BEGINLIST,ANYLABEL,WRITE,ENDLIST
STDLABEL IS       BLNKLBL,WRITE,BLANKEXP,OR,SYMBOL,BLANK,WRISYMBOL
ANYLABEL IS       GF,BLANK,OR,SKIPNB,BLANK,WRITE,SYNERR
COMMAND  IS       SYMBOL,COM1,OR,WRITE,BEGINLIST,CMNDERR,;
                  SKIPNB,BLANK16,WRITE,ENDLIST
COM1     IS       BLANK16,CF1SYM,OR,WRITE,BEGINLIST,CF1SYM,;
                  GFN,REPEAT,BLANK16,WRITE,ENDLIST
PROC     IS       SETPROCLV,EXCHSLOC,SKIP%OPERAND
OPEN     IS       SYMBOL,OPENSYM,NTHOPEN,REPEAT,ENDLINE,OR,ENDLINE
NTHOPEN  IS       ',',SYMBOL,OPENSYM
CLOSE    IS       SYMBOL,CLOSESYM,NTHCLOSE,REPEAT,ENDLINE,OR,ENDLINE
NTHCLOSE IS       ',',SYMBOL,CLOSESYM
LOCAL    IS       LCLDLTE,LOCAL1
LOCAL1   IS       SYMBOL,LOCALSYM,NTHLOCAL,REPEAT,WRITELOCALCT,;
                  ENDLINE,OR,WRITELOCALCT,ENDLINE
NTHLOCAL IS       ',',SYMBOL,LOCALSYM
SYSTEM   IS       SYMBOL,STSTSYMB,ENDLINE
SKIP%OPERAND  IS  RESETCHT,ENDLINE
OPERAND  IS       GF,ENDLINE,OR,WRITE,BLANKEXP,ENDLINE
GF       IS       TREE,GFN,REPEAT
GFN      IS       ',',TREE,OR,',',WRITE,BLANKEXP
TREE     IS       '*',EXPR,WRITE,INDIROP,OR,EXPR,OR,'*',;
                  WRITE,BLANKEXP,WRITE,INDIROP
EXPR     IS       PRIM1,DELIM,OR,LIST,OR,;
                  '=',WRITE,SBLSYM+1,EXPR,WRITE,ENDSBSYM,OR,;
                  WRITE,BEGINEXP,TERM,WRITE,ENDEXP
LIST     IS       '(',WRITE,BEGINLIST,GF,')',DELIM,WRITE,ENDLIST
TERM     IS       FA5,CL6,REPEAT
CL6      IS       ORCHAR,CL6A
ORCHAR   IS       '|',OR,X'B4'
CL6A     IS       ORCHAR,FA5,WRITE,XOROP,OR,FA5,WRITE,OROP
FA5      IS       FA4,CL5,REPEAT
CL5      IS       '&',FA4,WRITE,ANDOP
FA4      IS       FA3,CL4,REPEAT
CL4      IS       '=',FA3,WRITE,EQUALOP,OR,'~','=',FA3,WRITE,UNEQLOP,;
                  OR,'>','=',FA3,WRITE,GTEQOP,OR,'>',FA3,WRITE,GRTROP,;
                  OR,'<','=',FA3,WRITE,LTEQOP,OR,'<',FA3,WRITE,LESSOP,;
                  OR,X'B5','=',FA3,WRITE,UNEQLOP
FA3      IS       FA2,CL3,REPEAT
CL3      IS       '+',FA2,WRITE,PLUSOP,OR,'-',FA2,WRITE,MINUSOP
FA2      IS       FA1,CL2,REPEAT
CL2      IS       '*',FA1,WRITE,MPYOP,OR,'/','/',FA1,WRITE,INCLDIV,;
                  OR,'/',FA1,WRITE,DIVOP
FA1      IS       PRIMARY,CL1,REPEAT
CL1      IS       '*','*',PRIMARY,WRITE,SCALEOP
PRIMARY    IS     PRIM1,OR,'-',WRITE,SMALLINT,PRIMARY,WRITE,MINUSOP,;
                  OR,'~',MINUS%ONE,PRIMARY,WRITE,XOROP,;
                  OR,'+',WRITE,SMALLINT,PRIMARY,WRITE,PLUSOP,;
                  OR,'(',TERM,')',;
                  OR,X'B5',MINUS%ONE,PRIMARY,WRITE,XOROP
PRIM1    IS       SYMBOL,ATTRIBCK,OR,INTEGER,OR,'X','''',HEXC,;
                  '''',OR,OPTNLC,'''',ALF,'''',OR,'F',FXDORFLT,;
                  OR,'O','''',OCTC,'''',OR,'D','''',PKDEC,'''',;
                  OR,COMMACK,WRITE,BLANKEXP
FXDORFLT IS       'X','''',FXC,'''',OR,'S','''',FSC,'''',OR,;
                  'L','''',FLC,''''
OPTNLC   IS       'C',OR
SUBSYMB  IS       GF,')',WRITE,ENDSBSYM
         BOUND    4
         ORG,4    %                 GO BACK TO WORD RESOLUTION
         PAGE
*    D R I V E R .    S Y N T A X   T A B L E   D R I V E R
*        THIS ROUTINE CONTROLS THE SYNTAX ANALYSIS PROCESS, UNDER
*          CONTROL OF THE SYNTAX TABLE AND THE INPUT TO BE ANALYZED.
*
*        THE SYNTAX TABLE CONTAINS THE ACCEPTABLE SYNTAX OF THE LANGUAGE
*          BEING ANALYZED AS A SEQUENCE OF 16 BIT ENTRIES.  SEE 'IS'
*          PROC FOR THE FORMAT OF EACH ITEM.  A SYNTAX ITEM IS ONE OF
*          THE FOLLOWING:
*             (A) A (LITERAL) CHARACTER. THE NEXT INPUT CHARACTER IS
*                 MATCHED WITH THIS CHARACTER. IF EQUAL, ANALYSIS
*                 PROCEEDS; OTHERWISE IT FAILS, AND AN ALTERNATE IS
*                 INSPECTED IF PRESENT.
*             (B) REFERENCE TO A SYNTAX ELEMENT.  AN ENTRY IN THE
*                 RECURSIVE 'LEVEL' TABLE IS MADE, AND SYNTAX ANALYSIS
*                 PROCEEDS WITH THE REFERENCED SYNTAX ELEMENT.
*             (C) REFERENCE TO A SEMANTIC ROUTINE.  THE DRIVER BRANCHES
*                 TO THE SEMANTIC (ASSEMBLY CODE) ROUTINE WHICH CAN
*                 GENERATE OUTPUT, CHECK SYNTAX, OR WHATEVER. THESE
*                 ROUTINES RETURN TO THE DRIVER AT LOCATION 'TRUE',
*                 OR 'FALSE' AS APPROPRIATE
*
*                 SEMANTIC ROUTINE 'ENDEQN' DOES THE PROCESSING WHEN
*                 AN ENTIRE SYNTAX STATEMENT (OR EQUATION) IS TRUE.
*                 IT DELETES THE CURRENT LEVEL TABLE ENTRY, AND
*                 CONTINUES PROCESSING AT THE NEXT OUTER LEVEL.
*
*                 SEMANTIC ROUTINE 'REPEAT' CAUSES THE PREVIOUS SYNTAX
*                 ENTRY (WHICH MUST BE A REFERENCE TO A SYNTAX ELEMENT)
*                 TO BE REPEATED UNTIL IT BECOMES FALSE.  WHEN THIS
*                 OCCURS, ANALYSIS PROCEEDS WITH THE NEXT SYNTAX
*                 ELEMENT AS IF THE REPEATED ELEMENT TERMINATED AS TRUE.
*
*                 EXIT FROM THE DRIVER IS MADE (AT ANY SYNTAX LEVEL)
*                 BY REFERENCING SEMANTIC ROUTINE 'EXITSYN'.
         PAGE
*
DRIVER   RES      0
         STW,RL   DRIVEREXIT
         LI,IN    0                 CLEAR INPUT INDEX
         STW,IN   CONTIN%ERROR      CONTINUATION ERROR FLAG
         LW,LVL   LOCX
         AI,LVL   -10
         STW,LVL  LVLBASE           LEVEL TABLE BASE
         AI,LVL   -4                START OF 1ST ENTRY
*
*        SET INPUT BUFFER START MIDWAY BETWEEN END OF SYMBOL TABLE AND
*        START OF LEVEL TABLE, BUT NOT ABOVE PRE-DETERMINED BOUNDARY
*        OF AREA TO BE HELD OUT IF DISK SPILL INVOKED.
*
         LW,RL    NEXTST
         AI,RL    HED
         AW,RL    LVL
         SLS,RL   -1
         CW,RL    INBUFLMT
         IF,G
         LW,RL    INBUFLMT
         FI
         STW,RL   INBUF             FIXED BUFFER START
         STW,RL   BUFPTR            LAST RECORD START
         BAL,RL   READCARD          READ A RECORD.
         LW,N     IM@MAJOR
         MTW,0    NIVO              WITHIN A SYSTEM
         BNEZ     DRIVR1            BRANCH IF YES. USE IM@MAJOR
         MTW,0    IM@MINOR          IS THIS AN INSERTED LINE
         BEZ      DRIVR1            BRANCH IF NO. USE IM@MAJOR
         LI,N     0                 USE ZERO FOR AN INSERT
DRIVR1   RES      0
         CI,N     8191              WILL LINE # FIT AS A SMALL INT
         BG       DRIVR2            BRANCH IF NO
         AI,N     SMALLINT
         B        DRIVR3
DRIVR2   RES      0
         LI,N     LARGEINT+1
         BAL,RL   WDOUT
         LW,N     IM@MAJOR
DRIVR3   RES      0
         BAL,RL   WDOUT
         STW,OUT  NEXTLINE#         INDEX TO CONTINUATION LINE #
         LW,N     SYN
NEXTLEVEL  RES    0
         CW,LVL   BUFPTR            LEVEL TABLE OVERFLOW
         BLE      OVERFLOW          YES
         LCI      3                 SAVE IN, OUT, AND SYN
         STM,IN   LVLTBL,LVL          IN THE SYNTAX LEVEL TABLE
         AI,LVL   -3
         LW,SYN   N
TRUE1    RES      0
         LH,N     SYNTAX,SYN        NEXT SYNTAX ELEMENT
         BGZ      NOTSYNREF         NOT A REFERENCE TO A SYNTAX EQN
         AND,N    =ADDRESS          TRIM ADDRESS AND BRANCH
         B        NEXTLEVEL         TO BEGIN A NEW SYNTAX LEVEL
NOTSYNREF  RES    0
         CI,N     TYPE              TEST FOR A CHARACTER
         BAZ      CHARACTEREF         OR SEMANTIC ROUTINE REFERENCE
         AND,N    =ADDRESS
         B        SEMANBAS,N        BRANCH TO THE SEMANTIC ROUTINE
*    SYNTAX ELEMENT IS A CHARACTER
CHARACTEREF  RES  0
         AND,N    =ADDRESS
         BAL,RL   CHAR              GET NEXT INPUT CHARACTER (IN 'CRG')
         CW,N     CRG
         BE       TRUE
*    A SYNTAX ELEMENT IS FALSE
FALSE    RES      0
         AI,SYN   1                 ADVANCE TO NEXT SYNTAX ELEMENT
         LH,N     SYNTAX,SYN
         AND,N    =NOTINCR          CLEAR INCREMENT FIELD
         CI,N     TYPE1REPEAT       IS THIS ELEMENT 'REPEAT'
         BNE      FALSE1              NO
         LCI      2                 RESET 'IN' AND 'OUT' FROM THIS
         LM,IN    LVLTBL,LVL          SYNTAX LEVEL
TRUE     RES      0
         AI,SYN   1                 GO TO NEXT SYNTAX ELEMENT
         B        TRUE1
FALSE2   AI,LVL   3                 BACK-UP ONE SYNTAX LEVEL
         LW,SYN   LVLTBL+2,LVL      REPLACE NEXT SYN. EQN. ADDRESS
         B        FALSE
FALSE1   RES      0
         LH,N     SYNTAX,SYN        ADVANCE SYNTAX TABLE POINTER TO
         AND,N    =INCR               THE NEXT 'OR' OR 'ENDEQN'
         SLS,N    -ADDRSIZE           ELEMENT
         AW,SYN   N
         LH,N     SYNTAX,SYN
         CI,N     TYPE1OR           IS THE ELEMENT AN 'OR'
         BNE      FALSE2              NO
         LCI      2                 YES. RESET REG'S 'IN' AND 'OUT'
         LM,IN    LVLTBL+3,LVL        TO RE-START AFTER THE 'OR' ON
         B        TRUE                THE SAME LEVEL
*
SEMANBAS RES      0
*
*    THE ENTIRE SYNTAX EQUATION IS TRUE
ENDEQN   NOP      0
OR       RES      0
         AI,LVL   3                 BACK-UP ONE SYNTAX LEVEL
         LW,SYN   LVLTBL+2,LVL
         B        TRUE
*    REPEAT THE PREVIOUS SYNTAX ELEMENT (MUST BE A SYNTAX EQUATION)
REPEAT   RES      0
         AI,SYN   -1                BACK-UP SYNTAX TABLE POINTER
         B        TRUE1
*    EXIT FROM THE SYNTAX DRIVER
EXITSYN  RES      0
         B        *DRIVEREXIT
TYPE1REPEAT    EQU     X'4000'+(REPEAT-SEMANBAS)
TYPE1OR        EQU     X'4000'+(OR-SEMANBAS)
         PAGE
*
*    A L F
*        CONCATINATE THE CHARACTERS OF AN ALPHANUMERIC CONSTANT.
*        CONSTANT IS TERMINATED BY A SINGLE PRIME (') CHARACTER.
*        TWO CONSECUTIVE PRIMES CAUSE A SINGLE PRIME TO BE ENTERED
*        IN THE CONSTANT.  CHARACTERS ARE PACKED FOUR/WORD,AND
*        OUTPUT BY THIS ROUTINE AS MULTIPLE WORD INTEGERS. THE LAST
*        CHARACTERS ARE LEFT-ADJUSTED.
*
ALF      RES      0
         LI,XT    0
         STW,XT   OVFLAG            CLEAR TRUNCATION FLAG
         MTW,1    ALFLAG            SET FOR NO CONTINUATION
ALF1     RES      0
         BAL,RL   CHAR              NEXT CHARACTER
         CI,CRG   ''''
         BNE      ALF2
         BAL,RL   CHAR              TEST FOR DOUBLE PRIME
         CI,CRG   ''''
         BNE      ALF5              BRANCH IF ONLY SINGLE PRIME
ALF2     RES      0
         AI,XT    1
         STB,CRG  SYM1,XT           NO, STORE CHAR
         B        ALF1
ALF5     RES      0
         STB,XT   SYM1
         CW,XT    LASTIN
         BL       ALF3              BRANCH IF STILL WITHIN CURR LINE
         MTW,+1   OVFLAG            TRAILING PRIME IS MISSING
ALF3     RES      0
         AI,IN    -1
         LI,N     LARGEINT+CT2      LARGE INTEGER, CONVERSION TYPE 2
         AI,XT    1
         CI,XT    1                 TEST CHARACTER COUNT
         BAZ      ALF4              BRANCH IF EVEN
         LI,CRG   ' '                 AND STORE A TRAILING BLANK
         STB,CRG  SYM1,XT
         AI,XT    1                 MAKE CHARACTER COUNT EVEN
ALF4     RES      0
         LI,CRG   0
         STW,CRG  ALFLAG            RESET ALFLAG
         SLS,XT   -1
WRICONST RES      0
         AW,N     XT                ADD HALFWORD COUNT TO CONTROL ITEM
         BAL,RL   WDOUT             OUTPUT THE TYPE 7 CONTROL ITEM
* OUTPUT EACH SIGNIFICANT HALFWORD OF THE CONVERTED CONSTANT
ALF7     RES      0
         LH,N     SYM1,CRG
ALF6     BAL,RL   WDOUT
         AI,CRG   1
         BDR,XT   ALF7
         B        HEXC11
*
*    B L A N K   A N D   B L A N K 1 6
*        BLANK ROUTINES.  SKIP FROM 1 THROUGH 70 BLANKS.
*          EXIT IS TO 'TRUE' IF ONE OR MORE BLANKS IS SKIPPED,
*          ELSE EXIT TO 'FALSE'.
*
*        BLANK16 IS THE ENTRY WHICH SKIPS UP TO 16 BLANKS INSTEAD OF 70.
*
BLANK    RES      0
         LI,N     69
         B        BLNK1
BLANK16  RES      0
         LI,N     14
BLNK1    RES      0
         BAL,RL   CHAR              FIRST CHARACTER
         CI,CRG   ' '
         BE       BLNK2             YES, CONTINUE SCAN
BLNKLBL2 RES      0
         CI,CRG   X'05'             NO, TAB
         BE       TRUE              YES
         B        FALSE             NO
BLNK2    RES      0
         CB,CRG   *INBUF,IN         IS NEXT CHAR. BLANK
         BE       BLNK3             YES
         BAL,RL   CHAR              INSPECT CHARACTER PAST LAST BLANK
         CI,CRG   X'05'             NO, IS IT A TAB
         BE       TRUE              YES
         AI,IN    -1
BLNK4    RES      0
         CW,IN    LASTIN            IF 'IN' IS OFF END OF CARD,
         BLE      TRUE                RESET BACK TO END
*
         LW,IN    LASTIN
         B        TRUE
*
BLNK3    RES      0
         AI,IN    1
         BDR,N    BLNK2             CHECK NEXT CHAR
         B        BLNK4             COUNT EXHAUSTED
*
*    B L N K L B L
*
BLNKLBL  RES      0
         LW,CRG   L('    ')
         CW,CRG   *INBUF            ARE 1ST 4 CHARS BLANK
         BE       BLNKLBL3          YES
         LB,CRG   *INBUF            NO, IS 1ST CHAR BLANK
         LI,IN    1
         CI,CRG   ' '
         BE       BLNKLBL5          YES
         CI,CRG   '*'               NO, FIRST CHAR = '*'
         BNE      BLNKLBL2          NO
         LI,N     BLANKEXP          YES, COMMENT DIRECTIVE
         BAL,RL   WDOUT
         LI,N     COMNTDIR
         BAL,RL   WDOUT
         LI,N     ENDLN
         BAL,RL   WDOUT
         B        EXITSYN
BLNKLBL3 LI,IN    4
         LI,N     1
         CW,CRG   *INBUF,N          ARE 2ND 4 CHARS BLANK
         BNE      %+2               NO
         LI,IN    8                 YES
BLNKLBL5   RES    0
         LI,N     70
         SW,N     IN
         LI,CRG   ' '
         B        BLNK2
*
*   C F 1 S Y M
*        PROCESS THE COMMAND SYMBOL
*
*        THE FIRST SYMBOL IN THE COMMAND FIELD HAS BEEN READ AND
*          STORED IN THE ITEM BEGINNING AT HED.  THE SYMBOL TABLE
*          IS SEARCHED, A SYMBOL ITEM IS OUTPUT, AND THE CF1 BIT
*          IS SET IN THE SYMBOL TABLE.  THE OUTPUT COMMAND IS STORED
*          IN CURRCMND.
*
CF1SYM   RES      0
         LW,RT3   CURRCMND
         STW,RT3  LASTCMND
         CALL     *SEARCHV
         B        CF1S7             NOT FOUND IN SYMBOL TABLE
         CI,N     8192              IS IT LOCAL
         BL       CF1S8               NO
*  GET THE NON-LOCAL SYMBOL NUMBER FROM THE APPROPRIATE LOCAL TABLE
*    ADDRESS = ORIGIN - 2*(LOCAL-SYMBOL-NUMBER)
         AND,N    =ENCVAL           SAVE LOCAL-SYMBOL-NUMBER
         SLS,N    1                 MPY BY 2
         LW,M1    SLOC              USE PROC LOCAL TABLE IF WITHIN
         LW,CT    PROCLV              A PROC; OTHERWISE USE SOURCE
         BEZ      %+2                 LOCAL TABLE
         LW,M1    PLOC
         SW,M1    N
         LW,N     SNOFFSET,M1
         AND,N    =ENCVAL           TRIM THE SYMBOL NUMBER
         MTW,-1   INCORESF          DON'T LET LOCAL STORE CAUSE WRITE
         B        CF1S8
CF1S7    RES      0
         CALL     *INSERTV
CF1S8    RES      0
         LW,RT1|1  =CF1FLD          SET THE CF1 BIT ON
         STS,RT1|1  PTROFFSET,M1
         MTW,+1   INCORESF          SET DIRTY-PAGE FLAG
         AI,N     SYMTYPE           MAKE IT A SYMBOL
CF1S2    RES      0
         STW,N    CURRCMND
         BAL,RL   WDOUT             OUTPUT THE COMMAND
         CLM,N    RNG%SYN%DIR       COULD THIS HAVE A SPECIAL
         IF,IL                 -50-   SYNTAX EQUATION?
         AND,N    L(ENCVAL)         GET LOCATION OF APPROPRIATE
         LH,N     DIRBR,N             SYNTAX EQUATION
         BNEZ     NEXTLEVEL
*
         B        TRUE
*
         FI                    -50-
         CLM,N    RNG%DFN%DIR
         BOL      TRUE
*
         CI,N     COMDIR            IF THIS IS 'COM', 'CNAME', OR
         BE       EXCHSLOC            'FNAME' ,  DELETE THE
         CI,N     CNAMEDIR            CURRENT LOCAL TABLE
         BE       EXCHSLOC            ON THE SOURCE LEVEL
         CI,N     FNAMEDIR
         BNE      TRUE
         B        EXCHSLOC
*
*  C M N D E R R
*        HERE TO OUTPUT A SYNTAX ERROR FOR THE COMMAND FIELD
*
CMNDERR  RES      0
         LI,N     SYNERR
         B        CF1S2             GO STORE & SET CURRCMND
         PAGE
*
*   SEMANTIC ROUTINES FOR CONCORDANCE CONTROL COMMAND PROCESSING
*
*
*   R E S E T O U T
*        DELETE THE DUMMY CN LINE NUMBER BY BACKING UP
*        THE OUTPUT INDEX.
*
RESETOUT RES      0
         LW,OUT   OUTSAVE           INDEX AT START OF LINE
         B        TRUE
*
*   S E T C N I O
*        NOTE BEGINNING OF .IO CONCORDANCE COMMAND
*
SETCNIO  RES      0
         LV,RT1   CNIOMODE
         LV,RT2   CNIOFLG
         B        SETCNCOM
*
*
*   S E T C N S S
*        NOTE BEGINNING OF .SS CONCORDANCE COMMAND
*
SETCNSS  RES      0
         LW,RT1   CNCTRL
         CV,RT1   CNOSFLG           CANNOT HAVE HAD PREVIOUS .OS
         BANZ     CNERR2
*
         LV,RT1   CNSSMODE
         LV,RT2   CNSSFLG
         B        SETCNCOM
*
*
*   S E T C N O S
*        NOTE BEGINNING OF .OS CONCORDANCE COMMAND
*
SETCNOS  RES      0
         LW,RT1   CNCTRL
         CV,RT1   CNSSFLG           CANNOT HAVE HAD PREVIOUS .SS
         BANZ     CNERR2
*
         LV,RT1   CNOSMODE
         LV,RT2   CNOSFLG
         B        SETCNCOM
*
*
*   S E T C N D S
*        NOTE BEGINNING OF .DS CONCORDANCE COMMAND
*
SETCNDS  RES      0
         LV,RT1   CNDSMODE
         LV,RT2   CNDSFLG
*        (FALL THROUGH)
*
SETCNCOM RES      0
         LW,N     CNCTRL
         AND,N    L(CNFLGFLD)       SAVE OLD FLAGS
         OR,N     RT2               MERGE NEW FLAGS
         STB,RT1  N                 SET TYPE CODE
         STW,N    CNCTRL
         B        TRUE
*
*
*   E N D C N D S
*        FINISH PROCESSING OF .DS CONCORDANCE COMMAND
*
ENDCNDS  RES      0
         LI,N     1
         STH,N    LS%FLAG           OVERRIDE LS OPTION IF SPECIFIED
         LI,N     0
         STW,N    DSLNCTRL
         LW,OUT   OUTSAVE           DELETE DUMMY LINE NUMBER
         B        EXITSYN
*
*
*   E N D C N I O
*        FINISH PROCESSING OF .IO CONCORDANCE COMMAND
*
ENDCNIO  RES      0
         LV,RT1   CNIOFLG1
         B        ENDCNCOM
*
*
*   E N D C N S S
*        FINISH PROCESSING OF .SS CONCORDANCE COMMAND
*
ENDCNSS  RES      0
         LV,RT1   CNSSFLG1
*        (FALL THROUGH)
*
ENDCNCOM RES      0
         LW,N     CNCTRL
         CV,N     X'FFFF'
         IF,ANZ
         OR,N     RT1               SET USE FLAG
         STW,N    CNCTRL
         LV,N     ENDLN
         CALL     WDOUT
         FI
         B        EXITSYN           GET OUT OF EQUATIONS
*
*
*   C N S Y M
*        PROCESS THE SYMBOL SPECIFIED IN A CONCORDANCE CONTROL
*        COMMAND NAME LIST.
*
CNSYM    RES      0
         CALL     *SEARCHV
         CALL     *INSERTV
         LB,XT    CNCTRL            GET ID CODE FOR OPTION IN PROGRESS
         CV,XT    CNDSMODE
         IF,EQ                      .DS JUST SETS A BIT IN THE SYMT
         LV,XT    DSSYMBIT
         STS,XT   *FND
         MTW,+1   INCORESF          SET DIRTY-PAGE FLAG
         ELS                        ALL OTHERS GO OUT TO ENCODED BUFFER
         SHIFT,XT 31,16+2
         AW,N     XT
         CALL     WDOUT
         FI
         MTW,+1   CNCTRL            TALLY NAME-LIST SYMBOL
         B        TRUE
*
*
*   C N T E R M
*        WRAP UP CONCORDANCE CONTROL COMMAND PROCESSING
*
CNTERM   RES      0
         IF,G     1,OUT             DON'T WRITE AN EMPTY BUFFER
         CALL     IO%X3             WRITE ANYTHING IN THE BUFFER
         FI
         LH,XT    DC%FLAG
         CI,XT    2                 DID CN CONTROLS COME FROM X1?
         IF,EQ
         BAL,X7   FIN%X1            REWIND X1
         FI
         LW,N     CNCTRL
         AND,N    L(CNFLGFLD)       SAVE OPTION & NAME-LIST FLAGS
         AI,N     1**16
         LW,XT    NUMRECX3
         STB,XT   N                 SAVE X3 RECORD COUNT
         STW,N    DC%FLAG
         LI,XT    0
         STW,XT   CNCTRL            CLEAR CN CONTROL TOGGLE
         B        EXITSYN           GET OUT OF EQUATIONS
*
*
*   C N E R R 1
*        READ A NON-'.' CARD WHILE ACCESSING CN CONTROLS
*
CNERR1   RES      0
         LCI      15
         STM,1    SAVAREA           SAVE REGS
         LCI      10
         LM,1     CNERR1%MSG
         STM,1    LSTBF              (WRITELO MAY TRY TO MODIFY BUFFER)
         LI,IOADD LSTBF
         LI,IOSIZE   40
         BAL,IORL WRITELO
         LCI      15
         LM,1     SAVAREA            RESTOTE REGS
         B        TRUE
*
*
*   C N E R R 2
*        ERROR IN PROCESSING A CN CONTROL
*
CNERR2   RES      0
         LV,N     CNERR             ERROR CODE
         CALL     WDOUT
         LV,N     ENDLN
         CALL     WDOUT
         B        TRUE
         PAGE
*
*    R E A D C A R D
*        READ NEXT RECORD AND MOVE TO INBUF.
*        COMPRESS RECORD AND PUT IN SIBUF.
*
READCARD RES      0
         MTW,0    CNCTRL
         IF,NZ                      CN CONTROL COMMANDS BEING SCANNED
         BAL,IORL READC             GET NEXT CN CONTROL
         B        RCMOVE            TRANSFER BUFSI TO INPUT AREA
*
         FI
         BAL,LINK IM@READ           READ A RECORD.
* 15 SAVED REGISTERS ARE STILL IN SAVAREA
         MTW,0    LS%FLAG           SHALL WE PRINT LS?
         BEZ      AFTER%LS          BRANCH IF NO.
         MTW,0    NIVO              DON'T OUTPUT IF
         BNEZ     AFTER%LS            WITHIN A SYSTEM
*
         MTW,0    FIRSTREC
         IF,EZ
         MTW,+1   FIRSTREC
         ELS
         CALL     CHK%PRNT          PRINT LAST LINE IF NEEDS BE
         FI
         BAL,X7   CLRLSTBF
         LCI      10                MOVE CARD
         LM,1     BUFSI             TO
         STM,1    LSTBF+5           LISTING
         LM,1     BUFSI+10          PRINT
         STM,1    LSTBF+15          BUFFER
         LI,X2    7
         LI,X4    '*'
         LW,X5    IM@MINOR          GET
         BNEZ     LS#3              LINE
         LW,X5    IM@MAJOR          NUMBER,
         B        LS#5              EDIT LINE
LS#4     LI,X4    0                 NUMBER
         DW,X4    =10               TO
         AI,X4    X'F0'             EBCDIC,
LS#3     STB,X4   LSTBF+2,X2        INSERT ASTERISK
LS#5     AI,X2    -1                IF
         AI,X5    0                 LINE IS
         BNEZ     LS#4              FROM UPDATE PACKET, THEN PRINT LINE
*
AFTER%LS EQU      %
         LI,IN    BUFSI             SAVE ADDRESS
         STW,IN   CARDADDR            OF CARD IMAGE
*
*        COMPRESS A SOURCE RECORD
*
         OPEN     RT1,RL,LINK       RESOLVE A REGISTER CONFLICT
RL       EQU      4
LINK     EQU      5
RT1      EQU     2
         LW,OUT   CMPOUTSV
         LI,CT    X'21'
         LI,XT    19
         LW,N     L('    ')
         CW,N     BUFSI,XT          SEARCH FOR TRAILING BLANKS
         BNE      CMP15
         BDR,XT   %-2
         CW,N     BUFSI             IS ENTIRE RECORD BLANK
         BE       CMPEND25          YES, WRITE END RECORD ITEM
CMP15    AWM,XT   CARDADDR          NO
         LCW,XT   XT
CMP16    CW,N     *CARDADDR,XT      SEARCH FOR LEADING BLANKS
         BNE      CMP17
         AI,CT    4
         BIR,XT   CMP16
CMP17    MTW,+1   CARDADDR
         SLS,XT   2
         AI,XT    -5
         CI,CT    X'21'             ANY LEADING BLANKS
         BE       CMP25             NO
         AI,CT    -1                YES
         LI,RT1   ' '               SET REPEAT CHAR = ' '
         STW,RT1  CMPCHAR
         B        CMP46             GO OUTPUT
CMP25    BIR,XT   %+2               GET
         B        CMPEND                A
         LB,RT1   *CARDADDR,XT            CHAR.
CMP26    STW,RT1  CMPCHAR           SAVE
         CI,RT1   X'3F'             IS IT A SPECIAL CHAR
         BG       CMP35             NO
         CI,RT1   X'20'
         BL       CMP35             NO
         LI,N     X'21'             YES, WRITE X'21' SPEC. CHAR
         BAL,RL   CMPOUT
         LW,N     RT1
         BAL,RL   CMPOUT            WRITE SPECIAL CHAR
         B        CMP25
CMP35    BIR,XT   %+2               GET
         B        CMPEND                A
         LB,RT1   *CARDADDR,XT            CHAR.
         CW,RT1   CMPCHAR           SAME AS LAST CHAR
         BNE      CMP55             NO,
CMP45    AI,CT    1                 ADD 1 TO REPEAT COUNT
CMP46    BIR,XT   %+2               GET
         B        CMPEND                A
         LB,RT1   *CARDADDR,XT            CHAR.
         CW,RT1   CMPCHAR           SAME AS LAST CHAR
         BE       CMP45             YES
CMP50    BAL,LINK CMPRPT
         B        CMP26
CMP55    LW,N     CMPCHAR
         BIR,OUT  CMP60             BRANCH IF SIBUF NOT FULL
*
         CALL     IO%X3
         LI,OUT   -BYX3SIZE         RESET OUT
CMP60    RES      0
         STB,N    SIBUF+WDX3SIZE,OUT
         B        CMP26
CMPRPT   CI,CT    X'3F'             IS COUNT > X'3F'
         BG       CMPRPT5           YES
         LW,N     CT                NO, WRITE REPETITION CONTROL
         BAL,RL   CMPOUT
         LW,N     CMPCHAR
         BAL,RL   CMPOUT            WRITE CHARACTER
         LI,CT    X'21'
         EXIT     LINK
CMPRPT5  AI,CT    -31
         LI,N     X'3F'
         BAL,RL   CMPOUT            WRITE REPEAT ITEM
         LW,N     CMPCHAR
         BAL,RL   CMPOUT            WRITE CHAR
         B        CMPRPT
CMPEND   CI,RT1   X'40'             LAST CHAR = ' '
         BE       CMPEND25          YES
         BG       CMPEND15          NO, > X'40'
         CI,RT1   X'20'             NO, SPECIAL
         BGE      CMPEND25          YES
CMPEND15 CI,CT    X'21'             NO
         BG       CMPEND20          YES
         LW,N     RT1
         LI,RL    CMPEND25
CMPOUT   RES      0
         BIR,OUT  CMPOUT3           BUFFER FULL - NO
*
         CALL     IO%X3
         LI,OUT   -BYX3SIZE         RESET OUT
CMPOUT3  RES      0
         STB,N    SIBUF+WDX3SIZE,OUT  MOVE CHARACTER
         EXIT     RL
CMPEND20 BAL,LINK CMPRPT
CMPEND25 LI,N     X'20'
         BAL,RL   CMPOUT            WRITE END OF RECORD ITEM
         STW,OUT  CMPOUTSV          SAVE OUT INDEX
         CLOSE    RT1,RL,LINK       END OF REGISTER CONFLICT AREA
*
*  MOVE 18 WORDS FROM THE BUFSI AREA TO THE NEXT
*    18 WORDS IN THE INBUF AREA AND STORE A SPECIAL FLAG
*    WORD AFTER THE NEXT WORD.
*
RCMOVE   RES      0
         LW,1     BUFPTR
         LW,2     =' ;  '           BLANK,SEMICOLON,BLANK,BLANK
         STW,2    18,1
         LCI      +9
         LM,2     BUFSI
         STM,2    0,1
         LM,2     BUFSI+9
         STM,2    9,1
         AI,1     18                UPDATE BUFPTR FOR NEXT RECORD
         STW,1    BUFPTR
         LCI      15                RESTORE REGISTERS
         LM,1     SAVAREA
         CW,LVL   BUFPTR
         BG       *RL
         B        OVERFLOW
*
*    C H A R
*        GET THE NEXT INPUT CHARACTER
*        THE CHARACTER IS MADE AVAILABLE IN REGISTER  'CRG', AND
*        THE INPUT POINTER IS BUMPED.
*
CHAR     RES      0
         LB,CRG   *INBUF,IN         NEXT INPUT CHARACTER
         AI,IN    1                 BUMP INDEX TO INBUF
         CI,CRG   ';'               TEST FOR CONTINUATION CHARACTER
         BNE      *RL               NO.
         CW,IN    LASTIN            IS CHAR BEYOND END OF INBUF
         BLE      CHAR1             BRANCH IF WITHIN INBUF
         LI,CRG   ' '               RETURN A BLANK IF NOT IN TEXT
         MTW,+0   ALFLAG
         BEZ      *RL
         LI,CRG   ''''              OTHERWISE RETURN A PRIME
         EXIT RL
CHAR1    RES      0
         MTW,0    ALFLAG            IF WITHIN A TEXT STRING,
         BNEZ     *RL                 DON'T ALLOW CONTINUATION
* HERE TO PROCESS CONTINUATION
         STW,RL   CHARTEMP          SAVE EXIT
CHAR5    RES      0
         LW,RL    IN                IF THE NEXT CHARACTER HAS ALREADY
         AI,RL    72                  BEEN INPUT, DON'T RE-READ
         CW,RL    LASTIN
         BLE      CHAR2
         BAL,RL   READCARD          READ THE CONTINUATION LINE
         LI,N     2                 SET # HALFWORDS TO 2
         LW,LINK  IM@MAJOR          GET LINE NUMBER
         MTW,+0   NIVO              USE IM@MAJOR IF WITHIN
         BNEZ     LINE#1              A SYSTEM
         MTW,+0   IM@MINOR          USE ZERO IF THIS IS AN INSERT
         BEZ      LINE#1            BRANCH IF NOT AN INSERT
         LI,LINK  0
LINE#1   RES      0
         CI,LINK  X'1FFF'           WILL LINE # FIT AS SMALL INTEGER
         BG       LINE#2            BRANCH IF NO
         AI,LINK  SMALLINT
         LI,N     1
*  ADD SIZE OF INSERT LINE NUMBER TO EACH 'OUT' ENTRY IN LVLTBL
LINE#2   RES      0
         LW,IN    LVL
         AI,IN    3                 LVL POINTS TO NEXT AVAILABLE
LINE#6   RES      0
         AWM,N    LVLTBL+1,IN       ADD SIZE TO 'OUT' ENTRY
         AI,IN    3                 ADVANCE ADDRESS BY LVLTBL SIZE
         CW,IN    LVLBASE
         BL       LINE#6
LINE#7   RES      0
         LW,IN    OUT
         AW,IN    N
         STW,IN   SAVAREA-1+OUT     STORE FINAL ADDRESS OF OUT
         CI,IN    OUTSIZE           WILL THE LINE NUMBER FIT IN OUTBUF
         BL       LINE#3            BRANCH IF YES
         BAL,RL   WDOUT             TERMINATE OUTBUF BY OUTPUTTING
         BAL,RL   WDOUT               TWO DUMMY ENTRIES
         AI,OUT   -2                DELETE THE DUMMY ENTRIES
         B        LINE#7
LINE#3   RES      0
         LW,RL    OUT               PUT SIZE OF LINE IN RL
         SW,RL    NEXTLINE#
         BEZ      LINE#8            NO ENTRIES TO MOVE
LINE#4   RES      0
         AI,IN    -1                MOVE OUTBUF DOWN TO MAKE
         AI,OUT   -1                  ROOM FOR THE INSERT
         LH,RT4   OUTBUF,OUT          LINE NUMBER
         STH,RT4  OUTBUF,IN
         BDR,RL   LINE#4
LINE#8   RES      0
         AWM,N    NEXTLINE#         BUMP ADDRESS FOR NEXT LINE NUMBER
         CI,N     1                 IS LINE # A SINGLE HALFWORD
         BE       LINE#5              YES
         LI,N     LARGEINT+1        NO. OUTPUT LARGE INTEGER CONTROL
         BAL,RL   WDOUT
LINE#5   RES      0
         LW,N     LINK              OUTPUT LAST HALFWORD OF LINE #
         BAL,RL   WDOUT
         LCI      +15               RESTORE ALL REGISTERS
         LM,1     SAVAREA
         LW,IN    LASTIN
         LI,RL    72
         AWM,RL   LASTIN
         B        CHAR6
CHAR2    RES      0
         LW,RL    IN
         LI,IN    0
CHAR4    RES      0
         AI,IN    72
         CW,IN    RL
         BL       CHAR4
CHAR6    RES      0
         LB,CRG   *INBUF,IN         THE FIRST CHARACTER OF A
         CI,CRG   ' '                 CONTINUED RECORD SHOULD BE BLANK
         BE       CHAR7
         CI,CRG   X'05'             IT COULD ALSO BE 'TAB'
         BE       CHAR7
*
         CI,CRG   '*'               IS IT A COMMENT
         BNE      CHAR8             NO
         AI,IN    1
         B        CHAR5             GO READ NEXT LINE
CHAR8    RES      0
         MTW,+1   CONTIN%ERROR      SET CONTINUATION ERROR FLAG
         B        CHAR9
* ELIMINATE LEADING BLANKS ON THE CONTINUED RECORD
CHAR7    RES      0
         AI,IN    1
         CW,IN    LASTIN            BAD IF ENTIRE RECORD IS BLANK
         BE       CHAR8
         LB,CRG   *INBUF,IN
         CI,CRG   ' '
         BE       CHAR7
*
         CI,CRG   X'05'             CHECK FOR 'TAB'
         BE       CHAR7
CHAR9    RES      0
         LW,RL    CHARTEMP
         B        CHAR
*
*   C L O S E S Y M
*        'CLOSE' THE NEXT SYMBOL OF A CLOSE DIRECTIVE
*
CLOSESYM RES      0
         CALL     *SEARCHV
         CALL     *INSERTV
         CI,N     8192              ERROR IF THE SYMBOL IS LOCAL
         BANZ     OPENSYM1
         LW,RT2   =CLOFLD           SET THE CLOSE BIT ON
         STS,RT2  PTROFFSET,M1
         MTW,+1   INCORESF          SET DIRTY-PAGE FLAG
         B        SYMOUT
*
*   C O M M A C K
*
COMMACK  RES      0
         BAL,RL   CHAR
COMMACK1 RES      0
         CI,CRG   ','
         BE       RESETCHT
         B        FALSE
*
*   D E L I M
*        CHECK FOR A DELIMITER. (COMMA,BLANK, OR RT. PAREN.)
*
DELIM    RES      0
         BAL,RL   CHAR
         CI,CRG   ' '
         BE       RESETCHT
         CI,CRG   TAB
         BE       RESETCHT
         CI,CRG   ')'
         BNE      COMMACK1
         B        RESETCHT
*
*   C R E A T E 1 S T
*
*        CREATE A SYMBOL TABLE ENTRY LINKED TO THE MAIN ENTRY
*          LOCATION OF THE ENTRY TO BE LINKED IS IN M1
*
CREATE1ST  RES    0
         LW,XT    NEXTST
         CW,XT    SYMLMTM1
         IF,EQ                      DOIF 2-WD ENTRY WOULD BRIDGE
         AI,XT    1                   SPILL PAGE BOUNDARY.
         MTW,+1   NEXTST
         FI
         LW,CT    PTROFFSET,M1
         AND,CT   =PTRFLD+CLOFLD+CF1FLD
         STW,CT   PTRWD,XT
         LW,RT1   =PTRFLD
         LW,RT2   =PTRFLD+CLOFLD+CF1FLD
         STS,RT1  PTROFFSET,M1
         LW,RT1   SNOFFSET,M1
         STW,RT1  SNWD,XT
         STH,XT   RT1
         LW,RT2   =SNFLD
         STS,RT1  SNOFFSET,M1
         LW,M1    XT
         AI,M1    HED
         MTW,2    NEXTST
         EXIT     RL
*
*   E N D L I N E
*
ENDLINE  RES      0
         LW,RL    CONTIN%ERROR      ARE THERE CONTINUATION ERRORS
         BNEZ     ENDLINE2          BRANCH IF YES
         BAL,RL   CHAR
         CI,CRG   ' '
         BE       ENDLINE1
         CI,CRG   TAB
         BE       ENDLINE1
ENDLINE2    RES   0
         LI,N     SYNERR
         BAL,RL   WDOUT             OUTPUT THE SYNTAX ERROR
ENDLINE1 RES      0
         LI,N     ENDLN
         BAL,RL   WDOUT
         B        EXITSYN
*
*   E X C H S L O C
*        EXCHANGE SOURCE LEVEL LOCAL TABLE TABLE WITH SYMBOL TABLE
*
EXCHSLOC RES      0
         BAL,RL   EXCHS1
         B        TRUE
EXCHS1   RES      0
         LW,XT    SLOC
*  COMPUTE NUMBER OF ENTRIES IN SOURCE LEVEL LOCAL TABLE
         LCW,CT   LOCX              USE SLOC-LOCX IF ON SOURCE LEVEL
         MTW,0    PROCLV
         BEZ      %+2
         LCW,CT   PLOC              USE SLOC-PLOC IF WITHIN A PROC
         AW,CT    SLOC              ADD BASE ADDRESS OF SOURCE TABLE
         SLS,CT   -1
         B        SWAPLOC           SWAP LOCAL TABLES AND RETURN
*
*    I N T E G E R
*        CONVERT THE DIGITS OF A DECIMAL INTEGER.  AFTER THE FIRST
*        NON-DECIMAL CHARACTER IS FOUND, EXIT TO NUMOUT TO OUTPUT
*        THE CONVERTED NUMBER AND BACK-UP THE INPUT POINTER.
*
INTEGER  RES      0
         BAL,RL   CHAR              FIRST CHARACTER MUST BE
         LB,RT2   CONVTBL,CRG         DECIMAL, OR EXIT TO FALSE
         CI,RT2   DEC
         BAZ      FALSE
         AND,RT2  L(X'F')
         LI,RT1   0
         STW,RT1  OVFLAG            RESET OVERFLOW FLAG
INTGR1   BAL,RL   CHAR              GET NEXT CHARACTER
         LB,CRG   CONVTBL,CRG       IF NOT DECIMAL
         CI,CRG   DEC                 EXIT TO NUMOUT TO OUTPUT THE
         BAZ      NUMOUT              CONVERTED NUMBER
         AND,CRG  L(X'F')           CLEAN DIGIT
         SAD,RT1  1                 MULTIPLY ACCUMULATED INTEGER
         STD,RT1  RT3                 BY 10 AND ADD CURRENT DIGIT
         BNOV     %+2
         MTW,1    OVFLAG
         SAD,RT1  2
         BNOV     %+2
         MTW,1    OVFLAG
         AD,RT1   RT3
         BNOV     %+2
         MTW,1    OVFLAG
         AW,RT2   CRG
         BNC      CHAR
         AI,RT1   1
         BNOV     CHAR
         MTW,1    OVFLAG
         B        CHAR
*
*   M I N U S % O N E
*        OUTPUT AN ENCODED MINUS ONE
*
MINUS%ONE   RES   0
         AI,IN    1                 ADJUST FOR SUBTRACT AT RESETCHT
         LI,RT1   -1
         LI,RT2   -1
         B        NUMOUT
         PAGE
*
*    H E X I N T
*        READ AND CONVERT THE CHARACTERS OF A HEXADECIMAL INTEGER
*        SAME GROUND RULES AS OCTINT
*
HEXC     RES      0
         LI,CT    HEX               INDICATOR BIT FOR HEX
         LI,XT    4                 SHIFT AMOUNT FOR HEX
         LW,RT1   =X'10000000'      TRUNCATION TEST MASK
HEXC1    RES      0
         STW,RT1  M0                SAVE TRUNCATION TEST MASK
         LI,RT1   0                 CLEAR CONVERTED NUMBER
         LI,RT2   0
         STW,RT1  OVFLAG            CLEAR TRUNCATION FLAG
         BAL,RL   CHAR              FIRST CHARACTER
         LB,CRG   CONVTBL,CRG
         CW,CRG   CT                MUST BE HEX (OR OCTAL)
         BANZ     HEXC3             IT IS
         B        FALSE
HEXC2    RES      0
         CW,RT1   M0                TEST FOR TRUNCATION
         BL       %+2               NO
         MTW,+1   OVFLAG            SET TRUNCATION FLAG
         SAD,RT1  0,XT              SHIFT LEFT 3 OR 4
HEXC3    RES      0
         AND,CRG  L(X'F')
         OR,RT2   CRG                 AND INSERT IT IN CONSTANT
         BAL,RL   CHAR              NEXT CHARACTER
         LB,CRG   CONVTBL,CRG
         CW,CRG   CT
         BANZ     HEXC2             BRANCH IF HEX (OR OCTAL)
* FINISHED WITH CONVERSION. NOW OUTPUT THE CONSTANT
NUMOUT   RES      0
         CI,RT1   0                 IS HIGH ORDER 32 BITS ZERO
         BEZ      HEXC6             YES
         LI,N     LARGEINT+4
         BAL,RL   WDOUT             TYPE 7 CONTROL WORD
NUMOUT1  LH,N     RT1
         BAL,RL   WDOUT             HIGH ORDER 16 BITS,M.S. WORD
         LW,N     RT1
HEXC5    RES      0
         BAL,RL   WDOUT             LOW 16 BITS, M.S. WORD
NUMOUT2  RES      0
         LH,N     RT2
HEXC8    BAL,RL   WDOUT             HIGH 16 BITS, L.S. WORD
         LW,N     RT2
         B        HEXC10
HEXC6    RES      0
         LH,N     RT2               TEST HIGH 16 BITS OF L.S. WORD
         BEZ      HEXC7
         LI,N     LARGEINT+2
         B        HEXC5
HEXC7    RES      0
         CI,RT2   8191              WILL CONSTANT FIT IN 13 BITS
         BLE      HEXC9             YES. OUTPUT AS A TYPE 6 CONSTANT
         LI,N     LARGEINT+1
         B        HEXC8
HEXC9    RES      0
         LI,N     SMALLINT
         AW,N     RT2
HEXC10   RES      0
         BAL,RL   WDOUT
HEXC11   RES      0
         LW,N     OVFLAG            IS TRUNCATION FLAG SET
         BEZ      RESETCHT          NO, IT'S NOT
         LI,N     TRUNERR
         BAL,RL   WDOUT
         B        RESETCHT
*
*   L C L D L T E
*        DELETE THE CURRENT LOCAL TABLE. DON'T DELETE IF CURRENT
*          COMMAND AND LAST COMMAND ARE LOCAL DIRECTIVES
*
LCLDLTE  RES      0
         LI,XT    0
         STW,XT   CURLOCNT          CLEAR CURRENT LOCAL COUNT
         LW,XT    LASTCMND
         CW,XT    CURRCMND
         BE       TRUE
         BAL,RL   LCLDL1
         B        TRUE
LCLDL1   RES      0
*  DELETE THE SOURCE LEVEL LOCAL TABLE IF NOT WITHIN A PROC;
*    OTHERWISE DELETE THE PROC LEVEL LOCAL TABLE
         LW,XT    SLOC
         LW,RT1   PROCLV
         BEZ      %+2
         LW,XT    PLOC
         LW,CT    XT                COMPUTE NUMBER OF LOCALS
         SW,CT    LOCX                IN THE LOCAL TABLE
         SLS,CT   -1
         STW,XT   LOCX              RESET LOCATION FOR NEXT LOCAL
         LI,RT1   0
         STW,RT1  NXTLOC            CLEAR NEXT LOCAL NUMBER
         B        SWAPLOC           SWAP LOCAL TABLES AND RETURN
*
*   L O C A L S Y M
*        ENTER A SYMBOL IN THE CURRENT LOCAL SYMBOL TABLE
*
LOCALSYM RES      0
         LW,RL    LOCX              IS THERE ENOUGN ROOM
         CW,RL    LVLBASE             FOR ANOTHER LOCAL SYMBOL
         BLE      LVLMOVE           NO
         CALL     *SEARCHV
         CALL     *INSERTV
         CI,N     8192              IGNORE THIS SYMBOL IF IT'S
         BANZ     TRUE
         AI,M1    -HED
         LW,RL    PTRWD,M1
         LW,RT3   SNWD,M1
         LW,XT    LOCX
         STW,RL   PTROFFSET,XT      MOVE FLAGS TO LOCAL FLAGS
         LW,RT1   NXTLOC
         CI,RT1   255               TOO MANY LOCAL SYMBOLS
         BG       OPENSYM1          YES
         AI,RT1   8192
         LW,RT2   L(GLFLD)
         CW,RL    L(PTRFLD)         TEST PTR BIT TO FIND WHERE SN IS
         BANZ     LOCSYM1
         SLS,RT3  -16
         SLD,RT1  16
LOCSYM1  RES      0
         STS,RT1  GLWD,M1           STORE LOCAL SYMBOL NUMBER
         MTW,+1   INCORESF          SET DIRTY-PAGE FLAG
         LW,RT2   =CF1FLD+CLOFLD
         LI,RT1   0                 SET SYMBOL TABLE FLAGS
         STS,RT1  PTRWD,M1            TO LOCAL
         MTW,0    SPILLFLG
         IF,NZ                      DOIF IN SYMT SPILL MODE
         LW,M1    M1SAVE            GET VIRTUAL OFFSET, RATHER THAN REAL
         AI,M1    -HED
         FI
         STH,M1   RT3
         STW,RT3  GLOFFSET,XT       STORE SN & GL FIELDS IN LOCAL TABLE
         MTW,1    NXTLOC            BUMP NUMBER OF LOCALS
         MTW,1    CURLOCNT          ADD 1 TO CURRENT LOCAL COUNT
         MTW,-2   LOCX              ADVANCE LOCAL TABLE ADDRESS
         B        TRUE
LVLMOVE  RES      0
         LW,XT    LVL
LVLMOVE2 LW,RL    0,XT              MOVE A WORD
         STW,RL   -20,XT              IN LEVEL TABLE
         AI,XT    1
         CW,XT    LVLBASE           FINISHED
         BLE      LVLMOVE2          NO
         AI,LVL   -20               YES, RESET LVL
         AI,XT    -21
         STW,XT   LVLBASE           RESET LEVEL BASE
         CW,LVL   BUFPTR
         BLE      OVERFLOW
         B        LOCALSYM
*
*    W R I T E L O C A L C T
*
WRITELOCALCT   RES  0
         LI,N     SMALLINT
         AW,N     CURLOCNT          ADD LOCAL COUNT
         B        OPENSYM4
*
*   O C T I N T
*        READ AND CONVERT THE CHARACTERS OF AN OCTAL INTEGER.
*          AFTER THE FIRST NON-OCTAL CHARACTER IS FOUND, THE ROUTINE
*          BRANCHES TO NUMOUT TO OUTPUT THE CONVERTED NUMBER
*          AND BACK-UP THE INPUT POINTER.
*
OCTC     RES      0
         LI,CT    OCT               INDICATOR BIT FOR OCTAL
         LI,XT    3                 SHIFT AMOUNT FOR OCTAL
         LW,RT1   =X'20000000'      TRUNCATION TEST MASK
         B        HEXC1
*
*   O P E N S Y M
*        'OPEN' THE NEXT SYMBOL OF AN OPEN DIRECTIVE
*
OPENSYM  RES      0
         CALL     *SEARCHV
         B        OPENSYM3          NOT FOUND.  INSERT AND LEAVE
         CI,N     8192
         BAZ      OPENSYM2
OPENSYM1 RES      0
         LI,N     SYNERR
OPENSYM4 RES      0
         BAL,RL   WDOUT
         B        TRUE
OPENSYM2 RES      0
         LB,XT    *M1
         IF,NZ
         CALL     *CREATE1STV
         FI
         CALL     *NEWENTRYV
         B        SYMOUT
*    S T S T S Y M B
*
STSTSYMB RES      0
         LI,XT    0
         STW,XT   OVFLAG            CLEAR TRUNCATION FLAG
         STW,XT   SIGFLAG           TEMP
         LI,RT4   SMALLINT          INIT TEXT CONTROL WORD
         LB,XT    HED               CALCULATE BYTE COUNT OF
         SLS,XT   2                   SYS NAME TO NEAREST WD
         STW,XT   LL
         STW,XT   RT2
         AI,XT    -1
*        PUT SYSTEM NAME IN TEXTC FORMAT
SYSTEM15 LB,RT1   SYM1,XT           MOVE A BYTE
         STB,RT1  SYM1,LL
         CI,RT1   ' '               COUNT NUMBER OF
         BNE      %+2                 CHAR IN SYS N NAME
         AI,RT2   -1
         AI,XT    -1
         BDR,LL   SYSTEM15
         STB,RT2  SYM1              STORE CHAR COUNT
         CI,RT2   7                 DON'T COMPARE IF THERE'S MORE
         BG       SYSTEM50            THAN 7 CHARACTERS
*
         LW,RT1   SYM1              1ST WORD OF SYSTEM NAME
         LW,RT2   L(X'FFFFFF')
         CS,RT1   L(' SIG')         IS IT 'SIG'
         BNE      SYSTEM50          NO
SYSTEM20 RES      0
         LW,RT1   SYM1+1            GET 2ND WORD
         LI,XT    SIGTABEND-(SIGTAB+1)     # OF SUBSETS
SYSTEM25 RES      0
         CW,RT1   SIGTAB,XT         CHECK WHICH SIG
         BE       SYSTEM40
         BDR,XT   SYSTEM25
         B        SYSTEM50
SYSTEM40 RES      0
         LW,RT3   7FDPWORD
         STW,RT3  SYM1+1            FORCE SIG7FDP
         LI,RT3   3
         STB,RT3  SIGFLAG           SET 'SIG' FLAG ON
         STB,RT3  SYM1
         LB,RT1   SYSCODE,XT        GET S:IVAL VALUE
         AW,RT4   RT1               PUT VALUE IN TEXT WD
         STW,RT1  VAL%S:IVAL
SYSTEM50 RES      0
         MTW,0    ND%FLAG           WAS STD DEF FILE READ
         BNEZ     SYSTEM75          NO, DONT LOOK FOR SYS
         LW,XT    *SDFCONNCDR       GET COUNT OF # OF ITEMS
         AND,XT   L(X'FFFF')        CLEAN IT AND CHECK FOR 0
         BEZ      SYSTEM75          YES, ZERO
         STW,XT   #SYSITEM          SAVE COUNT
         LI,XT    4
         STW,XT   XTSAVE
SYSTEM52 LW,XT    XTSAVE            GET INDEX TO NEXT SYS NAME
         LB,LL    *SDFCONNCDR,XT
         AWM,LL   XTSAVE            SET INDEX TO NEXT
         MTW,1    XTSAVE              SYS NAME
         LW,XT    XTSAVE            POINT TO LAST CHAR+1 OF NAME
         CB,LL    SYM1              ARE NAMES SAME LENGTH
         BNE      SYSTEM60          NO
SYSTEM55 AI,XT    -1
         LB,RT1   SYM1,LL           ARE NAMES
         CB,RT1   *SDFCONNCDR,XT      THE SAME
         BNE      SYSTEM60          NO
         BDR,LL   SYSTEM55
         B        SYSTEM85
SYSTEM60 MTW,-1   #SYSITEM          FINISHED LOOKING FOR SYS NAMES
         BGZ      SYSTEM52          NO
*        SET UP BYTE POINTER TO SYSTEM NAME
SYSTEM75 RES      0
         MTW,0    SIGFLAG           'SIG' TYPE SYS
         BEZ      SYSTEM77          NO
         LI,RT1   7                 YES, SET LENGTH
         STB,RT1  SYM1                TO 7
SYSTEM77 RES      0
         LI,RT1   BA(SYM1)+1
         STW,RT1  IM@NAME
         LB,RT1   SYM1              GET COUNT
         STB,RT1  IM@NAME
         BAL,LINK IM@COPY           OPEN SYSTEM FILE & BUMP SYS LEVEL
         AI,RT4   X'400'
         MTW,0    IM@SYS            WAS SYSTEM FOUND
         BEZ      SYSTEM85          NO, LEAVE TYPE = 1
         AI,RT4   X'400'            YES, CONVERT TYPE TO 2
SYSTEM85 RES      0
         LW,N     RT4
         BAL,RL   WDOUT             WRITE SYSTEM FLAG WORD
         AI,IN    2
         LB,XT    SYM1
         B        ALF3              GO WRITE SYSTEM NAME
*
SIGTAB   EQU      %-1
7FDPWORD TEXT     '7FDP'
         TEXT     '7FD'
         TEXT     '7FP'
         TEXT     '7DP'
         TEXT     '7D'
         TEXT     '7F'
         TEXT     '7P'
         TEXT     '5FP'
         TEXT     '5P'
         TEXT     '5F'
         TEXT     '7'
         TEXT     '5'
         TEXT     '6FP'
         TEXT     '6F'
         TEXT     '6P'
         TEXT     '6'
         TEXT     '8P'
         TEXT     '8'
         TEXT     '9P'
         TEXT     '9'
SIGTABEND  RES    0
SYSCODE  RES      0
         DATA,1   0,15,14,13,11,10,12,9,5,1,4,8,0
         DATA,1   15,14,11,10
         DATA,1   29,28             SIG8 HAS NO DECIMAL INSTS.
         DATA,1   31,30
         BOUND    4
*
*   P K D E C
*        READ, PACK, AND OUTPUT THE CHARACTERS OF A PACKED DECIMAL CONSTANT
*
PKDEC    RES      0
         LI,RT2   0                 CLEAR THE CONVERTED CONSTANT
         STW,RT2  OVFLAG            CLEAR TRUNCATION FLAG
         LI,XT    -4
         STW,RT2  SYM1+4,XT
         BIR,XT   %-1
         BAL,RL   CHAR              GET THE FIRST CHARACTER
         LI,XT    X'C'              SIGN IS PLUS UNLESS CONSTANT
         CI,CRG   '-'                 IS PRECEDED BY '-'
         BNE      PKDEC1
         LI,XT    X'D'              SET SIGN MINUS
         B        PKDEC2
PKDEC1   RES      0
         CI,CRG   '+'
         BNE      PKDEC3
PKDEC2   RES      0
         BAL,RL   CHAR              GET FIRST NUMERIC DIGIT
PKDEC3   RES      0
         LB,CT    CONVTBL,CRG       THIS CHARACTER MUST BE NUMERIC
         CI,CT    DEC
         BANZ     PKDEC4
         B        FALSE
PKDEC5   RES      0
         BAL,RL   CHAR              GET NEXT CHARACTER
         LB,CT    CONVTBL,CRG       TEST FOR DECIMAL
         CI,CT    DEC
         BAZ      PKDEC7            NO. END OF CONSTANT
*
* SHIFT THE PARTIALLY CONVERTED CONSTANT LEFT 1 DIGIT AND CHECK
*   FOR TRUNCATION
*
PKDEC4   RES      0
         LD,RT1   SYM1
         CW,RT1   =X'10000000'      TEST FOR TRUNCATION
         BL       %+2               NO
         MTW,+1   OVFLAG            SET TRUNCATION FLAG
         SAD,RT1  4
         STW,RT1  SYM1
         LW,RT1   SYM1+1
         LW,RT2   SYM1+2
         SLD,RT1  4
         STW,RT1  SYM1+1
         LD,RT1   SYM1+2
         SLD,RT1  4
         AND,CT   L(X'F')
         SLS,CT   4
         OR,RT2   CT
         STD,RT1  SYM1+2
         B        PKDEC5
* NUMBER IS CONVERTED. NOW INSERT THE SIGN
PKDEC7   RES      0
         OR,RT2   XT                INSERT THE SIGN
         STW,RT2  SYM1+3
         LI,XT    -8
         LI,N     LARGEINT+CT1
PKDEC8   RES      0
         LH,CT    SYM1+4,XT
         BNEZ     PKDEC9
         BIR,XT   PKDEC8
PKDEC9   RES      0
         LI,CRG   8
         AW,CRG   XT
         LCW,XT   XT
         B        WRICONST
*
*   S E T P R O C L V
*        SPECIAL PROCESSING FOR THE 'PROC' DIRECTIVE
*
SETPROCLV  RES    0
         MTW,0    PROCLV            IGNORE IF ALREADY
         BNEZ     TRUE                WITHIN A PROC
         MTW,1    PROCLV            NON-ZERO TO 'WITHIN PROC' FLAG
         LW,XT    LOCX              STORE ORIGIN OF PROC LEVEL
         STW,XT   PLOC                LOCAL TABLE
         LI,XT    0
         STW,XT   NXTLOC            CLEAR NUMBER OF CURRENT LOCALS
         B        TRUE
*
*   S K I P N B
*        SKIP NON-BLANK CHARACTERS
*
SKIPNB   RES      0
         BAL,RL   CHAR
         CI,CRG   ' '
         BE       RESETCHT
         CI,CRG   TAB
         BNE      SKIPNB
         B        RESETCHT
*
*   S W A P L O C
*        EXCHANGE SYMBOL NUMBERS BETWEEN THE LOCAL SYMBOL TABLE
*          AND THE MAIN SYMBOL TABLE.
*        CALLED FROM PROC, PEND, END, COM, AND LOCAL DIRECTIVES
*
*         INPUT:  XT CONTAINS ORIGIN ADDRESS OF LOCAL TABLE
*                 CT CONTAINS NUMBER OF ENTRIES IN THE LOCAL TABLE
*
         LOCAL    %10                                          /27466/*D-NCD
*                                                              /27466/*D-NCD
SWAPLOC  RES      0
         STW,RL   SRCHXIT           SAVE RETURN                /27466/*D-NCD
%10      RES      0                                            /27466/*D-NCD
         CI,CT    0
         BLEZ     *SRCHXIT          BRIF DONE                  /27466/*D-NCD
*                                                              /27466/*D-NCD
         LW,RT1   SNOFFSET,XT
         LH,N     RT1               SYMBOL TABLE POINTER TO REG N
         AND,N    =GLFLD            TRIM TO DROP SIGN EXTENSION
         MTW,0    SPILLFLG          IN RAD-SPILL MODE?         /27466/*D-NCD
         IF,NZ                      DOIF WE ARE                /27466/*D-NCD
         LW,M1    N                                            /27466/*D-NCD
         AI,M1    HED               GET VIRTUAL ADDRESS        /27466/*D-NCD
         CALL     MAP%ADDR          MAKE SURE IT'S IN          /27466/*D-NCD
         AI,M1    -HED              GET REAL (TO US) OFFSET    /27466/*D-NCD
         STW,M1   N                                            /27466/*D-NCD
         MTW,+1   INCORESF          SET DIRTY-PAGE FLAG        /27466/*D-NCD
         LW,RT1   SNOFFSET,XT       RESTORE CLOBBERED REGISTER /27466/*D-NCD
         FI                                                    /27466/*D-NCD
         LI,RT2   GLFLD
         LW,RT3   SNWD,N
         LI,RT4   GLFLD
         LW,CRG   PTROFFSET,XT
         CW,CRG   L(X'01000000')    IF MAIN SYMBOL TABLE ENTRY
         BGE      SWPL2               SWAP WITH SN FIELD
         CW,CRG   =PTRFLD
         BANZ     SWPL1
SWPL2    RES      0
         SLS,RT3  -16
         SLD,RT1  16
SWPL1    RES      0
         STS,RT1  GLWD,N
         STS,RT3  GLOFFSET,XT
         LW,RT1   PTRWD,N
         LW,RT2   =PTRFLD+CF1FLD+CLOFLD
         STS,RT1  PTROFFSET,XT
         LW,RT1   CRG
         STS,RT1  PTRWD,N
         AI,XT    -2
         AI,CT    -1
         B        %10                                          /27466/*D-NCD
*
*   W R I S Y M B O L
*        SEARCH-INSERT THE LAST INPUT SYMBOL, AND OUTPUT IT.
*
WRISYMBOL  RES    0
         CALL     *SEARCHV
OPENSYM3 RES      0
         CALL     *INSERTV
SYMOUT   RES      0
         AI,N     SYMTYPE           SYMBOL CONTROL TYPE
         BAL,RL   WDOUT
         B        TRUE
*
*    W R I T E
*        WRITE THE NEXT SYNTAX ELEMENT IN THE OUTPUT STRING
*          AND SKIP THAT ELEMENT
*
WRITE    RES      0
         AI,SYN   1                 ADVANCE SYNTAX POINTER
         LH,N     SYNTAX,SYN        GET THE SYNTAX ELEMENT
         LI,RL    TRUE              SET EXIT AND FALL THROUGH TO WDOUT
*
*    W D O U T
*        WRITE AN ELEMENT IN THE OUTPUT STRING
*
WDOUT    RES      0
         STW,RL   WDOUTRTN          SAVE RETURN ADDRESS
         CI,OUT   OUTSIZE-1         IS OUTPUT BUFFER FULL
         BGE      WDOUT1            YES,
         STH,N    OUTBUF,OUT        NO, PUT ENCODED ITEM
         AI,OUT   1                   IN ENCODED TEXT BUFFER
         B        *WDOUTRTN         EXIT
WDOUT1   RES      0
         STW,XT   XTSAVE
         LI,XT    1
         LW,OUT   OUTSAVE
         IF,EZ                      DOIF FULL BUFFER           /27493/*D-NCD
         ABORT    ABORT21           (STATEMENT TOO LONG)       /27493/*D-NCD
         FI                                                    /27493/*D-NCD
         LH,RT4   OUTBUF,OUT        SAVE 1ST WORD OF LINE
         MTW,0    CNCTRL
         IF,NZ                      IN CN CONTROLS
         CALL     IO%X3
         ELS                        IN PROGRAM
         BAL,RL   IO%X1             WRITE OUTBUF
         FI
         STH,RT4  OUTBUF            MOVE 1ST WORD OF LINE
         AI,OUT   1
WDOUT3   RES      0
         LH,RT3   OUTBUF,OUT        MOVE AN ENCODED ITEM
         STH,RT3  OUTBUF,XT           ITEM
         AI,OUT   1
         AI,XT    1
         CI,OUT   OUTSIZE-1         FINISHED
         BL       WDOUT3            NO,
         STH,N    OUTBUF,XT         YES, MOVE LAST WORD
         AI,XT    1
         STW,XT   OUT               SET OUT TO NEW VALUE
         LCW,RT1  OUTSAVE           SAVE OUT OFFSET
         AWM,RT1  NEXTLINE#         BUMP ADDRESS FOR NEXT LINE NUMBER
         LI,XT    0
         STW,XT   OUTSAVE           RESET OUTSAVE
         LW,XT    LVL
         AI,XT    3
WDOUT7   AWM,RT1  LVLTBL+1,XT       MODIFY OUT ENTRIES
         AI,XT    3
         CW,XT    LVLBASE           FINISHED
         BL       WDOUT7            NO
WDOUT9   LW,XT    XTSAVE
         B        *WDOUTRTN         YES, EXIT
*
*    A T T R I B C K
*
ATTRIBCK RES      0
         CI,CRG   '('               LAST CHAR = '('
         BNE      WRISYMBOL
*
         AI,IN    1
         CALL     *SEARCHV          NO
         CALL     *INSERTV
         AI,N     SBSYM             SUBSCRIPTED SYMBOL
         BAL,RL   WDOUT
         LI,N     SUBSYMB-SYNTAX    GO TO SUBSYMB
         B        NEXTLEVEL           EQUATION
*
*    S Y M B O L
*
SYMBOL   RES      0
         BAL,RL   CHAR
         LI,RT2   ALPH+DEC          TEST FIRST CHARACTER
         CB,RT2   CONVTBL,CRG         FOR ALPHANUMERIC
         BAZ      FALSE
         LI,XT    -64               INDEX TO SYM1 CHARACTERS
         LW,N     ='    '           SET FIRST 8 CHARACTERS
         STW,N    SYM1                TO BLANKS
         STW,N    SYM1+1
         LI,RT1   ALPH              ALPHA FLAG
         B        SYMB2
SYMB1    RES      0
         BAL,RL   CHAR
SYMB2    RES      0
         CB,RT1   CONVTBL,CRG       BRANCH IF ALPHABETIC
         BANZ     SYMB3
         CB,RT2   CONVTBL,CRG       BRANCH IF NON-ALPHANUMERIC
         BAZ      FALSE
         STB,CRG  SYM1+16,XT        STORE LEADING NUMERIC DIGIT
         BIR,XT   SYMB1
         B        FALSE             64 NUMERIC DIGITS
SYMB3    RES      0
         STB,CRG  SYM1+16,XT        STORE ALPHANUMERIC CHARACTER
         BIR,XT   SYMB4
         MTW,+1   CONTIN%ERROR      SET CONTINUATION ERROR FLAG
         LI,XT    -1
SYMB4    RES      0
         BAL,RL   CHAR
         CB,RT2   CONVTBL,CRG       BRANCH IF ALPHANUMERIC
         BANZ     SYMB3
         CI,CRG   ''''              RETURN TO FALSE
         BE       FALSE               IF TERMINATOR IS A PRIME
         AI,XT    64
         CI,XT    8
         BLE      SYMB6
* STORE BLANKS IN TRAILING CHARACTER POSITIONS OF THE CURRENT WORD
SYMB5    RES      0
         CI,XT    3
         BAZ      SYMB7
         STB,N    SYM1,XT
         AI,XT    1
         B        SYMB5
SYMB6    RES      0
         AI,XT    3
SYMB7    RES      0
         SLS,XT   -2                STORE WORD COUNT
         STB,XT   HED
RESETCHT RES      0
         AI,IN    -1
         B        TRUE
         PAGE
*
******** SUBROUTINES FXC AND FSC AND FLC ******
*
*        INPUTS   R1-POSITION OF 1ST BYTE IN CONSTANT (BLDFBA)
*                 BYTP-POSITION OF LAST BYTE (') MINUS 1 (BLDLBA)
*
*        OUTPUTS  CON3,CON4 -SINGLE OR DOUBLE WORD CONSTANT.
*
*        FUNCTION CONVERT THE CONSTANT AT IBYT FROM ITS EBCDIC VALUE
*                 INTO A LONG FLOATING POINT NUMBER.  IF FXC IS USED,
*                 FIX THIS FLOATING POINT NUMBER ACCORDING TO THE
*                 BINARY SCALE FACTOR.  IF FSC IS USED, DISCARD THE
*                 LOW-ORDER 32 BITS OF THE NUMBER.
*
*
*********THE FLGS (R12) ARE SET AS FOLLOWS:
*
*            FLGS               MEANING
*          ********   **********************************
*          000000XX    SIGN OF INT0,INT1 (+=EVEN,-=ODD)
*          00001000    FXC ENTRY USED
*          00002000    FLC ENTRY USED
*          20000000    B FOUND
*          40000000    E FOUND
*          80000000    DECIMAL POINT FOUND
*
*
         LOCAL    R1,R2,R3,R13,R14,R15,LNKR,WAY,CC,WRK0,WRK1,DEXP,CNT,;
                  PNTR,INT0,INT1,FLGS,BIAS,LINK,CNTR,TMP0,TMP1,ESGN,;
                  HEXP,TMP2,FXFL,FLFL,EFLG,BFLG,DPFL
*
R1       EQU      1
R2       EQU      2
R3       EQU      3
LNKR     EQU      8
R13      EQU      13
R14      EQU      14
WAY      EQU      14
R15      EQU      15
*
CC       EQU      2
WRK0     EQU      4
WRK1     EQU      5
DEXP     EQU      6
CNT      EQU      7
PNTR     EQU      9
INT0     EQU      10
INT1     EQU      11
FLGS     EQU      12
BIAS     EQU      13
LINK     EQU      15
*
CNTR     EQU      1
TMP0     EQU      2
TMP1     EQU      3
ESGN     EQU      7
HEXP     EQU      9
TMP2     EQU      14
*
FXFL     EQU      X'1000'           FX ENTRY
FLFL     EQU      X'2000'
EFLG     EQU      4                 E FOUND
BFLG     EQU      2                 B FOUND
DPFL     EQU      8                 DEC PT FOUND
*
*
*********PART 1 - ACCUMULATION OF EBCDIC DIGITS
*
*            THIS PART GENERATES:
*              INT0,INT1-A HEXIDECIMAL INTEGER REPRESENTING THE CONSTANT
*              DEXP-THE DECIMAL EXPONENT OF INT0,INT1 (SIGNED)
*              BIAS-THE BINARY SCALE FACTOR OF AN FX CONSTANT (SIGNED)
*              FLGS-THE SIGN OF INT0,INT1
*
*
*
FXC      LI,R15   FXFL              SET FX ENTRY FLAG
         LI,N     LARGEINT+CT3+2
         B        FC1
FLC      LI,R15   FLFL              SET FL ENTRY FLAG
         LI,N     LARGEINT+CT5+4
         B        FC1
FSC      LI,R15   0                 SET FS ENTRY FLAG
         LI,N     LARGEINT+CT4+2
FC1      STW,R15  FLGS              SET FLAGS PER ENTRY
         LCI      6
         STM,2    FFFSAVE
         BAL,R15  SIGN              GET SIGN OF CONSTANT
         OR,FLGS  WAY               SAVE SIGN IN FLGS
         LD,DEXP  ZERO              SET DEXP=CNT=0
         LD,INT0  ZERO              SET INT0,INT1=0
         STW,DEXP OVFLAG            CLEAR TRUNCATION FLAG
         BAL,LINK ACUM              ACCUMULATE DIGITS TO 1ST NON-DIGIT
         LCF      CC                LOAD CC WITH NON-DIGIT CODE
         BCR,DPFL FC2               TEST IF NON-DIGIT IS A DEC PT
         OR,FLGS  CC                YES, SET DEC PT FLAG IN FLGS
         BAL,LINK ACUM              ACCUMULATE DIGITS TO NEXT NON-DIGIT
FC2      CI,CNT   0                 TEST IF >0 DIGITS ACCUMULATED
         BE       BLDCONE6          NO,ILLEGAL FORM
         OR,FLGS  CC                SET E FOUND OR B FOUND FLAG IN FLGS
         LCF      CC                LOAD CC WITH NON-DIGIT CODE
         BCR,EFLG FC3               TEST IF NON-DIGIT IS AN E
         BAL,LNKR GET2              YES, GET DIGITS AFTER E AND RETURN
*                                    /WITH CC OF NEXT NON-DIGIT
         AW,DEXP  WRK1              ADD EXPONENT TO DEXP
FC3      CI,FLGS  FXFL              TEST IF FX ENTRY WAS USED
         BAZ      FC4               NO, ANY B IS ILLEGAL
         LCF      CC                YES, LOAD CC WITH NON-DIGIT CODE
         BCR,BFLG BLDCONE6          TEST IF NON-DIGIT IS A B (IF NOT AN
*                                    /ERROR SINCE FX CONSTS MUST HAVE B)
         BAL,LNKR GET2              YES, GET DIGITS AFTER B AND RETURN
*                                    /WITH CC OF NEXT NON-DIGIT
         STW,WRK1 BIAS              SAVE BINARY SCALE FACTOR IN BIAS
         LCF      FLGS              PUT PREVIOUSLY SET FLAGS IN CC
         BCS,EFLG FC4               TEST IF A PREVIOUS E WAS FOUND
         LCF      CC                IF NOT, LOAD CC WITH NON-DIGIT CODE
         BCR,EFLG FC4               TEST IF NON-DIGIT IS AN E
         BAL,LNKR GET2              YES, GET DIGITS AFTER E
         AW,DEXP  WRK1              ADD EXPONENT TO DEXP
FC4      RES      0
*
*
*********PART 2 - BUILDING OF THE FLOATING POINT CONSTANT
*
*            THIS PART USES INT0,INT1, DEXP, BIAS, AND FLGS FROM
*            PART 1 AND GENERATES:
*              INT0,INT1-A DOUBLEWORD FLOATING POINT NUMBER FOR FSC AND
*                        FLC OR AN INTEGER FOR FXC (IN INT0)
*            THIS DOUBLEWORD IS RETURNED IN MAC1 AND MAC1+1.
*
*            FIXED POINT CALCULATIONS ARE CARRIED OUT BY MUL AND DIV.
*            BOTH EXPECT ARG1 IN INT0,INT1 AND GET ARG2 FROM CTBL.
*            THE INTERNAL FORMAT OF FLOATING POINT NUMBERS IS:
*                     0.(60 BITS OF SIGNIFICANCE)000       (64 BITS)
*            WHERE THE HEXIDECIMAL POINT IS AT BIT 0.  THE HEXIDECIMAL
*            EXPONENT IS KEPT IN HEXP.
*
         LD,TMP1  INT0              TEST IF INTEGER IS ZERO
         BEZ      EXITS             YES, EXIT
         LB,ESGN  DEXP              SET ESGN=0 IF DEXP>=0 OR
         SLS,ESGN -7                 /SET ESGN=1 IF DEXP<0
         LAW,DEXP DEXP              MAKE DEXP POSITIVE
         LI,HEXP  X'50'             SET HEX EXPONENT TO 16
         SCD,INT0 3                 NORMALIZE INTEGER TO INTERNAL F.P.
         BAL,LINK NM1                /FORMAT, NAMELY 0.(63 BITS)
         AND,INT0 L(X'7FFFFFFF')    SET SIGN-BIT TO ZERO (PLUS)
*
*            AT THIS POINT WE ARE READY TO PROCESS THE DEC EXPONENT, AS
*            FOLLOWS:
*             1) FOR DEXP>13, MULT/DIV BY 10**13 AND DECREMENT DEXP BY
*                13 UNTIL DEXP<=13.
*             2) FOR DEXP<=13, DO ONE MULT/DIV BY THIS POWER.
*
         AI,DEXP  -13               DECR DEXP BY -13
         BLZ      MF2               TEST IF DEXP<13
         LW,TMP2  DEXP              NO, DEXP>=13; SO SAVE DEXP IN TMP2
         LI,DEXP  12                 /AND SET DEXP=12
MF1      EXU      BTBL,ESGN         DO A MUL/DIV BY 10**13
         AI,TMP2  -13               DECR OLD DEXP BY 13
         BGZ      MF1               IF DEXP>13, REPEAT MUL/DIV BY 10**13
         LW,DEXP  TMP2              IF DEXP<=13, RESET DEXP TO NEW VALUE
MF2      AI,DEXP  12                RECOVER DEXP-1
         BLZ      MF3               TEST IF DEXP=0 (IF YES, RESULT OK)
         EXU      BTBL,ESGN         NO,SO DO A MUL/DIV BY 10**(DEXP+1)
MF3      RES      0
         CI,FLGS  FXFL
         BANZ     DOFX              TEST IF FXC ENTRY WAS USED
         CI,FLGS  FLFL              TEST IF FLC ENTRY WAS USED
         BANZ     MF4               YES, DON'T ROUND
         AI,INT0  X'40'             ROUND FS CONSTANTS TO 24 BITS
         BNOV     MF4               TEST IF OVER-FLOW ON ROUND
         LW,INT0  =X'7FFFFFFF'      CONSTANT FOR NO-ROUND CASE
         CI,HEXP  X'7F'             CAN NUMBER BE ROUNDED
         BE       MF4               CAN'T ROUND
         LW,INT0  =X'10000000'
         AI,HEXP  1                  /AND EXPONENT
MF4      RES      0
         CI,HEXP  X'7F'             TEST FOR
         BG       BLDCONE6          EXPONENT
         CI,HEXP  0                 OVERFLOW
         BL       BLDCONE6          OR UNDERFLOW
         SLD,INT0 -7                CHANGE RESULT TO STANDARD F.P.
         STB,HEXP INT0               /FORMAT, NAMELY 'CCMMMMMMMMMMMMMM'
         CI,FLGS  1
         BAZ      EXITS             TEST SIGN OF CONSTANT
         CI,FLGS  FLFL              COMPLEMENT SINGLE OR DOUBLE
         BAZ      MF5               SINGLE
         LCD,INT0 INT0
         B        EXITS
MF5      RES      0
         LCW,INT0 INT0
EXITS    CI,FLGS  FLFL
         BAZ      EXS1              TEST IF FLC ENTRY WAS USED
         XW,INT0  INT1              YES, SO FLIP INT0 AND INT1
         STW,INT1 RT1               UPPER TO RT1
EXS1     STW,INT0 RT2               LOWER TO RT2
         B        BLDCONX1          EXIT
DOFX     CI,FLGS  1
         BAZ      DF1               TEST SIGN OF RESULT
         LCD,INT0 INT0              NEGATIVE, SO COMPLIMENT RESULT
DF1      AI,HEXP  -X'40'            CALCULATE NUMBER OF POSITIONS
         SLS,HEXP 2                  /TO SHIFT SO AS TO ALLIGN HEX POINT
         SW,HEXP  BIAS               /ACCORDING TO BINARY SCALE FACTOR
         AND,HEXP L(X'FF')          PREPARE SHIFT INST.
         AI,HEXP  X'500'
         S,INT0   *HEXP             SHIFT (SAD)
         BNOV     EXITS             IF NO OVERFLOW-EXIT
BLDCONE6 RES      0
         MTW,+1   OVFLAG            SET TRUNCATION FLAG
         LD,RT1   ZERO
*
*
*
*  NORMAL  EXIT ROUTINE
*
BLDCONX1 LCI      6                 RESTORE REGISTERS.
         LM,2     FFFSAVE
         BAL,RL   WDOUT             WRITE CONSTANT TYPE.
         CI,FLGS  FLFL              FL CONSTANT
         BANZ     NUMOUT1           YES, GEN 4 HALF-WDS
         B        NUMOUT2           NO, GEN 2 HALF-WDS
*
*        SUBROUTINE TO ACCUMULATE DIGITS IN INT0,INT1
*
ACUM     STW,LINK ACUMLNK           SAVE LINK
ACUM1    BAL,LINK FFFGNC            GET NEXT CHAR.
         LB,R2    CONVTBL,R3        GET CHAR CODE.
         CI,R2    DEC               DIGIT
         BAZ      ACUMX             NO
         AND,R3   L(X'F')           YES,CLEAN IT
         AI,CNT   1                 KEEP COUNT OF NUMBER OF DIGITS
         STD,INT0 WRK0              START MULTIPLYING CURRENT
         SLD,WRK0 3                  /INTEGER BY 10
         BOV      AOV2              IF OVERFLOW, JUST INCR DEXP
         SLD,INT0 1                 DO 2ND STEP OF MULTIPLY
         AD,INT0  WRK0
         BOV      AOV1              IF OVERFLOW, RECOVER AND INCR DEXP
         LI,R2    0
         AD,INT0  R2                ADD ON NEW DIGIT
         BOV      AOV1              IF OVERFLOW, RECOVER AND INCR DEXP
         LCF      FLGS
         BCR,DPFL ACUM1             TEST IF DEC PT HAS BEEN ENCOUNTERED
         AI,DEXP  -1                YES, THEN DECR DEXP (I.E.,COUNT
         B        ACUM1             CONTINUE    /DIGITS AFTER DEC PT)
AOV1     SLD,WRK0 -3                RECOVER PREVIOUS RESULT
         LD,INT0  WRK0
AOV2     LC       FLGS
         BCS,DPFL ACUM1             TEST IF DEC PT HAS BEEN ENCOUNTERED
         AI,DEXP  1                 YES, THEN INCR DEXP ONLY (SINCE AT
         B        ACUM1             CONTINUE /MAX SIGNIFICANCE ALREADY)
ACUMX    LI,R2    4
ACUMX1   CB,R3    ACUMSPCH,R2       FIND B,E,.
         BNE      ACUMX2
         SLS,R2   29                FOUND,SHIFT TO CC. 2=B,4=E,8=.
         B        *ACUMLNK          EXIT
ACUMX2   BDR,R2   ACUMX1            NOT FOUND, CC=0
         B        *ACUMLNK          EXIT
*
*        THIS SUBROUTINE SAVES REGISTERS, BRANCHES TO 'CHAR' TO
*          GET THE NEXT CHARACTER, RESTORES REGISTERS, AND EXITS
*
FFFGNC   RES      0
         STW,LINK FFFGNCLNK         SAVE LINK
         LCI      6
         STM,2    FFFSAVE+6         SAVE CONVERT REGISTERS.
         LM,2     FFFSAVE           RESTORE ENCODE REGISTERS.
         BAL,RL   CHAR              GET NEXT CHAR.
         LCI      6
         STM,2    FFFSAVE           SAVE ENCODE REGISTERS.
         LM,2     FFFSAVE+6         RESTORE CONVERT REGISTERS.
         LW,R3    FFFSAVE+5         LOAD NEXT CHAR.
         B        *FFFGNCLNK        EXIT
*
*        SUBROUTINE TO ACCUMULATE DIGITS AFTER A B OR E (THE RESULT
*          IS A SIGNED INTEGER RETURNED IN WRK1)
*
GET2     LCI      8                 SAVE 6-13
         STM,DEXP GET2REGS
         BAL,R15  SIGN              GET SIGN OF EXPONENT (IN WAY)
         STW,WAY  R13               SAVE SIGN
         LD,INT0  ZERO              SET INT0,INT=0
         LI,CNT   0                 SET CNT=0
         BAL,LINK ACUM              ACCUMULATE DIGITS OF EXPONENT
         CLM,CNT  P1                TEST IF 0<CNT<3 (I.E.,IF EXP IS 1
         BCS,9    BLDCONE6          IF NOT ERROR         /OR 2 DIGITS)
         STW,INT1 WRK1              PUT RESULT IN WRK1
         CI,R13   1
         BAZ      %+2               TEST SIGN OF EXP
         LCW,WRK1 WRK1              NEGATIVE, SO COMPLIMENT RESULT
         LCI      8                 RESTORE
         LM,DEXP  GET2REGS          6-13
         B        *LNKR             EXIT
*
*        MULTIPLY SUBROUTINE (USING INTERNAL FORMAT)
*
MUL      LW,TMP1  INT0              SET UP 1ST MULTIPLY (UPPER 31 BITS)
         MW,TMP0  CTBL,DEXP         DO 1ST MULTIPLY (BY 10**(DEXP+1))
         SLS,INT1 -1                SET UP 2ND MULTIPLY (LOWER 31 BITS)
         MW,INT0  CTBL,DEXP         DO 2ND MULTIPLY (BY 10**(DEXP+1))
         SLD,INT0 -31               SCALE RESULT
         AD,INT0  TMP0              ADD TOGETHER THE TWO PRODUCTS
         LCH,CNTR STBL,DEXP         GET SHIFT COUNT TO CORRECTLY SCALE
         SLD,INT0 1,CNTR            SCALE            /RESULTANT PRODUCT
         BAL,LINK NORM              NORMALIZE RESULT
         AH,HEXP  ETBL,DEXP         ADD EXPONENT OF 10**(DEXP+1) TO HEXP
         AI,HEXP  1                  /AND THEN ADD ONE MORE
         B        *LNKR             RETURN
*
*        DIVIDE SUBROUTINE (USING INTERNAL FORMAT)
*
DIV      SAD,INT0 -2                SETUP 1ST DIVIDE
         DW,INT0  CTBL,DEXP         DO 1ST DIVIDE (BY 10**(DEXP+1))
         STW,INT1 TMP1              SAVE RESULTANT QUOTIENT
         LI,INT1  0                 SET UP 2ND DIVIDE,
         SAD,INT0 -1                 /NAMELY: REMAINDER/10**(DEXP+1)
         DW,INT0  CTBL,DEXP         DO 2ND DIVIDE
         LW,INT0  TMP1              CONSTRUCT FINAL QUOTIENT
         SLS,INT1 1                  .
         SH,HEXP  ETBL,DEXP         SUBT EXPON OF 10**(DEXP+1) FROM HEXP
         LH,CNTR  STBL,DEXP         GET SHIFT COUNT TO CORRECTLY SCALE
*                                    /THE RESULTANT QUOTIENT
         SCS,TMP1 1,CNTR            DO A TEST SCALING ON THE
         BNOV     DV1                /DUPLICATE QUOTIENT
         SLD,INT0 -3,CNTR           IF OVERFLOW, SCALE THE ACTUAL
*                                    /QUOTIENT BY A RIGHT SHIFT
         B        *LNKR             RETURN
DV1      SLD,INT0 1,CNTR            IF NO OVERFLOW, SCALE THE ACTUAL
*                                    /QUOTIENT BY A LEFT SHIFT
         BAL,LINK NORM              BE SURE THE RESULT IS NORMALIZED
         AI,HEXP  -1                DECREMENT HEX EXPONENT BY 1
         B        *LNKR             RETURN
*
*        SUBROUTINE TO NORMALIZE TO INTERNAL F.P. FORMAT
*
NORM     SCD,INT0 4                 ATTEMPT TO NORMALIZE
NM1      BOV      NM2               TEST IF NUMBER WAS ALREADY NORMAL-
         AI,HEXP  -1                NO, SO DECREMENT HEX EXP     /IZED
         B        NORM               /AND REPEAT NORMALIZATION PROCESS
NM2      SCD,INT0 -4                NORMALIZED, SO RECOVER RESULT
         B        *LINK              /AND EXIT
*
******** SUBROUTINE SIGN ***********   * * EXAMPLE USAGE
*                                      * *    BAL,R15   SIGN
*        INPUTS   BYTP                 * *    CI,WAY    1
*                                      * *    BL        NOSIGN
*        OUTPUTS  BYTP                 * *    BCR,4     PLUS
*                 WAY   0=NO SIGN      * *----ITS NEGATIVE----
*                       ODD=NEGATIVE
*                       EVEN=POSITIVE
*
*        CALL     BAL,R15    GETSIGN
*
*        FUNCTION COLLECT CONSECUTIVE SIGNS LEAVING RESULT IN WAY
*
SIGN     LI,WAY   0
         STW,R15  SIGNLNK           SAVE LINK
SIGN1    BAL,LINK FFFGNC            GET NEXT CHAR.
         CI,R3    '+'               CHAR = '+'
         BNE      %+3               NO
         AI,WAY   2                 YES, ADD 2
         B        SIGN1
         CI,R3    '-'               CHAR = '-'
         BNE      %+3               NO
         AI,WAY   1                 YES, ADD 1
         B        SIGN1
         MTW,-1   FFFSAVE           BACKUP 1 CHAR.
         B        *SIGNLNK          EXIT
         SPACE    5
*
*        DATA AND TABLES
*
BTBL     BAL,LNKR MUL               BRANCH TABLE
         BAL,LNKR DIV
*
CTBL     DATA     X'50000000'       CONSTANT TABLE     10**1
         DATA     X'64000000'                          10**2
         DATA     X'7D000000'                          10**3
         DATA     X'4E200000'                          10**4
         DATA     X'61A80000'                          10**5
         DATA     X'7A120000'                          10**6
         DATA     X'4C4B4000'                          10**7
         DATA     X'5F5E1000'                          10**8
         DATA     X'77359400'                          10**9
         DATA     X'4A817C80'                          10**10
         DATA     X'5D21DBA0'                          10**11
         DATA     X'746A5288'                          10**12
         DATA     X'48C27395'                          10**13
*
         BOUND    4
ETBL     DATA,2   0                 EXPONENT TABLE     10**1
         DATA,2   1                                    10**2
         DATA,2   2                                    10**3
         DATA,2   3                                    10**4
         DATA,2   4                                    10**5
         DATA,2   4                                    10**6
         DATA,2   5                                    10**7
         DATA,2   6                                    10**8
         DATA,2   7                                    10**9
         DATA,2   8                                    10**10
         DATA,2   9                                    10**11
         DATA,2   9                                    10**12
         DATA,2   10                                   10**13
*
         BOUND    4
STBL     DATA,2   0                 SHIFT TABLE        10**1
         DATA,2   1                                    10**2
         DATA,2   2                                    10**3
         DATA,2   2                                    10**4
         DATA,2   3                                    10**5
         DATA,2   0                                    10**6
         DATA,2   0                                    10**7
         DATA,2   1                                    10**8
         DATA,2   2                                    10**9
         DATA,2   2                                    10**10
         DATA,2   3                                    10**11
         DATA,2   0                                    10**12
         DATA,2   0                                    10**13
         BOUND    4
         PAGE
*
*    S E A R C H
*
*        SEARCH THE BALANCED TREE SYMBOL TABLE.  THE SEARCH ARGUMENT
*          IS CONTAINED IN THE ITEM STARTING AT HED, IN THE SAME
*          FORMAT AS EACH ITEM IN THE SYMBOL TABLE.
*
*          OUTPUT: FND CONTAINS THE ADDRESS (17 BITS, FULL ADDRESS)
*                  OF THE FOUND SYMBOL TABLE ENTRY, IF IT IS FOUND.
*                  N  CONTAINS THE SYMBOL NUMBER AND LOCAL BIT
*                  M1 CONTAINS THE LOCATION OF THE LAST OPEN SYMBOL
*                    TABLE ENTRY.
*                 EXIT TO CALLING ROUTINE + 1 IF NOT FOUND,
*                   OR TO CALLING ROUTINE + 2 IF FOUND.
*
SEARCH   RES      0
         STW,RL   SRCHXIT           SAVE EXIT
         LI,U     HED
         STW,U    M0
         LI,RT3   0
         LI,RT4   DIRFLD
         LW,M1    LLWD              LL(HED) TO (M1)
         LW,RT5   SYM1              KEEP SYM1 IN A REGISTER
         LI,RT2   -1                KEEP A MASK IN A REGISTER
         B        SRCH8
*  IF BALANCE AT M1 NE 0, MOVE M0 TO U
SRCH1    RES      0
         AI,M1    HED
         STW,M1   FND
         LW,XT    BOFFSET,M1
         CI,XT    BALFLD
         BAZ      SRCH2
         LW,U     M0
* COMPARE THE 1ST WORD OF THE SYMBOL
SRCH2    RES      0
         LI,XT    2
         CW,RT5   *FND,XT
         BNE      SRCH3             BRANCH IF 1ST WORD DOESN'T COMPARE
* CHOOSE THE SMALLER WORD COUNT TO TERMINATE THE COMPARE LOOP
         LB,CT    HED
         CB,CT    *FND
         BLE      SRCH4
         LB,CT    *FND
SRCH4    RES      0
         BDR,CT   SRCH5             BRANCH IF MORE THAN ONE WORD SYMBOL
         B        SRCH6
SRCH5    RES      0
         AI,XT    1
         LW,RT1   HED,XT            COMPARE THE NEXT WORD
         CS,RT1   *FND,XT
         BNE      SRCH3             NOT THIS SYMBOL
         BDR,CT   SRCH5
* THE NAMES COMPARE, BUT THEIR SIZES MAY DIFFER
SRCH6    RES      0
         LB,CT    HED
         CB,CT    *FND
         BNE      SRCH3             NOT THE SAME LENGTH
         MTW,1    SRCHXIT           CHANGE TO TAKE 'FOUND' EXIT
         LW,N     GLOFFSET,M1
         SLS,N    -16
         LW,CT    PTROFFSET,M1
         LV,RL    DSSYMBIT          SAVE .DS CN BIT IN CASE WE NEED IT
         AND,RL   CT
         STS,RL   DSLNCTRL
         CW,CT    =PTRFLD+CLOFLD    EXIT IF THIS FIELD IS OPEN AND
         BAZ      *SRCHXIT            NOT A POINTER
         CW,CT    =CLOFLD
         BANZ     SRCH12
         LW,M1    N
         LI,XT    0                 CLEAR 'FOUND LOCATION' FLAG
         B        SRCH11
* FOLLOW THE POINTER TO THE LAST OPEN SYMBOL TABLE ENTRY
SRCH9    RES      0
         LW,M1    SNOFFSET,M1
         SLS,M1   -16
SRCH11   RES      0
         AI,M1    HED
         LW,CT    PTROFFSET,M1
         CW,CT    =CLOFLD
         BANZ     SRCH10            THIS ENTRY IS CLOSED
         LW,XT    M1                MOVE LAST OPEN ADDRESS TO M1
SRCH10   RES      0
         CW,CT    =PTRFLD
         BANZ     SRCH9             NOT END OF POINTER CHAIN
         CI,XT    0
         BEZ      SRCH13
         LW,M1    XT
         LW,CT    PTROFFSET,M1
         LW,N     GLOFFSET,M1       SAVE SYMBOL NUMBER OF LAST OPEN SYM
*    SYMBOL NUMBER IS IN 'SN' FIELD IF PTR=0; OTHERWISE SYNBOL NUMBER
*      IS IN THE 'GL' FIELD.
         CW,CT    L(PTRFLD)
         BANZ     %+2
         SLS,N    -16
         AND,N    L(GLFLD)
         B        *SRCHXIT
SRCH12   RES      0
         BAL,RL   CREATE1ST
SRCH13   RES      0
         LW,RL    SRCHXIT
NEWENTRY RES      0
         LW,RT2   PTROFFSET,M1
         CW,RT2   =PTRFLD
         BANZ     NEWEN1
         LW,RT2   =PTRFLD
         STS,RT2  PTROFFSET,M1
         LW,RT2   NEXTST
         LW,RT1   SNOFFSET,M1
         SLS,RT1  -16
         STH,RT2  RT1
         STW,RT1  SNOFFSET,M1
         LW,M1    RT2
         CW,M1    SYMLMTM1
         IF,EQ                      DOIF 2-WD ENTRY WOULD BRIDGE
         AI,M1    1                   SPILL PAGE BOUNDARY.
         MTW,+1   NEXTST
         FI
         MTW,2    NEXTST
         AI,M1    HED
         LI,N     0
         STW,N    PTROFFSET,M1
         LW,N     NXSYMB
         SLS,N    16
         STW,N    SNOFFSET,M1
         MTW,1    NXSYMB
         SLS,N    -16
         EXIT     RL
NEWEN1   RES      0
         LW,M1    SNOFFSET,M1
         SLS,M1   -16
         AI,M1    HED
         B        NEWENTRY
* SYMBOLS NOT EQUAL. TAKE LESSER OR GREATER LINK
SRCH3    RES      0
         STW,M1   M0
         BG       SRCH7
         STS,RT3  DOFFSET,M1        CLEAR DIRECTION FIELD
         LW,M1    LLOFFSET,M1
SRCH8    RES      0
         AND,M1   =LLFLD            SAVE LESSER- OR GREATER-LINK
         BNEZ     SRCH1
         B        *SRCHXIT          EXIT. NOT FOUND
SRCH7    RES      0
         STS,RT4  DOFFSET,M1        SET DIRECTION FIELD TO 1
         LW,M1    GLOFFSET,M1
         B        SRCH8
INSERT   RES      0
         STD,SYN  NSRTR1            SAVE REGS. SYN AND LVL
         AI,U     -HED
         LI,RT2   LLFLD             MASK FOR GL OR LL FIELD
* MOVE (NEXTST) TO FWD(SYMT,M0)
         LW,XT    NEXTST
*
*        IF THIS ENTRY WOULD CROSS INTO THE SPILL PAGE, MOVE IT
*        UP TO START AT THE BEGINNING OF THE SPILL PAGE (ENTRIES MUST
*        NOT BE SPLIT ACCROSS PAGE BOUNDARIES ONCE WE GO INTO
*        SPILL MODE).
*
         CW,XT    SYMLMTM18
         IF,G
         LB,M1    WDCTWD            # WORDS IN NAME
         AW,M1    XT
         AI,M1    2                 PLUS THE 2 CONTROL WORDS
         CW,XT    SYMLMT
         IF,L
         CW,M1    SYMLMT
         IF,G
         LW,XT    SYMLMT
         STW,XT   NEXTST            START AT SPILL PAGE
         FI
         ELS
         AI,M1    HED               MAKE ADDRESS FROM OFFSET
         CW,M1    INBUFLMT
         IF,GE
*
*        ENTER SYMBOL-TABLE SPILL MODE
*
         MTW,0    PD%FLAG
         BNEZ     OVERFLOW          CANNOT SPILL SYMT IN PD MODE
*
         MTW,+1   SPILLFLG          SET SPILL-MODE INDICATOR
*
*        CHANGE BRANCH VECTORS
*
         LI,XT    CREATE1STS
         STW,XT   CREATE1STV
         LI,XT    INSERTS
         STW,XT   INSERTV
         LI,XT    NEWENTS
         STW,XT   NEWENTRYV
         LI,XT    SEARCHS
         STW,XT   SEARCHV
*
*        SET PARAMETERS FOR CALL TO INSERTS SUCH THAT CURRENT
*        BUFFER WILL BE WRITTEN, AND THE NEXT ONE READ.
*
         BAL,IORL OPENX5
         LI,XT    0
         STW,XT   INCOREB#          PAGE KEY CURRENTLY IN
         STW,XT   INCOREBMAX
         LW,IOADD SYMTLMT           BUFFER
         STW,IOADD   INCOREL        CURRENT LO ADDR IN CORE
         AI,IOADD 511
         STW,IOADD   INCOREH        CURRENT HI ADDR IN CORE
         LI,IOSIZE   1              DUMMY BLOCK NUMBER
         STW,IOSIZE   INCORESF      SET FLAG TO FORCE WRITE
         BAL,IORL WRITEX5           JUST TO GET PROPER KEY
         LW,XT    SYMLMT
         AI,XT    512
         STW,XT   NEXTST            PLACE TO INSERT
         LW,XT    M0
         LV,CT    DIRFLD
         AND,CT   DOFFSET,XT
         IF,NZ
         LI,CT    1
         FI
         STW,CT   DIR
         B        INSERTS
*
         FI
         FI
         FI
         AI,XT    HED               SAVE ACTUAL ADDRESS OF ENTRY
         STW,XT   FND
         LW,XT    NEXTST
         LW,M1    M0
         LW,CT    DOFFSET,M1
         CI,CT    DIRFLD
         BAZ      %+2
         AI,M1    1
         STS,XT   LLOFFSET,M1
* CLEAR LL(SYMT,NEXTST)  CLEAR FLAGS(SYMT,NEXTST)
* MOVE WDCT(HED) TO WDCT(SYMT,NEXTST)
         LW,M1    WDCTWD
         AND,M1   =X'FF000000'
         STW,M1   LLWD,XT
*  MOVE (NXSYMB) TO SN(SYMT,NEXTST)  CLEAR GL(SYMT,NEXTST)
         LW,CT    NXSYMB
         SLS,CT   16
         STW,CT   SNWD,XT
* MOVE SYMBOL(SYMT) TO SYMBOL(SYMT,NEXTST)
         LB,RT1   WDCTWD            NUMBER OF WORDS CONTAINING NAME
INS1     RES      0
         LW,CT    SYM1,M1
         STW,CT   SYM1,XT
         AI,XT    1
         AI,M1    1
         BDR,RT1  INS1
* MOVE FWD(SYMT,U) TO (V)
         LW,V     LLWD,U
         CI,V     DIRFLD
         BAZ      %+2
         LW,V     GLWD,U
         AND,V    =LLFLD
* MOVE FWD(SYMT,V) TO (W)
         LW,W     LLWD,V
         CI,W     DIRFLD
         BAZ      %+2
         LW,W     GLWD,V
         AND,W    =LLFLD
* IF BAL(SYMT,V) EQ 0  GOTO NS1
         LW,CT    BALWD,V
         CI,CT    BALFLD
         BAZ      NS1
* IF DIR(SYMT,V) PLUS BAL(SYMT,V) EQ 2 GOTO NS2
         AND,CT   =DIRFLD
         SLS,CT   -2
         AW,CT    BALWD,V
         AND,CT   =BALFLD
         CI,CT    X'20000'
         BE       NS2
* MOVE (W) TO (VWX)  GOTO NS4
         LW,VWX   W
         B        NS4
*NS2 MOVE FWD(SYMT,W) TO (X) MOVE (X) TO (VWX)
NS2      RES      0
         LW,X     LLWD,W
         CI,X     DIRFLD
         BAZ      %+2
         LW,X     GLWD,W
         AND,X    =LLFLD
         LW,VWX   X
*  IF DIR(SYMT,V) NE DIR(SYMT,W)  GOTO NS3
         LI,RT4   DIRFLD
         LW,RT3   DIRWD,V
         CS,RT3   DIRWD,W
         BNE      NS3
* MOVE (W) TO FWD(SYMT,U)
         LW,RT1   W
         LW,RT3   DIRWD,U
         CI,RT3   DIRFLD
         BAZ      %+2
         AI,U     1
         STS,RT1  LLWD,U
* SAVE REV(SYMT,W)  MOVE (V) TO REV(SYMT,W)
         LW,RT1   V
         LW,CT    DIRWD,W
         CI,CT    DIRFLD
         BAZ      INS5
         LW,U     LLWD,W
         STS,RT1  LLWD,W
         B        INS6
INS5     RES      0
         LW,U     GLWD,W
         STS,RT1  GLWD,W
INS6     RES      0
*  MOVE REV(SYMT,W) TO FWD(SYMT,V)
         LW,RT1   U                 U CONTAINS REV(SYMT,W)
         LW,CT    DIRWD,V
         CI,CT    DIRFLD
         BAZ      INS7
         STS,RT1  GLWD,V
         B        INS8
INS7     RES      0
         STS,RT1  LLWD,V
INS8     RES      0
* MOVE (X) TO (W)
         LW,W     X
*NS4  CLEAR BAL(SYMT,V) GOTO NS9
NS4      RES      0
         LI,RT3   0
         LI,RT4   BALFLD
         STS,RT3  BALWD,V
         B        NS9
*NS3  MOVE FWD(SYMT,X) TO (VWX)
NS3      RES      0
         LW,VWX   LLWD,X
         CI,VWX   DIRFLD
         BAZ      %+2
         LW,VWX   GLWD,X
         AND,VWX  =LLFLD
*  MOVE (X) TO FWD(SYMT,U)
         LW,CT    DIRWD,U
         CI,CT    DIRFLD
         BAZ      %+2
         AI,U     1
         LW,RT1   X
         STS,RT1  LLWD,U
*  IF DIR(SYMT,W) EQ 1 GOTO NS7
         LW,CT    DIRWD,W
         CI,CT    DIRFLD
         BANZ     NS7
* MOVE GL(SYMT,X) TO LL(SYMT,W)
         LW,RT1   GLWD,X
         STS,RT1  LLWD,W
* MOVE LL(SYMT,X) TO FWD(SYMT,V)
         LW,RT1   LLWD,X
         LW,U     V
         LW,CT    DIRWD,V
         CI,CT    DIRFLD
         BAZ      %+2
         AI,U     1
         STS,RT1  LLWD,U
* MOVE (V) TO LL(SYMT,X)  MOVE (W) TO GL(SYMT,X)  GOTO NS49
         LW,RT1   V
         STS,RT1  LLWD,X
         LW,RT1   W
         STS,RT1  GLWD,X
         B        NS49
*NS7 MOVE LL(SYMT,X) TO GL(SYMT,W)
NS7      RES      0
         LW,RT1   LLWD,X
         STS,RT1  GLWD,W
*  MOVE GL(SYMT,X) TO FWD(SYMT,V)
         LW,RT1   GLWD,X
         LW,U     V
         LW,CT    DIRWD,V
         CI,CT    DIRFLD
         BAZ      %+2
         AI,U     1
         STS,RT1  LLWD,U
*  MOVE (W) TO LL(SYMT,X)  MOVE (V) TO GL(SYMT,X)
         LW,RT1   W
         STS,RT1  LLWD,X
         LW,RT1   V
         STS,RT1  GLWD,X
*NS49  CLEAR BAL(SYMT,V)  CLEAR BAL(SYMT,X)
NS49     RES      0
         LI,RT3   0
         LI,RT4   BALFLD
         STS,RT3  BALWD,V
         STS,RT3  BALWD,X
* IF (X) EQ (NEXTST)  GOTO NS6
         CW,X     NEXTST
         BE       NS6
*  REV(SYMT,X) TO (U)
         LW,U     LLWD,X
         CI,U     DIRFLD
         BANZ     %+2
         LW,U     GLWD,X
         AND,U    =LLFLD
*  MOVE 1 TO BAL(SYMT,U)  IF DIR(SYMT,U) EQ 1 MOVE 2 TO BAL(SYMT,U)
         LI,RT3   X'10000'
         LW,CT    DIRWD,U
         CI,CT    DIRFLD
         BAZ      %+2
         LI,RT3   X'20000'
         STS,RT3  BALWD,U
*  FWD(SYMT,VWX) TO (W)  GOTO NS5
         LW,W     LLWD,VWX
         CI,W     DIRFLD
         BAZ      NS5
*
         LW,W     GLWD,VWX
         B        NS5
*NS1 MOVE (V) TO (VWX)
NS1      RES      0
         LW,VWX   V
*NS5  IF (W) EQ 0 GOTO NS6
NS5      RES      0
         AND,W    =LLFLD
         BE       NS6
* MOVE 1 TO BAL(SYMT,VWX) IF DIR(SYMT,VWX) EQ 0  MOVE 2 TO BAL(SYMT,VWX)
         LI,RT3   X'10000'
         LW,CT    DIRWD,VWX
         CI,CT    DIRFLD
         BANZ     %+2
         LI,RT3   X'20000'
         LI,RT4   BALFLD
         STS,RT3  BALWD,VWX
* MOVE (W) TO (VWX)
         LW,VWX   W
*NS9  MOVE FWD(SYMT,W) TO (W)  GOTO NS5
NS9      RES      0
         LW,CT    DIRWD,W
         CI,CT    DIRFLD
         BAZ      NS10
         LW,W     GLWD,W
         B        NS5
NS10     RES      0
         LW,W     LLWD,W
         B        NS5
*NS6 MOVE (NEXTST) TO (M1) ADD WDCT(HED) PLUS 2 TO (NEXTST)
NS6      RES      0
         LW,M1    NEXTST
         AI,M1    HED               EXIT WITH FOUND ADDRESS IN M1
         LW,N     NXSYMB            AND SYMBOL NUMBER IN N.
         LB,CT    WDCTWD
         AI,CT    2
         AWM,CT   NEXTST
*  ADD 1 TO (NXSYMB)
         MTW,1    NXSYMB
*  RESTORE REGISTERS AND EXIT
         LD,SYN   NSRTR1            RESTORE REGS. SYN AND LVL
         EXIT
*
OVERFLOW RES      0
         ABORT    ABORT3            ENCODER SPACE OVERFLOW
*
*    E N D   P R O C E S S I N G
*
         LOCAL    XT,IN,OUT,OUT1,OUT2,LL,XR7,RL1
XT       EQU      1
IN       EQU      2
OUT      EQU      3
OUT1     EQU      4
OUT2     EQU      5
LL       EQU      6
XR7      EQU      7
RL1      EQU      14
ENDIRCTV RES      0
         CALL     CHK%PRNT          PRINT LAST LINE IF NEEDED
         BAL,RL   LCLDL1            DELETE LOCAL REGION
         BAL,RL   IO%X1             WRITE OUTBUF
         CALL     IO%X3
         BAL,LINK IM@END
         LW,XT    NUMRECX1          SAVE ENCODED RECORD NUMBER
         STW,XT   OVFLAG
         LI,OUT   0                 SET SYMBUF INDEX
         LI,OUT1  0                 SET CF1BUF INDEX
         LI,XT    0                 SET SORTBL INDEX
         STW,XT   NUMRECX1          CLEAR TO COUNT SYMBOL TBL RECORDS
         STW,XT   NUMRECX3          CLEAR TO COUNT CF1 TABLE RECORDS
SYMTOUT  RES      0
         LW,LL    HED               PUT L.L. OF SYMBOL
         AND,LL   L(LLFLD)            TABLE CENTER IN SORTBL
         STW,LL   *INBUF            USE DYNAMIC FOR SORT TABLE
SYMTOUT2 RES      0
         MTW,0    SPILLFLG
         IF,NZ                      DOIF SPILLING SYMT
         LW,M1    LL
         AI,M1    HED
         CALL     MAP%ADDR          GET CORRECT PAGE IN CORE
         AI,M1    -HED
         STW,M1   LL
         FI
         LW,IN    LL
         LW,LL    HED,LL
         AND,LL   L(~DSSYMBIT)      TURN OFF POSSIBLE .DS CN FLAG
         STW,LL   HED,IN
         AND,LL   L(LLFLD)
         BEZ      SYMTOUT4          L.L. = 0, YES
         AI,XT    1                 NO, BUMP INDEX
         STW,LL   *INBUF,XT         MOVE L.L. TO SORTBL
         B        SYMTOUT2          GET NEXT L.L.
SYMTOUT4 BAL,RL   WRISYM            OUTPUT SYMBOL
         LW,M1    *INBUF,XT
         AI,M1    HED
         MTW,0    SPILLFLG
         IF,NZ                      DOIF SPILLING SYMT
         CALL     MAP%ADDR          GET CORRECT PAGE IN CORE
         FI
         LW,LL    GLOFFSET,M1
         AND,LL   L(GLFLD)
         BEZ      SYMTOUT6          G.L. = 0, YES
*
         STW,LL   *INBUF,XT           NO
         B        SYMTOUT2          YES
SYMTOUT6 AI,XT    -1                DECR INDEX
         BGEZ     SYMTOUT4          FINISHED, NO
         LI,RT2   -1                YES, WRITE END ITEM
         BAL,RL1  CF1OUT              IN TABLES
         LI,RT3   -1
         LI,XR7   -1
         LI,RT4   0
         BAL,RL1  SYMIOUT4          WRITE -1 AS LAST SYMBOL NUMBER
         BAL,RL   IO%X1A            WRITE SYMBUF
         CALL     IO%X3             WRITE THE LAST CF(1) RECORD
         LCW,IOSIZE  NUMRECX3       BACKSPACE TO BEGINNING
         BAL,IORL POSITIONX3        OF THE CF1 RECORDS
         MTW,0    PD%FLAG           IS STD DEF FILE REQUIRED
         BNEZ     PRODSDF           BRIF YES.
*
         MTW,0    SPILLFLG
         IF,NZ                      NOTE THAT SPILL OCCURRED
*
*        WRITE HEADER MESSAGE
*
         BAL,X7   CLRLSTBF
         LCI      8
         LM,1     SPILL%MSG
         STM,1    LSTBF
         CALL     PRINT
*
*        WRITE NUMBER OF WORDS THAT WOULD HAVE BEEN NEEDED
*
         BAL,X7   CLRLSTBF
         CALL     PRINT
         LCI      8
         LM,1     SPILL%MSG%REQ
         STM,1    LSTBF
         LW,X5    ENDCORE
         SW,X5    LOWCORE
         AW,X5    NEXTST
         SW,X5    SYMLMT
         AI,X5    512
         LI,X6    30
         BAL,X7   DEDIT
         CALL     PRINT
*
*        WRITE OUT THE NUMBER OF WORDS WE HAD
*
         LCI      8
         LM,1     SPILL%MSG%AVL     ;
         STM,1    LSTBF
         LW,X5    ENDCORE
         SW,X5    LOWCORE
         LI,X6    30
         BAL,X7   DEDIT
         CALL     PRINT
         BAL,X7   CLRLSTBF
         CALL     PRINT
         CALL     PRINT
         FI
         B        *ROOTRTN          EXIT ENCODER PHASE
         PAGE
*
WRISYM   RES      0
         STW,RL   SRCHXIT
         LI,OUT2  1
         LW,IN    *INBUF,XT         LINK TO SYMBOL
         MTW,0    SPILLFLG
         IF,NZ                      DOIF SPILLING SYMT
         LW,M1    IN
         AI,M1    HED
         CALL     MAP%ADDR          GET CORRECT PAGE IN CORE
         AI,M1    -HED
         STW,M1   IN
         FI
         LW,RT1   HED,IN
         AND,RT1  L(PTRFLD)         EXTRACT PTR FLAG
         SHIFT,RT1   PTRLOB,2+16    POSITION TO SORTED-SYMBOL MULTIPLE-
         STW,RT1  M0                  OCCURRENCE (OPEN/CLOSE) FLAG.
         SLS,IN   2                 BYTE OFFSET
         LB,RT4   HED,IN            GET WORD COUNT
         SLS,RT4  2                 SHIFT TO BYTE COUNT
WRISYM10 LB,RT1   HED+2,IN          MOVE A CHAR
         STB,RT1  SYM1,OUT2
         AI,IN    1
         AI,OUT2  1
         CW,OUT2  RT4               FINISHED
         BLE      WRISYM10          NO,
         LI,RT1   ' '               STORE A TRAILING BLANK
         STB,RT1  SYM1,OUT2
WRISYM20 AI,OUT2  -1                YES,
         LB,RT1   SYM1,OUT2         ADJUST COUNT FOR
         CI,RT1   ' '                 TRAILING BLANKS
         BE       WRISYM20
         STB,OUT2 SYM1              STORE COUNT AS 1ST BYTE
         LW,IN    *INBUF,XT         LINK TO SYMBOL
         MTW,0    SPILLFLG
         IF,NZ                      DOIF SPILLING SYMT
         LW,M1    IN
         AI,M1    HED
         CALL     MAP%ADDR          GET CORRECT PAGE IN CORE
         AI,M1    -HED
         STW,M1   IN
         FI
         B        WRISYM40          1ST TIME SPECIAL
WRISYM30 LW,RT1   HED,IN
WRISYM31 LW,RT2   HED+1,IN
         CW,RT1   L(PTRFLD)         POINTER FLAG ON
         BANZ     %+2               YES,
         SLS,RT2  -16
         CW,RT1   L(CF1FLD)         CF1 FLAG ON
         BAZ      %+2               NO,
         BAL,RL1  CF1OUT            YES, S.N. TO CF1 TABLE
         CW,RT1   L(CLOFLD)         CLOSE FLAG ON
         BAZ      %+2
         OR,RT2   L(X'4000')        TURN CLOSE FLAG ON
         OR,RT2   M0                MERGE MULTIPLE-OCCURRENCE FLAG
         BAL,RL1  SYMIOUT           SYMBOL TO SYMBOL TABLE
         CW,RT1   L(PTRFLD)         WAS POINTER FLAG ON
         BAZ      *SRCHXIT
*
WRISYM35 LW,IN    HED+1,IN          YES, GET NEXT LINK
         SLS,IN   -16
         MTW,0    SPILLFLG
         IF,NZ                      DOIF SPILLING SYMT
         LW,M1    IN
         AI,M1    HED
         CALL     MAP%ADDR          GET CORRECT PAGE IN CORE
         AI,M1    -HED
         STW,M1   IN
         FI
         B        WRISYM30          GO PROCESS
WRISYM40 LW,RT1   HED,IN
         CW,RT1   L(PTRFLD)         POINTER FLAG ON
         BANZ     WRISYM35          YES,
         B        WRISYM31          NO,
CF1OUT   RES      0
         CI,OUT1  HWX3SIZE          TEST FOR END OF X3 BUFFER
         BL       CF1OUT1           BRANCH IF NOT END
*
         CALL     IO%X3             WRITE A RECORD OF CF(1)'S
         LI,OUT1  0                 RESET INDEX
CF1OUT1  RES      0
         STH,RT2  CF1BUF,OUT1
         AI,OUT1  1
         B        *RL1
SYMIOUT  RES      0
         LB,RT4   SYM1              BYTE COUNT OF SYMBOL
         SLS,RT4  -1                CONVERT TO HALF-WD COUNT
         AI,RT4   1                 # HALF-WDS PER ENTRY - 1
         LI,XR7   -1
         LW,RT3   RT2
         B        SYMIOUT4
SYMIOUT3 LH,RT3   SYM1,XR7          MOVE A HALF-WD
SYMIOUT4 RES      0
         CI,OUT   HWX1SIZE          TEST FOR BUFFER FULL
         BGE      SYMIOUT5          BRANCH IF YES
         STH,RT3  SYMBUF,OUT
         AI,OUT   1
         AI,XR7   1
         CW,XR7   RT4               FINISHED
         BL       SYMIOUT3          NO,
         B        *RL1              YES
SYMIOUT5 STW,RL   OUT               SAVE RETURN
         STW,RT3  XTSAVE
         BAL,RL   IO%X1A            WRITE SYMBUF
         LW,RT3   XTSAVE
         LW,RL    OUT               RESTORE RETURN ADDRESS
         LI,OUT   0                 RESET OUT
         B        SYMIOUT4
         LOCAL
*
*    I O % X 1
*
IO%X1    RES      0
         LI,IORL  ENDBUF            END-OF-BUFFER
         STH,IORL OUTBUF,OUT
IO%X1A   RES      0
         BAL,IORL WRITEX1
         MTW,1    NUMRECX1          COUNT NUM OF REC IN X1
         B        *RL
*
*    I O % X 3
*
IO%X3    RES      0
         MTW,0    CNCTRL
         IF,EZ
         LI,IOADD X3BUF             IN PROGRAM - WRITE CONDENSED SOURCE
         ELS
         LV,IORL  ENDBUF            END-OF-BUFFER
         STH,IORL OUTBUF,OUT
         LI,IOADD X1BUF             IN CN CONTROLS - WRITE ENCODED
         FI
         BAL,IORL WRITEX3
         MTW,+1   NUMRECX3          TALLY RECORDS WRITTEN
         EXIT
         PAGE
*
*   P R I N T
*        WRITE 'LSTBF' AREA TO THE LISTING OUTPUT FILE
*
*        USES:    IOADD
*                 IOSIZE
*        IORL
*
PRINT    RES      0
         LI,IOADD LSTBF             BUFFER
         LI,IOSIZE   100            SIZE
         BAL,IORL WRITELO
         EXIT
*
*   C H K % P R N T
*        CONTROL PRINTING OF ENCODER SOURCE LINES.  IF THERE WAS
*        ANY POSSIBILITY FOR PRINT, 'READCARD' EDITED THE LINE
*        IMAGE INTO 'LSTBF'.
*
CHK%PRNT RES      0
         MTW,0    LS%FLAG
         IF,NZ                      EITHER LS OR .DS WAS SPECIFIED
         MTW,0    DSLNCTRL
         IF,NZ                      EITHER LS ONLY OR .DS SYM IN STMT
         LI,IOADD LSTBF
         LI,IOSIZE   100
         BAL,IORL WRITELO           WRITE LAST LINE
         MTH,0    LS%FLAG
         IF,NZ                      .DS IS CONTROLLING PRINT
         LI,XT    0
         STW,XT   DSLNCTRL          RESET TO NOT PRINT
         FI
         FI
         FI
         EXIT
*
*    R D S D F
*        READ STANDARD DEFINITION FILE
RDSDF    RES      0
         BAL,IORL REWSTD            REWIND F:STD
         LI,IOADD OUTBUF
         BAL,IORL READSTD
         LW,RT1   FIRSTST
         CW,RT1   FIRSTSTSDF        IS FILE COMPATIBLE
         BNE      RDSDFERR          NO
         LW,RT1   NEXTSTSDF         YES, RESTORE NEXTST
         STW,RT1  NEXTST
         LW,RT1   NXSYMBSDF         RESTORE NXSYMB
         STW,RT1  NXSYMB
         LW,RT1   HEDSDF            RESTORE HED
         STW,RT1  HED
         LCH,RT1  SDFCONSDF         GET WD COUNT OF SYS NAME TABLE
         AW,RT1   LOCX                AND CALCULATE START
         STW,RT1  SDFCONNCDR
         AI,RT1   -2
         STW,RT1  LOCX              STORE NEW START OF LOCAL TABLE
         STW,RT1  SLOC
         LH,XT    SDFCONSDF
         LW,RT1   SDFCONSDF,XT      MOVE SYSTEM NAME TABLE
         STW,RT1  *SDFCONNCDR,XT
         BDR,XT   %-2               FINISHED
         LW,RT1   SDFCONSDF         YES, MOVE CONTROL WD
         STW,RT1  *SDFCONNCDR         FOR TABLE
         LW,XT    FIRSTST           SET SYM TAB INDEX TO 1ST VALUE
         LI,IN    X'FFFF'           FORCE 1ST READ
RDSDF15  BAL,RL   RDSYMTAB          GET NEXT SYM TAB WORD
         STW,RT1  HED,XT            MOVE TO SYM TAB
         AI,XT    1
         CW,XT    NEXTST            FINISHED
         BL       RDSDF15           NO
         EXIT     LVL
RDSDFERR RES      0
         ABORT    ABORT4            STD DEF FILE INCOMPATIBLE
RDSYMTAB RES      0
         CI,IN    WDX1SIZE          READ THE NEXT RECORD
         BGE      RDSYMT10          YES
         LW,RT1   OUTBUF,IN         NO, GET WORD
         AI,IN    1
         B        *RL               RETURN
RDSYMT10   RES    0
         LI,IOADD OUTBUF
         BAL,IORL READSTD
         LI,IN    1                 RESET IN
         LW,RT1   OUTBUF            GET WORD
         EXIT     RL
*
*    P R O D S D F
*        PRODUCE STANDARD DEFINITION FILE
*
PRODSDF  RES      0
         BAL,IORL REWSTD
         LI,OUT   0                 SET OUT INDEX TO ZERO
         LW,RT1   FIRSTST           WRITE FIRST SYM TAB LOC
         BAL,RL   SDFOUT
         LW,RT1   NEXTST            WRITE NEXT SYM TAB LOCATION
         BAL,RL   SDFOUT
         LW,RT1   NXSYMB            WRITE NEXT SYMBOL NUMBER
         BAL,RL   SDFOUT
         LW,RT1   HED               WRITE ROOT OF SYM TAB
         BAL,RL   SDFOUT
         LH,RT2   SDFCON            GET TABLE LENGTH
         LI,XT    0
PRSDF15  LW,RT1   SDFCON,XT         WRITE SYSTEM NAME TABLE
         BAL,RL   SDFOUT
         AI,XT    1
         CW,XT    RT2               FINISHED
         BLE      PRSDF15           NO
         LI,IOADD OUTBUF
         BAL,IORL WRITESTD          WRITE CONTROL CARD
         LI,OUT   0                 RESET OUT INDEX
         LW,XT    FIRSTST           FIRST SYM TAB LOC
PRSDF20  LW,RT1   HED,XT            WRITE SYMBOL TABLE
         BAL,RL   SDFOUT
         AI,XT    1
         CW,XT    NEXTST            FINISHED
         BL       PRSDF20           NO
         LI,IOADD OUTBUF
         BAL,IORL WRITESTD          WRITE SYMBOL TABLE RECORD
         BAL,IORL REWX1
         LW,XT    OVFLAG            SAVED ENCODED RECORD NUMBER
PRSDF25  RES      0
         LI,IOADD OUTBUF
         BAL,IORL READX1
         BAL,IORL WRITESTD
         BDR,XT   PRSDF25
         LW,IOSIZE  NUMRECX1        SKIP SYMBOL TABLE RECORDS
         BAL,IORL POSITIONX1          AFTER PRODUCING STD DEF FILE
         B        *ROOTRTN          RETURN TO THE ROOT
*
*    S D F O U T
*
SDFOUT   RES      0
         CI,OUT   WDX1SIZE          IS OUTPUT BUFFER FULL
         BGE      SDFOUT3           YES
         STW,RT1  OUTBUF,OUT        NO, MOVE ITEM
         AI,OUT   1
         B        *RL               RETURN
SDFOUT3  RES      0
         LW,OUT   IOADD             SAVE IOADD
         LI,IOADD OUTBUF
         BAL,IORL WRITESTD          WRITE BUFFER
         STW,OUT  OUTBUF            MOVE ITEM TO FIRST WORD OF OUTBUF
         LI,OUT   1
         EXIT     RL
         PAGE
*
*   C R E A T E 1 S T S
*
*        CREATE A SYMBOL TABLE ENTRY LINKED TO THE MAIN ENTRY
*          LOCATION OF THE ENTRY TO BE LINKED IS IN M1
*
CREATE1STS   RES  0
         STW,RL   CRE8XIT           SAVE RETURN
         LW,XT    PTROFFSET,M1
         AND,XT   L(PTRFLD|CLOFLD|CF1FLD)
         STW,XT   SAVAREA           SAVE FLAGS (WDCT=0, LL=0)
         LW,XT    SNOFFSET,M1
         STW,XT   SAVAREA+1         SAVE SN
         LW,RT1   =PTRFLD
         LW,RT2   =PTRFLD+CLOFLD+CF1FLD
         STS,RT1  PTROFFSET,M1
         MTW,+1   INCORESF          SET DIRTY-PAGE FLAG
         LW,XT    NEXTST
         SW,XT    SYMLMT
         AND,XT   L(X'1FF')
         CI,XT    X'1FF'
         IF,EQ
         MTW,+1   NEXTST            ROUND TO SPILL PAGE BOUND
         FI
         LW,XT    NEXTST
         STH,XT   RT1
         LW,RT2   =SNFLD
         STS,RT1  SNOFFSET,M1
         LW,M1    XT
         AI,M1    HED
         CALL     MAP%ADDR          GET NEW PAGE
         LW,XT    SAVAREA
         STW,XT   PTROFFSET,M1
         MTW,+1   INCORESF          SET DIRTY-PAGE FLAG
         LW,XT    SAVAREA+1
         STW,XT   SNOFFSET,M1
         MTW,2    NEXTST
         B        *CRE8XIT          RETURN
         PAGE
*
*   M A P % A D D R
*
*        CALLED WHEN IN SYMBOL TABLE SPILL MODE.  ENSURES THAT
*        REQUESTED ADDRESS IS IN CORE.
*
*        INPUT:   M1 IS VIRTUAL (WORD) ADDRESS OF CELL TO BE ACCESSED.
*                 INCORELH IS LO-HI VIRTUAL ADDRESS BOUNDS IN CORE.
*                 INCORESF SET IF CURRENT PAGE IS DIRTY (STORED INTO).
*
*        OUTPUT:  M1 IS REAL CORE ADDRESS OF REQUIRED CELL.
*                 M1SAVE IS VIRTUAL (ENTRY) ADDRESS OF REQUIRED CELL.
*                 INCOREL, INCOREH, INCOREB# UPDATED IF NECESSARY.
*
*        USES:    M1
*                 IOADD
*                 IOSIZE
*                 IORL
*
MAP%ADDR RES      0
         STW,M1   M1SAVE
         CW,M1    SYMTLMT
         EXIT,L                     RETURN IF < SPILLED AREA
*
         CLM,M1   INCORELH
         IF,OL                      DOIF VIRTUAL PAGE NOT ALREADY IN
         MTW,0    INCORESF
         IF,NZ                      DOIF STORE OCCURRED INTO OLD PAGE
         LW,IOADD SYMTLMT
         LW,IOSIZE   INCOREB#
         CW,IOSIZE   INCOREBMAX
         IF,G
         STW,IOSIZE   INCOREBMAX
         FI
         BAL,IORL WRITEX5           WRITE CURRENT BUFFER BACK TO BULK
         LI,M1    0
         STW,M1   INCORESF          CLEAR STORE-FLAG
         LW,M1    M1SAVE
         FI
         SW,M1    SYMTLMT
         SLS,M1   -9
         STW,M1   INCOREB#          SAVE NEW BLOCK NUMBER
         SLS,M1   9
         AW,M1    SYMTLMT
         STW,M1   INCOREL           LOW VIRTUAL ADDRESS TO BE READ IN
         AI,M1    511
         STW,M1   INCOREH           HI VIRTUAL ADDRESS TO BE READ IN
         LW,IOSIZE   INCOREB#
         CW,IOSIZE   INCOREBMAX
         IF,LE
         LW,IOADD SYMTLMT
         BAL,IORL READX5            READ THE RECORD
         FI
         LW,M1    M1SAVE
         FI
         SW,M1    INCOREL           OFFSET INTO BUFFER
         AW,M1    SYMTLMT           PLUS BUFFER START
         EXIT                       M1 IS MAPPED TO REAL ADDRESS
         PAGE
*
*    S E A R C H S
*
*        SEARCH THE SPILLED SYMBOL TABLE.  THE SEARCH ARGUMENT
*          IS CONTAINED IN THE ITEM STARTING AT HED, IN THE SAME
*          FORMAT AS EACH ITEM IN THE SYMBOL TABLE.
*
*          OUTPUT: FND CONTAINS THE ADDRESS (17 BITS, FULL ADDRESS)
*                  OF THE FOUND SYMBOL TABLE ENTRY, IF IT IS FOUND.
*                  N  CONTAINS THE SYMBOL NUMBER AND LOCAL BIT
*                  M1 CONTAINS THE LOCATION OF THE LAST OPEN SYMBOL
*                    TABLE ENTRY.
*                 EXIT TO CALLING ROUTINE + 1 IF NOT FOUND,
*                   OR TO CALLING ROUTINE + 2 IF FOUND.
*
         LOCAL    SRCH1,SRCH3,SRCH5,SRCH11
         LOCAL    %40                                          /27466/*D-NCD
*
SEARCHS  RES      0
         STW,RL   SRCHXIT           SAVE EXIT
         LI,U     HED
         STW,U    M0
         LI,RT4   DIRFLD
         LW,M1    LLWD              LL(HED) TO (M1)
SRCH1    RES      0
         AND,M1   =LLFLD            SAVE LESSER- OR GREATER-LINK
         IF,EZ
         B        *SRCHXIT          EXIT. NOT FOUND
*
         FI
         AI,M1    HED
         CALL     MAP%ADDR
         STW,M1   FND
*
* COMPARE THE 1ST WORD OF THE SYMBOL
*
         LW,RT5   SYM1              KEEP SYM1 IN A REGISTER
         LI,XT    2
         CW,RT5   *FND,XT
         IF,EQ                      DOIF 1ST WORDS COMPARE
*
* CHOOSE THE SMALLER WORD COUNT TO TERMINATE THE COMPARE LOOP
*
         LB,CT    HED
         CB,CT    *FND
         IF,G
         LB,CT    *FND
         FI
         LI,RT2   -1                KEEP A MASK IN A REGISTER
         AI,CT    -1
         IF,GZ                      DOIF MORE THAN ONE-WORD SYMBOL
SRCH5    RES      0
         AI,XT    1
         LW,RT1   HED,XT            COMPARE THE NEXT WORD
         CS,RT1   *FND,XT
         BNE      SRCH3
*
         BDR,CT   SRCH5
*
         FI
*
* THE NAMES COMPARE, BUT THEIR SIZES MAY DIFFER
*
         LB,CT    HED
         CB,CT    *FND
         IF,EQ                      DOIF SAME LENGTH
         MTW,1    SRCHXIT           CHANGE TO TAKE 'FOUND' EXIT
         LW,N     GLOFFSET,M1
         SLS,N    -16
         LW,CT    PTROFFSET,M1
         LV,RL    DSSYMBIT          SAVE .DS CN BIT IN CASE WE NEED IT
         AND,RL   CT
         STS,RL   DSLNCTRL
         CW,CT    =PTRFLD+CLOFLD    EXIT IF THIS FIELD IS OPEN AND
         BAZ      *SRCHXIT            NOT A POINTER
*
         IF,FNZ   CLOFLD,CT
         CALL     CREATE1STS
         ELS
         LW,M1    N
         LI,XT    0                 CLEAR 'FOUND LOCATION' FLAG
*
* FOLLOW THE POINTER TO THE LAST OPEN SYMBOL TABLE ENTRY
*
SRCH11   RES      0
         AI,M1    HED
         CALL     MAP%ADDR
         LW,CT    PTROFFSET,M1
         IF,FZ    CLOFLD,CT         DOIF ENTRY NOT CLOSED
         LW,XT    M1SAVE            LAST OPEN (REAL) ADDR      /27466/*D-NCD
         FI
         IF,FNZ   PTRFLD,CT         DOIF NOT END OF POINTER CHAIN
         LW,M1    SNOFFSET,M1
         SLS,M1   -16
         B        SRCH11
*
         FI
*
         IF,NE    0,XT
         LW,M1    XT
         CALL     MAP%ADDR          GET LAST OPEN IN           /27466/*D-NCD
         LW,CT    PTROFFSET,M1
         LW,N     GLOFFSET,M1       SAVE SYMBOL NUMBER OF LAST OPEN SYM
*
*    SYMBOL NUMBER IS IN 'SN' FIELD IF PTR=0; OTHERWISE SYMBOL NUMBER
*      IS IN THE 'GL' FIELD.
*
         IF,FZ    PTRFLD,CT
         SLS,N    -16
         FI
         AND,N    L(GLFLD)
         B        *SRCHXIT
*
         FI
         FI
         LW,RL    SRCHXIT
*
NEWENTS  RES      0
         STW,RL   SRCHXIT           SAVE RETURN
%40      RES      0                                            /27466/*D-NCD
         LW,RT2   PTROFFSET,M1
         IF,FZ    PTRFLD,RT2
         LW,RT2   =PTRFLD
         STS,RT2  PTROFFSET,M1
         MTW,+1   INCORESF          SET DIRTY-PAGE FLAG
         LW,RT2   NEXTST
         SW,RT2   SYMLMT
         AND,RT2  L(X'1FF')
         CI,RT2   X'1FF'
         IF,EQ
         MTW,+1   NEXTST            ROUND TO SPILL PAGE BOUND
         FI
         LW,RT2   NEXTST
         LW,RT1   SNOFFSET,M1
         SLS,RT1  -16
         STH,RT2  RT1
         STW,RT1  SNOFFSET,M1
         LW,M1    NEXTST
         MTW,2    NEXTST
         AI,M1    HED
         CALL     MAP%ADDR          GET (POSSIBLY) NEW PAGE
         LI,N     0
         STW,N    PTROFFSET,M1
         MTW,+1   INCORESF          SET DIRTY-PAGE FLAG
         LW,N     NXSYMB
         SLS,N    16
         STW,N    SNOFFSET,M1
         MTW,1    NXSYMB
         SLS,N    -16
         B        *SRCHXIT
*
         FI
         LW,M1    SNOFFSET,M1
         SLS,M1   -16
         AI,M1    HED
         CALL     MAP%ADDR          GET (POSSIBLY) NEW PAGE
         B        %40               FIND END OF CHAIN          /27466/*D-NCD
*
         FI
         FI
*
* SYMBOLS NOT EQUAL. TAKE LESSER OR GREATER LINK
*
SRCH3    RES      0
         STW,M1   M0
         IF,LE
         LI,RT3   0
         STW,RT3  DIR
         LW,M1    LLOFFSET,M1
         B        SRCH1
*
         FI
         LI,RT3   1
         STW,RT3  DIR
         LW,M1    GLOFFSET,M1
         B        SRCH1
         PAGE
*
         LOCAL    INS1
INSERTS  RES      0
         STW,RL   SRCHXIT           SAVE RETURN
         STD,SYN  NSRTR1            SAVE REGS. SYN AND LVL
*
*        ENSURE THAT THIS ENTRY WILL FIT ENTIRELY WITHIN ONE PAGE.
*
         LW,XT    NEXTST
         SW,XT    SYMLMT
         AND,XT   L(X'1FF')         XT IS 0 - 511
         LB,M1    WDCTWD            GET # WORDS IN NAME
         AW,M1    XT
         AI,M1    2                 PLUS 2 CONTROL WORDS
         CI,M1    512
         IF,G                       MUST MOVE UP TO NEXT PAGE
         LI,M1    512
         SW,M1    XT
         AWM,M1   NEXTST
         FI
         LW,M1    M0
         AW,M1    DIR
         LW,XT    NEXTST            OFFSET
         STS,XT   LLOFFSET,M1
         MTW,+1   INCORESF          SET DIRTY-PAGE FLAG
         LW,M1    NEXTST
         AI,M1    HED
         CALL     MAP%ADDR          GET (POSSIBLY) NEW PAGE
         STW,M1   FND
         LW,XT    M1
         AI,XT    -HED
* CLEAR LL(SYMT,NEXTST)  CLEAR FLAGS(SYMT,NEXTST)
* MOVE WDCT(HED) TO WDCT(SYMT,NEXTST)
         LW,M1    WDCTWD
         AND,M1   =X'FF000000'
         STW,M1   LLWD,XT
         MTW,+1   INCORESF          SET DIRTY-PAGE FLAG
*  MOVE (NXSYMB) TO SN(SYMT,NEXTST)  CLEAR GL(SYMT,NEXTST)
         LW,CT    NXSYMB
         SLS,CT   16
         STW,CT   SNWD,XT
* MOVE SYMBOL(SYMT) TO SYMBOL(SYMT,NEXTST)
         LB,RT1   WDCTWD            NUMBER OF WORDS CONTAINING NAME
INS1     RES      0
         LW,CT    SYM1,M1
         STW,CT   SYM1,XT
         AI,XT    1
         AI,M1    1
         BDR,RT1  INS1
*
         LW,M1    FND               EXIT WITH FOUND ADDRESS IN M1
         LW,N     NXSYMB              AND SYMBOL NUMBER IN N.
         MTW,+1   NXSYMB
         LB,CT    WDCTWD
         AI,CT    2
         AWM,CT   NEXTST
         LD,SYN   NSRTR1
         B        *SRCHXIT
*
NCDREND  END
