*DECK CTLSCAN                                                           000130
PROC FTNSCAN;                                                           000920
#**********************************************************************#001360
#                                                                      #001370
#                        * *  F T N S C A N  * *                       #001380
#                                                                      #001390
#                    SCANNER FOR DDLF AND DML SYNTAX                   #000940
#                                                                      #001430
#**********************************************************************#001440
    BEGIN 
      XDEF
        BEGIN 
#-------------------START OF SPECIAL GROUPING--------------------------#000970
# ALL CUR----  AND NEX---- ITEM DECLARATIONS UP TO THE --- COMMENT MUST#000980
# BE IN THE SAME ORDER SO THEY MAY BE MOVED AS A GROUP AT LXSCN.       #000990
          ARRAY CWORD [0:25] S(1); # HOLDS THE CURRENT SOURCE WORD,LEFT#001000
           ITEM CURWORD U(0,0,60); # JUSTIFIED, WITH TRAILING ZEROES   #001010
          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 [0:25]S(1);# CONTAINS THE NEXT SOURCE WORD LEFT#001060
           ITEM NEXWRD U(0,0,60),  # JUSTIFIED, ZERO FILLED AT EXIT.   #006430
                NEXWRDC C(0,0,10); # 10 CHARS FOR SPEC.TESTS(BLNK FILL)#006440
          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;
#-------------------END OF SPECIAL GROUPING----------------------------#001120
          ITEM CURLABEL C(5);# LABEL (COL.1-5) OF FORTRAN STMT JUST    #000290
                             # COMPLETED (+EOS RETURNED OR +SNS DONE). #000300
          ITEM NEXLABEL C(5);# LABEL OF FORTRAN STMT BEING SCANNED.    #000310
          ITEM BLKLINE C(120);         # LISTING LINE MATCHING CURWORD #007850
          ITEM NEXBLKLINE C(120)=" ";  # LISTING LINE MATCHING NEXWRD  #007860
          ITEM NBRLINE C(10);          # LINE NO.(DISPLAY) MATCHING CUR#007870
          ITEM NEXNBRLINE C(10)="     00000";   # LINE NO.(DISPLAY) NEX#007880
          ITEM LINENBR;                # LINE NO.(INTEGER) MATCHING CUR#007890
          ITEM NEXLINENBR = 0;         # LINE NO.(INTEGER) MATCHING NEX#007900
          ITEM DDLEOF;
          ITEM STARSTMT B = FALSE;     # SET TO TRUE WHEN DDL/PRE-PASS #004660
                             # DETERMINES THAT A LINE (+ ANY CONTINU-  #004670
                             # ATION) SHOULD BE CONVERTED TO COMMENTS. #004680
          ITEM TRSSOUT = 0;  # TRACE-SSOUT FLAG.  1 = TRACE ON         #001540
        END 
      XREF                   #                                         #
                             #---------------XREFS---------------------#
        BEGIN                #                                         #
          ITEM DDLCOMP;      # CONTAINS CODE FOR FORTRAN VERSION       #
          ITEM DDLIRL;       # LENG IN CHARS OF INPUT LINE.            #001160
          ITEM PPFLAG B;     # TRUE IF PRE-PASS (DML) RUN,FALSE IF DDLF#001170
          ITEM TFLAG;        # FLAG FOR CTLSTD TO TRACE SYNGEN STEPS.  #001180
          ITEM TRACE;        # CONTAINS LOCATION OF TRACE TABLE,IF ANY.#001190
          PROC TRACOUT;      # ROUTINE TO WRITE TRACE OUTPUT.          #001200
          PROC DDLREAD;      # READ ROUTINE IN CTLIO/DMLIO.            #001210
          PROC DDLPRNT;      # ROUTINE TO WRITE TO OUTPUT FILE.        #001220
          PROC WSSOUT1;      # ROUTINE TO WRITE TO SSOUT FILE.         #006860
          PROC WDMLOUT;      # ROUTINE TO WRITE TO DMLOUT FILE.        #006870
          PROC ABRT5;        # ISSUES DIAG, ABORTS - WORD GR 255 CHARS.#001240
          ITEM LEXICO;       # CONTAINS LOCATION OF LEXICON            #001260
          ITEM LEXWD;        # CONTAINS LOC OF LEXWORDS                #001270
          ITEM PURGESS; 
          ITEM ORDFLAG;       # SET BY PASS1 TO 1 IF ORD MSG PENDING   #001290
          ITEM NOLIST;        # 0 IF LIST, 1 IF NOLIST                 #001300
          ITEM BLKLIN C(120); # LISTING LINE IN CTLIO/DMLIO            #001310
          ARRAY DDLIWSA [0:0] S(9); # [0] IS SOURCE LINE,[1] IS ORD MSG#001320
            ITEM CHARS C(0,0,90); # SOURCE LINE IN CTLIO/DMLIO(DDLIWSA)#001330
          ITEM NBRLIN C(10);  # LINE NO.(DISPLAY) IN CTLIO/DMLIO       #001340
          ITEM LINNBR;        # LINE NO.(INTEGER) IN CTLIO/DMLIO       #001350
        END                   #                                        #001360
                                #                                      #
                                #-----------------DEFS-----------------#
                                #                                      #
      DEF F4      #8#;          # FORTRAN 4 CODE - MATCHES DDL CODE    #
      DEF F5      #9#;          # FORTRAN 5 CODE - MATCHES DDL CODE    #
  
      ITEM              #                                              #
          LEXPTR,       # POINTER USED WITH THE CHAR AND STATUS STACK. #
          LEXLIM,       # MAX VALUE FOR LEXPTR, LINE LENGTH - 1, OR 71.#001390
          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.#
          I,J,K,L,      # SCRATCH ITEMS.                               #001410
          ITEMP,        # SCRATCH ITEM.                                #
          ZERO = 0,     # ZERO CONSTANT FOR C<> FUNCTION.              #001430
          HYPHEN B = FALSE,  # SET TRUE IF NEXWORD CONTAINS A HYPHEN.  #004720
          SKIPCONTINUE B = FALSE, # SET TRUE TO BYPASS ANY CONT. LINES.#004730
          INTERRUPTCON B = FALSE, # TRUE WHEN BLANK LINE STOPS CONTIN. #004740
          ATNEWSTMT B = TRUE,  # TRUE WHEN POSITIONED AT START OF STMT.#001450
          EOSNEEDED B = FALSE, # TRUE WHEN AN EOS IS TO BE STORED      #004750
                             # IN FRONT OF A NEW STATEMENT. FALSE IF NO#004760
                             # PRIOR STMT OR SNS SKIPPED END OF PRIOR. #004770
          EOSMARGIN B = FALSE, # TRUE WHEN FTN EOS FLAG CHANGES MARGIN.#004780
          NEEDKWTEST B,        # TRUE FOR DDLF/DML WHEN A NEW STATEMENT#006460
                               # IS READ IN. TRIGGERS KEY WORD TEST FOR#004800
                               # USING STARS ON OUTLINE, AND FOR       #006480
                               # SEPARATING FIRST KEY WORD OF STMT.    #006490
          NEEDPRECTEST B=FALSE,# TRUE WHEN "PRECISION" MAY FOLLOW KEYWD#006500
          NEEDFUNCTEST B=FALSE,# TRUE WHEN "FUNCTION" MAY FOLLOW KEYWD.#006510
          NEEDREALMTST B=FALSE,# TRUE BETWEEN "SUBSCHEMA" AND "RECORD" #006520
          NOPRIORLINE B = TRUE,# TRUE IN FORTRAN UNTIL FIRST LINE READ.#004840
          OUTLINE C(90),       # FORTRAN OUTPUT LINE FOR SSOUT FILE OR #
                               # DMLOUT FILE, WITH/WITHOUT STARS ADDED.#001510
          TCHAR C(40) = " ",   # TRACE OF CHARS USED WITH STATE TABLE. #001530
          TSTATUS C(40) = " ", # TRACE OF STATUS NUMBERS USED.         #001540
          TSWVAL C(40) = " ",  # TRACE OF SWITCH VALUES USED.          #001550
          TPTR = 1;            # TRACE POINTER FOR TCHAR,TSTATUS,TSWVAL#001560
      BASED ARRAY LWORDS [0] S(1);# POINTS TO THE LEXWORDTABLE.        #001570
        BEGIN                     #                                    #001580
          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] S(1); # POINTS TO THE LEXWORDLOC TABLE.#001600
        ITEM LEXENTRY U(0,0,60); # NUMBER OF ENTRIES FOR A KEYWRD SET. #
      CONTROL EJECT;                                                    000280
