*DECK LEXSCAN 
USETEXT TENVIRN 
      PROC QUSCAN;
      BEGIN 
*CALL ESTD
  
      XDEF ITEM EOTTERM I;         # FLAG FOR EOT TERMINATING A SCAN   #
                                   # STATE: < 0 MEANS EOT CAN POSSIBLY #
                                   # TERMINATE CURRENT STATE,          #
                                   # > 0 MEANS SOURCE ERROR.           #
      XDEF ITEM ESTDLEN I;         # NUM OF ITEMS IN -ESTD-            #
      XDEF ITEM SAMINPUT     B;    # TRUE IF -SAME- LIST IN -QUIWSA-   #
      XDEF ITEM SAMPTR  I;         # PTR TO FIRST WORD OF NEW -SAME-   #
      XDEF ITEM STATE   I;         # SUBSCRIPT INTO THE STATE TABLE    #
      XDEF ITEM SUB100  B;         # TRUE IF -OLDLEX- PTS INTO PREVIOUS#
                                   # SET OF 100 CHARS (IE, -CT100-     #
                                   # INCREMENTED IN MID-WORD)          #
      XDEF ITEM SVCT100 I;         # ADD TO -LEXPTR- TO GET NUMBER OF  #
                                   # CHARS SCANNED SO FAR              #
      XDEF ITEM SVEOTTERM    I;    # EOT STATUS OF ORIGINAL -QUIWSA-   #
      XDEF ITEM SVOLDLEX     I;    # SAVE -LEXPTR- VALUE BEFORE SCAN   #
      XDEF ITEM SVQUIRL I;         # LENGTH OF ORIGINAL -QUIWSA-       #
      XDEF ITEM SVQUIWSA     I;    # PTR TO ORIGINAL -QUIWSA-          #
      XDEF ITEM SVSTATE I;         # STATE ORIG -QUIWSA- WAS LEFT IN   #
      XDEF ITEM SVSTATRANS   I;    # PTR TO ORIGINAL STATE TABLE       #
  
      XDEF BASED ARRAY STATETRANS [0];  # STATE TABLE                  #
        BEGIN 
        ITEM STATETBLE I(0,0,60); 
        END 
      XDEF BASED ARRAY SVESTD;;    # TEMP HOLD FOR ORIGINAL -ESTD-     #
  
  
                                   #------X R E F S--------------------#
                                   #                                   #
      XREF ITEM QUIRL   I;         # LENGTH OF CURRENT TRANSMISSION    #
  
      XREF BASED ARRAY QUIWSA;     # CURRENT TRANSMISSION              #
        BEGIN 
        ITEM QUIFIRST   C(0,0,04); # FIRST FOUR CHARACTERS             #
        ITEM INWORD     C(0,0,10); # WHOLE WORD OF INPUT               #
        END 
  
      XREF PROC CMM$FRF;           # FREE FIXED BLOCK OF CORE          #
      XREF PROC CONVERT;           # CONVERT ONE ITEM                  #
      XREF PROC DIAG;              # ISSUE DIAGNOSTIC MESSAGE TO USER  #
      XREF PROC MOVE;              # WHOLE WORD MOVE                   #
  
  
                                   #------D E F S----------------------#
                                   #                                   #
      DEF J        #ENTRIES#;      # TEMPORARY SCRATCH VARIABLE        #
      DEF TEMP     #WRDPTR#;       # TEMPORARY SCRATCH VARIABLE        #
  
  
                                   #------I T E M S--------------------#
                                   #                                   #
      ITEM B       I;              # CONTAINS BIT POSITION VALUE       #
      ITEM BITLENG I; 
      ITEM CURRENTCHAR  I;         # CONTAINS SUBSCRIPT TO SWITCH      #
      ITEM CVTFLAG = 0;            # FLAG INDICATING CONVERSION        #
      ITEM CVTPTR  I;              # PTR TO DESTINATION FOR CONVERT    #
      ITEM ENTRIES I; 
      ITEM EQSCANNED    B;         # ALWAYS FALSE WHEN ENTERING LEXSCAN#
                                   # BECOMES TRUE WHEN THE KEY-WORD    #
                                   # *=* IS STORED IN NEXT-WORD        #
      ITEM I       I; 
      ITEM INPUTLG I;              # SET TO *QUIRL* BY LEXINIT         #
      ITEM ITEMP   I; 
      ITEM K       I; 
      ITEM LPTR    I; 
      ITEM SVMPTR  I; 
      ITEM W       I;              # CONTAINS A WORD POSITION VALUE    #
      ITEM WRDPTR  I; 
  
  
                                   #------B A S E D   A R R A Y S------#
                                   #                                   #
      BASED ARRAY LEXWORDS;        # UP TO 3 WDS FOR KEYWORD PLUS ONE  #
        BEGIN                      # FOR LEXID,P1,P2,P2LG, AND LSYNSCT #
          ITEM  LEXWRD C(0,0,10);                                       00000035
          ITEM  LEXID  U(0,0,15); 
          ITEM  P1     I(0,15,15);
          ITEM  P2     I(0,30,15);
          ITEM P2LG    I(0,36,09); # MIN LENGTH OF KEYWORD             #
          ITEM LSYNSCT I(0,45,15);
        END                                                             00000039
      BASED ARRAY LEXICON;         # ONE ENTRY FOR SPECIAL CHARS AND   #
        BEGIN                      # ONE FOR EACH ALPHABETIC STARTING  #
        ITEM LEXENTRY U(00,00,60); # WITH THIS CHARACTER               #
        END                        # BIT 0-5 = NO. OF 1-WD KEYWORDS    #
                                   #    6-17 = START WORD IN LEXWORDS  #
                                   #           OF 1-WD KEYWORDS BEGIN. #
                                   #           WITH THIS CHAR          #
                                   #   18-35 = SAME FOR 2-WD KEYWORDS  #
                                   #   36-53 = SAME FOR 3-WD KEYWORDS  #
  
  
                                   #------A R R A Y S------------------#
                                   #                                   #
      ARRAY ATTRIB [0:0] S(2);     # ATTRIBUTE ARRAY FOR CONVERT       #
        BEGIN 
        END 
  
      ARRAY CONVPARAMS [0] S(2);   # PARAMETERS FOR CONVERSION         #
        BEGIN 
        ITEM EDIT       B(0,03,01) = [FALSE]; 
        ITEM FROMCHAR   U(0,04,04) = [0]; 
        ITEM TOCHAR     U(0,08,04) = [0]; 
        ITEM NBCHAR     U(0,12,12); 
        ITEM FROMWORD   I(0,24,18); 
        ITEM TOWORD     I(0,42,18); 
        ITEM CONVERTCODE U(1,0,06); 
        ITEM FROMPTR    I(1,24,18) = [0]; 
        ITEM TOPTR      I(1,42,18) = [0]; 
        END 
  
      ARRAY STATE1TBLE[0:19];                                           000340
        ITEM ST1TBLE U = [    #   STATES   #
          # STATUS OF INPUT # # 0011233445 #
          #   CHARACTER     # # 0628406284 #
          # DELM          0 #  "ABBBBBB8EE",
          # PERIOD        1 #  "WW667778!!",
          # LEFTPRN       2 #  " 666###777",
          # RIGHTPRN      3 #  " 666###7[[",
          # PLUS          4 #  "N666777777",
          # MINUS         5 #  "N666TTT77X",
          # ASK           6 #  "O6P6777777",
          # SLASH         7 #  "P666777777",
          # EORD          8 #  "S666,,,S7S",
          # M             9 #  "Q666,,,S7S",
          # O            10 #  "R666,,,S7S",
          # I            11 #  "S666,,,S7S",
          # MSK          12 #  "S666,,,S7S",
          # LETTER       13 #  "S666,,,S7S",
          # OCTDIGIT     14 #  "VU66,,,S,,",
          # DIGIT        15 #  "VU66,,,S,,",
          # SPC          16 #  "P666777777",
          # TRCE         17 #  ".666777777",
          # SEPARATOR    18 #  "K666CD7777",
          # EQUAL        19 #  "@BBBBBB8EE"]; 
  
  
      ARRAY STATE2TBLE[0:19];                                           000360
        ITEM ST2TBLE U = [    #   STATES   #
          # STATUS OF INPUT # # 0011233445 #
          #   CHARACTER     # # 0628406284 #
          # DELM          0 #  "9F]=]612,L",
          # PERIOD        1 #  "+-***712,3",
          # LEFTPRN       2 #  "--***712,3",
          # RIGHTPRN      3 # "-<**<712,&", 
          # PLUS          4 #  "--P**712,3",
          # MINUS         5 #  "--P**?12,3",                            001200
          # ASK           6 #  "--***712,3",
          # SLASH         7 #  "--***712,3",
          # EORD          8 #  "YY***012,3",
          # M             9 #  "--***012,3",
          # O            10 #  "--***012,3",
          # I            11 #  "-ZZ*Z012,3",
          # MSK          12 #  "--***0,2,3",
          # LETTER       13 #  "--***012,3",
          # OCTDIGIT     14 #  "N,QQ,,1,,3",
          # DIGIT        15 #  "N,QQ,,12,3",
          # SPC          16 #  "--***712,3",
          # TRCE         17 #  "--***712,3",
          # SEPARATOR    18 #  "--***7HIJU",                            000230
          # EQUAL        19 #  "9F]=]612,L"]; 
  
  
      ARRAY STATE3TBLE[0:19];                                           000380
        BEGIN 
        ITEM ST3TBLE C(,,8)=[ #   STATES   #
          # STATUS OF INPUT # # 0011233445 #
          #   CHARACTER     # # 0628406284 #
          # DELM          0 #  "($MM$M]F",
          # PERIOD        1 #  "OO))))3+",
          # LEFTPRN       2 #  "))))))3-",
          # RIGHTPRN      #  "))<)))'-",
          # PLUS          4 #  "N))Q))3-",
          # MINUS         5 #  "N))Q))3-",
          # ASK           6 #  "))))))3-",
          # SLASH         7 #  "))))))3-",
          # EORD          8 #  "))G)))3_",
          # M             9 #  "))))))3-",
          # O            10 #  "))))))3-",
          # I            11 #  "))))))3Z",
          # MSK          12 #  "))))))3-",
          # LETTER       13 #  "))))))3-",
          # OCTDIGIT     14 #  "N,,RR,3""", 
          # DIGIT        15 #  "N,,RR,3""", 
          # SPC          16 #  "))))))3-",
          # TRCE         17 #  "))))))3-",
          # SEPARATOR    18 #  "))))))3-",
          # EQUAL        19 #  "($MM$M]F"]; 
        ITEM ST3TBLF U(0,48,12) = [20(0)];
        END 
  
  
                                   #------S W I T C H E S--------------#
                                   #                                   #
      SWITCH QUJMPVCTR QERR,       #   0   0                           #
                       ENTRSTTBLE, #   1   A                           #
                       SCANKEYWRD, #   2   B                           #
                       CMASK,      #   3   C                           #
                       OCTALLIT,   #   4   D                           #
                       QINTEGER,   #   5   E                           #
                       QFIXPOINT,  #   6   F                           #
                       ECHECK,     #   7   G                           #
                       ENDCMASK,   #   8   H                           #
                       ENDOCTAL,   #   9   I                           #
                       CKSEP,      #  10   J                           #
                       LITSEP,     #  11   K                           #
                       ENDCHARLIT, #  12   L                           #
                       QCOMPLEX,   #  13   M                           #
                       STOR1CHR,   #  14   N                           #
                       STOR2CHR,   #  15   O                           #
                       STOR3CHR,   #  16   P                           #
                       STOR4CHR,   #  17   Q                           #
                       STOR5CHR,   #  18   R                           #
                       STOR6CHR,   #  19   S                           #
                       STOR7CHR,   #  20   T                           #
                       STOR8CHR,   #  21   U                           #
                       STOR9CHR,   #  22   V                           #
                       STOR10CHR,  #  23   W                           #
                       STOR15CHR,  #  24   X                           #
                       FSTOR2CHR,  #  25   Y                           #
                       STOR20CHR,  #  26   Z                           #
                       T1STOR6CHR,  # 27   0                           #
                       Q1ERR,      #  28   1                           #
                       Q2ERR,      #  29   2                           #
                       Q3ERR,      #  30   3                           #
                       Q4ERR,      #  31   4                           #
                       Q5ERR,      #  32   5                           #
                       Q6ERR,      #  33   6                           #
                       Q7ERR,      #  34   7                           #
                       Q8ERR,      #  35   8                           #
                       Q9ERR,      #  36   9                           #
                       Q10ERR,     #  37   +                           #
                       Q11ERR,     #  38   -                           #
                       Q12ERR,     #  39   *                           #
                       Q13ERR,     #  40   /                           #
                       Q14ERR,     #  41   (                           #
                       Q15ERR,     #  42   )                           #
                       Q16ERR,     #  43   $                           #
                       Q17ERR,     #  44   =                           #
                       QKEYWRD,    #  45  BLANK                        #
                       QSTORCHR,   #  46   ,                           #
                       SETTRACE,   #  47   .                           #
                       SCNKEYWRD,  #  48  EQUIV                        #
                       INTSUBS,    #  49   [                           #
                       QU1EXIT,    #  50   ]                           #
                       QERR,       #  51   :  UNUSED VECTOR ENTRY      #
                       FIXSTOR1CHR,#  52   "                           #
                       FLTSTOR2CHR,#  53   _                           #
                       FIXSTOR7CHR,#  54   !                           #
                       CHARLITPAREN,# 55   &                           #
                       MASKLITPAREN,# 56   '                           #001220
                       NUMBERHYPHEN,# 57   ?                           #
                       FIXSUBS    , # 58   <                           #
                             COMPSUBS,     # 59  >                     #
                             EQSIGN;       # 60  @                     #
      CONTROL EJECT;
      #                     ** L E X I N I T  **                       #
      # INITIAL ENTRY POINT CALLED WHEN THERE IS A NEW SET OF SOURCE   #
      # INPUT. QUS I/O IS CALLED TO READ AN INPUT RECORD. THE INPUT    #
      # RECORD IS STORED IN QUIWSA AND THE LENGTH IN CHARS IS STORED   #
      # IN QUIRL. EACH CHAR (UP TO 100) IN QUIWSA IS STORED IN A 100   #
      # WORD ARRAY, ONE CHARACTER PER-WORD, SUCCESSIVE DELIMITERS BEING#
      # IGNORED. AFTER A CHARACTER IS STORED, THE DISPLAY CODE VALUE OF#
      # THAT CHARACTER IS USED AS A SUBSCRIPT TO A SWITCH WHICH IN TURN#
      # STORES A STATUS VALUE IN AN ARRAY THAT CORRESPONDS TO THE      #
      # CHARACTER ARRAY. THE ENTRIES IN THE STATUS ARRAY COMBINED WITH #
      # THE VALUE OF STATE, ARE USED AS SUBSCRIPTS INTO THE STATE      #
      # TRANSITION TABLE. THE FIRST SOURCE WORD CRACKED IS STORED IN   #
      # THE N E X T  I T E M S.                                        #
  ENTRY PROC LEXINIT; 
      P<STATETRANS> = LOC(STATE1TBLE);
      STATE = 0;
      LEXPTR = 0;                      # SET WRD PTR TO 1ST WORD.      #00000129
      WP = 0;                          # SIGNAL START OF INPUT STRING  #
      INPUTLG = QUIRL;                 # SAVE VALUE OF QUIRL TO ALLOW  #
                                       # COMPUTATION                   #
      BP = 0;                          # SET BIT POSITION TO 1ST CHAR. #00000130
      B = -6; 
      W = 0;
      FOR I=0 STEP 1 UNTIL 5 DO 
        INW[I] = " "; 
      NEXLENG = 0;                     #                               #00000135
      NEXLENW = 0;                     #                               #00000136
      NEXTYPE = 0;                     #                               #00000137
      NLX[0] = 0; 
      NP1[0] = 0; 
      NP2[0] = 0; 
      FROMWORD[0] = LOC(INW[0]);       # INITIALIZE CONVERSION PARAMS. #
      CVTPTR = LOC(INW[5]);        # SAVE ADDRESS OF DESTINATION       # QU3A094
      TOPTR = LOC(CVTPTR);         # DESTINATION OF CONVERT            # QU3A094
      IF QUIRL EQ 0 THEN
        BEGIN 
        NEXTYPE = 11;  # SET EOF TYPE  #
        RETURN; 
        END 
      CREATESTATUS;                    #                               #00000141
      GOTO STARTSTATE;
      CONTROL EJECT;
      ENTRY PROC LEXSNC;
                                       # ENTRY PT TO SKIP TO NEXT CARD #
                                       # OR TRANSMISSION.              #
        WP = -1;                       # SET FLAG FOR EOT SCANNED.     #
        LEXPTR = RECDSIZE + 1;
      CONTROL EJECT;
      #                     **  L E X S C A N  **                      #
      # STORES THE CONTENTS OF THE N E X T  I T E M S  INTO            #
      # C U R R E N T  I T E M S.  IDENTIFIES THE NEXT SOURCE WORD AND #
      # STORES THE REQUIRED INFORMATION ON IT INTO THE N E X T         #
      # I T E M S.                                                     #
  ENTRY PROC LEXSCAN; 
          IF WP EQ 0 THEN              # IF EOT ON LAST SCAN, QUIWSA   #
            BEGIN                      # CONTAINS NEW RECORD TO CRACK. #
              IF QUIRL EQ 0 THEN       # IF NO SOURCE THEN SET NEXTYPE #
                BEGIN                  # TO EOF.                       #
                  NEXTYPE = 11; 
                  RETURN; 
                END 
            CREATESTATUS; 
            GOTO STARTSTATE;
          END 
          IF NEXLENW GR 5 THEN
            J = NEXLENW - 1;
          ELSE J = 6; 
          FOR I=0 STEP 1 UNTIL J DO    # MOVE NEXT TO CURRENT.         #
          BEGIN 
            ICW[I] = INW[I];
            INW[I] = " "; 
          END 
                                   # FOR THE SPECIAL CASE WHEN LEXPTR  #
                                   # POINTS TO THE 101ST CHARACTER     #
                                   # WHICH WILL BE THE START OF A NEW  #
                                   # CHARACTER ARRAY, OLDLEX MUST BE   #
                                   # SET TO ZERO SINCE LEXPTR WILL BE  #
                                   # SET TO ZERO AND CT100 WILL BE     #
                                   # INCREMENTED BY CREATESTATUS.      #
                                   # FOR ALL OTHER CONDITIONS, OLDLEX  #
                                   # IS SET TO LEXPTR WHICH POINTS TO  #
                                   # THE CURRENT STARTING POSITION     #
          IF LEXPTR EQ 100
            AND WP GQ 0 
          THEN
            BEGIN 
            OLDLEX = 0; 
            END 
          ELSE
            BEGIN 
            OLDLEX = LEXPTR;
            END 
  
          CURLENG = NEXLENG;
          NEXLENG = 0;
          CURLENW = NEXLENW;
          NEXLENW = 0;
          CURTYPE = NEXTYPE;
          NEXTYPE = 0;
          SYNSECT = NEXSYNSECT; 
          NEXSYNSECT = 0; 
          CLX[0] = NLX[0];
          NLX[0] = 0; 
          CP1[0] = NP1[0];
          NP1[0] = 0; 
          CP2[0] = NP2[0];
          NP2[0] = 0; 
          SUB100 = FALSE;          # ASSUME WORD NOT SPLIT OVER TWO    #
                                   # -CHARLIST- ARRAYS                 #
  
          IF LEXPTR GR RECDSIZE THEN   # CHECK FOR END OF CHAR ARRAY.  #
          BEGIN 
CHECKEOT: 
        IF WP LS 0                 # IF AT END OF -QUIWSA-             #
        THEN
          BEGIN 
          IF SAMINPUT              # IF -SAME- LIST IS IN -QUIWSA-     #
          THEN
            BEGIN 
            RESTINP;               # RESTORE ORIGINAL INPUT BUFFER     #
            RETURN;                # RETURN WITH LAST WORD OF -SAME-   #
                                   # LIST IN -CURWORD- AND WORD AFTER  #
                                   # -SAME- IN -NEXWORD-               #
            END 
  
          ELSE                     # IF ORIGINAL -QUIWSA-              #
            BEGIN 
            NEXTYPE = 12;          # SET TYPE = EOT                    #
            WP = -2;               # FLAG THAT EOT SCANNED             #
            RETURN; 
            END 
          END                      # END IF AT END OF -QUIWSA-         #
  
        CREATESTATUS; 
      END 
          GOTO STARTSTATE;
      LITSEP:                          # BEGINNING OF CHARACTER LITERAL#
          P<STATETRANS> = LOC(STATE2TBLE);
          STATE = 48; 
          GOTO ENTRSTTBLE;
      CMASK:  
       IF (LEXPTR-1) NQ SVMPTR THEN GOTO Q7ERR; 
          STATE = 36; 
          GOTO RESETB;                 # BEGINNING OF CHARACTER MASK.  #
      OCTALLIT: 
          STATE = 42;                  # BEGINNING OF OCTAL LITERAL.   #
      RESETB: 
          B = -6; 
          P<STATETRANS> = LOC(STATE2TBLE);
          GOTO ENTRSTTBLE;
      ENDCMASK: 
          NEXTYPE = 104;               # TYPE = CHARACTER MASK.        #
          GOTO SCANFORTERM; 
      ENDOCTAL: 
          NEXTYPE = 106;               # OCTAL.                        #
          IF W GR 1 THEN               # MAX SIZE OF OCTAL LIT IS 20.  #
          BEGIN 
            K = 24; 
                  GOTO ERREXIT; 
                END 
              TEMP = 0;                # INITIALIZE RESULT.            #
              K = 0;
      CONVERTOCTAL: 
              FOR I=0 STEP 6 UNTIL 54 DO
              BEGIN 
                ITEMP = B<I,6>INW[K]; 
                IF ITEMP EQ O"55" THEN GOTO OCTBIN;#BLANK ENDS STRING. #
                TEMP = TEMP * 2**3 + ITEMP - O"33"; 
              END 
              IF K EQ 0 AND 
                 W GR 0 THEN
              BEGIN 
                K = 1;
                GOTO CONVERTOCTAL;
              END 
      OCTBIN: 
              B<0,60>INW[5] = TEMP; 
      SCANFORTERM:                     # DELIMITER MUST FOLLOW SEPARATR#
          P<STATETRANS> = LOC(STATE3TBLE);
          STATE = 36; 
          GOTO ENTRSTTBLE;
      CKSEP:  
          STATE = 54; 
          GOTO ENTRSTTBLE;
      CHARLITPAREN: 
          LEXPTR = LEXPTR - 1;         # HAVE TO RESCAN THE PAREN.     #
      ENDCHARLIT: 
          NEXTYPE = 103;               # CHARLIT.                      #
          GOTO QU1EXIT; 
      INTSUBS:  
          LEXPTR = LEXPTR - 1;         # HAVE TO RESCAN THE PAREN.     #
      QINTEGER: 
          NEXTYPE = 107;
          IF W GR 0 THEN               # MAXIMUM SIZE OF A DECIMAL     #
            IF W GR 1 OR               # LITERAL IS 14 DIGITS.         #
               B GR 18 THEN 
            BEGIN 
              K = 26; 
              GOTO ERREXIT; 
            END 
          CVTFLAG = 3;                 # FLAG FOR CHAR TO INT CONVERT. #
          GOTO QUEXIT;
       FIXSUBS: # # 
          LEXPTR = LEXPTR - 1;
      QFIXPOINT:  
          NEXTYPE = 108;
          CVTFLAG = 5;                 # FLAG FOR CHAR TO REAL CONVERT.#
          GOTO QU1EXIT; 
       COMPSUBS: # #
          LEXPTR = LEXPTR - 1;
      QCOMPLEX: 
          NEXTYPE = 109;
          CVTFLAG = 7;                 # FLAG FOR CHAR TO CMPLX CONVERT#
          GOTO QU1EXIT; 
      ECHECK:                          # ONLY SINGLE PRECISION ALLOWED #
          IF LEXCHAR[LEXPTR] NQ "E" THEN #IN IMAGINARY PART OF COMPLEX #
          BEGIN                        # LITERAL.                      #
            K = 37; 
            GOTO ERREXIT; 
          END 
          STATE = 18; 
      QSTORCHR: 
          IF W GQ 25 AND               # CHECK IF EXCEEDING MAX SIZE OF#
             B GQ 24 THEN              # A SOURCE WORD - 255 CHARACTERS#
             BEGIN
               K = 33;
               GOTO ERREXIT;
             END
          IF B GR 48 THEN              # STEP POINTERS TO NEXT BYTE.   #
          BEGIN 
            B = 0;
            W = W + 1;
          END 
          ELSE B = B + 6; 
          B<B,6>INW[W] = B<0,6>LEXCHAR[LEXPTR]; 
  
  
      ENTRSTTBLE: 
          LEXPTR = LEXPTR + 1;
          IF LEXPTR GR RECDSIZE THEN
            BEGIN 
            IF WP GQ 0 THEN            # IF MORE SOURCE, CREATE CHAR   #
            BEGIN                      # AND STATUS STACKS AND CONTINUE#
              SUB100 = TRUE;       # SIGNAL -NEXWORD- IS SPLIT OVER    #
                                   # -CHARLIST- BOUNDARY               #
              CREATESTATUS; 
              GOTO STARTSTATE;
            END 
            IF B LS 0 AND STATE EQ 0 THEN #IF NOTHING FOUND YET, THIS  #
              GOTO CHECKEOT;           # IS EOT.                       #
            EOTTERM = -EOTTERM;        # IF NO MORE SOURCE TRY TERMINA-#
            IF EOTTERM GR 0 THEN       # TING THE STATE WITH A DELIMI- #
              GOTO Q4ERR;              # TER. IF FAILS ISSUE DIAGNOSTIC#
            GOTO QUJMPVCTR[B<STATE,6>STATETBLE[0]]; 
            END 
  
  
      STARTSTATE: 
          GOTO QUJMPVCTR[B<STATE,6>STATETBLE[STATUSLIST[LEXPTR]]];
      FIXSTOR1CHR:  
          P<STATETRANS> = LOC(STATE2TBLE);
      STOR1CHR: 
          STATE = 6;
          GOTO QSTORCHR;
      FLTSTOR2CHR:  
          P<STATETRANS> = LOC(STATE2TBLE);
      FSTOR2CHR:  
          IF LEXCHAR[LEXPTR] EQ "E" THEN #IF THE SOURCE CHAR IS AN E...#
          BEGIN 
            CVTFLAG = 5;               # FLAG FOR CHAR TO REAL CONVERT.#
            NEXTYPE = 111;
          END 
          ELSE
          BEGIN 
            CVTFLAG = 6;               # FLAG FOR CHAR TO DBL CONVERT. #
            NEXTYPE = 112;
          END 
      STOR2CHR: 
          STATE = 12; 
          GOTO QSTORCHR;
      SETTRACE: 
*IF DEF,DEBUG 
      #****************************************************************#
      #            DEBUG STUFF BETWEEN **** CARDS-PULL FOR RELEASE.    #
          IF STATUSLIST[LEXPTR+1] NQ S"DELM" THEN #TRACE INDICATOR MUST#
            GOTO Q5ERR;                # BE FOLLOWED BY DELIMETER.     #
          TFLAG = TFLAG + 1;
        GOTO ENTRSTTBLE;
      #****************************************************************#
*ENDIF
      STOR3CHR: 
          STATE = 18; 
          GOTO QSTORCHR;
      STOR4CHR: 
          STATE = 24; 
      SVMPTR = LEXPTR;
          GOTO QSTORCHR;
      STOR5CHR: 
          STATE = 30; 
          GOTO QSTORCHR;
      T1STOR6CHR: 
          P<STATETRANS> = LOC(STATE1TBLE);
      STOR6CHR: 
          STATE = 36; 
          GOTO QSTORCHR;
      NUMBERHYPHEN:                    #                               #001250
          IF LEXCHAR[LEXPTR-1] EQ "-" THEN # CHECK FOR --              #001260
            GOTO Q7ERR;                                                 001270
          GOTO QSTORCHR;                                                001280
      FIXSTOR7CHR:  
          P<STATETRANS> = LOC(STATE3TBLE);
      STOR7CHR: 
          STATE = 42; 
          GOTO QSTORCHR;
      STOR8CHR: 
          STATE = 48; 
          GOTO QSTORCHR;
      STOR9CHR: 
          STATE = 54; 
          GOTO QSTORCHR;
      STOR10CHR:  
          STATE = 0;
          P<STATETRANS> = LOC(STATE2TBLE);
          GOTO QSTORCHR;
      STOR15CHR:  
          P<STATETRANS> = LOC(STATE2TBLE);
          GOTO STOR5CHR;                                                001300
      STOR20CHR:  
          IF NEXTYPE EQ 112 THEN       # REAL PART OF COMPLEX MAY NOT  #
          BEGIN                        # BE DOUBLE PRECISION.          #
            K = 37; 
            GOTO ERREXIT; 
          END 
          P<STATETRANS> = LOC(STATE3TBLE);
          STATE = 0;
          GOTO QSTORCHR;
      MASKLITPAREN: 
          LEXPTR = LEXPTR - 1;         # HAVE TO RESCAN THE PAREN.     #
      QU1EXIT:  
          P<STATETRANS> = LOC(STATE1TBLE);
      QUEXIT: 
          IF LEXCHAR[LEXPTR] NQ "=" OR EQSCANNED THEN 
                                       LEXPTR=LEXPTR+1; 
                                       #SO THAT EQUAL-SIGN WILL BE
                                        RESCANNED AT NEXT LEXSCAN CALL# 
          NEXLENG = W*10 + B/6 + 1; 
          NEXLENW = W + 1;
  
  
          IF CVTFLAG NQ 0 THEN         # IF NUMERIC LITERAL IS NEXT    #
          BEGIN                        # SOURCE WORD, CONVERT TO INTER-#
            CONVERTCODE[0] = CVTFLAG;  # NAL REPRESENTATION.           #
            NBCHAR[0] = NEXLENG;
            TOWORD[0] = LOC(ATTRIB) - 1;
            CONVERT(CONVPARAMS,CVTFLAG);
            IF CVTFLAG NQ 0 THEN       # SKIP WORD IF ERROR IN CONVERT.#
            BEGIN 
              DIAG(CVTFLAG);
              CVTFLAG = 0;
              GOTO QERR;
            END 
          END 
          STATE = 0;
          EQSCANNED = FALSE;
          B = -6; 
          W = 0;
          RETURN; 
  
  
      EQSIGN:    #ENTER HERE WHEN EQUAL-SIGN FOUND UPON ENTERING
                   LEXSCAN.  #
          EQSCANNED = TRUE; 
          INW[0]="="; 
          B=0;
          GOTO SCANKEYWRD;
  
      QERR: 
          K = 6;
          GOTO ERREXIT; 
      Q1ERR:  
          K = 1;
          GOTO ERREXIT; 
      Q2ERR:  
          K = 2;
          GOTO ERREXIT; 
      Q3ERR:  
          K = 3;
          GOTO ERREXIT; 
      Q4ERR:  
          K = 4;
          GOTO ERREXIT; 
      Q5ERR:  
          K = 5;
          GOTO ERREXIT; 
      Q6ERR:  
          K = 6;
          GOTO ERREXIT; 
      Q7ERR:  
          K = 7;
          GOTO ERREXIT; 
      Q8ERR:  
          K = 8;
          GOTO ERREXIT; 
      Q9ERR:  
          K = 9;
          GOTO ERREXIT; 
      Q10ERR: 
          K = 10; 
          GOTO ERREXIT; 
      Q11ERR: 
          K = 11; 
          GOTO ERREXIT; 
      Q12ERR: 
          K = 12; 
          GOTO ERREXIT; 
      Q13ERR: 
          K = 13; 
          GOTO ERREXIT; 
      Q14ERR: 
          K = 14; 
          GOTO ERREXIT; 
      Q15ERR: 
          K = 15; 
          GOTO ERREXIT; 
      Q16ERR: 
          K = 16; 
          GOTO ERREXIT; 
      Q17ERR: 
          K = 17; 
      ERREXIT:                         # SCANS FOR THE FIRST DELIMITER #
                                       # AND COMPLETES THE EXIT CONDIT-#00000549
                                       # IONS.                         #00000550
          FOR LEXPTR=LEXPTR STEP 1 UNTIL RECDSIZE DO # SCAN FOR DELIM. #
          BEGIN 
            IF STATUSLIST[LEXPTR] EQ 0 THEN 
              GOTO DELIMFOUND;
            IF W LS 26 THEN 
            BEGIN 
              IF B GR 48 THEN 
              BEGIN 
                B = 0;
                W = W + 1;
              END 
              ELSE B = B + 6; 
              B<B,6>INW[W] = B<0,6>LEXCHAR[LEXPTR];#STORE CHAR IN NEXWD#
            END 
          END 
      DELIMFOUND: 
          NEXLENG = W*10 + B/6 + 1; 
          DIAG(K);                     # PRINT OUT DIAGNOSTIC MESSAGE. #
           IF RECORDFLAG THEN PLACEFLAG = 77; 
      NEXLENW = W + 1;
          B = -6; 
        W = 0;
        STATE = 0;
        P<STATETRANS> = LOC(STATE1TBLE);
        RETURN; 
  
      QKEYWRD:  
          B<0,6>INW[0] = B<0,6>LEXCHAR[LEXPTR];#( AND ) ARE KEYWORDS.  #
          B = 0;
          GOTO SCANKEYWRD;
      SCNKEYWRD:  
          LEXPTR = LEXPTR - 1;
      SCANKEYWRD: 
                                       # NO KEYWORDS EXCEED 2 WORDS IN #
            IF W GR 1 THEN             # LENGTH SO NO NEED TO MESS WITH#
            BEGIN                      # SOURCE WORDS LONGER THAN 2.   #
              IF W GQ 3 THEN           # DATA NAMES MAY NOT EXCEED 32  #
              BEGIN                    # CHARACTERS IN LENGTH.         #
                IF W GQ 4 OR
                   B GQ 12 THEN 
                     GOTO Q8ERR;
              END 
              NEXTYPE = 101;
              GOTO QUEXIT;
            END 
          K = B + 6;
          BITLENG = W*60 + K; 
          ITEMP = W * 18; 
          P<LEXWORDS> = PLEXWORDS;     # INSURE BASED ARRAYS ARE POIN- #
          P<LEXICON> = PLEXICON;       # TING TO CURRENT TABLES.       #
          LPTR = B<0,6>INW[0];
          IF LPTR GR O"32" THEN 
            BEGIN 
              WRDPTR = B<6,12>LEXENTRY[0];
              ENTRIES = B<0,6>LEXENTRY[0];
              GOTO SCNLEXWRD; 
            END 
          WRDPTR = B<ITEMP+6,12>LEXENTRY[LPTR]; 
          ENTRIES = B<ITEMP,6>LEXENTRY[LPTR]; 
      SCNLEXWRD:                       # NUMBER OF KEYWRD ENTRIES.     #
          FOR I=1 STEP 1 UNTIL ENTRIES DO  #COMPARE SOURCE WORD WITH   #
          BEGIN                            #ALL KEYWORDS IN THE LEXICON#
            IF BITLENG GQ P2LG[WRDPTR+W+1] THEN 
                                   #THAT BEGIN WITH THE SAME# 
            BEGIN                          #LETTER AND WHOSE P2 IS LQ  #
              IF W GR 0                    #THE SIZE OF THE SOURCE WORD#
              THEN                 # SOURCE WORD > 1 WORD LONG         #
                BEGIN              # COMPARE 2ND AND THEN 1ST WDS OF   #
                IF B<0,K>INW[1] EQ B<0,K>LEXWRD[WRDPTR+1]  # SOURCE AND#
                  AND INW[0] EQ LEXWRD[WRDPTR]   #           KEYWORD   #
                THEN
                  BEGIN 
                  GOTO SCANEXIT;   # SOURCE = KEYWORD                  #
                  END 
                ELSE
                  BEGIN 
                  GOTO NEXTENTRY;  # SOURCE NQ KEYWORD                 #
                  END 
                END 
              ELSE                 # SOURCE = 1 WORD LONG              #
                BEGIN 
                IF B<0,K>INW[0] EQ B<0,K>LEXWRD[WRDPTR] 
                THEN
                  BEGIN 
                  GOTO SCANEXIT;   # SOURCE = KEYWORD                  #
                  END 
                END 
            END 
      NEXTENTRY:  
            WRDPTR = WRDPTR + W + 2;       #BUMP TO NEXT LEXICON ENTRY.#
          END 
          NEXTYPE = 101;
          GOTO QUEXIT;
      SCANEXIT:                        #                               #
          WRDPTR = WRDPTR + W + 1;         #BUMP TO WORD WITH ID,P1,P2.#
          NP1[0] = P1[WRDPTR];             #STORE P1 AND P2.           #
          NP2[0] = P2[WRDPTR];
          NLX[0]=LEXID[WRDPTR];        #  STORE LEXID                  #
          NEXTYPE = 100;
          NEXSYNSECT = LSYNSCT[WRDPTR]; 
          GOTO QUEXIT;
      CONTROL EJECT;
      #****************************************************************#
      #                                                                #
      #            PROC CREATESTATUS                                   #
      #                                                                #
      #****************************************************************#
      PROC CREATESTATUS;               # CREATE THE STATUS ARRAY AND   #
        BEGIN                          # CHARACTER ARRAY.              #
      SWITCH LISTSWITCH                                                 00000630
        SC,                            # : #
        LET,                           # A #                            00000631
        LET,                           # B #                            00000632
        LET,                           # C #                            00000633
        FLOATPT,                       # D #                            00000634
        FLOATPT,                       # E #                            00000635
        LET,                           # F #                            00000636
        LET,                           # G #                            00000637
        LET,                           # H #                            00000638
        INTEGER,                       # I #                            00000639
        LET,                           # J #                            00000640
        LET,                           # K #                            00000641
        LET,                           # L #                            00000642
        MASK,                          # M #                            00000643
        MASKITEM,                      # N #                            00000644
        CONSTANT,                      # O #                            00000645
        LET,                           # P #                            00000646
        LET,                           # Q #                            00000647
        LET,                           # R #                            00000648
        LET,                           # S #                            00000649
        LET,                           # T #                            00000650
        LET,                           # U #                            00000651
        LET,                           # V #                            00000652
        LET,                           # W #                            00000653
        LET,                           # X #                            00000654
        MASKITEM,                      # Y #                            00000655
        LET,                           # Z #                            00000656
        OCTDGT,                        # 0 #                            00000657
        OCTDGT,                        # 1 #                            00000658
        OCTDGT,                        # 2 #                            00000659
        OCTDGT,                        # 3 #                            00000660
        OCTDGT,                        # 4 #                            00000661
        OCTDGT,                        # 5 #                            00000662
        OCTDGT,                        # 6 #                            00000663
        OCTDGT,                        # 7 #                            00000664
        DGT,                           # 8 #                            00000665
        DGT,                           # 9 #                            00000666
        PLS,                           # + #                            00000667
        MINS,                          # - #                            00000668
        ASTERISK,                      # * #                            00000669
        SLSH,                          # / #                            00000670
        LPAREN,                        # ( #                            00000671
        RPAREN,                        # ) #                            00000672
        SC,                            # $ #                            00000673
        EQUAL,                    # = # 
        DELEM,                         #   #                            00000674
        DELEM,                         # , #                            00000675
        DECIMAL,                       # . #                            00000676
        TRACEIND,                      # EQUIV #
        SC,                            # [ #                            00000678
        SC,                            # ] #                            00000679
        SC,                            # : #                            00000680
        SC,                            # " #                            00000681
        SC,                            # _ #                            00000682
        SC,                            # ! #                            00000683
        SC,                            # & #                            00000684
        SC,                            # ' #                            00000685
        SC,                            # ? #                            00000686
        SC,                            # < #                            00000687
        SC,                            # > #                            00000688
        SC,                            # @ #                            00000689
        SC,                            # \ #                            00000690
        SC,                            # ^ #                            00000691
        DELEM;                         # SEMI COLON #                   00000692
      IF WP EQ 0 THEN                  # WP=0 MEANS QUIWSA CONTAINS A  #
        QUIRL = QUIRL - 1;             # NEW RECORD.                   #
      INPUTLG = QUIRL;
      RECDSIZE = INPUTLG; 
      LEXPTR = 0; 
      CT100 = CT100 + 100;
          EOTTERM = 1;                 # RESET FLAG FOR EOT STATE TER- #
                                       # MINATION.                     #
      LSTSWTCH:                        #                               #
          CURRENTCHAR = B<BP,6>INWORD[WP];# GET NEXT SOURCE CHARACTER. #
          IF BP GR 48 THEN
          BEGIN 
            BP = 0; 
            WP = WP + 1;
          END 
          ELSE BP = BP +6;
                                       # CURRENT CHAR USED AS A SUB-   #
          GOTO LISTSWITCH[CURRENTCHAR];# SCRIPT TO A SWITCH WHICH IN   #
                                       # TURNS CREATES THE CHAR + STAT-#00000720
                                       # US ARRAYS.                    #00000721
      DELEM:                           #                               #
      STATUSLIST[LEXPTR] = S"DELM";    # STORE STATUS VALUE.           #00000728
      GOTO STORECHAR;                  #                               #00000729
      LET:                             #                               #
      STATUSLIST[LEXPTR] = S"LETTER";  # STORE STATUS VALUE.           #00000731
      GOTO STORECHAR;                  #                               #00000732
      OCTDGT:                          #                               #
      STATUSLIST[LEXPTR] = S"OCTDIGIT";# STORE STATUS VALUE.           #00000734
      GOTO STORECHAR;                  #                               #00000735
      DGT:                             #                               #
      STATUSLIST[LEXPTR] = S"DIGIT";   # STORE STATUS VALUE.           #00000737
      GOTO STORECHAR;                  #                               #00000738
      FLOATPT:                         #                               #
      STATUSLIST[LEXPTR] = S"E";       # STORE STATUS VALUE.           #00000740
      GOTO STORECHAR;                  #                               #00000741
      INTEGER:                         #                               #
      STATUSLIST[LEXPTR] = S"I";       # STORE STATUS VALUE.           #00000743
      GOTO STORECHAR;                  #                               #00000744
      MASK:                            #                               #
      STATUSLIST[LEXPTR] = S"M";       # STORE STATUS VALUE.           #00000746
      GOTO STORECHAR;                  #                               #00000747
      MASKITEM:                        #                               #
      STATUSLIST[LEXPTR] = S"MSK";     # STORE STATUS VALUE.           #00000749
      GOTO STORECHAR;                  #                               #00000750
      CONSTANT:                        #                               #
      STATUSLIST[LEXPTR] = S"O";       # STORE STATUS VALUE.           #00000752
      GOTO STORECHAR;                  #                               #00000753
      PLS:                             #                               #
      STATUSLIST[LEXPTR] = S"PLUS";    # STORE STATUS VALUE.           #00000755
      GOTO STORECHAR;                  #                               #00000756
      MINS:                            #                               #
      STATUSLIST[LEXPTR] = S"MINUS";   # STORE STATUS VALUE.           #00000758
      GOTO STORECHAR;                  #                               #00000759
      ASTERISK:                        #                               #
      STATUSLIST[LEXPTR] = S"ASK";     # STORE STATUS VALUE.           #00000761
      GOTO STORECHAR;                  #                               #00000762
      SLSH:                            #                               #
      STATUSLIST[LEXPTR] = S"SLASH";   # STORE STATUS VALUE.           #00000764
      GOTO STORECHAR;                  #                               #00000765
      LPAREN:                          #                               #
      STATUSLIST[LEXPTR] = S"LEFTPRN"; # STORE STATUS VALUE.           #00000767
      GOTO STORECHAR;                  #                               #00000768
      RPAREN:                          #                               #
      STATUSLIST[LEXPTR] = S"RIGHTPRN";# STORE STATUS VALUE.           #00000770
      GOTO STORECHAR;                  #                               #00000771
      TRACEIND: 
*IF DEF,DEBUG 
      #****************************************************************#
      #    **WARNING - CODE CONNECTED WITH STD TRACE OUTPUT**          #
      #    **PULL CARDS BETWEEN ****** CARDS FOR RELEASE.**            #
        STATUSLIST[LEXPTR] = S"TRCE"; 
        GOTO STORECHAR; 
      #****************************************************************#
*ENDIF
      SC:                              #                               #
      STATUSLIST[LEXPTR] = S"SPC";     # STORE STATUS VALUE.           #00000773
      GOTO STORECHAR;                  #                               #00000774
      DECIMAL:                         #                               #
      STATUSLIST[LEXPTR] = S"PERIOD";  # STORE STATUS VALUE.           #00000776
      GOTO STORECHAR;                  #                               #00000777
      EQUAL:                              #    #                        000140
          STATUSLIST[LEXPTR] = S"EQU";                                  000150
      STORECHAR:                       #                               #
      LEXCHAR[LEXPTR] = CURRENTCHAR;   # STORE CHARACTER.              #00000779
      IF LEXCHAR[LEXPTR] EQ SEPARATOR THEN    #CHECK FOR SEPARATOR.    #
        STATUSLIST[LEXPTR] = S"SEP";
      LEXPTR = LEXPTR + 1;             # INCREMENT PTR TO NEXT WORD.   #00000780
      IF LEXPTR GR 99 THEN             # CHECK IF CHAR ARRAY IS FULL.  #00000792
        BEGIN                          #                               #00000793
          RECDSIZE = 99;               # STORE SIZE.                   #00000794
          INPUTLG = INPUTLG - 100; # STORE REMAINING NUMBER OF CHAR    #
          QUIRL = INPUTLG;
          IF INPUTLG LS 0 
          THEN
            BEGIN 
            WP = -1;
            BP = 0; 
            END 
          LEXPTR = 0;                         #                        #00000796
          RETURN;                      #                               #00000797
        END                            #                               #00000798
      IF LEXPTR GR INPUTLG             # CHECK IF AT END OF RECORD     #
      THEN
        BEGIN                          #                               #00000783
          LEXCHAR[LEXPTR] = O"55";     # STORE BLANK TO INDICATE END OF#00000784
          STATUSLIST[LEXPTR] = S"DELM"; 
          LEXPTR = 0;                         #                        #00000785
          WP = -1;                     # FLAG FOR EOT READ.            #
          BP = 0;                      # SET BIT POSITION TO 1ST CHAR. #00000787
                                       # STORE NEXT REC.               #00000788
          RECDSIZE = INPUTLG;          # STORE RECORD SIZE             #
          RETURN;                      #                               #00000790
        END                            #                               #00000791
      GOTO LSTSWTCH;                   #                               #00000799
  END                                  #                               #00000800
  
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     R E S T I N P                                                    #
#                                                                      #
#     *RESTINP* IS CALLED FROM *LEXSCAN* WHEN THE END OF THE *SAME*    #
#     INPUT BUFFER HAS BEEN REACHED.   IT RESTORES ALL THE LEXICAL     #
#     INFORMATION FROM THE ORIGINAL INPUT BUFFER (EXCEPT FOR THOSE     #
#     ITEMS PERTAINING TO THE CURRENT WORD), AND SWITCHES THE SCAN     #
#     BACK TO THE ORIGINAL *QUIWSA*.                                   #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC RESTINP; 
      BEGIN 
                                   # RESTORE THE VALUES TO -ESTD-      #
      MOVE (SVESTD, ESTDLEN, ESTDBEG);
      CMM$FRF (P<SVESTD>);
                                   # RESTORE ALL OTHER SAVED ITEMS     #
      CT100 = SVCT100;
      EOTTERM = SVEOTTERM;
      OLDLEX = SVOLDLEX;
      QUIRL = SVQUIRL;
      P<QUIWSA> = SVQUIWSA; 
      STATE = SVSTATE;
      P<STATETRANS> = SVSTATRANS; 
  
      SAMINPUT = FALSE;            # -SAME- LIST NO LONGER IN -QUIWSA- #
  
      RETURN; 
      END                          # PROC *RESTINP*                    #
      END    #LEXSCAN#
  TERM;                                                                 00000808
