*DECK DRIVER
USETEXT CCTTEXT 
USETEXT DNTEXT
      PROC DRIVER(PHASE); 
         BEGIN
  
         ITEM PHASE        I; # INPUT PARAMETER                        #
  
      #----------------------------------------------------------------#
      #                                                                #
      # "INCLUDE" SOME COMMON DECKS                                    #
      #                                                                #
      #----------------------------------------------------------------#
  
*CALL CTXTVALS
*CALL CTEXT 
*CALL DNATVALS
*CALL INT1
*CALL GETSET
*CALL TABLNAMES 
*CALL GTEXT1
*CALL PLT1
*CALL WORKTABS
*CALL RALINE
*CALL DPPPDDATA 
*CALL LISTCTL 
         CONTROL EJECT; 
         SWITCH SUPERSWITCH 
                   FILEREF,       #00#
                   AAREA,         #01#
                   ADVANCE,       #02#
                   ALLOWDIAG,     #03#
                   CONDNAME,      #04#
                   FILLERX,       #05#
                   ENDDECLAR,     #06#
                   EQUALS,        #07#
                   EXPONENT,      #08#
                   GREATER,       #09#
                   KEEP,          #10#
                   KEYELEM,       #11#
                   LEFTPARN,      #12#
                   LESSTHAN,      #13#
                   MINUS,         #14#
                   PERIOD,        #15#
                   PICTURE,       #16#
                   PLUS,          #17#
                   PNDEF,         #18#
                   RETURNX,       #19#
                   ERRETURNX,     #20#
                   RETRUE,        #21#
                   RTPAREN,       #22#
                   SLASH,         #23#
                   SNDEF,         #24#
                   STAR,          #25#
                   SETTFFLAG,     #26#
                   CTEXTRET,      #27#
                   CONAMECTX,     #28#
                   STOPX,         #29#
                   EOF,           #30#
                   RETFALSE,      #31#
                   PASTFFLAG,     #32#
                   CLAUSE,        #33#
                   DNDEF,         #34#
                   DNREF,         #35#
                   INTEGER,       #36#
                   LITERAL,       #37#
                   PNREF,         #38#
                   STATEMENT,     #39#
                   IMPLNAME,      #40#
                   DATAREF,       #41#
                   LINECOUNTER,   #42#
                   PAGECOUNTER,   #43#
                   LINAGECOUNT,   #44#
                   DEBUGITEM,     #45#
                   HASHEDVALUE,   #46#
                   BLDGTXT,       #47#
                   ALLOW,         #48#
                   DEFPT,         #49#
                   TESCNTXT,      #50#
                   COMMARW,       #51#
                   LEVEL,         #52#
                   SETFLAG,       #53#
                   CLEARFLAG,     #54#
                   TESTFLAG,      #55#
                   BRANCH1,       #56#
                   BRANCH2,       #57#
                   BRANCH3,       #58#
                   EBRANCH1,      #59#
                   EBRANCH2,      #60#
                   EBRANCH3,      #61#
                   BAR1,          #62#
                   BAR2,          #63#
                   BAR3,          #64#
                   SUB1,          #65#
                   SUB2,          #66#
                   SUB3,          #67#
                   SUB4,
                   SUB5,
                   SUB6,
                   SUB7,
                   SUB8,
                   SUB9,
                   SUB10, 
                   SUB11, 
                   SUB12, 
                   SUB13,         #77#
                   DIAGNOSTIC,    #78#
                   DIAGNOSTIC,    #79#
                   DIAGNRET,      #80#
                   DIAGNRET,      #81#
                   DSR,           #82#
                   DSR,           #83#
                   COLON;         #84#
         CONTROL EJECT; 
  
         $BEGIN 
         ARRAY COMMANDS [0:84] S(1);
         ITEM COMMAND C(0,0,10) = [ 
                  "FILEREF",       #00# 
                  "AAREA",         #01# 
                  "ADVANCE",       #02# 
                  "ALWDIAG",       #03# 
                  "CONNAME",       #04# 
                  "FILLERX",       #05# 
                  "ENDDECL",       #06# 
                  "EQUALS",        #07# 
                  "EXPONENT",      #08# 
                  "GREATER",       #09# 
                  "KEEP",          #10# 
                  "KEYELEM",       #11# 
                  "LFTPARN",       #12# 
                  "LSTHAN",        #13# 
                  "MINUS",         #14# 
                  "PERIOD",        #15# 
                  "PICTURE",       #16# 
                  "PLUS",          #17# 
                  "PNDEF",         #18# 
                  "RETURNX",       #19# 
                  "ERRETURN",      #20# 
                  "RETTRUE",       #21# 
                  "RTPARN",        #22# 
                  "SLASH",         #23# 
                  "SNDEF",         #24# 
                  "STAR",          #25# 
                  "SETTFFL",       #26# 
                  "CTXTRET",       #27# 
                  "CNCTXT",        #28# 
                  "STOP",          #29# 
                  "ENDOFFI",       #30# 
                  "RETFALS",       #31# 
                  "PASSTF",        #32# 
                  "CLAUSE",        #33# 
                  "DNDEF",         #34# 
                  "DNREF",         #35# 
                  "INTEGER",       #36# 
                  "LITERAL",       #37# 
                  "PNREF",         #38# 
                  "STATEMENT",     #39# 
                  "IMPNAME",       #40# 
                  "DATAREF",       #41# 
                  "LINECTR",       #42# 
                  "PAGECTR",       #43# 
                  "LNGCTR",        #44# 
                  "DBUGITM",       #45# 
                  "HASH",          #46# 
                  "BLDGTXT",       #47# 
                  "ALLOW",         #48# 
                  "DEFPT",         #49# 
                  "TSTCONT",       #50# 
                  "COMMARW",       #51# 
                  "LEVEL",         #52# 
                  "SETFLAG",       #53# 
                  "CLRFLAG",       #54# 
                  "TSTFLAG",       #55# 
                  "BRANCH",        #56# 
                  "BRANCH",        #57# 
                  "BRANCH",        #58# 
                  "EBRANCH",       #59# 
                  "EBRANCH",       #60# 
                  "EBRANCH",       #61# 
                  "BRANRET",       #62# 
                  "BRANRET",       #63# 
                  "BRANRET",       #64# 
                  "SUBROUT",       #65# 
                  "SUBROUT",       #66# 
                  "SUBROUT",       #67# 
                  "SUBROUT",       #68# 
                  "SUBROUT",       #69# 
                  "SUBROUT",       #70# 
                  "SUBROUT",       #71# 
                  "SUBROUT",       #72# 
                  "SUBROUT",       #73# 
                  "SUBROUT",       #74# 
                  "SUBROUT",       #75# 
                  "SUBROUT",       #76# 
                  "SUBROUT",       #77# 
                  "DIAGNOS",       #78# 
                  "DIAGNOS",       #79# 
                  "DIAGRET",       #80# 
                  "DIAGRET",       #81# 
                  "DSR",           #82# 
                  "DSR",           #83# 
                  "COLON"];        #84# 
         $END 
         CONTROL EJECT; 
  
         XREF      PROC           CBLIST; 
         XREF      FUNC           STACK;
         XREF      PROC           TMRTNTB;
         XREF      PROC           INTERCEPTOR;
         XREF      FUNC           OCT C(40);
         XREF      FUNC           DEC C(10);
         XREF      ITEM           DDTABLE;
         XREF      ITEM           DDVERBS;
         XREF      ITEM           DD6BITS;
         XREF      ITEM           EETABLE;
         XREF      ITEM           EEVERBS;
         XREF      ITEM           EE6BITS;
         XREF      ITEM           RRTABLE;
         XREF      ITEM           RRVERBS;
         XREF      ITEM           RR6BITS;
         XREF      ITEM           PPTABLE;
         XREF      ITEM           PPVERBS;
         XREF      ITEM           PP6BITS;
         XREF      ITEM           PPGTEXT;
         XREF      PROC           CMM$FGR;
         XREF      FUNC           CMM$AGR;
         XREF      PROC           CMM$GLV;
         XREF      FUNC           CMM$ALV;
         XREF      PROC           SET1; 
         XREF      PROC           SET2; 
         XREF      PROC           SET3; 
         XREF      PROC           SET4; 
         XREF      PROC           SET5; 
         XREF      PROC           SET7; 
         XREF      PROC           LDPPSET;
         XREF      PROC           D$SUBS; 
         XREF      PROC           E$SUBS; 
         XREF      PROC           R$SUBS; 
         ITEM      W1             I;
         ITEM      W2             I;
         ITEM      W3             I;
         ITEM      W4             I;
         ITEM      W5             I;
         ITEM      W8             I;
         ITEM      W9             I;
         ITEM      W10            I;
         ITEM      W11            I;
         ITEM      CTEXTLENGTH    I;
         ITEM      BITADDRESS     I;
         ITEM      WORDADDRESS    I;
         ITEM      RXMAX          I;
         ITEM      GROUPNUMBER    I;
         ITEM      RESIDUE        I;
         ITEM      WORD           I;
         ITEM      CWORD          I;
         ITEM      BGWORD         I;
         ITEM      TF             I;
         ITEM      CONTEXT        I;
         ITEM      LC             I;
         ITEM      LCLINE         I;
         ITEM      LCCOLUMN       I;
         ITEM      LCCOUNT        I;
         ITEM      LCCOUNTHOLD    I;
         ITEM      PDL            I;
         ITEM      NKEY           U;
         ITEM      NCODE          U;
         ITEM      NVALUE         U;
         ITEM      NLINE          U;
         ITEM      NCOLUMN        U;
         ITEM      CLASSTYPE      U;
         ITEM      CTEXTHOLD      U;
         ITEM      LASTBUG        I;
         ITEM      RX             U;
         ITEM      DN             B;
         ITEM      LR             I;
         ITEM      CW             I;
         ITEM      DUMP           C(40);
         DEF       BOUNDARY1      #46#; 
         DEF       RWELSE         #55#; 
         DEF       RWNEXT         #70#; 
         DEF       RWWHEN         #92#; 
         DEF       RWSECTION      #202#;
         DEF       DECLARTV       #287#;
         DEF       DECLARATION    #1#;
         DEF       SEVERE         #2#;
         DEF       PROPAGATED     #3#;
         DEF       ADVISORY       #4#;
         DEF       TRIVIAL        #5#;
         DEF       ANSI           #6#;
         DEF       MSGTRACE       #B<2> FLAGS#; 
         DEF       CMDTRACE       #B<3> FLAGS#; 
         DEF       FIRSTRW        #0#;
         DEF       LEVELTWO       #2#;
         DEF       LEVEL49        #49#; 
         DEF       UNDEFINED      #1#;
         DEF       OPCODE         #B<RESIDUE+2,7> WORD#;
         DEF       TENBITS        #B<RESIDUE+10,10> WORD#;
         BASED
         ARRAY     BGTABLE [0]; 
         ITEM      BG U;
         BASED
         ARRAY     SYNTAXTABL[0]; 
                   ITEM SYNTABL U;
         BASED ARRAY RETURNSTACK [0] S(2);
         BEGIN
         ITEM WA I(00,00,60); 
         ITEM RS I(01,00,60); 
         END
         BASED
         ARRAY     VTSTRING [37]; 
         ITEM      STRING         C(0,0,10);
         BASED
         ARRAY     VTABLE [25]; 
         ITEM      VT             U;
         ARRAY     LDBITS [16]    S(1); 
         ITEM      LDBITSTRING    U 
         =[ 
         O"00000 00000 01100 00000",    #00-01# 
         O"11540 00000 10740 00000",    #02-03# 
         O"10540 00000 11740 00000",    #04-05# 
         O"00100 00000 00124 00000",    #06-07# 
         O"00114 00000 14100 00000",    #08-09# 
         O"04100 00000 20540 00000",    #10-11# 
         O"23540 00000 20700 00000",    #12-13# 
         O"21740 00000 21700 00000",    #14-15# 
         O"00300 00000 30740 00000",    #16-17# 
         O"23740 00000 01300 00000",    #18-19# 
         O"00000 20400 00000 14600",    #20-21# 
         O"00000 06600 00000 01600",    #22-23# 
         O"00000 00140 00002 00400",    #24-25# 
         O"00000 40000 00001 00140",    #26-27# 
                                        #REPORT WRITER STRINGS# 
  
         O"20000 00000 17400 00000",    #28-29# 
         O"21360 40000 21477 76000",    #30-31# 
         O"20420 00000 00000 00000"];   #32-  # 
         CONTROL EJECT; 
