*DECK             SPRECG
USETEXT   TSOURCE 
USETEXT   TCEXECQ 
USETEXT   TSYMC5Q 
USETEXT   TSYMCNS 
USETEXT   TCEXEC
USETEXT   TSYMC5
USETEXT   TSTABLE 
PROC SPRECG;                  #SYMPL    PRECOGNITION# 
      BEGIN 
  
  
#     COMDECKS                                                         #
  
*CALL COMEX 
*CALL NUMCOM                                                             SMPA029
  
  
  
  
#     DEFS                                                             #
  
      DEF GENRED #GTSRC#; 
   DEF BLANK #45#;                                                       NEWFEAT
      DEF D136 #136#;        #DIAGNOSTIC 136# 
      DEF J864 #864#;              # SYMABT DIAGNOSTIC 864             # SPRECG 
  
  
  
#     XREFS                                                            #
      XREF PROC SYMABT;                                                  SPRECG 
      XREF PROC GTSRC;
      XREF PROC NXTCHR; 
      XREF PROC DIAG0;                                                   SPRECG 
  XREF  PROC  SNEXT;
  XREF  PROC  FNEXT;
  
  XREF ITEM DEFCHR B;              # SET TRUE BY F/SNEXT IF DEF        # SPRECGC
  XREF ITEM DEFINT B;              # SET TRUE BY SPRECG IF DEF         # SPRECGC
  
  
  
#     XDEFS                                                            #
  
  XDEF ITEM SPQR =0;                                                     NEWFEAT
    XDEF  ITEM PGIX8LTR B;                                               NEWFEAT
  
  
  
  
#     SWITCHES                                                         #
  
      $BEGIN                                                             NOV04
      XREF PROC DMPCSNR;                                                 NOV04
      $END                                                               NOV04
  XDEF  PROC  FNEOF;
          ITEM  ZEROFG       I;    # LEADING/TRAILING ZERO FLAG        # SMPA029
  
         SWITCH PGIXS  PGIX0,PGIX1,PGIX2,PGIX3,PGIX4,PGIX5,PGIX6,        NEWFEAT
                         PGIX7,PGIX8,PGIX9,PGIX8  ; 
SWITCH NCARS N0,N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12; 
SWITCH PCTPS:QPCTP  PCTLTR:LTR, 
                    PCTDGT:DGT, 
                    PCTBLK:BLK, 
                   PCTPAM:PAM,                                           NEWFEAT
                    PCTSPC:SPC; 
SWITCH PCTPD:QPCTP  PCDDGT:DGT, 
                    PCDLTR:LTR, 
                    PCTOTH:BLK, 
                   PCTPAM:PAM,                                           NEWFEAT
                    PCTOTH:SPC; 
SWITCH PCTPL:QPCTP  PCLLDG:DGT, 
                    PCLLDG:LTR, 
                    PCTOTH:BLK, 
                   PCTPAM:PAM,                                           NEWFEAT
                    PCTOTH:SPC; 
  
  
  
  