#**********************************************************************#000290
#                                                                      #000300
#                   * *  S T A T E   T A B L E  * *                    #001620
#                                                                      #000320
#      JUST BEFORE EACH CHARACTER IS PROCESSED, THE SCANNER IS IN ONE  #000330
#      STATE.  EACH STATE REPRESENTS WHAT THE WORD LOOKS LIKE SO FAR.  #001640
#      BEFORE THE FIRST CHARACTER OF A WORD IS PROCESSED, THE STATE IN #001650
#      EFFECT IS STATE 00.                                             #001660
#                                                                      #000380
#       STATE MEANINGS:                                                #001680
#        00...NO CHARACTERS PROCESSED FOR WORD SO FAR                  #000430
#        06...(NOT USED)                                               #001700
#        12...NON-NUMERIC LITERAL SO FAR                               #000450
#        18...FIXED POINT REAL SO FAR                                  #001720
#        24...INTEGER SO FAR                                           #000470
#        30...UNABLE TO ASSIGN TYPE (GARBAGE)                          #001740
#        36...(NOT USED)                                               #001750
#        42...PERIOD OR DECIMAL SO FAR                                 #000500
#        48...NAME SO FAR (DATA NAMES,FTN NAMES,AND ALPHANUM KEYWORDS) #000510
#        54...DATA NAME ENDING IN "-" SO FAR                           #000520
#                                                                      #000530
#      TO TRACE THE SCAN OF A WORD, DO THE FOLLOWING:                  #000540
#        1. FIND THE STATUS OF CURRENT CHARACTER (SET WHEN THE LINE WAS#000550
#           READ IN).                                                  #001770
#        2. FIND THE SWITCH VALUE AT INTERSECTION OF STATUS AND        #000570
#           CURRENT STATE IN THE STATE TABLE.                          #001790
#        3. FIND THE MATCHING LABEL IN DDLJUMPVCTR. (STARTSTATE GOTO)  #000590
#        4. GO TO THAT ROUTINE AND WATCH FOR THESE POSSIBILITIES:      #000600
#            - ROUTINE MAY CHANGE THE STATE                            #000610
#            - ROUTINE WILL USUALLY STORE THE CHARACTER,UNLESS IT LOOKS#000630
#              LIKE THE START OF THE NEXT WORD                         #000640
#            - WHEN THE END OF A WORD IS FOUND, TYPE IS SET, AND LEXID #000650
#              IF A KEYWORD, AND SCANNER RETURNS TO SYNTAX TABLE DRIVER#000660
#        REPEAT FOR NEXT CHARACTER, USING THE NEW STATE.               #000670
#                                                                      #000680
#     EXAMPLE - SCANNING OF LINE CONTAINING  ...ITM-3)... :            #001820
#                      1.       2.     3.       4.                     #000700
#             LEXPTR          SWITCH            NEW          NEX  NEX  #001840
#    STATE    CHAR   STATUS   VALUE  ROUTINE   STATE NEXWORD TYPE LXID #000720
#                                                                      #000730
#  ENTER                                                               #000740
#      00      I     LETTER     7    DSTORCHR    48  I       0     0   #001860
#      48      T     LETTER     Z    DSTORCHR        IT      0     0   #001870
#      48      M     LETTER     Z    DSTORCHR        ITM     0     0   #001880
#      48      -     MINUS      8    D54STORCHR  54  ITM-    0     0   #001890
#      54      3     DIGIT      7    D48STORCHR  48  ITM-3   0     0   #001900
#      48      )     SPECIAL    N    D1SCANKEY       ITM-3   101   0   #001910
#  RETURN                                                              #000810
#           NOTE: ON NEXT CALL, STATE IS ZEROED, LEXPTR POINTS TO ")". #000820
#**********************************************************************#000830
      CONTROL EJECT;                                                    000840