# CONTEXT MATRIX
                   1 DATA THINGS       13 SPECIAL NAMES ITEMS 
                   2 FILE THINGS       14 FILE CONTROL ITEMS
                   3 FILE SORT THINGS  15 I-O CONTROL ITEMS 
                   4 OCCURS            16 CONFIGURATION SECTION 
                   5 LEVEL 66          17 SOURCE COMPUTER 
                   6 LEVEL 88          18 OBJECT COMPUTER 
                   7 LEVEL 77          19 DEBUG 
                   8 LEVEL 01          20 SEGMENT LIMIT 
                   9 LEVEL 02          21 INPUT OUTPUT
                  10 CD INPUT          22 SPECIAL NAMES 
                  11 CD OUTPUT         23 IO CONTROL
                  12 CD I-O            24 SELECT
DEFINITION
POINTS                               1 1 1 1 1 1 1 1 1 1 2 2 2 2 2
                 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4
               0                                                      0 
66             1           1     1                                    1 
66-88          2     1     1 1   1 1                                  2 
77-88          3     1       1 1 1 1                                  3 
88             4     1       1   1 1                                  4 
66-77-88       5     1     1 1 1 1 1                                  5 
CD DATA NAME   6                 1                                    6 
CD INPUT       7                 1   1   1                            7 
CD OUTPUT      8                 1     1 1                            8 
FD             9     1 1         1                                    9 
SD            10       1         1                                    10
01            11   1         1   1 1                                  11
02            12   1     1 1 1   1 1                                  12
77            13   1         1 1 1                                    13
77-02         14   1       1 1 1 1 1                                  14
77-66         15   1       1 1 1 1                                    15
WS            16               1 1                                    16
ANY 77-01     17   1 1       1 1 1 1                                  17
ANY 77-02     18   1     1 1 1 1 1 1                                  18
ANY 77-66     19           1   1 1                                    19
ENVIRONMENT   20                                 1         1          20
CONFIGURATION 21                                   1 1     1 1        21
SOURCE COMP   22                                     1 1   1 1        22
OBJECT COMP   23                                         1 1 1        23
FILE CONTROL  24                                               1 1    24
SPECIAL NAMES 25                           1               1          25
I-O CONTROL   26                               1                      26
SELECT        27                             1                 1 1    27
REPORT WRITER 28   1                                                  28
REPORT WRITER 29     1 1 1 1 1                                        29
REPORT WRITER 30   1       1   1 1 1 1         1                      30
REPORT WRITER 31   1       1 1     1 1 1 1 1 1 1 1 1 1 1              31
REPORT WRITER 32   1         1       1                                32
  
                                     1 1 1 1 1 1 1 1 1 1 2 2 2 2 2
                 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4
END CONTEXT MATRIX #
          CONTROL EJECT;
          $BEGIN
  
#     LOCALS TO DRIVER                                                 #
  
          ITEM ATOM$FIRST    I;        # FIRST CTEXT ATOM TO TRACE     #
          ITEM ATOM$LAST     I;        # LAST CTEXT ATOM TO TRACE      #
          ITEM $BOOLSTK$TRC  B;        # TRACE BOOLEAN STACK           #
          ITEM $CSTTRACE     B;        # SUBSCRIPT TABLE TRACE         #
          ITEM $DBUGSTK$TRC  B;        # TRACE DEBUG STACK             #
          ITEM DEBUGGING     B;        # TRUE IFF ANY DEBUG FLAG TRUE  #
          ITEM $FORMSTK$TRC  B;        # TRACE FORMULA STACK           #
          ITEM $GTEXT$TRACE  B;        # GTEXT TRACE FLAG              #
          ITEM LINE$FIRST    I;        # FIRST SOURCE LINE TO TRACE    #
          ITEM LINE$LAST     I;        # LAST SOURCE LINE TO TRACE     #
          ITEM $PRI$STK$TRC  B;        # TRACE PRIORITY STACK          #
          ITEM $STACK$TRACE  B;        # TRACE MAIN STACK              #
          ITEM $SUB$OBJ$TRC  B;        # TRACE OBJECT/SUBJECT STACK    #
          ITEM TBLTRACE      B;        # TABLE TRACE FLAG (CMDTRACE)   #
  
  