#     LOCAL DATA                                                       #
  
          ITEM TPYX,TPYY,TPYZ;    # TEMPS FOR SPRECG  # 
      CONTROL EJECT;
  PROC CHECKCNTX;   BEGIN   #IN SPECIAL PGIX =8 MODE CHECK FLAG SPQR#    NEWFEAT
         IF CCHAR EQ CCPRIM THEN                                         NEWFEAT
            BEGIN IF SPQR EQ 0 THEN SPQR = CCPRIM;                       NEWFEAT
                     ELSE                                                NEWFEAT
                  IF SPQR EQ CCPRIM THEN SPQR = 0 ;                      NEWFEAT
            END # DOES IT MATCH AN EARLIER PRIME OR IS IT THE FIRST#     NEWFEAT
         IF CCHAR EQ CCQUOT THEN                                         NEWFEAT
                  IF SPQR EQ 0 THEN SPQR = CCQUOT;                       NEWFEAT
                   ELSE                                                  NEWFEAT
            BEGIN NXTCHR; #LOOK AHEAD#                                   NEWFEAT
                  IF CCHAR NQ CCQUOT THEN BEGIN CCHAR = CCQUOT;          NEWFEAT
                                                SPQR = 0; END            NEWFEAT
                           ELSE  #DOUBLE QUOTE#                          NEWFEAT
                  IF SPQR EQ CCQUOT THEN SPQR = 0 ;                      NEWFEAT
            END                                                          NEWFEAT
   $BEGIN   IF DEBFLG EQ 1 THEN BEGIN                                    NEWFEAT
         PRINT("( 10H SPRECG   ,O20,2X,O20,2X,O20)");                    NEWFEAT
          LIST(SPQR);  LIST(CCHAR); LIST(CSTAKP);  ENDL;                 NEWFEAT
              END  $END                                                  NEWFEAT
                    END                                                  NEWFEAT
      CONTROL EJECT;
        PROC  FNEOF;   #EOF PROCESSING#     BEGIN 
  
      SWITCH EOFS                  # PGIX SWITCH FOR EOF ACTION        #
        E0, 
        E1, 
        E2, 
        E3, 
        E4, 
        E0, 
        E3, 
        E4, 
        E1, 
        E4, 
        E4; 
  
            #PGIX SWITCH FOR EOF ACTION#                                 NEWFEAT
  
         EOFI=1;
          GOTO EOFS[PGIX];
E1:E2:    CSNR[ARG]=CLIST"BADSTR";
          GOTO FNEOUT;
E3:       CSNR[ARG]=CLIST"BADCOM";
          GOTO FNEOUT;
E0:       CSNR[ARG]=CLIST"NOTERM";
          GOTO FNEOUT;
E4:       PGIX=0; 
FNEOUT:   ARG=FLNK[ARG];
          GOTO EOFOUT;
     END  #OF FNEXT#
      CONTROL EJECT;
#     BEGINNING OF CODE FOR SPRECG                                     #
  
PGIX4:  # PGIX NEVER  4 ON ENTRY #
          GOTO PGIXS[PGIX]; 
PGIX9:   #EXTRA SPECIAL -- STOPS SWALLOWING UP RESERVED WORDS AFTER MACR NEWFEAT
                  MACRO EXPANSION#                                       NEWFEAT
          PGIX = 0;   #ONCE IS ENOUGH#                                   NEWFEAT
          CCHAR = BLANK;                                                 NEWFEAT
          GOTO PCTSPC;                                                   NEWFEAT
                                                                         NEWFEAT
PGIX8:    #PRECOGNITION FOR DEF STRING TO RETURN IDENTIFIERS ONLY UNLESS NEWFEAT
                 IN PRIMES OR (DOUBLE) QUOTES#                           NEWFEAT
         SNEXT;                                                          NEWFEAT
         IF PCTP[CCHAR ] EQ QPCTP"LTR" AND SPQR EQ 0 THEN BEGIN          NEWFEAT
               PGIX8LTR = TRUE;                                          NEWFEAT
               GOTO PCTLTR8;                                             NEWFEAT
                                                          END            NEWFEAT
         PGIX8LTR= FALSE;                                                NEWFEAT
                #LETTER IN THE OPEN#                                     NEWFEAT
         IF PCTP[CCHAR] EQ QPCTP"BLK" AND SPQR EQ 0 THEN BEGIN           NEWFEAT
       #BLANKS MUST BE KEPT BUT ONE IS ENOUGH IN ANY SEQUENCE#           NEWFEAT
 LOOKAHEADB:   NXTCHR;                                                   NEWFEAT
         IF PCTP[CCHAR] NQ QPCTP"BLK" THEN BEGIN                         NEWFEAT
                                            CCHAR = BLANK;               NEWFEAT
                                            GOTO PCTSPC;                 NEWFEAT
                                            END                          NEWFEAT
         SNEXT;                                                          NEWFEAT
         GOTO LOOKAHEADB;                                                NEWFEAT
         END                                                             NEWFEAT
         CHECKCNTX;   #SET UP SPQR#                                      NEWFEAT
          IF PGIX EQ 10 AND SPQR NQ 0 THEN  # SKIPPING CONDIT CODE
                                            IGNORE COMMENTS AND STRINGS#
                  GOTO PGIX8; 
          IF CCHAR EQ ENDDEF THEN 
            GOTO PCTPAM;
          ELSE
            GOTO PCTSPC  ;
