         SYSTEM   SIG7FDP
         TITLE    ' S A D    THE SYNTAX ANALYSIS DRIVER '
*
         OPEN     NAME
*
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
R8       EQU      8
R9       EQU      9
R10      EQU      10
R11      EQU      11
R15      EQU      15
*
*
         DEF      A
         DEF      ACCT
         DEF      CCT
         DEF      COMMA
         DEF      DCCT
         DEF      ENDSOUR
         DEF      INTEGER
         DEF      INTGR
         DEF      JUMPTBL
         DEF      NAME
         DEF      NONNLIT
         DEF      NOYES
         DEF      NUMBER
         DEF      SADGO
         DEF      SADIAG
         DEF      SADNO
         DEF      SADNOSN
         DEF      SADYES
         DEF      SBW
         DEF      SEMICOL
         DEF      SNC
         DEF      SNW
         DEF      SYNTABLE
         DEF      YDISP
         DEF      DIVON,AHLNK,LEXLOOK
         PAGE
         REF      BYTESNLT
         REF      COLAFLG
         REF      COLUMN
         REF      COMAFLG
         REF      CONTROL
         REF      DIAG
         REF      INTAGER
         REF      NOSCAN
         REF      PHASE1
         REF      POINTLOC
         REF      SCAN
         REF      SEMIFLG
         REF      SKIP
         REF      REARF
         REF      BYTESNWD,RETURN,STRING
         REF      DIAGCALL,PDBJ,UNARYFLG,M:LO
         REF      PHASEF
         PAGE
SSTAK    DATA     0                 STACK POINTER
         RES      59
YSTAK    DATA     0                 YES DISP FOR SSTAK
         RES      29
SYNTABLE DATA     0                 ADDR - SYNTAX TABLE
JUMPTBL  DATA     0                 ADDR - JUMP TABLE
YDISP    DATA     0                 DISP FOR YES RETURN
STAKP    DATA     0                 SSTAK POINTER
DIVON    DATA     X'80000000'       DIVISION INDICATER
AHLNK    DATA     0
TEMPWD   TEXT     'LEX         '
PLISTL   GEN,8,24 X'11',M:LO        M:WRITE
         DATA     X'30000010'
         DATA     TEMPWD
         DATA     12
*
*    ENTRY POINT - SYNTAX TABLE DRIVER
*
SADGO    STW,R4   STAKP             INITIALIZE STAKP
SADGO1   LH,R2    *SYNTABLE,R4      GET NEXT TABLE ENTRY
         AND,R2   L(X'0FFFF')       STRIP EXTENDED SIGN
         SLD,R2   -13               SPLIT CLUE
         SLS,R3   -19
         LW,R6    R3
         SLD,R6   -11
         AND,R3   L(X'7FF')         STRIP DISP
         B        SADTBL,R2         BRANCH ACCORDING TO CLUE
SADTBL   B        SLEXNO            LEXICON
         B        SADRET            YES-NO RETURN
         B        SADIAG            DIAGNOSTIC
         B        SADSBP            SBR WITH PARAM
         B        SADSBR            SUBROUTINE
         B        SADGOT            GO TO SECTION NO
         B        SADSEC1           GO TO SECTION
SADSEC   AI,R3    2048              GO TO SECTION
SADSEC1  XW,R4    R3
         MTW,1    STAKP             BUMP BY 1
         LW,R5    STAKP
         CI,R5    120
         BGE      SADSO             STACK OVERFLOW
         STH,R3   SSTAK,R5          SAVE TABLE DISP
         STB,R6   YSTAK,R5          DISP FOR YES RETURN
         B        SADGO1
SLEXNO   STW,R6   YDISP             SET DISP FOR YES RETURN
         BAL,11   SCAN              GET NEXT WORD
         SW,R3    CONTROL           LEXICON
SADTST   BEZ      SADYES              NUMBER EQUAL
SADNOSN  LI,R2    1
         STB,R2   NOSCAN            SET NOSCAN
SADNO    AI,R4    1
         B        SADGO1
SADYES   AW,R4    YDISP             ADJUST BY DISP
         AI,R4    2                   FOR YES RETURN
         B        SADGO1
SADSO    LI,R1    61                DIAG                                SAD
         BAL,11   DIAG                STATEMENT TOO COMPLEX             SAD
         LI,R1    -1                                                    SAD
         STW,R1   PHASEF            SET ABORT FLAG                      SAD
         B        PHASE1                                                SAD
SADIAG   LW,R1    R3
         BAL,11   DIAG              GIVE DIAGNOSTIC
         B        SADNO