#     EXTERNAL FLAGS NEEDED TO MATCH SOME OF THE ABOVE FLAGS           #
  
          XDEF
              BEGIN 
              ITEM BOOL$STK$TRC        B; 
              ITEM CSTTRACE            B; 
              ITEM DBUG$STK$TRC        B; 
              ITEM FORM$STK$TRC        B; 
              ITEM GTEXT$TRACE         B; 
              ITEM PRI$STK$TRC         B; 
              ITEM STACK$TRACE         B; 
              ITEM SUB$OBJ$TRC         B; 
              END 
  
*CALL PARSCOM 
  
          $END
          $BEGIN
          PROC  DEBUG;
  
#**       DEBUG -  SET DEBUG INFORMATION FROM PARAMETER CARD           #
#                                                                      #
#     CALLING SEQUENCE-                                                #
#         DEBUG:                                                       #
#                                                                      #
#     GIVEN-                                                           #
#         -PARSERS- CARD IMAGE IN COMMON BLOCK /PARSCOM/.              #
#             PARSERS,<PHRASE-1>,...,<PHRASE-N>                        #
#               WHERE <PHRASE-I> MAY BE-                               #
#                 GTXTTRACE                                            #
#                 PRIORSTK                                             #
#                 SUBOBJSTK                                            #
#                 STACK                                                #
#                 TBLTRACE                                             #
#                 CSTTRACE                                             #
#                 BOOLSTK                                              #
#                 FORMSTK                                              #
#                 DEBUGSTK                                             #
#                 ALL                                                  #
#                 <LINE NUMBER>                                        #
#                 (<LINE NUMBER>,<LINE NUMBER>)                        #
#                                                                      #
#     DOES-                                                            #
#         SETS DEBUG VARIABLES ACCORDING TO PARAMETERS.                #
  
  
          $BEGIN
  
  
          DEF  CHAR$BLANK   #" "#;     # BLANK CHARACTER               #
          DEF  CHAR$COMMA   #","#;     # ,                             #
          DEF  CHAR$NINE    #"9"#;     # 9                             #
          DEF  CHAR$ZERO    #"0"#;     # 0                             #
          DEF  CHAR$A       #"A"#;     # A                             #
          DEF  CHAR$D       #"D"#;     # D                             #
          DEF  CHAR$Z       #"Z"#;     # Z                             #
  
*CALL LISTCTL 
  
          XREF               # EXTERNAL PROCEDURES                     #
              BEGIN 
              PROC  CBLIST;            # COBOL LISTING ROUTINE         #
              FUNC  TOBIN       I;     # DISPLAY TO BINARY             #
              END 
  
  
          ITEM  CHAR         C(1);     # RESULT FROM -GETCHAR-         #
          ITEM  GC$POS       I;        # GETCHAR- BIT POS. OF NEXT CHAR#
          ITEM  GC$I         I;        # GETCHAR- WORD INDEX TO CARD   #
          ITEM  GC$WORD      C(10);    # CURRENT WORD FROM CARD        #
          ITEM  I            I;        # SCRATCH                       #
          ITEM  NUM          I;        # RESULT FROM -GETNUM-          #
          ITEM   C           I;        # SCRATCH                       #
          ITEM   CTEMP       C(10);    # CHARACTER TEMP                #
          ITEM  WORD         C(10);    # RESULT FROM -GETWORD-         #
  
  
  
  
          PROC  GETCHAR;
          BEGIN 
          IF GC$POS EQ 10  THEN 
              BEGIN 
              GC$I = GC$I + 1;
              GC$WORD = PARSCOMWORD[GC$I];
              GC$POS = 0; 
              END 
          CHAR = C<GC$POS> GC$WORD; 
          GC$POS = GC$POS + 1;
          END 
  
  
  
  
          PROC  GETNUM; 
          BEGIN 
          CTEMP = CHAR$BLANK; 
          C<0>CTEMP = CHAR; 
          C<1>CTEMP = CHAR$D; 
          GETCHAR;
          C = 1;
          FOR I = I WHILE CHAR GQ CHAR$ZERO AND CHAR LQ CHAR$NINE AND 
                    C LS 10 
          DO
              BEGIN 
              C<C>CTEMP = CHAR; 
              C = C+1;
              GETCHAR;
              END 
          IF C GR 9 
          THEN   # ERROR NUMBER TOO LONG                               #
              NUM = -1; 
          ELSE
              BEGIN 
              C<C>CTEMP = CHAR$D; 
              NUM = TOBIN(CTEMP,C+1); 
              END 
          END 
  
  
  
  
          PROC  GETWORD;
          BEGIN 
          WORD = "          ";
          I = 0;
          FOR I=I WHILE CHAR GQ CHAR$A
                    AND CHAR LQ CHAR$Z  DO
              BEGIN 
              C<I>WORD = CHAR;
              I = I + 1;
              GETCHAR;
              END 
          END # OF GETWORD #
  
#     INITIALIZE -GETCHAR-                                             #
  
          GC$I = 0;                              # INDEX TO CARD       #
          GC$WORD = PARSCOMWORD[GC$I];            # CURRENT WORD       #
          GC$POS = 8;                            # (SKIP "PARSERS,")   #
  
#     INITIALIZE DEBUG FLAGS                                           #
  
          DEBUGGING = FALSE;
          $BOOLSTK$TRC = FALSE; 
          $CSTTRACE = FALSE;
          $DBUGSTK$TRC = FALSE; 
          $FORMSTK$TRC = FALSE; 
          $GTEXT$TRACE = FALSE; 
          LINE$FIRST = -3;
          LINE$LAST = -3; 
          $PRI$STK$TRC = FALSE; 
          $STACK$TRACE = FALSE; 
          $SUB$OBJ$TRC = FALSE; 
          TBLTRACE = FALSE; 
  
          IF CCTICHKOUT[0] THEN 
              DEBUGGING = TRUE; 
          ELSE
              RETURN; 
  
#     PROCESS THE CONTROL CARD                                         #
  
          GETCHAR;
NEXTPARAM:  
          IF CHAR GQ CHAR$A 
           AND CHAR LQ CHAR$Z  THEN 
              BEGIN                    # KEYWORD                       #
              GETWORD;
              IF WORD EQ "ALL" THEN 
                  BEGIN 
                  $BOOLSTK$TRC = TRUE;
                  $CSTTRACE = TRUE; 
                  $DBUGSTK$TRC = TRUE;
                  $FORMSTK$TRC = TRUE;
                  $GTEXT$TRACE = TRUE;
                  $PRI$STK$TRC = TRUE;
                  $STACK$TRACE = TRUE;
                  $SUB$OBJ$TRC = TRUE;
                  TBLTRACE = TRUE;
                  END 
              ELSE
              IF WORD EQ "BOOLSTK" THEN 
                  $BOOLSTK$TRC = TRUE;
              ELSE
              IF WORD EQ "CSTTRACE" THEN
                  $CSTTRACE = TRUE; 
              ELSE
              IF WORD EQ "DEBUGSTK" THEN
                  $DBUGSTK$TRC = TRUE;
              ELSE
              IF WORD EQ "FORMSTK" THEN 
                  $FORMSTK$TRC = TRUE;
              ELSE
              IF WORD EQ "GTXTTRACE" THEN 
                  $GTEXT$TRACE = TRUE;
              ELSE
              IF WORD EQ "PRIORSTK" THEN
                  $PRI$STK$TRC = TRUE;
              ELSE
              IF WORD EQ "STACK" THEN 
                  $STACK$TRACE = TRUE;
              ELSE
              IF WORD EQ "TBLTRACE" THEN
                  TBLTRACE = TRUE;
              ELSE