PGIX7:  PGIX = 0;  RETURN; #SPECIAL SETTING FOR $BEGIN , $END 
        PROCESSING  # 
  
PGIX5:    GENRED(CWORD,EOF5); 
          GOTO PGIX5; 
EOF5:     EOFI=1; 
          RETURN; 
PGIX6:    #COMMENTS INSIDE OCTAL AND HEX CONSTANTS# 
          PGIX=1; 
          GOTO PGIX3A;
PGIX1:    #    STRINGS# 
PGIX2:    #    O AND X   #
          SNEXT;                        #SNEXT RETAINS BLANKS#
PCTSPC:   CSNR[ARG]=SCCN[CCHAR];        #PUT CONSTRUCT NO IN STRING#
          CSDF[ARG] = FALSE;
      $BEGIN                                                             NOV04
      DMPCSNR("SPRECG.1..");       # IF *=0 DUMP THE CONSTRUCT STRING  # NOV04
      $END                                                               NOV04
          GOTO PREOUT;
  
PGIX3:    #    COMMENTS  #
          PGIX=0; 
PGIX3A:   FNEXT;
          IF CCHAR EQ CCQUOT THEN GOTO PGIXS[PGIX]; 
          IF CCHAR NQ CCSEMI THEN GOTO PGIX3A;
          DIAG0(136);              # SEMI ENDS COMMENT                 # SPRECG 
               GOTO PGIXS[PGIX];
  
PCTBLK:   #BLANK ENTRANCE # 
PGIX0:         #    FIND A TOKEN# 
          FNEXT;                        #DISCARDS BLANK WORDS#
          GOTO PCTPS[PCTP[CCHAR]];      #SWITCH ON CHAR TYPE# 
  
#----------------------------------------------------------------------# SMPA029
#         PROCESS NUMERIC STRING.....                                  # SMPA029
#             DOES CONVERSION FROM DISP. CODE TO INTEGER.  IF THE      # SMPA029
#             INTEGER IS TOO BIG TO FIT INTO 47 BITS, WE MAKE IT       # SMPA029
#             DOUBLE PRECISION. THE VALUES RETURN IN DIVAL AND DIVALU  # SMPA029
#----------------------------------------------------------------------# SMPA029
                                                                         SMPA029
PCTDGT:   #    PROCESS FIRST DIGIT OF INTEGER#
          NCAR=1; 
             DIVALU = 0;                                                 SMPA029
             DPFLG = FALSE;        # SET SINGLE PRECISION              # SMPA029
             TRZERO = 0;           # NO TRAILING ZEROS YET             # SMPA029
             DIVERR = 0;           # NO ERRORS EITHER...               # SMPA029
          DIVAL=SCVL[CCHAR];
          PGIX=4;                       #FLAG FOR EOF PROCESSOR#
          CSNR[ARG]=CLIST"DINT";
          CSDF[ARG] = FALSE;
          IF DEFCHR                                                      SPRECGC
          THEN                     # CHARACTER CAME FROM A DEF         # SPRECGC
            BEGIN                                                        SPRECGC
            DEFINT = TRUE;                                               SPRECGC
            DEFCHR = FALSE;        # RESET DEFCHR                      # SPRECGC
            END                                                          SPRECGC
          IF  DIVAL EQ 0                                                 SMPA029
          THEN                                                           SMPA029
            BEGIN                                                        SMPA029
            ZEROFG = 1;                                                  SMPA029
            LDZERO = 1;                                                  SMPA029
            END                                                          SMPA029
          ELSE                                                           SMPA029
            BEGIN                                                        SMPA029
            ZEROFG = 0;                                                  SMPA029
            LDZERO = 0;                                                  SMPA029
            END                                                          SMPA029
                                                                         SMPA029
      $BEGIN                                                             NOV04
      DMPCSNR("SPRECG.2..");       # IF *=0 DUMP THE CONSTRUCT STRING  # NOV04
      $END                                                               NOV04