# ** TO ADD STATES, JUST LENGTHEN THE C ITEM. DO NOT ADD ANOTHER TABLE.#001930
      ARRAY STATETABLE [1:9] S(1);                                      001940
          ITEM STATETBLE C(0,0,10)=[ #   STATES   #                     001950
            # STATUS OF INPUT CHAR # # 0011233445 #                     001960
                                     # 0628406284 #                     001970
            # BLANK              1 #  "A4ZAAA4AAA",                     001980
            # DECIMAL            2 #  "64ZJH94NN4",                     001990
            # QUOTE              3 #  "D4FJ4Z4N44",                     002000
            # PLUS               4 #  "34ZJ4Z4N44",                     002010
            # MINUS              5 #  "34ZJ4Z4N84",                     002020
            # LETTER             6 #  "74ZJYZ4NZ7",                     006400
            # DIGIT              7 #  "34ZZZZ4IZ7",                     002040
            # SPECIAL            8 #  "B4ZJY94NN4",                     002050
            # TRACECHAR          9 #  "C4ZJY94NN4" ];                   002060
                                                                        000850
SWITCH DDLJMPVCTR            # NOTE. IF ROUTINE NAME IS D1... IT MEANS #002080
                             # CURRENT CHAR IS NOT INCLUDED IN WORD.   #002090
         ,DPROCEED,    # A  (01)  SKIP BLANKS(1ST WORD GOTO SCANKEYWRD)#002100
          DKEYWRD,     # B  (02)  TREAT THIS SPEC.CHAR AS COMPLETE WORD#002110
          DSETTRACE,   # C  (03)  SET,TOGGLE TR. FLAGS,OR GO TO DKEYWRD#002120
          DLITERAL,    # D  (04)  SKIP INITIAL QUOTE, STATE=12 (LIT)   #002130
         ,DNONNUMLIT,  # F  (06)  END QUOTE OR DOUBLE QUOTE PROCESSING #002140
         ,DINTDECIMAL, # H  (10)  GO TO EITHER DINTEGER OR D18STORCHR  #002150
          DDECIMAL,    # I  (11)  GO TO EITHER DKEYWORD OR D18STORCHR  #002160
          D1FIXPOINT,  # J  (12)  RETURN TYPE 108 - FIXED POINT REAL   #002170
       ,,,D1SCANKEY,   # N  (16)  CHECK FOR KEYWORD AND NAME OR FNAME  #002180
,,,,,,,,,,D1INTEGER,   # Y  (31)  RETURN TYPE 107 - INTEGER            #002190
          DSTORCHR,    # Z  (32)  ADD CHAR TO WORD, TEST FOR SP. CASES #002200
         ,D12STORCHR,  # 1  (34)  STATE=12 (LITERAL), ADD CHAR TO WORD #002210
          D18STORCHR,  # 2  (35)  STATE=18 (FIXED),   ADD CHAR TO WORD #002220
          D24STORCHR,  # 3  (36)  STATE=24 (INTEGER), ADD CHAR TO WORD #002230
          D30STORCHR,  # 4  (37)  STATE=30 (GARBAGE), ADD CHAR TO WORD #002240
         ,D42STORCHR,  # 6  (41)  STATE=42 (DECIMAL), ADD CHAR TO WORD #002250
          D48STORCHR,  # 7  (42)  STATE=48 (NAME),    ADD CHAR TO WORD #002260
          D54STORCHR,  # 8  (43)  STATE=54 (NAME-),   ADD CHAR TO WORD #002270
          D1GARBAGE  ; # 9  (44)  RETURN TYPE 0 - NO TYPE (GARBAGE)    #002280
                                                                        002290
      ARRAY CHARLIST [0:71] S(1);# CONTAINS THE INPUT RECORD,ONE CHAR  #002300
        ITEM LEXCHAR C(0,0,1);   # PER WORD.                           #002310
      ARRAY SLIST [0:71] S(1);   # CONTAINS THE STATUS VALUE FOR THE   #002320
        ITEM CHSTATUS;           # CORRESPONDING ENTRY IN CHARLIST.    #002330
      CONTROL EJECT;                                                    000920
#**********************************************************************#002350
#                      **   D D L I N I T   **                         #002360
# INITIAL ENTRY POINT CALLED WHEN THERE IS A NEW SET OF SOURCE INPUT.  #002370
# DDLIO IS CALLED TO READ AN INPUT RECORD. THE INPUT RECORD IS STORED  #002380
# IN THE WORKING STORAGE AREA DDLIWSA AND THE LENGTH IN CHARS IS STOR- #002390
# ED IN DDLIRL. EACH CHAR OF THE INPUT RECORD IS STORED IN A CHARACTER #002400
# ARRAY, ONE CHARACTER PER-WORD, AFTER THE CHARACTER ARRAY IS COMPLET- #002410
# ED A CORRESPONDING ARRAY IS BUILT CONTAINING THE STATUS VALUE OF THE #002420
# CHARACTER. THE ENTRIES IN THE STATUS ARRAY COMBINED WITH THE VALUES  #002430
# OF STATE, ARE USED AS SUBSCRIPTS INTO THE STATE TRANSITION TABLE.    #002440
# THE 1ST SOURCE WORD CRACKED IS STORED IN THE N E X  ITEMS.           #002450
ENTRY PROC DDLINIT;                                                     002460
      P<LWORDS> = LEXWD;     # PICK UP TABLES GENERATED BY SYNGEN      #002470
      P<LEXWRDLOC> = LEXICO;                                            002480
ENTRY PROC CBPINIT;          # CBPINIT IS ENTRY POINT TO PURGE SS.     #002490
      LEXLIM = 71;           # SET LEXPTR GR LEXLIM TO FORCE FIRST     #002500
      LEXPTR = 72;           # READ AT NEXTLINETEST.  THEN WE ARE ABLE #002510
      GOTO LXSCN;            # TO GO TO THE NORMAL SCAN ENTRY, LXSCN.  #002520
                                                                        000930
#**********************************************************************#000940
#                    **   D C I N I T   **                             #002540
# INITIALIZE RELATION/RESTRICT OVERLAY (FTRSYN) PROCESSING             #002550
ENTRY PROC DCTINIT;                                                     002560
      P<LWORDS> = LEXWD;
      P<LEXWRDLOC> = LEXICO;
      RETURN; 
  
#**********************************************************************#004950
#                       **   S N S   **                                #004960
# SCAN NEXT STATEMENT. USED TO GO TO START OF NEW STATEMENT,           #004970
# SKIPPING ANY REMAINING CONTINUATION LINES.                           #004980
# BUILDSTACK HANDLES CONTINUATION AND SETS UP NEXT LINE FOR LEXSCAN.   #004990
                                                                        005000
ENTRY PROC LEXSNS;  ENTRY PROC LEXSNC;  #(+SNC ALSO COMES HERE FOR FTN)#002590
                             # IF EOS WAS RETURNED LAST TIME, THEN     #005020
                             # ALREADY POSITIONED AT NEW STATEMENT.    #005030
      IF NEXTYPE EQ O"12" THEN GOTO LXSCN;                              002610
                             # IF POINTER IS IN MARGIN (LOOKING FOR    #002620
                             # EOS) THEN POSITIONED JUST PRIOR TO NEW  #002630
                             # STATEMENT.                              #002640
      IF LEXPTR LS 6 THEN                                               002650
      BEGIN                                                             002660
        LEXPTR = 6;          # POSITION TO START OF NEW STMT (COL 7),  #002670
        ATNEWSTMT = TRUE;    # SET FLAG THAT POINTER IS AT NEW STMT,   #002680
        GOTO LXSCN;          # AND GO TO THE NORMAL SCAN ENTRY, LXSCN. #002690
      END                                                               002700
                             # WITHIN STMT. SET FLAGS FOR BUILDSTACK.  #002720
      SKIPCONTINUE = TRUE;                                              005060
      EOSNEEDED = FALSE;                                                005070
      LEXPTR = LEXLIM + 1;   # SKIP REMAINING CHARS FOR NEXTLINETEST.  #002740
      ATNEWSTMT = TRUE;      # SET FLAG THAT POINTER IS AT NEW STMT.   #002750
      IF PPFLAG 
      THEN
        BUILDSTACK; 
      GOTO LXSCN;            # GO TO THE NORMAL SCAN ENTRY, LXSCN.     #002760
      CONTROL EJECT;                                                    002770
#**********************************************************************#002780
#                      **   L E X S C A N   **                         #002790
# THIS IS THE NORMAL SCANNER ENTRY POINT FROM STD AFTER THE INIT CALL. #002800
# STORES THE CONTENTS OF  N E X  ITEMS INTO  C U R  ITEMS. IDENTIFIES  #002810
# THE NEXT SOURCE WORD AND STORES THE REQUIRED INFORMATION INTO  N E X #002820
# ITEMS.                                                               #002830
                                                                        005100
ENTRY PROC LEXSCAN;                                                     002850
LXSCN:                           # LOOP COUNT IS NO. OF WORDS TO SWAP. #002870
      FOR I=0 STEP 1 UNTIL ( LOC(NEXWORD) - LOC(CWORD) -1 ) DO          002880
        BEGIN                    # STORE THE CONTENTS OF THE N E X     #002890
          CURWORD[I] = NEXWRD[I];# ITEMS INTO THE C U R ITEMS.         #002900
          NEXWRD[I]  = 0;        # CLEAR THE N E X ITEMS.              #002910
        END                                                             002920
      BLKLINE = NEXBLKLINE;      # LINE MATCHING CUR ITEMS AND ITS     #006540
      NBRLINE = NEXNBRLINE;      # LINE NUMBERS ARE UPDATED OUTSIDE OF #006550
      LINENBR = NEXLINENBR;      # LOOP SO THEY ARE NOT CLEARED.       #006560
      HYPHEN = FALSE;                                                   002930
      IF ATNEWSTMT THEN          # IF POSITIONED AT START OF NEW STMT, #006590
      BEGIN                                                             006600
        IF ORDFLAG EQ 1 THEN     # IF OUTSTANDING "ORDINAL" OR "WITHIN"#006610
        BEGIN                    # MESSAGE FROM PASS1, PRINT IT NOW.   #006620
          IF NOLIST EQ 0 THEN DDLPRNT(CHARS[1],20);                     006630
          WSSOUT1(CHARS[1],20);                                         006640
          ORDFLAG = 0;                                                  006650
        END                                                             006660
        NEXBLKLINE = BLKLIN;     # SAVE LIST LINE AND                  #006670
        NEXNBRLINE = NBRLIN;     # AND LINE NUMBER ITEMS.              #006680
        NEXLINENBR = LINNBR;                                            006690
        NEEDKWTEST = TRUE;       # SET FLAG FOR CONTEXT AND STAR TESTS.#006700
        ATNEWSTMT = FALSE;                                              006710
      END                                                               006720
      IF DDLEOF EQ 1 THEN    # IF EOF WAS DETECTED DURING LAST CALL,   #002940
        BEGIN                                                           002950
          NEXTYPE = O"14";   # STORE SYNTACTIC TYPE FOR EOT.           #002960
          GOTO THATSALL;     # EXIT SCANNER.                           #002970
        END                                                             002980
NEXTLINETEST:                                                           002990
      HYPHEN = FALSE;                                                   003000
      IF LEXPTR GR LEXLIM THEN   # IF NO CHARS LEFT TO SCAN IN LINE,   #003010
        BUILDSTACK;              # THEN READ NEXT, ASSIGN CHAR STATUS. #003020
                                                                        005160
#*****  MAIN BRANCH, CHARACTER BY CHARACTER, THROUGH THE STATE TABLE.  #003040
STARTSTATE:                                                             003060
      IF TFLAG EQ 1 THEN     # IF TRACE FLAG IS ON, SAVE VALUES TESTED.#003070
        BEGIN                                                           003080
          C<TPTR>TCHAR = LEXCHAR[LEXPTR];             # CURRENT CHAR   #003090
          C<TPTR>TSTATUS = CHSTATUS[LEXPTR] + O"33";  # STATUS(DISPLAY)#003100
          C<TPTR>TSWVAL = B<STATE,6>STATETBLE[CHSTATUS[LEXPTR]];#SW VAL#003110
          TPTR = TPTR + 1;                                              003120
          IF TPTR GQ 40 THEN TPRINT;  # IF TRACE ITEMS FULL, PRINT NOW.#003130
        END                                                             003140
                             # GO TO ROUTINE LISTED FOR SWITCH VALUE.  #003150
      GOTO DDLJMPVCTR [ B<STATE,6>STATETBLE [ CHSTATUS [ LEXPTR ] ] ];  003160
      CONTROL EJECT;                                                    003170
#** ROUTINES BRANCHED TO AT STARTSTATE ACCORDING TO DDLJMPVCTR SWITCH  #003180
                                                                        001290
  DSETTRACE:                                                            003200
                 # TRACE CHAR FOUND. CHECK IF TRACE TABLE              #001620
                 # LOADED. IF ADDR IS 0, NO TRACE CHARS ARE RECOGNIZED.#001630
      IF TRACE EQ 0 THEN GOTO DKEYWRD;                                  003220
                 # TRACE TABLE LOADED, SO                              #001560
      TRSSOUT = 1;           # TURN ON TRACE-SSOUT FLAG                #001570
      IF TFLAG EQ 0          # TOGGLE TRACE-SYNGEN-STEPS FLAG          #001580
        THEN TFLAG = 1;                                                 001590
        ELSE TFLAG = 0;                                                 001600
      GOTO ENTRSTTBLE;
  DPROCEED:                  # THIS ROUTINE SKIPS BLANKS (AND OTHER    #003240
                             # BLANK STATUS CHARS) AS INSIGNIFICANT.   #003250
                             # THIS ROUTINE IS NOT CALLED FOR LITERALS.#003260
      FOR LEXPTR = LEXPTR + 1 STEP 1 UNTIL LEXLIM DO                    003300
        BEGIN 
          IF LEXCHAR[LEXPTR] NQ " " THEN                                003320
          BEGIN 
            GOTO STARTSTATE;
          END 
        END 
      LEXPTR = LEXPTR + 1;   # WHEN ENTIRE LINE SCANNED, READ NEXT.    #003340
      GOTO NEXTLINETEST;                                                003350
  DLITERAL:                  #                                         #
      STATE = 12;            # SET STATE FOR NON-NUMERIC LITERAL.      #
      GOTO ENTRSTTBLE;       # RE-ENTER STATE TRANSITION TABLE.        #
  DNONNUMLIT:                #                                         #
      IF (LEXCHAR[LEXPTR + 1] EQ """" 
        OR LEXCHAR[LEXPTR + 1] EQ "'")
      THEN                                  # IF QUOTES ARE PART OF A  #
        BEGIN                               # LITERAL STRING, ADJUST   #
          LEXPTR = LEXPTR + 1;              # POINTER TO REFLECT NEXT  #
          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.           #
  DINTDECIMAL:               # SPECIAL CASE TEST FOR DECIDING WHETHER  #003400
                             # . AFTER INTEGER IS START OF .AND./.OR., #003410
                             # OR JUST CHANGES DIGITS TO FIXED POINT.  #003420
                             # IF A OR O FOLLOWS . THEN DIGITS ARE INT.#003430
      IF LEXCHAR[LEXPTR + 1] EQ "A" OR LEXCHAR[LEXPTR + 1] EQ "O"       003440
      THEN GOTO D1INTEGER;   # A/O FOLLOWS DECIMAL, RETURN INTEGER.    #003450
      ELSE GOTO D18STORCHR;  # ELSE, CONTINUE SEARCH AT FIXED POINT.   #003460
  DDECIMAL:                  # SPECIAL CASE TEST FOR DECIDING IF A     #003470
                             # DECIMAL IS THE END OF A KEYWORD LIKE    #003480
                             # .EQ. OR JUST THE START OF A NUMBER.     #003490
                             # IF THE SYNGEN P2 FIELD OF THE LAST      #003500
                             # WORD IS 500-577, DECIMAL MAY FOLLOW IT. #003510
      IF CURP2 GQ O"500" AND CURP2 LQ O"577"                            003520
      THEN GOTO D1SCANKEY;   # DECIMAL FOLLOWS KEYWORD,RETURN IT ALONE.#003530
      ELSE GOTO D18STORCHR;  # ELSE, CONTINUE SEARCH AT FIXED POINT.   #003540
  D1INTEGER:  
      NEXTYPE = 107;         # STORE SYNTACTIC TYPE FOR INTEGER.       #
      GOTO DDL1EXIT;         # COMPLETE THE EXIT CONDITIONS.           #003570
  D1FIXPOINT:                #                                         #003580
      NEXTYPE = 108;         # STORE SYNTACTIC TYPE FOR FIX POINT LIT. #
      GOTO DDL1EXIT;         # COMPLETE THE EXIT CONDITIONS.           #
  D1GARBAGE:                                                            003610
      NEXTYPE = 0;           # STORE SYNTACTIC TYPE 0(NONE) FOR GARBAGE#003620
      GOTO DDL1EXIT;         # COMPLETE THE EXIT CONDITIONS.           #
  DSTORCHR:                  #                                         #
      IF STATE EQ 12         # ** STATE 12 MEANS NON-NUMBERIC LIT.     #006750
      AND LEXPTR LS 6        # IF EOS IN MARGIN, THEN END QUOTE MISSING#006760
      THEN GOTO D1GARBAGE;   # SO TREAT AS GARBAGE.                    #006770
      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.     #
      IF LEXCHAR[LEXPTR] EQ "-"   # TEST FOR HYPHEN IN NEXWORD.        #005460
      THEN HYPHEN = TRUE;                                               005470
                                                                        006790
      # SPECIAL CASE TESTS FOR KEYWORDS THAT ARE FOLLOWED BY NAMES/EOS.#006800
      # AFTER A CHARACTER IS STORED, TESTS ARE MADE TO SEE IF IT       #006810
      # COMPLETES SUCH A KEYWORD.  IF SO, GO TO SCANKEYWRD, ELSE       #006820
      # CONTINUE TO ENTRSTTBLE.                                        #006830
      # TEST FLAGS ARE USED TO ENSURE THAT SUCH WORDS ARE RECOGNIZED   #006840
      # ONLY IN SPECIFIC CONTEXTS, SINCE THEY ARE ALSO LEGAL NAMES.    #006850
      # THE FLAGS ALSO MINIMIZE THE NUMBER OF WORDS TESTED.            #006860
                                                                        006870
                             # ELIMINATE MAJOR CLASSES OF WORDS TESTED.#006880
      IF STATE NQ 48         # ** STATE 48 MEANS DATA NAME OR FTN NAME.#006890
      OR NEXLENG LS 4        # SUCH KEYWORD ARE GQ 4 CHARS LONG.       #006900
      OR NOT (NEEDKWTEST OR NEEDPRECTEST OR NEEDFUNCTEST) # TEST FLAGS.#006910
      THEN GOTO ENTRSTTBLE;  # IF NOT ALL APPLY, SKIP SPECIAL TESTS.   #006920
                                                                        006930
      IF NOT PPFLAG THEN               # DDLF CATEGORIES -             #006940
      BEGIN                                                             006950
        IF NEEDKWTEST THEN                                              006960
        BEGIN                                                           006970
          IF NEXWRDC[0] EQ "SUBSCHEMA" THEN    # AFTER SUBSCHEMA,      #006980
          BEGIN                                                         006990
            NEEDREALMTST = TRUE;               # TEST REALM, NOT REAL  #007000
            GOTO SCANKEYWRD;                                            007010
          END                                                           007020
          IF NEEDREALMTST AND NEXWRDC[0] EQ "REALM"                     007030
          THEN GOTO SCANKEYWRD;                                         007040
          IF NEXWRDC[0] EQ "RECORD" THEN       # AFTER RECORD,         #007050
          BEGIN                                                         007060
            NEEDREALMTST = FALSE;              # TEST REAL, NOT REALM  #007070
            GOTO SCANKEYWRD;                                            007080
          END                                                           007090
          IF NOT NEEDREALMTST THEN             # WORDS FOLLOWING RECORD#007100
          BEGIN                                                         007110
            IF NEXWRDC[0] EQ "REAL"                                     007120
            OR NEXWRDC[0] EQ "BOOLEAN"                                  007130
            OR NEXWRDC[0] EQ "COMPLEX"                                  007140
            OR NEXWRDC[0] EQ "INTEGER"                                  007150
            OR NEXWRDC[0] EQ "LOGICAL"                                  007160
            OR NEXWRDC[0] EQ "CHARACTER"                                007170
            OR NEXWRDC[0] EQ "RELATION"                                 007180
            OR NEXWRDC[0] EQ "RESTRICT"                                 007190
            THEN GOTO SCANKEYWRD;                                       007200
            IF NEXWRDC[0] EQ "DOUBLE" THEN     # AFTER DOUBLE,         #007210
            BEGIN                                                       007220
              NEEDPRECTEST = TRUE;             # TURN ON PRECISION TEST#007230
              GOTO SCANKEYWRD;                                          007240
            END                                                         007250
          END                                                           007260
        END                                                             007270
        IF NEEDPRECTEST AND NEXWRDC[0] EQ "PRECISION"                   007280
        THEN GOTO SCANKEYWRD;                                           007290
      END                                                               007300
      ELSE                             # DML CATEGORIES -              #007310
      BEGIN                                                             007320
        IF NEEDKWTEST THEN                                              007330
        BEGIN                                                           007340
          IF NEXWRDC[0] EQ "PROGRAM"                                    007350
          OR NEXWRDC[0] EQ "FUNCTION"                                   007360
          OR NEXWRDC[0] EQ "SUBROUTINE"                                 007370
          OR NEXWRDC[0] EQ "INVOKE"                                     007380
          OR NEXWRDC[0] EQ "TERMINATE"                                  007390
        OR NEXWRDC[0] EQ "COMMITTRAN" 
        OR NEXWRDC[0] EQ "DROPTRAN" 
          THEN GOTO SCANKEYWRD;                                         007400
          IF NEXWRDC[0] EQ "REAL"              # AFTER TYPE KEYWORDS,  #007410
          OR NEXWRDC[0] EQ "BOOLEAN"                                    007420
          OR NEXWRDC[0] EQ "COMPLEX"                                    007430
          OR NEXWRDC[0] EQ "INTEGER"                                    007440
          OR NEXWRDC[0] EQ "LOGICAL"                                    007450
          OR NEXWRDC[0] EQ "CHARACTER" THEN                             007460
          BEGIN                                                         007470
            NEEDFUNCTEST = TRUE;               # TURN ON FUNCTION TEST #007480
            GOTO SCANKEYWRD;                                            007490
          END                                                           007500
          IF NEXWRDC[0] EQ "DOUBLE" THEN       # AFTER DOUBLE,         #007510
          BEGIN                                                         007520
            NEEDPRECTEST = TRUE;               # TURN ON PRECISION TEST#007530
            NEEDFUNCTEST = TRUE;               # TURN ON FUNCTION TEST #007540
            GOTO SCANKEYWRD;                                            007550
          END                                                           007560
        END                                                             007570
        IF NEEDPRECTEST AND NEXWRDC[0] EQ "PRECISION" THEN              007580
        BEGIN                                  # AFTER PRECISION,      #007590
          NEEDFUNCTEST = TRUE;                 # TURN ON FUNCTION TEST #007600
          GOTO SCANKEYWRD;                                              007610
        END                                                             007620
        IF NEEDFUNCTEST AND NEXWRDC[0] EQ "FUNCTION"                    007630
        THEN GOTO SCANKEYWRD;                                           007640
      END                                                               007650
  ENTRSTTBLE:                #                                         #
      LEXPTR = LEXPTR + 1;   # INCREMENT PTR TO NEXT CHAR.             #003650
      GOTO NEXTLINETEST;     # GO TO MAIN TEST FOR END OF LINE.        #003660
  D12STORCHR:                                                           003670
      STATE = 12;                                                       003680
      GOTO DSTORCHR;
  D18STORCHR:                                                           003700
      STATE = 18;                                                       003710
      GOTO DSTORCHR;
  D24STORCHR:                                                           003730
      STATE = 24;                                                       003740
      GOTO DSTORCHR;
  D30STORCHR:                                                           003760
      STATE = 30;                                                       003770
      GOTO DSTORCHR;
  D42STORCHR:                                                           003790
      STATE = 42;                                                       003800
      GOTO DSTORCHR;
  D48STORCHR:                                                           003820
      STATE = 48;                                                       003830
      IF NEXLENG EQ 0                                                   000140
      THEN                       # ON FIRST CHAR OF NAME               #000150
        NEXWRDC[0] = " ";        # BLANK FILL FOR SPECIAL TESTS        #000160
      GOTO DSTORCHR;
  D54STORCHR:                                                           003850
      STATE = 54;                                                       003860
      GOTO DSTORCHR;
  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 
  D1SCANKEY:                 #                                         #003890
      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:                 #                                         #
                             # CHECK FOR END OF STATEMENT FLAG -       #003910
                             # BUILDSTACK PUTS "$" IN MARGIN FOR EOS.  #003920
      IF C<0,1>NEXWRD[0] EQ "$" AND LEXPTR LS 7 THEN  #(PTR WAS INCR.) #003930
        BEGIN                                                           006330
          NEXTYPE = O"12";   # STORE SYNTACTIC TYPE FOR EOS.           #003950
          ATNEWSTMT = TRUE;  # SET FLAG THAT POINTER IS AT NEW STMT.   #003960
          GOTO DDL1EXIT;     # COMPLETE THE EXIT CONDITIONS.           #007920
        END                                                             006360
      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] = " ";                                    003980
      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<0,10>ZERO;   # ZERO FILL NAME.       #004000
                             # TEST FOR FORTRAN NAME(FNAME)            #004010
      IF STATE EQ 48 THEN    # ** STATE 48 MEANS DATA NAME OR FTN NAME #004020
      BEGIN                                                             004030
       IF NEXLENG LS 8 AND NOT HYPHEN                                   004040
       THEN NEXTYPE = 99;    # STORE SYNTACTIC TYPE FOR FNAME.         #004050
       ELSE                                                             004060
       NEXTYPE = 101;        # STORE SYNTACTIC TYPE FOR DATA NAME.     #004070
      END                                                               004080
      ELSE NEXTYPE = 0;      # STORE TYPE 0 (NO TYPE/SPECIAL CHAR)     #004090
      GOTO DDL1EXIT;         # COMPLETE THE EXIT CONDITIONS.           #
  SCANEXIT:                  #                                         #
      IF L NQ 10 THEN                                                   004110
        C<L,K>NEXWRD[NEXLENW] = C<0,10>ZERO;   # ZERO FILL NAME.       #004120
      NEXP1 = P1[WRDPTR];    # STORE THE VALUE OF P1.                  #
      NEXP2 = P2[WRDPTR];    # STORE THE VALUE OF P2.                  #
      NEXLXID = LEXID[WRDPTR];# STORE THE VALUE OF LEXID.              #
                             # THERE ARE NO RESERVED WORDS IN FORTRAN  #004140
                             # TEST FOR FORTRAN NAME(FNAME).           #004150
      IF STATE EQ 48 THEN    # ** STATE 48 MEANS DATA NAME OR FTN NAME #004160
      BEGIN                                                             004170
       IF NEXLENG LS 8 AND NOT HYPHEN                                   004180
       THEN NEXTYPE = 99;    # STORE SYNTACTIC TYPE FOR FNAME.         #004190
       ELSE NEXTYPE = 101;   # STORE SYNTACTIC TYPE FOR DATA NAME.     #004200
      END                                                               004210
      # SPECIAL CASE TESTS FOR STARS, BASED ON KEYWORD LEXID NUMBER    #004220
                             # FOR PRE-PASS, AN INITIAL KEYWORD WITH   #000530
                             # LEXID OF 400-477 (SINGLE-WORD DML STMTS)#000540
                             # MEANS STARS MUST BE ADDED BY SCANNER,   #000550
                             # DUE TO LOOK-AHEAD PROBLEM.              #000560
                             # FOR DDLF, AN INITIAL KEYWORD            #004240
                             # WITH LEXID OF 400-477 (TYPE STATEMENTS) #005360
                             # MEANS STMT GOES TO SSOUT FILE WITHOUT   #005370
                             # STARS ADDED.                            #005380
      IF NEEDKWTEST AND NEXLXID GQ O"400" AND NEXLXID LQ O"477"         004260
      THEN IF PPFLAG                                                    004270
           THEN STARSTMT = TRUE;                                        004280
           ELSE STARSTMT = FALSE;                                       004290
      GOTO DDL1EXIT;
  DDLEXIT:                   #                                         #
      LEXPTR = LEXPTR + 1;   # INCREMENT PTR TO NEXT CHAR.             #
  DDL1EXIT:                  #                                         #
      NEXLENW = NEXLENW + 1;                                            004310
      STATE = 0;             # SET STATE TO INITIAL VALUE.             #
      BP = -6;               # INITIALIZE BIT PTR.                     #
      NEXCOL = LEXPTR - (NEXLENG + 1);
      IF NEXCOL LS 0 THEN NEXCOL = LEXPTR - 1;
                                                                        007670
                             # SPECIAL CASE FLAGS TURNED OFF AT RETURN #007680
                                                                        007690
                             # RETURN OF ANY WORD AFTER FIRST KEY WORD #007700
                             # OR A TEST FOR "PRECISION" MEANS         #007710
                             # "FUNCTION" TEST IS NO LONGER NEEDED.    #007720
      IF NOT NEEDKWTEST AND NOT NEEDPRECTEST                            007730
      THEN NEEDFUNCTEST = FALSE;                                        007740
                             # RETURN OF ANY WORD AFTER FIRST KEY WORD #007750
                             # MEANS "PRECISION" TEST NO LONGER NEEDED #007760
      IF NOT NEEDKWTEST THEN NEEDPRECTEST = FALSE;                      007770
                             # RETURN OF ANY WORD MEANS KW TEST NO     #007780
      NEEDKWTEST=FALSE;      # LONGER NEEDED.                          #007790
  
THATSALL:   # *** RETURN *** #
      IF TFLAG EQ 1 THEN TPRINT;  # IF TRACE IS ON, PRINT VALUES USED. #004340
      RETURN;                # RETURN TO CALLER.                       #
      CONTROL EJECT;                                                    004360
#************************ B U I L D S T A C K *************************#004370
PROC BUILDSTACK;             # READ NEXT LINE, BURST, ASSIGN STATUS.   #004380
    BEGIN 
#**********************************************************************#001030
#       * *  S T A T U S   OF CHARS IS DETERMINED BY THIS SWITCH  * *  #001040
#**********************************************************************#001050
SWITCH STACKSWITCH                                                      004410
        SPECIAL,             # : #                                      004420
        LETTER,              # A #
        LETTER,              # B #
        LETTER,              # C #
        LETTER,              # D #
        LETTER,              # E #                                      004440
        LETTER,              # F #
        LETTER,              # G #
        LETTER,              # H #
        LETTER,              # I #                                      004460
        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,               # - #
        SPECIAL,             # * #                                      004480
        SPECIAL,             # / #                                      004490
        SPECIAL,             # ( #                                      004500
        SPECIAL,             # ) #                                      004510
        SPECIAL,             # $ #                                      004520
        SPECIAL,             # = #                                      004530
        BLANK,               # BLANK #                                  004540
        SPECIAL,             # , #                                      004550
        DECIMAL,             # . #                                      004560
        SPECIAL,             # EQUIV #                                  004570
        SPECIAL,             # [ #                                      004580
        SPECIAL,             # ] #                                      004590
        SPECIAL,             # : #                                      004600
        QUOTE,               # QUOTE #                                  004610
        TRACECHAR,           # _ #                                      004620
        SPECIAL,             # ! #                                      004630
        SPECIAL,             # & #                                      004640
        QUOTE,               # ' F5 SINGLE QUOTE #                      004650
        SPECIAL,             # ? #                                      004660
        SPECIAL,             # < #                                      004670
        SPECIAL,             # > #                                      004680
        SPECIAL,             # @ #                                      004690
        SPECIAL,             # \ #                                      004700
        SPECIAL,             # ^ #                                      004710
        SPECIAL;             # SEMICOLON #                              004720
                                                                        000300
                                  # ON ENTRY TO BUILDSTACK,            #007940
      IF TFLAG EQ 1 THEN TPRINT;  # IF TRACE IS ON, PRINT VALUES SO FAR#007950
STARTEST:                    # ADD STARS TO OUTLINE AS                 #004740
                             # NEEDED. STARS SHOULD BE LEFT ON FOR     #006520
                             # CONTINUATION LINES, BUT SKIPPED FOR     #006530
                             # INTERVENING COMMENTS AND BLANK LINES.   #006540
      IF STARSTMT THEN                                                  004760
        C<0,5>OUTLINE = "**   ";                                        006560
RDNEXRECD:                                                              004780
                             # WRITE LINE JUST PROCESSED               #004790
                             # TO SSOUT/DMLOUT FILE.                   #004800
      IF NOPRIORLINE                                                    004810
      THEN NOPRIORLINE = FALSE;                                         004820
      ELSE                                                              004830
        BEGIN                                                           006610
          IF PPFLAG                                                     004850
          THEN WDMLOUT(OUTLINE,DDLIRL);                                 004860
          ELSE WSSOUT1(OUTLINE,DDLIRL);                                 004870
        END                                                             006770
                             # CALL DDLREAD TO LIST LINE JUST PROCESSED#006780
                             # AND READ IN THE NEXT LINE.              #006790
      DDLREAD;
      IF DDLEOF EQ 1 THEN    # IF EOR/EOF, STORE DUMMY LINE TO FINISH  #004890
        BEGIN                # OUT THE LAST WORD OF THE LAST LINE WITH #004900
          C<0,10>CHARS = "12345     ";  # A NORMAL RETURN OR EOS RETURN#004910
          DDLIRL = 10;       # AND ONLY THEN FOLLOWED BY EOT.          #004920
          EOSNEEDED = TRUE;                                             004930
        END 
                             # COPY LINE TO OUTLINE ITEM FOR PROCESSING#004950
      OUTLINE = CHARS;                                                  004960
      LEXLIM = DDLIRL - 1;   # LEXLIM IS MAX SUBSCRIPT FOR LEXCHAR     #004970
      IF LEXLIM GR 71 THEN                                              004980
        LEXLIM = 71;                                                    004990
                             # SKIP COMMENT LINES RIGHT AWAY.          #005580
                             # FOR FORTRAN 4, C, *, OR $ IN COLUMN 1   #
                             # FOR FORTRAN 5, C OR * ONLY IN COLUMN 1  #
      IF (DDLCOMP EQ F4 
           AND (C<0>CHARS EQ "C"
               OR C<0>CHARS EQ "*"
               OR C<0>CHARS EQ "$"))
        OR (DDLCOMP EQ F5 
           AND (C<0>CHARS EQ "C"
               OR C<0>CHARS EQ "*"))
      THEN
        GOTO RDNEXRECD;      # READ NEXT RECORD                        #
                             # IF SKIPCONTINUE WAS SET BY SNS,         #005700
      IF SKIPCONTINUE THEN                                              005710
        BEGIN                # TEST FOR CONTINUATION LINES.            #005720
                             # (FOR FORTRAN, COL. 6 NE BLANK OR 0)     #005730
          IF  C<5>CHARS NQ " " AND C<5>CHARS NQ "0"                     005040
          THEN GOTO STARTEST;# SKIP CONTINUATION LINES.                #005050
          ELSE SKIPCONTINUE = FALSE; # AT END OF CONTIN., CLEAR FLAG.  #005830
        END                                                             005840
                             # CHECK FOR BLANK LINE, COL. 1-72         #005070
      IF C<0,72>CHARS EQ " " THEN                                       005080
        BEGIN                                                           005870
          IF DDLCOMP EQ F4
          THEN               # FOR FTN4 BLANK LINES BREAK CONTINUATION #
             INTERRUPTCON = TRUE; 
          GOTO RDNEXRECD;      # SKIP BLANK LINE.                      #005900
        END                                                             005910
                             #***********  BURST LINE INTO 1 CHAR/WORD.#005110
      FOR I = 0 STEP 1 UNTIL LEXLIM DO                                  005120
        LEXCHAR[I] = C<I>CHARS;                                         005130
  
      IF INTERRUPTCON        # IF BLANK LINES BROKE CONTINUATION (FTN4)#
      THEN
        BEGIN 
          LEXCHAR[5] = " ";  # FORCE COL. 6 TO BLANK.                  #005160
          INTERRUPTCON = FALSE;                                         005170
        END 
                             # IF NEW STATEMENT,                       #006010
      IF LEXCHAR[5] EQ " " OR LEXCHAR[5] EQ "0" THEN                    005200
       BEGIN                                                            005210
                             # SET CURLABEL FOR STATEMENT JUST FINISHED#000240
                             # AND PICK UP NEW STATEMENT LABEL.        #000250
        CURLABEL = NEXLABEL;                                            005230
        NEXLABEL = C<0,5>CHARS;                                         005240
                             # STORE "$" IN MARGIN TO SIGNAL EOS FOR   #006040
                             # PRIOR STATEMENT.                        #006050
        IF EOSNEEDED THEN                                               005260
         BEGIN                                                          005270
          LEXCHAR[4] = "$";                                             005280
          IF PPFLAG              # IF DML,                             #005290
          THEN LEXCHAR[5] = "$"; # USE DOUBLE EOS TO PREVENT LOOKAHEAD.#005300
          ELSE LEXCHAR[5] = " ";                                        005310
          EOSMARGIN = TRUE;  # SET FLAG TO CHANGE STARTING COLUMN.     #005320
         END                                                            005330
                             # FOR FORTRAN PRE-PASS, DEFAULT IS NO     #006120
                             # STARS. STARS ARE REQUESTED IN DMLSYN    #006130
                             # BY *COMMENT CALL.                       #006140
        IF PPFLAG                                                       005350
        THEN STARSTMT = FALSE;                                          005360
                             # FOR DDLF, DEFAULT IS STARS.             #005370
        ELSE STARSTMT = TRUE;                                           005380
       END                                                              005410
      EOSNEEDED = TRUE;      # STMT IN PROCESS, SO EOS NEEDED AT END.  #005420
      FOR LEXPTR = 0 STEP 1 UNTIL LEXLIM DO                             005430
        BEGIN                                                           005440
          GOTO STACKSWITCH[LEXCHAR[LEXPTR]];                            005450
            BLANK:     CHSTATUS[LEXPTR] = 1;  TEST;                     005460
            DECIMAL:   CHSTATUS[LEXPTR] = 2;  TEST;                     005470
            QUOTE:     CHSTATUS[LEXPTR] = 3;  TEST;                     005480
            PLUS:      CHSTATUS[LEXPTR] = 4;  TEST;                     005490
            MINUS:     CHSTATUS[LEXPTR] = 5;  TEST;                     005500
            LETTER:    CHSTATUS[LEXPTR] = 6;  TEST;                     005510
            DIGIT:     CHSTATUS[LEXPTR] = 7;  TEST;                     005520
            SPECIAL:   CHSTATUS[LEXPTR] = 8;  TEST;                     005530
            TRACECHAR: CHSTATUS[LEXPTR] = 9;  TEST;                     005540
        END                                                             006270
                             # IF EOS STORED IN MARGIN,                #005560
      IF EOSMARGIN THEN                                                 005570
        BEGIN 
          LEXPTR = 4;        # SCAN STARTS AT EOS CHAR (COL. 5).       #005590
          EOSMARGIN = FALSE;                                            005600
          RETURN;            # RETURN TO THE MAIN SCANNER PROC.        #005610
        END                                                             005620
      LEXPTR = 6; # SET POINTER TO THE 1ST CHAR OF THE STACK (COL. 7). #005660
      RETURN;                # RETURN TO THE MAIN SCANNER PROC.        #005670
    END                                                                 005680
  
#**************************** T P R I N T *****************************#005700
PROC TPRINT;                 # PRINT TRACE OF VALUES TESTED, USED.     #005710
     BEGIN                                                              005720
      TRACOUT(TCHAR,TPTR);                                              005730
      TRACOUT(TSTATUS,TPTR);                                            005740
      TRACOUT(TSWVAL,TPTR);                                             005750
      TCHAR = " ";           # CLEAR TRACE ITEMS.                      #005760
      TSTATUS = " ";                                                    005770
      TSWVAL = " ";                                                     005780
      TPTR = 1;              # POINTER SET PAST CARRIAGE CONTROL CHAR. #005790
      RETURN;                # RETURN TO THE MAIN SCANNER PROC.        #005800
     END                                                                005810
    END 
  TERM; 