#***#             GOTO ERROR; 
              END 
          ELSE
          IF CHAR GQ CHAR$ZERO
           AND CHAR LQ CHAR$NINE  THEN
              BEGIN                    # <LINE-NUMBER>                 #
              GETNUM; 
              LINE$FIRST = NUM; 
              LINE$LAST = NUM;
              IF NUM LS 0 THEN  GOTO ERROR; 
              END 
          ELSE
          IF CHAR EQ "(" THEN 
              BEGIN                    # <LINE-NUMBER>,<LINE-NUMBER>)  #
              GETCHAR;
              GETNUM; 
              LINE$FIRST = NUM; 
              IF NUM LS 0 THEN  GOTO ERROR; 
              IF CHAR NQ CHAR$COMMA  THEN 
#***#             GOTO ERROR; 
              GETCHAR;
              IF CHAR LS CHAR$ZERO
               OR CHAR GR CHAR$NINE  THEN 
#***#             GOTO ERROR; 
              GETNUM; 
              IF NUM LS 0 THEN  GOTO ERROR; 
              LINE$LAST = NUM;
              IF CHAR NQ ")" THEN 
#***#             GOTO ERROR; 
              GETCHAR;
              END 
          ELSE
          IF CHAR EQ CHAR$COMMA  THEN 
              BEGIN                    # ,                             #
              GETCHAR;
              END 
          ELSE
          IF CHAR EQ CHAR$BLANK  THEN 
              BEGIN                    # END-OF-CARD                   #
#***#             GOTO DONECARD;
              END 
          ELSE
              BEGIN                    # ERROR                         #
ERROR:  
              CBLIST(LISTCTL"LINE"," PARSERS CARD ERROR",19); 
              DEBUGGING = FALSE;
              RETURN; 
              END 
          GOTO NEXTPARAM; 
  
  
#     DONE EXAMINING CARD                                              #
  