SADRET   LW,R6    STAKP             YES-NO RETURN
         BEZ      PHASE1            EMPTY - GO TO NEXT PHASE
         MTW,-1   STAKP
         LH,R4    SSTAK,R6          NO RETURN DISP
         AI,R3    0
         BEZ      SADNO             NO RETURN
         LB,R6    YSTAK,R6
         AW,R4    R6
         B        SADYES+1          YES RETURN
SADSBP   SLD,R6   2                 SUBROUTINE WITH PARAM
         AND,R3   L(X'1FF')
         B        *JUMPTBL,R6
SADSBR   STW,R6   YDISP             DISP FOR YES RETURN
         CI,R3    1000
         BL       *JUMPTBL,R3       NOT SADYES
         AI,R3    -1000
         B        *JUMPTBL,R3       SADYES
SADGOT   LW,R4    R3                GO TO SECTION NO
         AI,R6    0
         BEZ      SADGO1
         AI,R4    2048              ADJUST BY 2048
         B        SADGO1
         TITLE    ' SYNTAX TABLE COMMON ROUTINES '
*
CCTFLG   GEN,32   0                 CONDITIONAL COMMA TEST FLAG
INTGR    GEN,32   0                 STORAGE AREA FOR INTEGER
*
************************************************************************
*    A            TEST COLUMN A
*
A        LW,R2    COLUMN
         CI,R2    11
         BG       COLAERR        GOTO COLAERR IF NOT COLUMN A
         LI,R2    0                 X
         STW,R2   COLAFLG           X RESET COLAFLG
         B        SADNO         RETURN TO DRIVER
COLAERR  LI,R3    3                   X GENERATE DIAGNOSTIC
         B        SADIAG              X 003 AND RETURN
************************************************************************
*    ACCT         ALLOW CONDITIONAL COMMA TEST
*
ACCT     LI,R2    1                   X SET CCTFLG
         STW,R2   CCTFLG              X
         B        SADNO         RETURN TO DRIVER
************************************************************************
*    CCT          CONDITIONAL COMMA TEST
*
CCT      LW,R2    CCTFLG
         BEZ      SADNO         IF CCTFLG IS OFF, RETURN TO DRIVER
*
*        OTHERWISE  FALL INTO COMMA
*
************************************************************************
*    COMMA
*
COMMA    LI,R2    0             X
         STW,R2   COMAFLG       X RESET COMAFLG
         B        SADNO
************************************************************************
*    DCCT         DISALLOW CONDITIONAL COMMA TEST
*
DCCT     LI,R2    0           X
         STW,R2   CCTFLG      X RESET CCTFLG
         B        SADNO
************************************************************************
*    ENDSOUR      END OF SOURCE TEST
*
ENDSOUR  BAL,11   SCAN
         LI,R2    1
         EOR,R2   CONTROL
         B        SADTST
************************************************************************
*    INTEGER      TEST FOR INTEGER
*
INTEGER  BAL,11   SCAN
         LW,R2    CONTROL
         CI,R2    3
         BNE      SADNOSN           EXIT IF NOT NUMBER
         LI,R2    X'FF'
         AND,R2    POINTLOC
         BNEZ     SADNOSN           EXIT IF NOT INTEGER
         LB,R5    BYTESNLT         -
         SLS,R5   20               - LOAD PACKED INTEGER INTO
         OR,R5    DECLOD           - DECIMAL ACCUMULATOR
         EXU      R5               -
         LI,R2    1                 X
         AND,R2   R15               X GO TO SINER IF NEGATIVE
         BNEZ     SINER             X
         DC,4     L(X'9999999C')   X GO TO XS IF TOO LARGE TO CONVERT
         BG       XS               X
CONVRT   CVA,14   CONTBL
         STW,14   INTGR          STORE BINARY INTEGER
         B        SADYES
DECLOD   GEN,8,24 X'7E',INTAGER    SKELOTEN DECIMAL LOAD
XS       LI,R1    64       D064 = TOO LARGE TO CONVERT
         B        SINER+1
SINER    LI,R1    63       D063 = INTEGER MUST BE NON-NEGATIVE
         LI,14    1          DEFAULT INTEGER = 1
         BAL,11   DIAG
         B        CONVRT+1
*
*     PACKED BCD TO BINARY TRANSLATION TABLE USED BY INTEGER
*
CONTBL   GEN,32   8000000
         GEN,32   4000000
         GEN,32   2000000
         GEN,32   1000000
         GEN,32   800000
         GEN,32   400000
         GEN,32   200000
         GEN,32   100000
         GEN,32   80000
         GEN,32   40000
         GEN,32   20000
         GEN,32   10000
         GEN,32   8000
         GEN,32   4000
         GEN,32   2000
         GEN,32   1000
         GEN,32   800
         GEN,32   400
         GEN,32   200
         GEN,32   100
         GEN,32   80
         GEN,32   40
         GEN,32   20
         GEN,32   10
         GEN,32   8
         GEN,32   4
         GEN,32   2
         GEN,32   1
         GEN,32   0
         GEN,32   0