PCDNXT:   SNEXT;                        #RETAINS BLANKS#
          GOTO PCTPD[PCTP[CCHAR]];      #SWITCH ON TYPE OF NEXT CHAR# 
PCDDGT:   #ANOTHER DIGIT# 
          IF  SCVL[CCHAR] NQ 0                                           SMPA029
          THEN                                                           SMPA029
            BEGIN                                                        SMPA029
            ZEROFG = 0;                                                  SMPA029
            TRZERO = 0;                                                  SMPA029
            END                                                          SMPA029
          ELSE                                                           SMPA029
            BEGIN                                                        SMPA029
            IF  ZEROFG EQ 1        # STILL HAVE LEADING ZEROS          # SMPA029
            THEN                                                         SMPA029
              BEGIN                                                      SMPA029
              LDZERO = LDZERO + 1;    # ACCUMULATE LEADING ZERO COUNT  # SMPA029
              END                                                        SMPA029
            ELSE                                                         SMPA029
              BEGIN                                                      SMPA029
              IF  ZEROFG EQ 0      # FIRST TRAILING ZERO CHAR          # SMPA029
              THEN                                                       SMPA029
                BEGIN                                                    SMPA029
                TRZERO = 1;                                              SMPA029
                ZEROFG = 2;                                              SMPA029
                END                                                      SMPA029
              ELSE                                                       SMPA029
                BEGIN                                                    SMPA029
                TRZERO = TRZERO + 1;       # UP TRAILING ZERO COUNT    # SMPA029
                END                                                      SMPA029
              END                                                        SMPA029
            END                                                          SMPA029
                                                                         SMPA029
                                                                         SMPA029
          IF NOT DPFLG             # STILL A SINGLE PRECISION NUMBER   # SMPA029
          THEN                                                           SMPA029
            BEGIN                                                        SMPA029
            IF  NCAR - LDZERO GQ INTMAX       # GOT OVERFLOW NOW       # SMPA029
            THEN                                                         SMPA029
              BEGIN                                                      SMPA029
              DIVALU = DIVAL;                                            SMPA029
              DIVAL = 0;                                                 SMPA029
              DPFLG = TRUE;                                              SMPA029
              END                                                        SMPA029
            END                                                          SMPA029
          ELSE                                                           SMPA029
            BEGIN                                                        SMPA029
            IF  NCAR - LDZERO GQ 2 * INTMAX     # C.F. DOUBLE OFLOW    # SMPA029
            THEN                                                         SMPA029
              BEGIN                                                      SMPA029
              DIVERR = 1;          # SET ERROR STATUS                  # SMPA029
              END                                                        SMPA029
            END                                                          SMPA029
                                                                         SMPA029
                                                                         SMPA029
          NCAR=NCAR+1;
##       DIVAL=(DIVAL*8) + (DIVAL*2)  +  SCVL[CCHAR]; 
          IF DEFCHR                                                      SPRECGC
          THEN                                                           SPRECGC
            BEGIN                                                        SPRECGC
            DEFINT = TRUE;                                               SPRECGC
            DEFCHR = FALSE;                                              SPRECGC
            END                                                          SPRECGC
          GOTO PCDNXT;
PCDLTR:   #LETTER DELIMITS DIGIT STRING#
          PGIX=0; 
          CSTAKP=CSTAKP+1;       #BACK UP TO CATCH LETTER AGAIN#
          GOTO PREOUT;
  