DONECARD: 
          IF  LINE$FIRST EQ 0 THEN
              BEGIN 
              BOOL$STK$TRC = $BOOLSTK$TRC;
              CSTTRACE = $CSTTRACE; 
              DBUG$STK$TRC = $DBUGSTK$TRC;
              FORM$STK$TRC = $FORMSTK$TRC;
              GTEXT$TRACE = $GTEXT$TRACE; 
              PRI$STK$TRC = $PRI$STK$TRC; 
              STACK$TRACE = $STACK$TRACE; 
              SUB$OBJ$TRC = $SUB$OBJ$TRC; 
              IF TBLTRACE THEN CMDTRACE = 1;
              END 
  
          IF LINE$LAST EQ -3 THEN DEBUGGING = FALSE;
  
  
          $END
          $END
          $BEGIN
          PROC TRACE$TABLE; 
          BEGIN 
  
          ITEM DUMP          C(70);    # TRACE OUTPUT LINE             #
          ITEM SCRATCH      I;    # LOCAL SCRATCH ITEM                 #
  
          ARRAY [0:12] S(1);
              BEGIN 
              ITEM DESTINATION  C(0,0,10) = [ 
                  "SET1", 
                  "SET2", 
                  "SET3", 
                  "SET4", 
                  "SET5", 
                  "SET6", 
                  "SET7", 
                  "SET8", 
                  "SET9", 
                  "SET10",
                  "D$SUBS", 
                  "E$SUBS", 
                  "R$SUBS"];
              END 
  
  
          DUMP = " "; 
          C<0,5>DUMP = OCT(WORDADDRESS,15,5); 
          SCRATCH = B<RESIDUE,2>WORD; 
          IF SCRATCH EQ 0 THEN C<9,1>DUMP = "F";
          IF SCRATCH EQ 1 THEN C<9,1>DUMP = "T";
          C<10,10>DUMP = COMMAND[OPCODE]; 
          IF OPCODE GQ 65 AND OPCODE LQ 77 THEN 
              BEGIN 
              C<25,10>DUMP = DESTINATION[OPCODE-65];
              C<35,3>DUMP = "SUB";
              C<38,5>DUMP = DEC(TENBITS); 
              END 
          C<45,5>DUMP = DEC(CTEXTINDEX-1);
          IF TF EQ 0 THEN 
              C<52,1>DUMP = "F";
          ELSE
              C<52,1>DUMP = "T";
          SCRATCH = B<RESIDUE,2>WORD; 
          C<60,1>DUMP = DEC(SCRATCH); 
          C<62,3>DUMP = DEC(OPCODE);
          SCRATCH = B<RESIDUE+9,11>WORD;
          C<66,4>DUMP = DEC(SCRATCH); 
          CBLIST(LISTCTL"LINE",DUMP,70);
          RETURN; 
  
          END     # PROC TRACE$TABLE   #
          $END
      CONTROL EJECT;
  
      PROC SEARCH;
         BEGIN
         W8 = NVALUE / 10;
         W9 = NVALUE - 10 * W8; 
         W10 = C<W9> STRING [W8]; 
         W8 = W10 / 4;
         W9 = (W10 - 4 * W8) * 15;
         W9 = B<W9,15> VT [W8]; 
         WORDADDRESS = W9 / 6;
         RESIDUE = 10 * ( W9 - 6 * WORDADDRESS);
         WORD = SYNTABL [WORDADDRESS];
         END
      CONTROL EJECT;
  
      PROC ERROR(S1); 
         BEGIN
         ITEM S1; 
         IF ERRORFLAG EQ 0
         THEN BEGIN 
              W8 = B<RESIDUE+9,11> WORD;
              IF S1 EQ 2
              THEN INTERCEPTOR(COLUMN$,LINE$,W8,0); 
              ELSE INTERCEPTOR(NCOLUMN,NLINE,W8,0); 
              END 
         END
      CONTROL EJECT;
  
      PROC BADCOMMA;
         BEGIN
         INTERCEPTOR(LCCOLUMN,LCLINE,999,TRIVIAL);
         END
      CONTROL EJECT;
  
      PROC PUNCTUATION; 
         BEGIN
         IF B<RESIDUE+9> WORD EQ 0
         THEN RETURN; 
         IF LC EQ 0 OR LC GQ CTEXTINDEX THEN RETURN;
         IF LCCOUNT GR 0 THEN BADCOMMA; 
         LC = 0;
         LCCOUNT = -1;
         END
      CONTROL EJECT;
  
      PROC INCREMENT; 
         BEGIN
         VALUE$ = NVALUE; 
         LINE$ = NLINE; 
         COLUMN$ = NCOLUMN; 
  
  
         NEXT:  
         CTEXTINDEX = CTEXTINDEX + 1; 
         IF CTEXTINDEX GR CTEXTLENGTH 
         THEN BEGIN 
              NCODE = CTDELIMITER;
              NVALUE = CTENDOFFILE; 
              NKEY = 1; 
              RETURN; 
              END 
         IF LR EQ 0 
         THEN BEGIN 
              CW = CW + 1;
              CWORD = GETQUICK(CTEXTWORD,CTEXT$,CW);
              NKEY = B<00,01>CWORD; 
              NCOLUMN = B<01,07> CWORD; 
              NCODE = B<08,06> CWORD; 
              NVALUE = B<14,16> CWORD;
              LR = 1; 
              END 
         ELSE BEGIN 
              NKEY = B<30,01> CWORD;
              NCOLUMN = B<31,07> CWORD; 
              NCODE = B<38,06> CWORD; 
              NVALUE = B<44,16> CWORD;
              LR = 0; 
              END 
         IF NCODE EQ CTDELIMITER
         THEN GOTO XXX; 
         IF AFLAG EQ 0 AND
            KFLAG EQ 0 AND
            NCOLUMN GQ 8 AND
            NCOLUMN LQ 11 AND 
            NCODE NQ CTPNDEF AND
            NCODE NQ CTSNDEF AND
            NCODE NQ CTPERIOD AND 
            NCODE NQ CTENDDCL AND 
            NOT (NCODE EQ CTRESERVEDWD AND
                (NVALUE EQ DECLARTV OR NVALUE EQ RWSECTION))
         THEN INTERCEPTOR(NCOLUMN,NLINE,997,TRIVIAL); 
         KFLAG = 0; 
         IF LC NQ 0 
         THEN BEGIN 
              LCCOUNT = LCCOUNT + 1;
              END 
         RETURN;
  
         XXX: 
         IF NVALUE LS CTSPECIALREG
         THEN BEGIN 
              #THIS IS A LINE NUMBER CTEXT ATOM#
              NLINE = NVALUE; 
              # LINE NUMBER -> RA + 21 #
              RA$LINE = NLINE;
              $BEGIN
              IF DEBUGGING THEN 
                  BEGIN 
                  IF (LINE$FIRST LQ NLINE AND NLINE LQ LINE$LAST) OR
                     (LINE$FIRST LQ PDL AND PDL LQ LINE$LAST) 
                  THEN
                      BEGIN 
                      BOOL$STK$TRC = $BOOLSTK$TRC;
                      CSTTRACE = $CSTTRACE; 
                      DBUG$STK$TRC = $DBUGSTK$TRC;
                      FORM$STK$TRC = $FORMSTK$TRC;
                      GTEXT$TRACE = $GTEXT$TRACE; 
                      PRI$STK$TRC = $PRI$STK$TRC; 
                      STACK$TRACE = $STACK$TRACE; 
                      SUB$OBJ$TRC = $SUB$OBJ$TRC; 
                      IF TBLTRACE THEN CMDTRACE = 1;
                      END 
                  ELSE
                      BEGIN 
                      IF NLINE GQ LINE$LAST THEN
                          BEGIN 
                          DEBUGGING = FALSE;
                          BOOL$STK$TRC = FALSE; 
                          CSTTRACE = FALSE; 
                          DBUG$STK$TRC = FALSE; 
                          FORM$STK$TRC = FALSE; 
                          GTEXT$TRACE = FALSE;
                          PRI$STK$TRC = FALSE;
                          STACK$TRACE = FALSE;
                          SUB$OBJ$TRC = FALSE;
                          CMDTRACE = 0; 
                          END 
                      END 
                  END 
              $END
              GOTO NEXT;
              END 
         IF NVALUE EQ CTCOMMA OR NVALUE EQ CTSEMICOLON
         THEN BEGIN 
              IF PFLAG EQ 1 THEN GOTO NEXT; 
              IF CCTFIPSLEVEL LS 3
              THEN BEGIN
                   # FIPS = 3 SUPPORTS THE SEPARATORS COMMA AND SEMI #
                   INTERCEPTOR(NCOLUMN,NLINE,986,ANSI); 
                   END
              IF LC NQ 0
              THEN BEGIN
                   IF LC GQ CTEXTINDEX
                   THEN GOTO NEXT;
                   ELSE BADCOMMA; 
                   END
              LC = CTEXTINDEX;
              LCLINE = NLINE; 
              LCCOLUMN = NCOLUMN; 
              LCCOUNT = -1; 
              GOTO NEXT;
              END 
         IF NVALUE EQ CTSPECIALREG
         THEN BEGIN 
              SPECREGFLAG = 1;
              GOTO NEXT;
              END 
         END #OF INCREMENT# 
      CONTROL EJECT;
  
      PROC UNPACKCTEXT; 
         BEGIN
         CW = CTEXTINDEX/2; 
         CWORD = GETQUICK(CTEXTWORD,CTEXT$,CW); 
         IF B<59,01> CTEXTINDEX EQ 0
         THEN BEGIN 
              NKEY = B<00,01> CWORD;
              NCOLUMN = B<01,07> CWORD; 
              NCODE = B<08,06> CWORD; 
              NVALUE = B<14,16> CWORD;
              LR = 1; 
              END 
         ELSE BEGIN 
              NKEY = B<30,01> CWORD;
              NCOLUMN = B<31,07> CWORD; 
              NCODE = B<38,06> CWORD; 
              NVALUE = B<44,16> CWORD;
              LR = 0; 
              END 
         END
      CONTROL EJECT;
  
      FUNC READ(P1, P2) I;
  
         BEGIN
  
         ITEM P1     I; 
         ITEM P2     I; 
  
         W8 = P2 / 2; 
         W9 = 30 * (P2 - 2 * W8); 
         W10 = GETQUICK(CTEXTWORD,CTEXT$,W8); 
         IF P1 EQ 1 THEN READ = B<W9> W10;
         IF P1 EQ 2 THEN READ = B<W9+1,7> W10;
         IF P1 EQ 3 THEN READ = B<W9+8,6> W10;
         IF P1 EQ 4 THEN READ = B<W9+14,16> W10;
         END
         CONTROL EJECT; 
         # ----- DRIVER MAIN LINE STARTS HERE ----- # 
         FLAGS = 0; 
         TRUEFALSE = 1; 
         IF PHASE EQ 1
         THEN BEGIN 
              CTEXTINDEX = CCTDDCTXADDR;
              CTEXTLENGTH = CCTDDCTXLEN;
              NLINE = CCTDDLINENUM; 
              P<VTABLE> = LOC(DDVERBS); 
              P<VTSTRING> = LOC(DD6BITS); 
              P<SYNTAXTABL> = LOC(DDTABLE); 
              END 
         ELSE IF PHASE EQ 2 
         THEN BEGIN 
              CTEXTINDEX = CCTEDCTXADDR;
              CTEXTLENGTH = CCTEDCTXLEN;
              NLINE = CCTEDLINENUM; 
              P<VTABLE> = LOC(EEVERBS); 
              P<VTSTRING> = LOC(EE6BITS); 
              P<SYNTAXTABL> = LOC(EETABLE); 
              END 
         ELSE IF PHASE EQ 3 
         THEN BEGIN 
              CTEXTINDEX = CCTPDCTXADDR;
              CTEXTLENGTH = CCTPDCTXLEN;
              NLINE = CCTPDLINENUM; 
              P<VTABLE> = LOC(PPVERBS); 
              P<VTSTRING> = LOC(PP6BITS); 
              P<SYNTAXTABL> = LOC(PPTABLE); 
              P<BGTABLE> = LOC(PPGTEXT);
              END 
         ELSE BEGIN 
              CTEXTINDEX = CCTRSCTXADDR;
              CTEXTLENGTH = CCTRSCTXLEN;
              NLINE = CCTRSLINENUM; 
              P<VTABLE> = LOC(RRVERBS); 
              P<VTSTRING> = LOC(RR6BITS); 
              P<SYNTAXTABL> = LOC(RRTABLE); 
              END 
         # CHECK FOR MISSING DIVISION # 
         IF CTEXTLENGTH EQ 0
         THEN BEGIN 
              # SINCE THERE WONT BE A LINE NUMBER ATOM #
              # MAKE THE EOF TEST PASS IMMEDIATELY     #
              CTEXTINDEX = 2; 
              ERRORFLAG = 1;
              IF PHASE EQ 2 
              THEN INTERCEPTOR(0,NLINE,988,ANSI); 
              ELSE INTERCEPTOR(0,NLINE,989,SEVERE); 
              IF PHASE NQ 3 
              THEN RETURN;
              END 
         CONTROL EJECT; 
  
         #  INITIALIZATION  # 
  
         TF = 1;
         LC = 0;
         AFLAG = 1; 
         IF CCTFIPSLEVEL GQ 2 THEN FIPS2 = 1; 
         IF CCTFIPSLEVEL GQ 3 THEN FIPS3 = 1; 
         IF CCTFIPSLEVEL GQ 4 THEN FIPS4 = 1; 
         IF CCTFIPSLEVEL EQ 5 THEN FIPS5 = 1; 
         RX = 0;
         RXMAX = 28;
         GROUPNUMBER = CMM$AGR(0);
         W1 = CMM$ALV(60,1,3,GROUPNUMBER,P<RETURNSTACK>,0); 
         WORDADDRESS = 0; 
         RESIDUE = 0; 
         WORD = SYNTABL [WORDADDRESS];
         LASTBUG = -1;
         $BEGIN 
         PDL = -1;
         DEBUG; 
         $END 
  
         # -------------------------------------------------------- # 
         # BY ADJUSTING CTEXTINDEX AND CTEXTLENGTH, WE CAN ARRANGE  # 
         # THINGS SO THAT CTEXTINDEX/2 WILL GIVE US A POINTER       # 
         # (WITHOUT CORRECTION) TO THE WORD CONTAINING THE CTEXT    # 
         # ATOM ASSOCIATED WITH CTEXTINDEX ...                      # 
         # DRIVER ...          0/2   1/2     WORD 0                 # 
         #                     2/2   3/2     WORD 1                 # 
         #                     4/2   5/2     WORD 2                 # 
         # SSCANNER GIVES US CTEXT INDICIES WHICH LOOK LIKE ...     # 
         #                     N/A   N/A     WORD 0                 # 
         #                     1     2       WORD 1                 # 
         #                     3     4       WORD 2                 # 
         # THE CCT DIRECTS US TO THE START OF EACH DIVISIONS CTEXT. # 
         # NORMALLY IT WILL POINT TO THE LINE NUMBER ATOM OF THE    # 
         # DIVISION HEADER CARD BUT UNDER UNUSUAL CIRCUMSTANCES THE # 
         # INDEX MAY POINT TO THE ACTUAL FIRST CTEXT ATOM OF THE    # 
         # DIVISION. THIS SHOULD CAUSE NO PROBLEMS SINCE NLINE IS   # 
         # SET UP VIA THE SSCANNER SUPPLIED CCT LINE NUMBERS ...    # 
         # IN ORDER TO MAKE OUR LITTLE INTERNAL TRANSFORMATION, WE  # 
         # SHOULD ADD ONE TO BOTH CTEXTINDEX AND CTEXTLENGTH ...    # 
         # BUT WE WILL IN FACT ONLY CORRECT CTEXTLENGTH ... THIS    # 
         # HAS THE EFFECT OF STARTING WITH THE ATOM PRECEDING THE   # 
         # THE LINE NUMBER ATOM ... WE WILL UNPACK THIS ATOM ...    # 
         # CALCULATING THE APPROPRIATE VALUES OF CW AND LR          # 
         # INCREMENT THE CTEXT OBTAINING THE APPROPRIATE LINE       # 
         # NUMBER AND LAND EXACTLY UPON THE DIVISION HEADER READY   # 
         # TO GO ...                                                # 
         # NOTE - NLINE IS CORRECT BUT LINE$ WILL BE INCORRECT      # 
         # UNTIL AFTER THE NEXT INCREMENT CTEXT TAKES PLACE         # 
         # -------------------------------------------------------- # 
         CTEXTLENGTH = CTEXTLENGTH + 1; 
         UNPACKCTEXT; 
         INCREMENT; 
         GOTO LZ; 
         CONTROL EJECT; 
         # ----- OPCODE CRACKER ----- # 
