*DECK CTLSCAN                                                           000130
  PROC CTLSCAN;                                                         000320
    BEGIN 
  
      XREF PROC SNATCHC;
      XREF PROC SNATCHO;
  
             #   DDL CONTROL CARD PARAMETERS  R#
             #   REFERENCED IN DDLCOMP TESTS   #
          DEF QD #3#; 
          DEF QC #4#;              # COMPILATION MODE IS QU/CDCS       #
          DEF DS #1#; 
          DEF EX #2#; 
      DEF CB #5#; 
      XDEF
        BEGIN 
          PROC ENDDL; 
# ALL CUR----  AND NEX---- ITEM DECLARATIONS MUST REMAIN IN THIS #
# ORDER.  DO NOT INSERT OR DELETE BETWEEN CTLSCAN.17 AND CTLSCAN.34 # 
          ARRAY CWORD [25] S(1);# CONTAINS THE CURRENT SOURCE WORD,LEFT#
        BEGIN 
        ITEM CURWORD U(0,0,60);    # JUSTIFIED, WITH TRAILING BLANKS   #
        ITEM CURWRD30 C(0,0,30);   # FOR QD - Q1, ZEROES FOR DS - EX.  #
        END 
          ITEM CURLENG;      # LENG IN CHARS OF THE CURRENT SOURCE WRD.#
          ITEM CURLENW;      # LENG IN WRDS OF THE CURRENT SOURCE WRD. #
          ITEM CURLXID;      # LEXID OF THE CURRENT KEY WRD.           #
          ITEM CURP1;        # 1ST PARAMETER OF THE CURRENT KEY WRD.   #
          ITEM CURP2;        # 2ND PARAMETER OF THE CURRENT KEY WRD.   #
          ITEM CURTYPE;      # SYNTACTIC TYPE OF THE CURRENT SOURCE WRD#
          ITEM CURCOL;
           ARRAY NEXWORD[25];   # CONTAINS THE NEXT SOURCE WORD LEFT   #
        ITEM NEXWRD  U(0,0,60);    # JUSTIFIED, WITH TRAILING # 
                     # BLANKS FOR QD - Q1, ZEROES FOR DS - EX # 
          ITEM NEXLENG;      # LENG IN CHARS OF THE NEXT SOURCE WRD.   #
          ITEM NEXLENW;      # LENG IN WRDS OF THE NEXT SOURCE WRD.    #
          ITEM NEXLXID;      # LEXID OF THE NEXT KEY WRD.              #
          ITEM NEXP1;        # 1ST PARAMETER OF THE NEXT KEYWRD.       #
          ITEM NEXP2;        # 2ND PARAMETER OF THE NEXT KEYWRD.       #
          ITEM NEXTYPE;      # SYNTACTIC TYPE OF THE NEXT SOURCE WRD.  #
          ITEM NEXCOL;
          ARRAY CWRD [25];
        ITEM CURNWD U(0,0,60);
          ITEM DDLEOF;
          ITEM LINEFLG;                                                 000200
        END 
      XREF                   #                                         #
        BEGIN                #                                         #
          ITEM DDLIRL;       # LENG IN CHARS OF DDL"S INPUT RECORD.    #
          ITEM TFLAG; 
          ITEM TRACE; 
          PROC DDLREAD; 
          PROC INCRLNE;                                                 000370
          PROC ABRT5;                  # ISSUES DIAGNOSTIC - SOURCE WRD#
                                       # IS GREATER THAN 255 CHARS AND #
                                       # ABORTS RUN.                   #
          ITEM DDLCOMP; 
          ITEM LEXICO;    # DONTAINS LOCATION OF LEXICON               #
          ITEM LEXWD;      # CONTAINS LOC OF LEXWORDS                  #
          ITEM PURGESS; 
          ARRAY DDLIWSA [9];
        BEGIN 
          ITEM CHAR0 C(0,00,1); 
          ITEM CHAR1 C(0,06,1); 
          ITEM CHAR2 C(0,12,1); 
          ITEM CHAR3 C(0,18,1); 
          ITEM CHAR4 C(0,24,1); 
          ITEM CHAR5 C(0,30,1); 
          ITEM CHAR6 C(0,36,1); 
          ITEM CHAR7 C(0,42,1); 
          ITEM CHAR8 C(0,48,1); 
          ITEM CHAR9 C(0,54,1); 
          ITEM CHAR  C(0,00,10);
        END 
        END                  #                                         #
      ITEM              #                                              #
            CONTFLAG B,   # CONTINUATION SYMBOL FLAG(CB AND QD)        # D2A152 
          LEXPTR,       # POINTER USED WITH THE CHAR AND STATUS STACK. #
          STATE,        # INDEX INTO THE STATE TRANSITION TABLE.       #
          BP = -6,      # CONTAINS THE BIT POSITION VALUE IN NEXWORD.  #
          LPTR,         # POINTER USED WITH THE LEXWORDLOC TABLE.      #
          WRDPTR,       # PTR TO WHERE THE SCAN STARTS IN THE LEXWORDS.#
          ENTRIES,      # NO. OF ENTRIES BASED ON 1ST CHAR IN LEXWORDS.#
          K,J,I,        # SCRATCH ITEM.                                #
          ITEMP,        # SCRATCH ITEM.                                #
          L,            # SCRATCH ITEM                                 #
          LOCKWRD,           # CONTAINS WRD POSITION IN DDLIWSA.       #
          LOCKPTR,           # CONTAINS CHAR POSITION IN DDLIWSA.      #
          NAMELENG, 
          CARDCOL,
          WORKFIL;
      STATUS QCHAR DELM,           # 0  # 
                   PERIOD,         # 1  # 
                   LEFTPRN,        # 2  # 
                   RIGHTPRN,       # 3  # 
                   DLRSIGN,        # 4  # 
                   QUOTE,          # 5  # 
                   PLS,            # 6  # 
                   MNUS,           # 7  # 
                   SLASH,          # 8  # 
                   ASTERISK,       # 9  # 
                   I,              # 10 # 
                   E,              # 11 # 
                   LTR,            # 12 # 
                   DGT,            # 13 # 
                   SC,             # 14 # 
                   TRCE;           # 15 # 
      BASED ARRAY STATETRANS [0]; 
        ITEM STATETBLE I(0,0,60); 
      BASED ARRAY LWORDS [0]; # POINTS TO THE LEXWORDTABLE.            #
        BEGIN                #                                         #
          ITEM LEXWRD U(0,0,60);
          ITEM LEXID  I(0,0,15);  #                                    #
          ITEM P1     I(0,15,15); #                                    #
          ITEM P2     I(0,30,15); #                                    #
        END 
      BASED ARRAY LEXWRDLOC [0]; # POINTS TO THE LEXWORDLOC TABLE.     #
        ITEM LEXENTRY U(0,0,60); # NUMBER OF ENTRIES FOR A KEYWRD SET. #
      ARRAY STATE1TABLE [15]; 
          ITEM ST1TBLE U(0,0,60) = [ #   STATES   # 
            # STATUS OF INPUT CHAR # # 0011233445 # 
                                     # 0628406284 # 
            # DELM               0 #  "AZZ4GWEHHW", 
            # PERIOD             1 #  "6ZZ4V9 VNY", 
            # LEFTPRN            2 #  "BZZ44Z 4MY", 
            # RIGHTPRN           3 #  "BBZ4YZ44NP", 
            # DLRSIGN            4 #  "C(Z44Z1444", 
            # QUOTE              5 #  "DZF44Z4444", 
            # PLS                6 #  "3ZZ44Z4444", 
            # MNUS               7 #  "3ZZ44Z4484", 
            # SLASH              8 #  "/ZZ44Z4444", 
            # ASTERISK           9 #  "4ZZP4Z4444", 
            # I                 10 #  "7ZZ44Z44Z7", 
            # E                 11 #  "7ZZ44Z44Z7", 
            # LTR               12 #  "7ZZ44Z44Z7", 
            # DGT               13 #  "3ZZ4ZZ4,Z7", 
            # SC                14 #  "BZZ44Z44M4", 
            # TRACE             15 #  "_ZZ44Z4444"];
      ARRAY STATE2TABLE [15]; 
          ITEM ST2TBLE U(0,0,60) = [ #   STATES   # 
            # STATUS OF INPUT CHAR # # 0011233445 # 
                                     # 0628406284 # 
            # DELM               0 #  "II+K+++++-", 
            # PERIOD             1 #  "JJ+L+5+++*", 
            # LEFTPRN            2 #  "++++++++++", 
            # RIGHTPRN           3 #  "++++++++++", 
            # DLRSIGN            4 #  "++++++++++", 
            # QUOTE              5 #  "++++++++++", 
            # PLS                6 #  "++2+4+++8+", 
            # MNUS               7 #  "++2+4+++8+", 
            # SLASH              8 #  "++++++++++", 
            # ASTERISK           9 #  "++++++++++", 
            # I                 10 #  "+++3++++++", 
            # E                 11 #  "11++++77++", 
            # LTR               12 #  "++++++++++", 
            # DGT               13 #  "ZZ2Z4Z6Z8Z", 
            # SC                14 #  "++++++++++", 
            # TRCE              15 #  "++++++++++"];
      ARRAY PRIVATE1TBLE [15];
        BEGIN 
          ITEM PRI1TBL U(0,0,60) = ["AZ')=W[HH)", 
                                    "6Z'):9S)N)", 
                                    "#Z'))'S)&)", 
                                    "#Z')='))&)", 
                                    "C('))'1)))", 
                                    "]Z!..'....", 
                                    ":Z'))'))))", 
                                    ":Z'))'))))", 
                                    "/Z'))'))))", 
                                    ")Z'P)'))))", 
                                    "7Z'))'))Z7", 
                                    "7Z'))'))Z7", 
                                    "7Z'))'))Z7", 
                                    ":Z')@'))Z7", 
                                    ")Z'))'))))", 
                                    "_Z'))'))))"];
        END 
      ARRAY PRIVATE2TBLE [15];
        BEGIN 
          ITEM PRI2TBL U(0,0,60) = [")UIKK)", 
                                    "?)JLL)", 
                                    "))))))", 
                                    "))))))", 
                                    "))))))", 
                                    "))))))", 
                                    ")))\))", 
                                    ")))\))", 
                                    "))))))", 
                                    "))))))", 
                                    ")))TT)", 
                                    "))>)))", 
                                    "))))))", 
                                    "^<'@'@", 
                                    "))))))", 
                                    "))))))"];
        END 
      ARRAY PRIVATE3TBLE [15];
        BEGIN 
          ITEM PRI3TBL U(0,0,60) = [")))))--)", 
                                    ")>>))**)", 
                                    "))))))))", 
                                    "))))))))", 
                                    "))))))))", 
                                    "))))))))", 
                                    "?))));))", 
                                    "?))));))", 
                                    "))))))))", 
                                    "))))))))", 
                                    "))))))))", 
                                    "))@)\)))", 
                                    "))))))))", 
                                    "<<'@'^'^", 
                                    "))))))))", 
                                    "))))))))"];
        END 
      SWITCH DDLJMPVCTR      ERR,            # COLON      0  #
                             DPROCEED,       # A          1  #
                             DKEYWRD,        # B          2  #
                             DESCAPE,        # C          3  #
                             DLITERAL,       # D          4  #
                             DESCAPENAME,    # E          5  #
                             DNONNUMLIT,     # F          6  #
                             DINTEGER,       # G          7  #
                             SCANKEYWRD,     # H          10 #
                             DFIXPOINT,      # I          11 #
                             DFIX1POINT,     # J          12 #
                             DFLOATPT,       # K          13 #
                             D1FLOATPT,      # L          14 #
                             DATANAME,       # M          15 #
                             SCNKEYWRD,      # N          16 #
                             CKFORQUOTE,     # O          17 #
                             SKIPCHAR,       # P          20 #
                             CONT1CK,        # Q          21 #
                             CONT2CK,        # R          22 #
                             P1ESCAPENAME,   # S          23 #
                             PTABLE3,        # T          24 #
                             PKEYWRD,        # U          25 #
                             D2TBLE,         # V          26 #
                             DGARBAGE,       # W          27 #
                             CONT3CK,        # X          30 #
                             D1INTEGER,      # Y          31 #
                             DSTORCHR,       # Z          32 #
                             DSTOR1CHR,      # 0          33 #
                             DSTOR2CHR,      # 1          34 #
                             DSTOR3CHR,      # 2          35 #
                             DSTOR4CHR,      # 3          36 #
                             DSTOR5CHR,      # 4          37 #
                             DSTOR6CHR,      # 5          40 #
                             DSTOR7CHR,      # 6          41 #
                             DSTOR8CHR,      # 7          42 #
                             DSTOR9CHR,      # 8          43 #
                             D1GARBAGE,      # 9          44 #
                             D1TABLE,        # +          45 #
                             DCOMPLEX,       # -          46 #
                             D1COMPLEX,      # *          47 #
                             DSLASH,         # /          50 #
                             D1ESCAPE,       # (          51 #
                             P1TABLE,        # )          52 #
                             P1INTEGER,      # $          53 #
                             PINTEGER,       # =          54 #
                             D1ESCAPENAME,   # BLANK      55 #
                             DTABLE2,        # ,          56 #
                             DTABLE3,        # .          57 #
                             PKEY,           # EQUIV      60 #
                             PESCAPENAME,    # [          61 #
                             PLITERAL,       # ]          62 #
                             PTBL2,          # PERCENT    63 #
                             PTABLE2,        # QUOTE      64 #
                             SETTRACE,       # _          65 #
                             PNONNUMLIT,     # !          66 #
                             PDATANAME,      # &          67 #
                             PSTORCHR,       # '          70 #
                             PSTOR1CHR,      # ?          71 #
                             PSTOR2CHR,      # <          72 #
                             PSTOR3CHR,      # >          73 #
                             PSTOR4CHR,      # @          74 #
                             PSTOR5CHR,      # \          75 #
                             PSTOR6CHR,      # ^          76 #
                             PSTOR7CHR;      #            77 #
      ARRAY CHARLIST [79];     # CONTAINS THE INPUT RECORD, ONE CHR PER#
        ITEM LEXCHAR C(0,0,1); # WORD.                                 #
      ARRAY SLIST [71];      # CONTAIN THE STATUS VALUE OF THE CORRESP-#
        ITEM STATUSLIST S:QCHAR(0,0,60); # ONDING ENTRY IN CHARLIST.   #
 #                      **   D D L I N I T   **                        #
 # INITIAL ENTRY POINT CALLED WHEN THERE IS A NEW SET OF SOURCE INPUT. #
 # DDLIO IS CALLED TO READ AN INPUT RECORD. THE INPUT RECORD IS STORED #
 # IN THE WORKING STORAGE AREA DDLIWSA AND THE LENGTH IN CHARS IS STOR-#
 # ED IN DDLIRL. EACH CHAR OF THE INPUT RECORD IS STORE IN A CHARACTER #
 # ARRAY, ONE CHARACTER PER-WORD, AFTER THE CHARACTER ARRAY IS COMPLET-#
 # ED A CORRESPONDING ARRAY IS BUILT CONTAINING THE STATUS VALUE OF THE#
 # CHARACTER. THE ENTRIES IN THE STATUS ARRAY COMBINED WITH THE VALUES #
 # OF STATE, ARE USED AS SUBSCRIPTS INTO THE STATE TRANSITION TABLE.   #
 # THE 1ST SOURCE WORD CRACKED IS STORED IN THE N E X  ITEMS.          #
  ENTRY PROC DDLINIT; 
      P<STATETRANS> = LOC(STATE1TABLE); #   SET TO 1ST TABLE.          #
          P<LWORDS> = LEXWD;
          P<LEXWRDLOC> = LEXICO;
 ENTRY PROC CBPINIT;
      P<STATETRANS> = LOC(STATE1TABLE); 
      CARDCOL = 0;                 # SOURCE STARTS IN COLUMN 1         #
      WORKFIL = 0;                 # NAMES ARE ZERO FILLED             #
      NAMELENG = 30;               # MAX LENG OF NAMES IN CHARS        #
      IF DDLCOMP EQ QD             # IF COMPILATION MODE IS QU/CRM     #
      THEN
        BEGIN 
        CARDCOL = 7;               # SOURCE STARTS IN COLUMN 8         #
        WORKFIL = O"55555555555555555555";   # NAMES ARE BLANK FILLED  #
        END 
      IF DDLCOMP EQ QC             # IF COMPILATION MODE IS QU/CDCS    #
        OR DDLCOMP EQ CB           # OR COBOL                          #
      THEN
        CARDCOL = 7;               # SOURCE STARTS IN COLUMN 8         #
      FOR I = 0 STEP 1 UNTIL 25 DO                                      000500
        NEXWRD[I] = WORKFIL;                                            000510
  NEXTRECD: 
      IF DDLEOF EQ 1 THEN                                               000083
        BEGIN                                                           000120
          NEXTYPE = O"14";                                              000130
          RETURN;                                                       000140
        END                                                             000150
      CKLNEFLG; 
      BUILDSTACK;            # READ NEXT RECD AND SCAN FOR SOURCE WRD. #
      IF DDLCOMP EQ QD THEN 
      IF NEXLENG NQ 0 AND NOT CONTFLAG THEN                              D2A152 
        BEGIN    # PROCESS LAST SYNTAX ELEMENT ON PREVIOUS SOURCE LINE # D2A152 
                 # (APPLICABLE ONLY WHEN LAST SYNTAX ELEMENT ENDS IN   # D2A152 
                 # COLUMN 72 OF SOURCE RECORD)                         # D2A152 
          LEXPTR = LEXPTR - 1;                                           D2A152 
          GOTO DDLJMPVCTR[B<STATE,6>STATETBLE[0]]; # GO TO DELIMETER   # D2A152 
        END                  # STATE IN STATE TRANSITION TABLE.        # D2A152 
      GOTO STARTSTATE;
  
  
#**************************************************************#
# INITIALIZE DATA CONTROL OVERLAY PROCESSING                   #
#    *****  PROC  D C I N I T     *****                        #
      ENTRY PROC DCTINIT; 
      P<LWORDS> = LEXWD;
      P<LEXWRDLOC> = LEXICO;
      RETURN; 
  
  
  
#***************************************************************# 
  ENTRY PROC DDLLOCK; 
      P<STATETRANS> = LOC(PRIVATE1TBLE);
          GOTO LXSCN; 
          ENTRY PROC LEXSNC;
             BEGIN
             NEXLENG = 0;                                                D2A152 
             BUILDSTACK;
          END 
 #                      **   D D L S C A N   **                        #
 # STORES THE CONTENTS OF  N E X  ITEMS INTO  C U R  ITEMS. IDENTIFIES #
 # THE NEXT SOURCE WORD AND STORES THE REQUIRED INFORMATION INTO  N E X#
 # ITEMS.                                                              #
       ENTRY PROC LEXSCAN;
          LXSCN:  
      FOR I=0 STEP 1 UNTIL 32 DO # STORE THE CONTENTS OF THE  N E X    #
        BEGIN                # ITEMS INTO THE  C U R  ITEMS.           #
          CURWORD[I] = NEXWRD[I]; 
        END                  #                                         #
      IF DDLCOMP EQ QD             # IF COMPILATION MODE IS QU/CRM     #
      THEN
        BEGIN 
          FOR I=0 STEP 1 UNTIL NEXLENW DO 
            BEGIN 
             CURNWD[I] = WORKFIL;                                       000530
            END 
      K = 0;
      J = 0;
      I = 6;
      FOR L=1 STEP 1 UNTIL NEXLENW DO 
        BEGIN 
          B<I,54>CURNWD[J] = B<0,54>CURWORD[K]; 
          B<0,6>CURNWD[J+1] = B<54,6>CURWORD[K];
          J = J + 1;
          K = K + 1;
        END 
          B<0,6>CURNWD[0] = CURLENW;
        END 
      FOR I=0 STEP 1 UNTIL NEXLENW DO  # INITIALIZE NEX ITEMS          #
        BEGIN 
         NEXWRD[I] = WORKFIL;                                           000550
        END 
      NEXLENG = 0;
      NEXLENW = 0;
      NEXLXID = 0;
      NEXP1 = 0;
      NEXP2 = 0;
      NEXTYPE = 0;
      NEXCOL = 0; 
      CKLNEFLG; 
      IF LEXPTR GR DDLIRL THEN # CHECK IF THE WORD PTR IS POINTING TO  #
        GOTO NEXTRECD;       # THE LAST ENTRY IN THE CHAR AND STATUS SK#
      GOTO STARTSTATE;
  SETTRACE: 
      IF TRACE EQ 0 THEN
        BEGIN 
        B<0,6>NEXWRD[0] = B<0,6>LEXCHAR[LEXPTR];  # STORE CHAR(=)      #
        NEXLENG = 1;
        GOTO DGARBAGE;
        END 
      TFLAG = TFLAG + 1;
      GOTO ENTRSTTBLE;
  DPROCEED:                  #                                         #
      FOR LEXPTR = LEXPTR + 1 STEP 1 UNTIL DDLIRL DO
        BEGIN 
          IF LEXCHAR[LEXPTR] NQ O"55" THEN
          BEGIN 
            GOTO STARTSTATE;
          END 
        END 
      CKLNEFLG; 
      BUILDSTACK; 
      LEXPTR = LEXPTR - 1;
      GOTO DPROCEED;
  PLITERAL: 
      XOUT; 
  DLITERAL:                  #                                         #
      STATE = 12;            # SET STATE FOR NON-NUMERIC LITERAL.      #
      GOTO ENTRSTTBLE;       # RE-ENTER STATE TRANSITION TABLE.        #
  PNONNUMLIT: 
      XOUT; 
  DNONNUMLIT:                #                                         #
      IF LEXCHAR[LEXPTR + 1] EQ O"64" THEN # IF QUOTES PART OF LITER- # 
        BEGIN                               # AL STRING, THEN ADJUST   #
          LEXPTR = LEXPTR + 1;              # POINTER TO REFLECT NEXT  #
          DDLIRL = DDLIRL - 1;              # INPUT REC LENGTH         #
          GOTO DSTORCHR;                    # SCANNABLE CHARACTER, AND #
        END                                 # GO STORE CHARACTER.      #
      IF NEXLENG EQ 0 THEN   # IF LITERAL IS NULL STRING, THEN RETURN. #
        GOTO DDLEXIT; 
      NEXTYPE = 103;         # STORE SYNTACTIC TYPE FOR NON-NUMERIC LIT#
      GOTO DDLEXIT;          # COMPLETE THE EXIT CONDITIONS.           #
  P1INTEGER:  
      P<STATETRANS> = LOC(STATE1TABLE); 
  D1INTEGER:  
      NEXTYPE = 107;
      GOTO DDL1EXIT;
  PINTEGER: 
      P<STATETRANS> = LOC(STATE1TABLE); # RESET TO 1ST TABLE.          #
  DINTEGER:                  #                                         #
      NEXTYPE = 107;         # STORE SYNTACTIC TYPE FOR INTEGER.       #
      GOTO DDLEXIT;          # COMPLETE THE EXIT CONDITIONS.           #
  DFIXPOINT:                 #                                         #
      P<STATETRANS> = LOC(STATE1TABLE); # RESET TO 1ST TABLE.          #
      NEXTYPE = 108;         # STORE SYNTACTIC TYPE FOR FIX POINT LIT. #
      GOTO DDLEXIT;          # COMPLETE THE EXIT CONDITIONS.           #
  DFIX1POINT:                #                                         #
      IF LEXCHAR[LEXPTR+1] NQ O"55" THEN
        GOTO DSTORCHR;
      P<STATETRANS> = LOC(STATE1TABLE); # RESET TO 1ST TABLE.          #
      NEXTYPE = 108;         # STORE SYNTACTIC TYPE FOR FIX POINT LIT. #
      GOTO DDL1EXIT;         # COMPLETE THE EXIT CONDITIONS.           #
  DFLOATPT:                  #                                         #
      P<STATETRANS> = LOC(STATE1TABLE); # RESET TO 1ST TABLE.          #
      NEXTYPE = 110;         # STORE SYNTACTIC TYPE FOR FLOATING POINT.#
      GOTO DDLEXIT;          # COMPLETES THE EXIT CONDITIONS.          #
  D1FLOATPT:  
      P<STATETRANS> = LOC(STATE1TABLE); # RESET TO 1ST TABLE.          #
      NEXTYPE = 110;         # STORE SYNTACTIC TYPE FOR FLOATING POINT.#
      GOTO DDL1EXIT;         # COMPLETE THE EXIT CONDITIONS.           #
  PDATANAME:  
      P<STATETRANS> = LOC(STATE1TABLE); 
  DATANAME:                  #                                         #
      NEXTYPE = 101;         # STORE SYNTACTIC TYPE FOR DATA NAME.     #
      GOTO DDL1EXIT;         # COMPLETE THE REQUIRED EXIT CONDITIONS.  #
  DCOMPLEX:                  #                                         #
      P<STATETRANS> = LOC(STATE1TABLE); # RESET TO 1ST TABLE.          #
      NEXTYPE = 109;         # STORE SYNTACTIC TYPE FOR COMPLEX LITERAL#
      GOTO DDLEXIT;          # COMPLETE THE REQUIRED EXIT CONDITIONS.  #
  D1COMPLEX:                 #                                         #
      P<STATETRANS> = LOC(STATE1TABLE); # RESET TO 1ST TABLE.          #
      NEXTYPE = 109;         # STORE SYNTACTIC TYPE FOR COMPLEX LITERAL#
      GOTO DDL1EXIT;         # COMPLETE THE REQUIRED EXIT CONDITIONS.  #
  DESCAPE:                   #                                         #
      STATE = 6;             # SET STATE  FOR ESCAPE NAME.             #
      GOTO ENTRSTTBLE;       # RE-ENTER STATE TRANSITION TABLE.        #
  D1ESCAPE:                  #                                         #
      STATE = 36;            # SET STATE FOR ESCAPE NAME.              #
      GOTO ENTRSTTBLE;       # RE-ENTER STATE TRANSITION TABLE.        #
  PESCAPENAME:  
      P<STATETRANS> = LOC(STATE1TABLE); 
  DESCAPENAME:               #                                         #
      NEXTYPE = 101;         # STORE SYNTACTIC TYPE FOR ESCAPE NAME.   #
      GOTO DDLEXIT;          # COMPLETE THE EXIT CONDITIONS.           #
  P1ESCAPENAME: 
      P<STATETRANS> = LOC(STATE1TABLE); 
  D1ESCAPENAME: 
      NEXTYPE = 101;
      GOTO DDL1EXIT;
  DSLASH:                    #                                         #
      STATE = 18;            # SET STATE FOR POSSIBLE COMMENT.         #
      GOTO ENTRSTTBLE;       # RE-ENTER STATE TRANSITION TABLE.        #
  DGARBAGE: 
      IF NEXLENG EQ 0 THEN
        GOTO ENTRSTTBLE;
      IF B<0,12>NEXWRD[0] EQ O"1123" THEN 
        BEGIN 
          LEXPTR = LEXPTR + 1;
          BP = -6;
          NEXWRD[0] = 0;
          NEXLENG = 0;
          GOTO STARTSTATE;
        END 
      NEXTYPE = 0;
      IF (DDLCOMP EQ QD            # IF COMPILATION MODE IS QU/CRM     #
          OR DDLCOMP EQ QC)        # OR QU/CDCS                        #
        AND B<0,6>LEXCHAR[LEXPTR] NQ O"55"  # AND NEXCHAR NOT A BLANK  #
      THEN GOTO DSTORCHR; 
      GOTO DDLEXIT; 
  D1GARBAGE:  
      NEXTYPE = 0;
      IF B<0,12>NEXWRD[0] EQ O"1123" THEN 
        GOTO SCANKEYWRD;
      IF B<0,6>LEXCHAR[LEXPTR] EQ O"56" THEN
        GOTO DSTORCHR;
      IF B<BP,6>NEXWRD[NEXLENW] EQ O"57" THEN                           000440
        BEGIN 
          B<BP,6>NEXWRD[NEXLENW] = O"55"; 
          LEXPTR = LEXPTR - 1;
        END 
      IF LEXCHAR[LEXPTR + 1] NQ O"55" THEN
        GOTO DSTORCHR;
      GOTO DDL1EXIT;
  SKIPCHAR: 
      STATE = 0;
      CKLNEFLG; 
      FOR LEXPTR = LEXPTR STEP 1 UNTIL DDLIRL DO
        BEGIN 
          IF LEXCHAR[LEXPTR] EQ O"47" THEN
            BEGIN 
              LEXPTR = LEXPTR + 1; # SCAN AHEAD FOR POSSIBLE COMM. END #
              IF LEXPTR GR DDLIRL THEN
                BEGIN        # COLUMN 72 #
                  BUILDSTACK;      # READ IN NEXT SOURCE LINE # 
                  CKLNEFLG;        # PRINT OUT LAST LINE #
                END 
              IF LEXCHAR[LEXPTR] EQ O"50" THEN
                GOTO ENTRSTTBLE;   #CHAR / DETECTED-COMMENT TERMINATED# 
              LEXPTR = LEXPTR - 1; # NOT COMM. END, RESET SCAN POINTER #
            END 
        END 
      BUILDSTACK; 
      GOTO SKIPCHAR;
  PSTORCHR: 
      XOUT; 
  DSTORCHR:                  #                                         #
      NEXLENG = NEXLENG + 1;
      IF NEXLENG GR 255 THEN
        ABRT5;
      BP = BP + 6;           # INCREMENT BIT POSITION TO THE NEXT CHAR.#
      IF BP GR 54 THEN       # CHECK IF BIT POSITION HAS CROSSED A WORD#
        BEGIN                # BOUNDRY. IF IT HAS, SET WORD PTR TO THE #
          BP = 0;            # NEXT AND SET THE BIT PTR TO THE 1ST CHAR#
          NEXLENW = NEXLENW + 1;
        END                  #                                         #
      B<BP,6>NEXWRD[NEXLENW] = B<0,6>LEXCHAR[LEXPTR]; #STORE CHAR.     #
  ENTRSTTBLE:                #                                         #
      LEXPTR = LEXPTR + 1;   # INCREMENT PTR TO NEXT WORD.             #
  
  
      IF LEXPTR GR DDLIRL THEN # CHECK IF PTR EXCEEDED RECORD SIZE.   # 
        BEGIN 
      IF LEXCHAR[LEXPTR - 1] EQ O"57" AND STATE EQ 42 THEN # IF PERIOD #
        GOTO SCANKEYWRD;           # IN COLUMN 72, SCAN FOR KEYWORD.   #
        ELSE
          GOTO NEXTRECD;     # READ NEXT RECORD AND SCAN FOR SOURCE WRD#
        END 
  STARTSTATE: 
  
  
      GOTO DDLJMPVCTR[B<STATE,6>STATETBLE[STATUSLIST[LEXPTR]]]; 
  PSTOR1CHR:  
      XOUT; 
  DSTOR1CHR:  
      STATE = 6;
      GOTO DSTORCHR;
  PSTOR2CHR:  
      XOUT; 
  DSTOR2CHR:  
      STATE = 12; 
      GOTO DSTORCHR;
  PSTOR3CHR:  
      XOUT; 
  DSTOR3CHR:  
      STATE = 18; 
      GOTO DSTORCHR;
  PSTOR4CHR:  
      XOUT; 
  DSTOR4CHR:  
      STATE = 24; 
      GOTO DSTORCHR;
  PSTOR5CHR:  
      XOUT; 
  DSTOR5CHR:  
      STATE = 30; 
      GOTO DSTORCHR;
  PSTOR6CHR:  
      XOUT; 
  DSTOR6CHR:  
      STATE = 36; 
      GOTO DSTORCHR;
  PSTOR7CHR:  
      XOUT; 
  DSTOR7CHR:  
      STATE = 42; 
      GOTO DSTORCHR;
      IF NAMELENG EQ 32 THEN
        GOTO DSTOR5CHR; 
  DSTOR8CHR:  
      STATE = 48; 
      GOTO DSTORCHR;
  DSTOR9CHR:  
      STATE = 54; 
      GOTO DSTORCHR;
  CKFORQUOTE: 
      FOR LEXPTR = 11 STEP 1 UNTIL DDLIRL DO
        BEGIN 
          IF LEXCHAR[LEXPTR] NQ O"55" THEN
            BEGIN 
              IF LEXCHAR[LEXPTR] EQ O"64" THEN
                BEGIN 
                  LEXPTR = LEXPTR + 1;
                  GOTO STARTSTATE;
                END 
              GOTO DSTOR1CHR; 
            END 
        END 
  CONT1CK:  
      IF LEXPTR EQ 6 THEN 
          CKFORCHR; 
      GOTO DSTOR1CHR; 
  CONT2CK:  
      IF LEXPTR EQ 6 THEN 
          CKFORCHR; 
      GOTO DSTOR4CHR; 
  CONT3CK:  
      IF LEXPTR EQ 6 THEN 
          CKFORCHR; 
      GOTO DSTOR7CHR; 
  D1TABLE:  
      P<STATETRANS> = LOC(STATE1TABLE); 
         STATE = 30;
      GOTO DSTORCHR;
  P1TABLE:  
      P<STATETRANS> = LOC(PRIVATE1TBLE);
      STATE = 30; 
      GOTO PSTORCHR;
  D2TBLE: 
      IF LEXCHAR[LEXPTR + 1] EQ O"55" THEN
          GOTO D1INTEGER; 
      STATE = 6;
      P<STATETRANS> = LOC(STATE2TABLE); 
      GOTO DSTORCHR;
  DTABLE2:  
      STATE = 0;
      P<STATETRANS> = LOC(STATE2TABLE); 
      GOTO DSTORCHR;
  DTABLE3:  
      STATE = 0;
      GOTO DSTORCHR;
  PTBL2:  
      IF LEXCHAR[LEXPTR + 1] EQ O"55" THEN
          GOTO P1INTEGER; 
      STATE = 6;
      P<STATETRANS> = LOC(PRIVATE2TBLE);
      GOTO PSTORCHR;
  PTABLE2:  
      STATE = 0;
      P<STATETRANS> = LOC(PRIVATE2TBLE);
      GOTO PSTORCHR;
  PTABLE3:  
      STATE = 0;
      P<STATETRANS> = LOC(PRIVATE3TBLE);
      GOTO PSTORCHR;
  PKEY: 
      XOUT;                  # OVERLAY PASS-WORD CHAR.                 #
      GOTO DKEYWRD; 
  PKEYWRD:  
      P<STATETRANS> = LOC(STATE1TABLE); 
  DKEYWRD:                   #                                         #
      B<0,6> NEXWRD[0] = LEXCHAR[LEXPTR]; #STORE CHARACTER             #
      BP = 6; 
      NEXLENG = 1;
  SCANKEYWRD:                #                                         #
      LEXPTR = LEXPTR + 1;   # INCREMENT PTR TO NEXT CHARACTER.        #
      IF PURGESS EQ 1 THEN
        BEGIN 
          NEXTYPE = 101;
          GOTO DDL1EXIT;
        END 
      GOTO SKPPCHK; 
  SCNKEYWRD:                 #                                         #
      IF LEXCHAR[LEXPTR] NQ O"52" THEN
      BEGIN 
      IF LEXCHAR[LEXPTR + 1] NQ O"55" THEN
        BEGIN 
          STATE = 30; 
          GOTO DSTORCHR;
        END 
      END 
  SKPPCHK:   #   #
      LPTR = B<0,6> NEXWRD[0];# USE DISPLAY CODE VALUE OF CHAR AS      #
                             # A SUBSCRIPT VALUE.                      #
      IF LPTR GR O"32" THEN  # IF THE THE VALUE OF LPTR GR THAN 32     #
        BEGIN                # TREAT IT HAS A SPECIAL CHARACTER.       #
          WRDPTR = B<6,12>LEXENTRY[0]; # WRD ADDR OF WHERE SPEC CHR STR#
          ENTRIES = B<0,6>LEXENTRY[0]; # NO. OF SPEC CHAR ENTRIES.     #
          GOTO SCNLEXWRD;    # SCAN THE LEXICON TABLE.                 #
        END                  #                                         #
      ITEMP = NEXLENW * 18; 
      WRDPTR = B<ITEMP+6,12>LEXENTRY[LPTR]; # WRD ADDR OF CHAR GROUP.  #
      ENTRIES = B<ITEMP,6>LEXENTRY[LPTR]; # NO OF ENTRIES IN CHAR GROUP#
  SCNLEXWRD:                 #                                         #
      IF NEXLENW GR 0 THEN
        K = (NEXLENW + 1) * 10 - NEXLENG; 
       ELSE 
        K = 10 - NEXLENG; 
      L = 10 - K; 
      IF L NQ 10 THEN 
        C<L,K>NEXWRD[NEXLENW] = O"55555555555555555555";
      FOR I=1 STEP 1 UNTIL ENTRIES DO # STEP THRU THE LEXICON TABLE    #
        BEGIN                # USING WRDPTR HAS THE STARTING LOCATION  #
                             # AND ENTRIES HAS THE MAXIMUM NUMBER OF   #
                             # KEYWRDS TO SCAN.                        #
          IF LEXWRD[WRDPTR] EQ NEXWRD[0] THEN 
            BEGIN 
              IF NEXLENW LS 1 THEN
                BEGIN 
                  WRDPTR = WRDPTR + 1;
                  GOTO SCANEXIT;
                END 
              IF LEXWRD[WRDPTR+1] EQ NEXWRD[1] THEN 
                BEGIN 
                  IF NEXLENW LS 2 THEN
                    BEGIN 
                        WRDPTR = WRDPTR + 2;
                      GOTO SCANEXIT;
                    END 
                  IF LEXWRD[WRDPTR+2] EQ NEXWRD[2] THEN 
                    BEGIN 
                        WRDPTR = WRDPTR + 3;
                      GOTO SCANEXIT;
                    END 
                END 
            END 
          WRDPTR = WRDPTR + 2 + NEXLENW;
        END 
      IF L NQ 10 THEN 
        C<L,K>NEXWRD[NEXLENW] = C<L,K>WORKFIL; # ZERO FIL NAME.        #
      NEXTYPE = 101;         # STORE SYNTACTIC TYPE FOR DATA NAME.     #
      GOTO DDL1EXIT;         # COMPLETE THE EXIT CONDITIONS.           #
  SCANEXIT:                  #                                         #
      NEXP1 = P1[WRDPTR];    # STORE THE VALUE OF P1.                  #
      NEXP2 = P2[WRDPTR];    # STORE THE VALUE OF P2.                  #
      NEXLXID = LEXID[WRDPTR];# STORE THE VALUE OF LEXID.              #
      NEXTYPE = 100;         # STORE SYNTACTIC TYPE FOR KEYWORD.       #
      GOTO DDL1EXIT;
  DDLEXIT:                   #                                         #
      LEXPTR = LEXPTR + 1;   # INCREMENT PTR TO NEXT CHAR.             #
  
  
DDL1EXIT: 
  
      IF DDLCOMP EQ QD                 # QU/CRM NAMES CONTAIN LENGTH   #
                                       # OF NAME IN WORDS IN BITS 0-6  #
                                       # OF WORD ZERO OF NAME          #
      THEN
        NEXLENW = NEXLENG / 10 + 1;    # MUST ADJUST LENGTH            #
        ELSE
          NEXLENW = NEXLENW + 1;
      STATE = 0;             # SET STATE TO INITIAL VALUE.             #
      BP = -6;               # INITIALIZE BIT PTR.                     #
      NEXCOL = LEXPTR - (NEXLENG + 1);
      IF NEXCOL LS 0 THEN NEXCOL = LEXPTR - 1;
  
      IF DDLCOMP NQ DS AND (NEXLENG EQ 7 AND C<0,7>NEXWRD[0] EQ 
                            "PICTURE" OR NEXLENG EQ 3 AND 
                            C<0,3>NEXWRD[0] EQ "PIC") 
                            THEN
        STATE = 30; 
  
THATSALL:   # *** RETURN *** #
ERR:        # *** RETURN *** #
      RETURN;                # RETURN TO CALLER.                       #
  PROC CKFORCHR;
    BEGIN 
      FOR LEXPTR = 11 STEP 1 UNTIL DDLIRL DO
        BEGIN 
          IF LEXCHAR[LEXPTR] NQ O"55" THEN
            GOTO STARTSTATE;
        END 
      RETURN; 
    END 
  PROC XOUT;
    BEGIN 
      LOCKWRD = LEXPTR / 10; # GET WORD POSITION OF PASS-WORD.         #
      LOCKPTR = (LEXPTR - LOCKWRD * 10) * 6;  # GET CHAR POSITION.     #
      B<LOCKPTR,6>CHAR[LOCKWRD] = O"47";
      RETURN; 
    END 
  PROC CKLNEFLG;   # CHECKS IF THE SOURCE LINE FLAG IS ON. IF SO      # 
    BEGIN          # INCREMENTS THE SOURCE LINE NUMBER.               # 
      IF LINEFLG EQ 1 THEN
        BEGIN 
          LINEFLG = 0;
          INCRLNE;
        END 
      RETURN; 
    END 
  PROC ENDDL; 
    BEGIN 
      IF NEXLENG NQ 0 THEN                                               D2A152 
        BEGIN    # PROCESS LAST SYNTAX ELEMENT ON PREVIOUS SOURCE LINE # D2A152 
                 # BECAUSE IT ENDS IN COLUMN 72(EXCEPT . )             # D2A152 
          LEXPTR = LEXPTR - 1;                                           D2A152 
          GOTO DDLJMPVCTR[B<STATE,6>STATETBLE[0]]; # GO TO DELIMETER   # D2A152 
                                   # STATE IN STATE TRANSITION TABLE   # D2A152 
        END                                                              D2A152 
          NEXTYPE = O"14";
      GOTO THATSALL;
    END 
  PROC BUILDSTACK;
    BEGIN 
      SWITCH STACKSWITCH
        SPECIALCHAR,         # : #
        LETTER,              # A #
        LETTER,              # B #
        LETTER,              # C #
        LETTER,              # D #
        FLOATPT,             # E #
        LETTER,              # F #
        LETTER,              # G #
        LETTER,              # H #
        COMPLEX,             # I #
        LETTER,              # J #
        LETTER,              # K #
        LETTER,              # L #
        LETTER,              # M #
        LETTER,              # N #
        LETTER,              # O #
        LETTER,              # P #
        LETTER,              # Q #
        LETTER,              # R #
        LETTER,              # S #
        LETTER,              # T #
        LETTER,              # U #
        LETTER,              # V #
        LETTER,              # W #
        LETTER,              # X #
        LETTER,              # Y #
        LETTER,              # Z #
        DIGIT,               # 0 #
        DIGIT,               # 1 #
        DIGIT,               # 2 #
        DIGIT,               # 3 #
        DIGIT,               # 4 #
        DIGIT,               # 5 #
        DIGIT,               # 6 #
        DIGIT,               # 7 #
        DIGIT,               # 8 #
        DIGIT,               # 9 #
        PLUS,                # + #
        MINUS,               # - #
        COMMENTEND,          # * #
        COMMENTBEG,          # / #
        LEFTPARN,            # ( #
        RIGHTPARN,           # ) #
        DOLLAR,              # $ #
        TRACEIND,            # = #
        DELIMITER,           # BLANK #
        DELIMITER,           # , #
        ENDCLAUSE,           # . #
        SPECIALCHAR,         # EQUIV #
        SPECIALCHAR,         # [ #
        SPECIALCHAR,         # ] #
        SPECIALCHAR,         # : #
        QUTE,                # QUOTE #
        SPECIALCHAR,         # _ #
        SPECIALCHAR,         # ! #
        SPECIALCHAR,         # & #
        SPECIALCHAR,         # ' #
        SPECIALCHAR,         # ? #
        SPECIALCHAR,         # < #
        SPECIALCHAR,         # > #
        SPECIALCHAR,         # @ #
        SPECIALCHAR,         # \ #
        SPECIALCHAR,         # ^ #
        DELIMITER;           # SEMI COLON # 
  RDNEXRECD:  
      DDLREAD;
      CONTFLAG = FALSE;      # INITIALIZE #                              D2A152 
      IF DDLEOF EQ 1 THEN 
        BEGIN 
          NEXTYPE = O"14";
          RETURN; 
        END 
      LINEFLG  = 1;                                                     000220
      IF DDLIRL GR 72 THEN
        DDLIRL = 71;
      FOR I = 0 STEP 1 UNTIL 7 DO 
        BEGIN 
          J = I * 10; 
          LEXCHAR[J]   = CHAR0[I];
          LEXCHAR[J+1] = CHAR1[I];
          LEXCHAR[J+2] = CHAR2[I];
          LEXCHAR[J+3] = CHAR3[I];
          LEXCHAR[J+4] = CHAR4[I];
          LEXCHAR[J+5] = CHAR5[I];
          LEXCHAR[J+6] = CHAR6[I];
          LEXCHAR[J+7] = CHAR7[I];
          LEXCHAR[J+8] = CHAR8[I];
          LEXCHAR[J+9] = CHAR9[I];
  
  
        END 
      FOR I = 72 STEP 1 UNTIL 79 DO    # BLANK OUT COLMUNS 73 THRU 80  # D2A152 
          LEXCHAR[I] = " ";                                              D2A152 
      I = DDLIRL;                  # FIND MAX(DDLIRL,CARDCOL)          #
      IF I LS CARDCOL 
      THEN
        I = CARDCOL;
      FOR LEXPTR = 0 STEP 1 UNTIL I DO
        BEGIN 
  
  
          GOTO STACKSWITCH[LEXCHAR[LEXPTR]];
            TRACEIND: 
                STATUSLIST[LEXPTR] = S"TRCE"; 
                TEST; 
            SPECIALCHAR:  
                STATUSLIST[LEXPTR] = S"SC"; 
                TEST; 
            QUTE: 
                STATUSLIST[LEXPTR] = S"QUOTE";
                TEST; 
            LETTER: 
                STATUSLIST[LEXPTR] = S"LTR";
                TEST; 
            FLOATPT:  
                STATUSLIST[LEXPTR] = S"E";
                TEST; 
            COMPLEX:  
                STATUSLIST[LEXPTR] = S"I";
                TEST; 
            DIGIT:  
                STATUSLIST[LEXPTR] = S"DGT";
                TEST; 
            PLUS: 
                STATUSLIST[LEXPTR] = S"PLS";
                TEST; 
            MINUS:  
                STATUSLIST[LEXPTR] = S"MNUS"; 
                TEST; 
            LEFTPARN: 
                STATUSLIST[LEXPTR] = S"LEFTPRN";
                TEST; 
            RIGHTPARN:  
                STATUSLIST[LEXPTR] = S"RIGHTPRN"; 
                TEST; 
            ENDCLAUSE:  
                STATUSLIST[LEXPTR] = S"PERIOD"; 
                TEST; 
            COMMENTBEG: 
                STATUSLIST[LEXPTR] = S"SLASH";
                TEST; 
            COMMENTEND: 
          IF DDLCOMP EQ QD OR 
            DDLCOMP EQ QC OR       # OR QU/CDCS                        #
         DDLCOMP EQ CB THEN 
  
        BEGIN 
          IF LEXPTR EQ 6 THEN 
            BEGIN 
          INCRLNE;                                                      000260
          LINEFLG = 1;                                                  000270
              GOTO RDNEXRECD; 
            END 
        END 
                STATUSLIST[LEXPTR] = S"ASTERISK"; 
                TEST; 
            DOLLAR: 
                STATUSLIST[LEXPTR] = S"DLRSIGN";
                TEST; 
            DELIMITER:  
                STATUSLIST[LEXPTR] = S"DELM"; 
                TEST; 
        END 
        IF DDLCOMP EQ CB           # IF COMPILATION MODE IS COBOL      #
          OR DDLCOMP EQ QD         # OR QU/CRM                         #
          OR DDLCOMP EQ QC         # OR QU/CDCS                        #
        THEN
        IF LEXCHAR[6] EQ O"46" THEN 
          BEGIN 
            LEXPTR = 11;
            CONTFLAG = TRUE;       # CONTINUATION SYMBOL SPECIFIED     # D2A152 
            RETURN; 
          END 
      LEXPTR = CARDCOL;      # SET POINTER TO THE 1ST CHAR OF THE STACK#
      RETURN;                # RETURN TO THE CALLING ROUTINE.          #
    END 
    END 
  TERM; 