PCTPAM: 
       IF CCHAR EQ ENDDEF THEN
         BEGIN
         TPYX = SPTRW;
         SPTRW = DTXTENTRY[SPTRW]; # UNSTACK SPTRW #
         TPYY = PARLNK[ MACNAMED[SPTRW]] ;   # 1ST PARAM  # 
         FOR TPYZ = SPTRW+1 STEP 1 UNTIL TPYX-1 DO
           BEGIN
           SPTR[TPYY] = DTXTENTRY[TPYZ];
           TPYY = PARLNK[TPYY];   # NEXT PARAM  # 
           END
         CCHAR = " "; 
         GOTO PCTBLK; 
         END
       ELSE 
         CCHAR = "?"; 
                 GOTO PCLLDG;                                            NEWFEAT
PCTOTH:   #DONE THIS STRING OR INTEGER# 
          IF PGIX NQ 8 AND PGIX NQ 10 
                   THEN PGIX =0;
                      ELSE  #CHECK FOR DELIMITER BEGING QUOTE OR PRIME   NEWFEAT
                              IN CONTEXT#                                NEWFEAT
                         CHECKCNTX;                                      NEWFEAT
          CRNO[ARG]=CRDN; 
          ARG=FLNK[ARG];
          CSNR[ARG]=SCCN[CCHAR];
          CSDF[ARG] = FALSE;
      $BEGIN                                                             NOV04
      DMPCSNR("SPRECG.3..");       # IF *=0 DUMP THE CONSTRUCT STRING  # NOV04
      $END                                                               NOV04
PREOUT:   CRNO[ARG]=CRDN; 
          ARG=FLNK[ARG];
           IF CSNR[ARG] NQ 0 THEN    # CONSTRUCT STRING OVERFLOW   #     L414 
        SYMABT(J864,"UNINTERPRETABLE SOURCE/EXPRESSION TOO LONG(SPRECG)" SPRECG 
               ,50);                                                     SPRECG 
          RETURN; 
  
  
PCTLTR:   #    PROCESS FIRST LETTER OF NAME#
          PGIX=4;                       #FLAG FOR EOF ROUTIND#
PCTLTR8:                                                                 NEWFEAT
          NCAR=1; 
          CSNR[ARG]=CLIST"PLTR";
          CSDF[ARG] = FALSE;
      $BEGIN                                                             NOV04
      DMPCSNR("SPRECG.4..");       # IF *=0 DUMP THE CONSTRUCT STRING  # NOV04
      $END                                                               NOV04
          NAMARR[0]="      "; 
          NAMC1[0]=CCHAR;               #STORE FIRST CHAR#
PCLNXT:   SNEXT;                        #KEEP BLANKS# 
          GOTO PCTPL[PCTP[CCHAR]];      #SWITCH ON TYPE OF NEXT CHAR# 
  
PCLLDG:   #PROCESS MORE OF SAME NAME# 
          NCAR=NCAR+1;
          IF NCAR LQ IDLEN THEN GOTO NCARS[NCAR]; 
          GOTO PCLNXT;
N0:N1:    #DUMMIES# 
N2:       NAMC2  [0]=CCHAR;  GOTO PCLNXT; 
N3:       NAMC3  [0]=CCHAR;  GOTO PCLNXT; 
N4:       NAMC4  [0]=CCHAR;  GOTO PCLNXT; 
N5:       NAMC5  [0]=CCHAR;  GOTO PCLNXT; 
N6:       NAMC6  [0]=CCHAR;  GOTO PCLNXT; 
N7:       NAMC7  [0]=CCHAR;  GOTO PCLNXT; 
N8:       NAMC8  [0]=CCHAR;  GOTO PCLNXT; 
N9:       NAMC9  [0]=CCHAR;  GOTO PCLNXT; 
N10:      NAMC10 [0]=CCHAR;  GOTO PCLNXT; 
N11:      NAMARR[1]=" ";    NAMC1[1]=CCHAR;  GOTO PCLNXT; 
N12:      NAMC2  [1]=CCHAR;  GOTO PCLNXT; 
  
EOFOUT:   RETURN; 
     END  #OF  SPRECG#
TERM