L10:  
L20:  
         IF RESIDUE NQ 40 
         THEN BEGIN 
              RESIDUE = RESIDUE + 20; 
              GOTO LZ;
              END 
         RESIDUE = 0; 
         WORDADDRESS = WORDADDRESS + 1; 
         WORD = SYNTABL [WORDADDRESS];
LZ: 
         $BEGIN 
         IF CMDTRACE EQ 1 
         THEN  TRACE$TABLE; 
         $END 
         IF TF LXR B<RESIDUE,2> WORD EQ 1 
         THEN GOTO L20; 
         ELSE GOTO SUPERSWITCH [OPCODE];
         CONTROL EJECT; 
FILEREF:  
         TF = 0;
         IF NCODE NQ CTDNREF THEN GOTO L10; 
         W2 = GETQUICK(IN$CODE,INT$,NVALUE);
         IF W2 EQ 0 
         THEN BEGIN 
              W3 = GETQUICK(IN$NAME,INT$,NVALUE); 
              W1 = GETQUICK(DN$LEVEL,DNAT$,W3); 
              IF W1 EQ FDDESCR OR W1 EQ SDDESCR 
              THEN BEGIN
                   TF = 1;
                   PUNCTUATION; 
                   INCREMENT; 
                   VALUE$ = W3; 
                   END
              END 
         GOTO L10;
AAREA:  
         IF COLUMN$ LS 8 OR COLUMN$ GR 11 
         THEN INTERCEPTOR(COLUMN$,LINE$,995,TRIVIAL); 
         GOTO L10;
ADVANCE:  
         PFLAG = 1; 
         FOR W1 = CTEXTINDEX
         STEP 1 
         WHILE W1 LQ CTEXTLENGTH AND NKEY NQ 1
         DO INCREMENT;
         PFLAG = 0; 
         IF NCODE EQ CTLINECOUNT OR 
            NCODE EQ CTLINAGECOUN OR
            NCODE EQ CTPAGECOUNT OR 
            NCODE EQ CTDEBUGITEM
          THEN
            SPECREGFLAG = 1;
          ELSE
            SPECREGFLAG = 0;
         GOTO L10;
ALLOW:  
         #RESERVED WORD ALSO# 
         TF = 0;
         IF NCODE EQ CTRESERVEDWD AND NVALUE EQ TENBITS 
         THEN BEGIN 
              TF = 1; 
              INCREMENT;
              END 
         GOTO L20;
ALLOWDIAG:  
         ERRORFLAG = 0; 
         GOTO L10;
BRANCH1:  
         W1 = 0;
         GOTO COMMONBRANCH; 
BRANCH2:  
         W1 = 20; 
         GOTO COMMONBRANCH; 
BRANCH3:  
         W1 = 40; 
         GOTO COMMONBRANCH; 
EBRANCH1: 
         W1 = 0;
         IF ERRORFLAG EQ 1
         THEN GOTO COMMONBRANCH;
         ELSE GOTO L20; 
EBRANCH2: 
         W1 = 20; 
         IF ERRORFLAG EQ 1
         THEN GOTO COMMONBRANCH;
         ELSE GOTO L20; 
EBRANCH3: 
         W1 = 40; 
         IF ERRORFLAG EQ 1
         THEN GOTO COMMONBRANCH;
         ELSE GOTO L20; 
BAR1: 
         W1 = 0;
         GOTO COMMONBAR;
BAR2: 
         W1 = 20; 
         GOTO COMMONBAR;
BAR3: 
         W1 = 40; 
     COMMONBAR: 
         RS [RX] = RESIDUE; 
         WA [RX] = WORDADDRESS; 
         IF RX GR RXMAX 
         THEN BEGIN 
              CMM$GLV(RETURNSTACK,60);
              RXMAX = RXMAX + 30; 
              END 
         RX = RX + 1; 
         #FALLING THRU# 
    COMMONBRANCH: 
         WORDADDRESS = B<RESIDUE+9,11> WORD;
         RESIDUE = W1;
         WORD = SYNTABL [WORDADDRESS];
         GOTO LZ; 
BLDGTXT:  
         BGWORD = BG [TENBITS]; 
         S = B<4,4> BGWORD; 
         FOR W1 = 4 
         STEP 4 
         UNTIL 4 * B<0,4> BGWORD
         DO  BEGIN
             W2 = B<4+W1,4> BGWORD; 
             IF W2 EQ 13 THEN W2 = DIVISOR; ELSE
             IF W2 EQ 14 THEN W2 = DIVIDEND; ELSE 
             IF W2 EQ 15 THEN W2 = VERBENTRY; 
             G = G + 1; 
             IF B<59,1> G EQ 0
             THEN SETFIELD(GTEXTATOM1,GTEXT$,G/2,STACK(W2));
             ELSE SETFIELD(GTEXTATOM2,GTEXT$,G/2,STACK(W2));
             END
         GOTO L20;
CLAUSE: 
         TF = 0;
         IF NKEY EQ 1 AND NCODE EQ CTRESERVEDWD 
         THEN BEGIN 
              RS [RX] = RESIDUE;
              WA [RX] = WORDADDRESS;
              IF RX GR RXMAX
              THEN BEGIN
                   CMM$GLV(RETURNSTACK,60); 
                   RXMAX = RXMAX + 30;
                   END
              RX = RX + 1;
              PUNCTUATION;
              SEARCH; 
              INCREMENT;
              GOTO LZ;
              END 
         GOTO L10;