*   NOTE TABLE DOES NOT HAVE ENTRIES FOR BITS 30 AND 31 SINCE
*        THESE BITS ARE ALWAYS 0.
*
************************************************************************
*    NAME         TEST FOR NAME
*
NAME     BAL,11   SCAN
         LW,R2    CONTROL
         B        SADTST
************************************************************************
*    NONNLIT      TEST FOR NON-NUMERIC LITERAL
*
NONNLIT  BAL,11   SCAN
         LI,R2    X'2'
         EOR,R2   CONTROL
         B        SADTST
************************************************************************
*    NOYES        ALTERNATE SAD RETURN
*
NOYES    LI,R2    1
         STB,R2   NOSCAN
         B        SADYES           OTHERWISE YES RETURN
************************************************************************
*    NUMBER       TEST FOR NUMBER
*
NUMBER   BAL,11   SCAN
         LI,R2    X'3'
         EOR,R2   CONTROL
         B        SADTST
************************************************************************
*    SBW          SET BACK A WORD
*
         REF      COLACHK
SBW      MTW,1    COLACHK
         B        SADNOSN
************************************************************************
*    SEMICOL      TEST FOR SEMI-COLON
*
SEMICOL  LI,R2    0
         STW,R2   SEMIFLG          RESET SEMIFLG
         B        SADNO
************************************************************************
*    SNC          SET TO NEW CARD
*
SNC      LI,R2    1            X  SET BYTE 0 OF SKIP
         STB,R2   SKIP         X
         LI,R2    0
         STB,R2   NOSCAN
*
*        FALL INTO SNW
*
************************************************************************
*    SNW          SET TO NEW WORD
*
SNW      BAL,11   SCAN              SCAN ONE 'WORD'
         B        SADNO
         TITLE    'LEXICON SEARCH SUBROUTINE'
*
*    LEXLOOK - RESERVED WORD IDENTIFIER
*
*        INPUT  - HASH LINK INDEX IN R7
*        OUTPUT - 0 IN CONTROL FOR LEXICON NOT FOUND
*               - LEXICON NUMBER IN CONTROL FOR LEXICON FOUND
*
LEXLOOK  LI,R15   0                 ENTRY
         STW,R15  CONTROL           CLEAR CONTROL                       SAD
         LH,R6    *AHLNK,R7         DISP OF THE ITEM
         BEZ      *R10              EMPTY
         LB,R9    BYTESNWD          BYTE COUNT OF STRING
         AI,R9    3
         SLS,R9   -2                 TO WORD COUNT
LEXLOK1  INT,R4   *AHLNK,R6
         STCF     R11               DIVISION FLAG
         LI,R8    X'FFF'
         AND,R8   R5                GET LINKAGE
         SLS,R5   -12               WORD LENGTH
         CW,R5    R9
         BNE      LEXLOK6           NOT SAME LENGTH
         AW,R6    AHLNK
LEXLOK2  LW,R7    *R6,R5            COMPARE FROM LAST WORD
         CW,R7    STRING-1,R5
         BNE      LEXLOK6           NOT EQUAL
         BDR,R5   LEXLOK2
         AND,R11  DIVON
         BNEZ     LEXLOK3           LEGAL IN THIS DIVISION
         STW,R10  RETURN
         BAL,R10  DIAGCALL
         DATA     8                 RESERVE WORD DIAG
         B        *RETURN
LEXLOK3  STW,R4   CONTROL           SET LEXICON NUMBER
         MTW,0    UNARYFLG
         BEZ      LEXLOK4           NO UNARY FLAG
         STW,R1   R7
         LI,R1    5                 ILLEGAL CHAR DIAG
         BAL,R11  DIAG
         LW,R1    R7
LEXLOK4  MTW,0    REARF
         BGZ      *R10              IN REPLACING
         LW,R6    PDBJ
         AND,R6   L(X'800')
         BEZ      *R10              NO PRINT
         LI,R6    4
LEXLOK5  SLD,R4   -3                CONVERT TO PRINT FORMAT
         SLS,R5   -5
         BDR,R6   LEXLOK5
         OR,R5    L(C'0000')
         STW,R5   TEMPWD+2
         CAL1,1   PLISTL            M:WRITE
         B        *R10
LEXLOK6  LW,R6    R8                NEXT ENTRY
         BEZ      *R10              NO MORE
         B        LEXLOK1
         END