CONDNAME: 
         TF = 0;
         IF NCODE EQ CTDNREF AND
            REPORTMODE EQ 0 AND 
            GETQUICK(IN$CODE,INT$,NVALUE) EQ 0
         THEN BEGIN 
              W1 = GETQUICK(IN$NAME,INT$,NVALUE); 
              IF GETQUICK(DN$LEVEL,DNAT$,W1) EQ 88
              THEN BEGIN
                   CTEXTHOLD = GETQUICK(DN$88CPTR,DNAT$,W1);
                   NVALUE = W1; 
                   PUNCTUATION; 
                   INCREMENT; 
                   TF = 1;
                   END
              END 
         GOTO L10;
TESCNTXT: 
         TF = B<TENBITS> CONTEXT; 
         SYNTAXONLY = 1 - TF; 
         GOTO L20;
DEFPT:  
         W1 = TENBITS;
         W2 = W1 / 2; 
         W3 = W1 - 2 * W2;
         W4 = 30 * W3;
         B<0,30> CONTEXT = B<W4,30> LDBITSTRING [W2]; 
         GOTO L20;
DIAGNOSTIC: 
         IF OPCODE EQ 78
         THEN ERROR(1); 
         ELSE ERROR(2); 
         GOTO L20;
FILLERX:  
         TF = 0;
         IF NCODE EQ CTFILLER 
         THEN BEGIN 
              TF = 1; 
              INCREMENT;
              END 
         GOTO L10;
DIAGNRET: 
         IF OPCODE EQ 80
         THEN ERROR (1);
         ELSE ERROR(2); 
         GOTO RETURNX;
ENDDECLAR:  
         CLASSTYPE = CTENDDCL;
         GOTO CLASS;
DNDEF:  
         CLASSTYPE = CTDNDEF; 
         GOTO PCLASS; 
DSR:  
         IF OPCODE EQ 82
         THEN ERROR(1); 
         ELSE ERROR(2); 
         ERRORFLAG = 1; 
         GOTO RETURNX;
EQUALS: 
         CLASSTYPE = CTEQUALS;
         GOTO CLASS;
EXPONENT: 
         CLASSTYPE = CTEXPONENT;
         GOTO CLASS;
GREATER:  
         CLASSTYPE = CTGREATER; 
         GOTO CLASS;
KEEP: 
         FOR W1 = CTEXTINDEX - 1
         STEP -1
         UNTIL 0
         DO BEGIN 
            IF READ(3,W1) NQ CTDELIMITER
            THEN BEGIN
                 CTEXTINDEX = W1; 
                 LCCOUNT = LCCOUNT - 1; 
                 UNPACKCTEXT; 
                 FOR W2 = W1 - 1
                 STEP -1
                 UNTIL 0
                 DO BEGIN 
                    W3 = READ(3,W2);
                    W4 = READ(4,W2);
                    IF W3 EQ CTDELIMITER AND W4 LS CTSPECIALREG 
                    THEN BEGIN
                         NLINE = W4;
  
                         KFLAG = 1; 
                         GOTO L10;
                         END
                    END 
                END 
            END 
         GOTO L10;
KEYELEM:  
         TF = 0;
         IF NKEY EQ 1 THEN TF = 1;
         GOTO L10;
LEFTPARN: 
         CLASSTYPE = CTLEFTPAREN; 
         GOTO CLASS;
LESSTHAN: 
         CLASSTYPE = CTLESSTHAN;
         GOTO CLASS;
INTEGER:  
         TF = 0;
         IF NCODE NQ CTLITERAL THEN GOTO L10; 
         IF GETQUICK(PL$CODE,PLT$,NVALUE) EQ 2
         THEN BEGIN 
              TF = 1; 
              PUNCTUATION;
              INCREMENT;
              END 
         GOTO L10;
LITERAL:  
         CLASSTYPE = CTLITERAL; 
         GOTO PCLASS; 
MINUS:  
         CLASSTYPE = CTMINUS; 
         GOTO CLASS;
PERIOD: 
         CLASSTYPE = CTPERIOD;
         GOTO CLASS;
PICTURE:  
         CLASSTYPE = CTPICTURE; 
         GOTO CLASS;
PLUS: 
         CLASSTYPE = CTPLUS;
         GOTO CLASS;
COLON:  
         CLASSTYPE = CTCOLON; 
         GOTO CLASS;
PNDEF:  
         CLASSTYPE = CTPNDEF; 
         GOTO CLASS;
PNREF:  
         TF = 0;
         W4 = CTEXTINDEX; 
         IF NCODE EQ CTPNREF
         THEN BEGIN 
              TF = 1; 
              PUNCTUATION;
              INCREMENT;
              IF REPORTMODE EQ 1 THEN GOTO L10; 
              W2 = GETQUICK(IN$CODE,INT$,VALUE$); 
              IF W2 EQ 0
              THEN BEGIN
                   IP$ = VALUE$;
                   VALUE$ = GETQUICK(IN$NAME,INT$,VALUE$);
                   GOTO L10;
                   END
              IF W2 EQ 1 THEN W3 = 996; 
                         ELSE W3 = 993; 
              FREEZEFLAG = 0; 
              VALUE$ = 0; 
              IF W4 EQ LASTBUG THEN GOTO L10; 
              LASTBUG = W4; 
              INTERCEPTOR(COLUMN$,LINE$,W3,SEVERE); 
              END 
         GOTO L10;
RETURNX:  
         RX = RX - 1; 
         WORDADDRESS = WA [RX]; 
         RESIDUE = RS [RX]; 
         WORD = SYNTABL [WORDADDRESS];
         GOTO L20;
ERRETURNX:  
         IF ERRORFLAG EQ 1
         THEN GOTO RETURNX; 
         ELSE GOTO L10; 
RETRUE: 
         TF = 1;
         GOTO RETURNX;
RTPAREN:  
         CLASSTYPE = CTRIGHTPAREN;
         GOTO CLASS;
SLASH:  
         CLASSTYPE = CTSLASH; 
         GOTO CLASS;
SNDEF:  
         CLASSTYPE = CTSNDEF; 
         GOTO CLASS;
STAR: 
         CLASSTYPE = CTSTAR;
         GOTO CLASS;
STATEMENT:  
         TF = 0;
         IF NKEY EQ 0 THEN GOTO L10;
         IF NCODE NQ CTRESERVEDWD THEN GOTO L10;
         IF NVALUE EQ RWELSE OR 
            NVALUE EQ RWNEXT OR 
            NVALUE EQ DECLARTV OR 
            NVALUE EQ RWWHEN THEN GOTO L10; 
         TF = 1;
         PUNCTUATION; 
         RS [RX] = RESIDUE; 
         WA [RX] = WORDADDRESS; 
         IF RX GR RXMAX 
         THEN BEGIN 
              CMM$GLV(RETURNSTACK,60);
              RXMAX = RXMAX + 30; 
              END 
         RX = RX + 1; 
         SEARCH;
         SWITCH PSSWITCH PS0,PS1,PS2,PS3,PS4,PS5,PS6,PS7,PS8; 
         GOTO PSSWITCH [PARSTATUS]; 
         PS0:      W1 = 46; 
                   PARSTATUS = 2; 
                   GOTO BAD;
         PS1:      PARSTATUS = 2; 
                   GOTO PS3;
         PS4:      W1 = 72; 
                   GOTO BAD3; 
         PS5:      W1 = 38; 
                   GOTO BAD3; 
         PS6:      W1 = 3;
                   GOTO BAD3; 
         PS7:      W1 = 590;
                   GOTO BAD3; 
         PS8:      W1 = 591;
         BAD3:     PARSTATUS = 3; 
         BAD:      INCREMENT; 
                   INTERCEPTOR(COLUMN$,LINE$,W1,0); 
                   GOTO LZ; 
         PS2:      PARSTATUS = 3; 
         PS3:      INCREMENT; 
                   GOTO LZ; 
SUB1:    SUB$ = TENBITS; SET1; GOTO L20;
SUB2:    SUB$ = TENBITS; SET2; GOTO L20;
SUB3:    SUB$ = TENBITS; SET3; GOTO L20;
SUB4:    SUB$ = TENBITS; SET4; GOTO L20;
SUB5:    SUB$ = TENBITS; SET5; GOTO L20;
SUB6:    SUB$ = TENBITS; LDPPSET(3); GOTO L20;
SUB7:    SUB$ = TENBITS; SET7; GOTO L20;
SUB8:    SUB$ = TENBITS; LDPPSET(5); GOTO L20;
SUB9:    SUB$ = TENBITS; LDPPSET(6); GOTO L20;
SUB10:   SUB$ = TENBITS; LDPPSET(7); GOTO L20;
SUB11:   SUB$ = TENBITS; D$SUBS; GOTO L20;
SUB12:   SUB$ = TENBITS; E$SUBS; GOTO L20;
SUB13:   SUB$ = TENBITS; R$SUBS; GOTO L20;
SETTFFLAG:  
         TF = TRUEFALSE;
         TRUEFALSE = 1; 
         GOTO L10;
CTEXTRET: 
         CTEXTINDEX = CTEXTHOLD;
         AFLAG = 0; 
         PFLAG = 0; 
         LCCOUNT = LCCOUNTHOLD; 
         NLINE = PDL; 
         $BEGIN 
         PDL = -1;
         $END 
         UNPACKCTEXT; 
         GOTO L10;
CONAMECTX:  
         CTEXTHOLD == CTEXTINDEX; 
         AFLAG = 1; 
         PFLAG = 1; 
         LCCOUNTHOLD = LCCOUNT; 
         PDL = NLINE; 
         UNPACKCTEXT; 
         GOTO L10;
STOPX:  
         #RETURN THE DRIVER STACK WORK SPACE# 
         CMM$FGR(GROUPNUMBER);
         RETURN;
EOF:  
         TF = 0;
         IF NCODE EQ CTDELIMITER AND NVALUE EQ CTENDOFFILE
         THEN TF = 1; 
         GOTO L10;
RETFALSE: 
         TF = 0;
         GOTO RETURNX;
COMMARW:  
         TF = 0;
         IF NCODE EQ CTRESERVEDWD AND NVALUE EQ TENBITS 
         THEN BEGIN 
              TF = 1; 
              PUNCTUATION;
              INCREMENT;
              END 
         GOTO L20;
LEVEL:  
         TF = 0;
         W1 = TENBITS;
         IF NCODE NQ CTLEVELNUM THEN GOTO L20;
         IF W1 EQ LEVELTWO
         THEN BEGIN 
              IF NVALUE LS LEVELTWO OR NVALUE GR LEVEL49
              THEN GOTO L20;
              END 
         ELSE BEGIN 
              #WE DESIRE A LEVEL OTHER THAN 2 - 49# 
              IF W1 NQ NVALUE 
              THEN GOTO L20;
              END 
         TF = 1;
         INCREMENT; 
         GOTO L20;
IMPLNAME: 
         #RETURN TRUE          IF UNDEFINED DNREF#
         #RETURN FALSE (F35=1) IF NOT A DNREF#
         #RETURN FALSE (F35=0) IF DNREF IS DEFINED# 
         TF = 0;
         IMPLFLAG = 1;
         IF NCODE EQ CTDNREF
         THEN BEGIN 
              IF GETQUICK(IN$CODE,INT$,NVALUE) EQ UNDEFINED 
              THEN TF = 1;
              ELSE IMPLFLAG = 0;
              NVALUE = GETQUICK(IN$NAME,INT$,NVALUE); 
              #NVALUE NOW CONTAINS PLT OR DNAT INDEX# 
              PUNCTUATION;
              INCREMENT;
              END 
         GOTO L10;
PASTFFLAG:  
         TRUEFALSE = TF;
         GOTO L10;
DATAREF:  
         DN = FALSE;
         GOTO DNCOMMON; 
DNREF:  
         DN = TRUE; 
DNCOMMON: 
         TF = 0;
         W4 = CTEXTINDEX; 
         IF NCODE NQ CTDNREF THEN GOTO L10; 
         LINECTRFLAG = 0; 
         LINAGEFLAG = 0;
         TF = 1;
         PUNCTUATION; 
         INCREMENT; 
         IF DN AND REPORTMODE EQ 1 THEN GOTO L10; 
         W2 = GETQUICK(IN$CODE,INT$,VALUE$);
         IF W2 EQ 0 
         THEN BEGIN 
              IP$ = VALUE$; 
              VALUE$ = GETQUICK(IN$NAME,INT$,VALUE$); 
              IF DN AND CCTSSDNATPTR NQ 0 
              THEN BEGIN
                   IF SECONDARY2 EQ 0 
                   THEN BEGIN 
                        W1 = GETQUICK(DN$MAJMSEC,DNAT$,VALUE$); 
                        IF W1 EQ SECSMSEC AND W4 NQ LASTBUG 
                        THEN BEGIN
                             INTERCEPTOR(COLUMN$,LINE$,998,SEVERE); 
                             FREEZEFLAG = 0;
                             LASTBUG = W4;
                             END
                        END 
                   END
              IF NOT DN THEN GOTO L10;
              IF GETQUICK(DN$RITEM,DNAT$,VALUE$) EQ 1 
                 AND RITEMLEGAL EQ 0
              THEN BEGIN
                   VALUE$ = 0;
                   FREEZEFLAG = 0;
                   IF COLUMN$ NQ 0 AND W4 NQ LASTBUG
                   THEN INTERCEPTOR(COLUMN$,LINE$,992,SEVERE);
                   LASTBUG = W4;
                   END
              GOTO L10; 
              END 
         IF W2 EQ 1 
         THEN W3 = 994; 
         ELSE W3 = 990; 
         VALUE$ = 0;
         FREEZEFLAG = 0;
         IF W4 EQ LASTBUG THEN GOTO L10;
         LASTBUG = W4;
         INTERCEPTOR(COLUMN$,LINE$,W3,SEVERE);
         GOTO L10;
SETFLAG:  
         B<TENBITS> FLAGS = 1;
         GOTO L20;
CLEARFLAG:  
         B<TENBITS> FLAGS = 0;
         GOTO L20;
TESTFLAG: 
         TF = 0;
         IF B<TENBITS> FLAGS EQ 1 
         THEN TF = 1; 
         GOTO L20;
LINECOUNTER:  
         W1 = CTLINECOUNT;
         GOTO ZUSAMMEN; 
PAGECOUNTER:  
         W1 = CTPAGECOUNT;
         GOTO ZUSAMMEN; 
LINAGECOUNT:  
         W1 = CTLINAGECOUN; 
         GOTO ZUSAMMEN; 
DEBUGITEM:  
         W1 = CTDEBUGITEM;
         GOTO ZUSAMMEN; 
HASHEDVALUE:  
         W1 = CTHASHEDVALU; 
         #FALLING THROUGH#
ZUSAMMEN: 
         LINECTRFLAG = 0; 
         LINAGEFLAG = 0;
         TF = 0;
         IF NCODE NQ W1 THEN GOTO L10;
         SPECREGFLAG = 0; 
         PUNCTUATION; 
         INCREMENT; 
         TF = 1;
         IF GETQUICK(IN$CODE,INT$,VALUE$) NQ 0
         THEN BEGIN 
              W2 = GETQUICK(IN$CODE,INT$,VALUE$); 
              IF W2 EQ 1
              THEN W3 = 985;
              ELSE W3 = 984;
              VALUE$ = 0; 
              FREEZEFLAG = 0; 
              INTERCEPTOR(COLUMN$,LINE$,W3,SEVERE); 
              GOTO L10; 
              END 
         VALUE$ = GETQUICK(IN$NAME,INT$,VALUE$);
         IF W1 EQ CTLINAGECOUN AND
            GETQUICK(DN$LINAGE,DNAT$,VALUE$-1) NQ 1 
         THEN BEGIN 
              VALUE$ = 0; 
              FREEZEFLAG = 0; 
              INTERCEPTOR(COLUMN$,LINE$,987,SEVERE);
              END 
         GOTO L10;
PCLASS: 
         TF = 0;
         IF NCODE EQ CLASSTYPE
         THEN BEGIN 
              PUNCTUATION;
              INCREMENT;
              TF = 1; 
              END 
         GOTO L10;
CLASS:  
         TF = 0;
         IF NCODE EQ CLASSTYPE
         THEN BEGIN 
              TF = 1; 
              INCREMENT;
              END 
         GOTO L10;
         END
         TERM 
