*DECK             PF11
USETEXT   TSOURCE 
USETEXT   TSYMCNS 
USETEXT   TCEXECQ 
USETEXT   TSYMC5Q 
USETEXT   TSTABLE 
USETEXT   TCOM37Q 
USETEXT   TCEXEC
USETEXT   TSYMC5
      PROC PF11;
      BEGIN 
#**********************************************************************#
#                                                                      #
#     PF11 - SYMPL SCAN 1 PRAGMATIC FUNCTIONS                          #
#                                                                      #
#**********************************************************************#
  
  
  
  
#     COMDECKS                                                         #
  
*CALL COMEX 
  
*CALL SPFSW1
*CALL NUMCOM                                                             SMPA029
                                                                         NOV04
*CALL REALCOM                                                            NOV04
  
  
  
  
#     XREFS                                                            #
  
XREF BEGIN
     PROC ABORT;
     PROC BINDEC;                                                        NOV04
     PROC BLDREAL;                                                       NOV04
     PROC B$KT; 
     PROC DEBUG;
     PROC DEFEXP; 
     PROC FPLINK; 
     PROC NXTCHR; 
     PROC SYMABT;                                                        PF11 
     PROC PCONS;
     PROC PNAM; 
    PROC DTXTNAM; 
     PROC POSTNN; 
     PROC POW;
     PROC DIAG;                                                          PF11 
     PROC DIAG0;                                                         PF11 
     PROC S$EMI;
     PROC SOVER;
     PROC SRCH; 
     PROC XRUSE;
     PROC XUSE; 
      ITEM SKIPOF$; 
      ITEM SPQR;
      ITEM PGIX8LTR B;
     END
        XREF PROC LOOKUP; 
      XREF PROC SPRECG; 
  
     XREF ITEM DEFINT B;                                                 PF11C
  
  
  
#     LOCAL DATA                                                       #
  
      $BEGIN                                                             NOV04
      XREF PROC DMPCSNR;                                                 NOV04
      $END                                                               NOV04
      ITEM BECNT; 
          ITEM LNAM$ ;
      ITEM DLIM,NPCNT,DEFNAM,LAST B;                                     NEWFEAT
          ITEM  ASAVECCHAR ;                                             NEWFEAT
          ITEM HALFBW  U=O"00550055005500550055" ;                       NEWFEAT
          ITEM PARAMM B;      #FLAG TO DIFFERENTIATE MACROS / PARAMETS#  NEWFEAT
          ITEM MCAR;                                                     NEWFEAT
      ITEM SAVARG;
          ITEM   TPYRT       I;    # TYPE OF REAL ITEM (SINGLE/DOUBLE) # NOV04
                                                                         NOV04
                                                                         NOV04
                                                                         NOV04
#     DIAGNOSTIC DEFS                                                  # PF11C
                                                                         NOV04
      DEF D001 #  1#;        #DIAGNOSTIC   1#                            NOV04
      DEF D004 #  4#;        #DIAGNOSTIC   4#                            NOV04
      DEF D005 #  5#;        #DIAGNOSTIC   5#                            NOV04
      DEF D006 #  6#;        #DIAGNOSTIC   6#                            NOV04
      DEF D007 #  7#;        #DIAGNOSTIC   7#                            NOV04
      DEF D008 #  8#;        #DIAGNOSTIC   8#                            NOV04
      DEF D009 #  9#;        #DIAGNOSTIC   9#                            NOV04
      DEF D060 # 60#;        #DIAGNOSTIC  60#                            SMPA029
      DEF D120 #120#;        #DIAGNOSTIC 120#                            NOV04
      DEF D123 #123#;        #DIAGNOSTIC 123#                            NOV04
      DEF D138 #138#;        #DIAGNOSTIC 138#                            NOV04
      DEF D144 #144#;        #DIAGNOSTIC 144#                            NOV04
      DEF D148 #148#;        #DIAGNOSTIC 148#                            NOV04
      DEF D152 #152#;        #DIAGNOSTIC 152#                            NOV04
      DEF D158 #158#;        #DIAGNOSTIC 158#                            NOV04
      DEF D160 #160#;        #DIAGNOSTIC 160#                            NOV04
      DEF D161 #161#;        #DIAGNOSTIC 161#                            NOV04
      DEF D162 #162#;        #DIAGNOSTIC 162#                            NOV04
      DEF D163 #163#;        #DIAGNOSTIC 163#                            NOV04
      DEF D165 #165#;        #DIAGNOSTIC 165#                            NOV04
      DEF D164 #164#;        #DIAGNOSTIC 164#                            NOV04
      DEF D182 #182#;        #DIAGNOSTIC 182#                            NOV04
      DEF D195 #195#;        #DIAGNOSTIC 195#                            PF11C
      DEF D200 #200#;        #DIAGNOSTIC 200#                            PF11C
      DEF J816 #816#;        # SYMABT DIAGNOSTIC 816                   # PF11 
      DEF J817 #817#;        # SYMABT DIAGNOSTIC 817                   # PF11 
      DEF J818 #818#;        # SYMABT DIAGNOSTIC 818                   # PF11 
  
  
  
  
#     DEFS                                                             #
  
      DEF CSRF$ #CSRF[POZN] = CSRF[BLNK[POZN]];#; 
                 DEF SPECCHAR # O"100"  #  ;                             NEWFEAT
          DEF SIG$DIGITS     #15#; # NR SIGNIF. DIGITS IN A F.P. CONST # SMPA029
          DEF MAX$DIGITS     #18#; # APPROX MAX DIGITS IN 60 BITS      # SMPA029
##       CONTROL EJECT; 
      PROC BEMATCH((I));
##       BEGIN
  
  
      ITEM I B;              #T = BEGIN/$BEGIN, F = END/$END           #
##           ITEM BENUM I = 0;
  
  
##       BASED ARRAY $$BEM[0:0];; 
##       P<$$BEM> = LOC(CWORD) - 1; 
##           IF I THEN BEGIN
##               BENUM = BENUM + 1; 
##               WCHAR0[-1] = "B";
##            BINDEC($$BEM,1,BENUM,2);
##           END
      ELSE
          BEGIN 
##           WCHAR0[-1] = "E";
##            BINDEC($$BEM,1,BENUM,2);
##           BENUM = BENUM - 1; 
          END 
##       END
          CONTROL EJECT;
          # PROC FOR PACKING CCHAR INTO ZCHRB#                           NEWFEAT
   PROC PACKCCHAR;                                                       NEWFEAT
        BEGIN                                                            NEWFEAT
                B<TPYA,12> CHRBUF[TPYB] = CCHAR;                         NEWFEAT
                TPYA = TPYA + 12 ;                                       NEWFEAT
     $BEGIN                                                              NEWFEAT
  IF DEBFLG  EQ 1 THEN BEGIN                                             NEWFEAT
     PRINT (" (   10H CHAR10 =         ,O20,O20)");                      NEWFEAT
     LIST (CHRBUF[TPYB] ) ;   LIST (TPYB) ;  ENDL;                       NEWFEAT
   END    $END                                                           NEWFEAT
                IF TPYA GQ CMPAR3  THEN BEGIN                            NEWFEAT
                                       TPYA = 0;                         NEWFEAT
                                       TPYB = TPYB + 1;                  NEWFEAT
                                IF TPYB + 2 LQ CMPR13*2 THEN
                                       CHRBUF[TPYB] = HALFBW ;           NEWFEAT
                                       END                               NEWFEAT
                RETURN;                                                  NEWFEAT
        END                                                              NEWFEAT
         CONTROL EJECT; 
#      THIS IS THE BEGINNING OF CODE FOR PF11.  IT IS SIMPLY A SWITCH  #
#     TO THE APPROPRIATE PRAGMATIC FUNCTION.                           # DON/D
  
          $BEGIN IF DMPFLG EQ 1 THEN PRINTLABEL1;   $END
  
GOTO SWDF11[DEFN];
  
  
  
  
DFER: 
      SYMABT(J816,"NO PRAGMATIC FUNC(PF11)",23);                         PF11 
  
#***********************************************************************
                                                  SCAN ONE
                                                  PRAGMATIC FUNCTIONS 
***********************************************************************#
  
DEBUG8:  #:      (SPBEGN)==(BEGIN2)    #
      BEMATCH(TRUE);
        IF DEBCOD  NQ 0  THEN GOTO DBEND2;
      WCHAR4[-1] = "-";      #INDICATE CODE SKIPPED ON LISTING# 
          SKIPOF$ = 0;                                                   NEWFEAT
        BECNT = 1;
      SAVARG=ARG; 
DEBUGL:                                                                  L414 
          ARG = SAVARG;                                                  L414 
          CSNR[ARG] =0;                                                  L414 
          CSNR[FLNK[ARG]] = 0;                                           L414 
      $BEGIN                                                             NOV04
      DMPCSNR("PF11......");       # IF *=0 DUMP THE CONSTRUCT STRING  # NOV04
      $END                                                               NOV04
          SPRECG;                                                        L414 
  
#         JIF AN EOF OCCURRED ON INPUT FILE WHILE PROCESSING SOURCE 
          STATEMENTS FOLLOWING A $BEGIN.  # 
  
          IF CSNR[SAVARG] EQ CLIST"NOTERM" THEN GOTO DBEND; 
      IF CSNR[SAVARG] NQ CLIST"PLTR" THEN GOTO DEBUGL;
        TPYA=NCAR;
        IF NCAR GR IDLEN THEN TPYA = IDLEN; 
        LOOKUP(ZNAMR,TPYA,TPYB);
        IF TPYB EQ 0 THEN GOTO DEBUGL;
          IF NCSR[TPYB] EQ CLIST"NOTERM"                                 L414 
                                                                         L414 
             THEN GOTO DBEND; 
        IF NCSR[TPYB] EQ CLIST"SPBEGN"  THEN  BEGIN 
             BECNT=BECNT+1; GOTO DEBUGL; END
        IF NCSR[TPYB]  EQ  CLIST"SPEND"   THEN BEGIN
             BECNT=BECNT-1; 
             IF BECNT EQ 0 THEN GOTO DBEND;  END
        GOTO DEBUGL;
DBEND:  PGIX=7;  #SET TO RESCAN LAST ITEM#
DBEND2: 
          SKIPOF$ = 1 ;       #CLEAR - IN COL J[-1]#                     NEWFEAT
      GOTO L$$; 
DEBUG9:   #    (SPEND)==(END2)     #
      BEMATCH(FALSE); 
L$$:  
          CSRF[POZN]=DEBCOD;  #IN HIBIT CODE IF ZERO# 
          GOTO OW20A;         #FINISH LIKE BEGIN AND END# 
ON5:      #    TEST(LETTER)==(ANY)  WHOLE NAME IN # 
          TPYA=NCAR;
          DSFTP=DESFLG;                           #STORE FLAGS IN TEMP# 
          SCFTP=SCXFLG; 
          DXFTP=DCXFLG; 
          DCXFLG=0;                               #CLEAR FLGS#
          DESFLG=0; 
          SCXFLG=0; 
          IF NCAR GR IDLEN THEN TPYA=IDLEN;       #TOO LONG#
          PNAM(ZNAMR,TPYA,NSEC);
      IF NCAR GR IDLEN
      THEN
          DIAG(D001,NSEC);   #TOO LONG MESSAGE# 
#NAME IS COLLECTED AND POSTED--CHECK FOR STATUS CONSTANT USAGE# 
          IF SCFTP NQ 0 THEN                      #STATUS CONSTANT# 
               BEGIN     #SCXFLG IS 1 FOR USE-SHOULD COME OUT (STSNAM). 
                          SCXFLG IS 2 FOR DEFINITION--SHOULD FAIL 
                              THIS TEST AND COME OUT (DECNAM) LATER#
               RPLI=S"STSNAM"*(2-SCFTP);          #HEE HEE HEE# 
               RETURN;
               END
#NOW CHECK FOR RESERVED WORD USE--EXCEPT IN STATUS CONSTANTS, 
     EVERY OCCURRENCE OF A RESERVED WORD DENOTES THE WORD ITSELF# 
  
          RPLI=NMCSTR[NSEC];   #NONZERO FOR RESERVED WORDS# 
          RETURN;                       #AN APPLE A DAY IS LOATHESOME#
  
  
  
  
ON6:      #TEST (LETTER)==(DECNAM) UP---TEST DECLARATIVE CONTEXT--- 
          AT THIS POINT A SEARCH IS MADE FOR PRIOR VALID DECLARATIONS9
          THE RESULTS OF THE PRIOR DECLARATION SEARCH ARE USED LATER
          IF THE NAME IS NEITHER IN DECLARATIVE OR DESCRIPTOR CONTXT# 
          PVDF=0; 
          CSRF[POZN]=NSEC;                        #PUT NAME LINK IN STR#
          SRCH (NSEC,FOUND,DSEC);       #FIND OLD DECLARATION#
ON6A:     IF FOUND THEN 
               BEGIN
               IF ENDM[SBEG[DSEC]] THEN #SCOPE CLOSED--TRY AGAIN# 
                    BEGIN 
                    SOVER (DSEC); 
                    GOTO ON6A;
                    END 
               PVDF=DSEC;               #VALID PRIOR DEC FOUND# 
               END
          RPLI=DXFTP;                             #0 FOR USE--1 FOR DEF#
          RETURN; 
  
  
  
  
ON7:      #TEST (NAME)==(DESCR) 
               DESFLG=0 FOR NO DESCRIPTOR ANTICIPATED 
               DESFLG=1 FOR TYPE DESCRIPTOR ANTICIPATED 
               DESFLG=2 FOR LAYOUT LETTER ANTICIPATED#
          IF DSFTP EQ 0 THEN RETURN;
          IF NCAR NQ 1   THEN RETURN;   #ZILCH# 
#ARRAY DLTR HAS BEEN SET TO THE NAME-SECTION POINTERS FOR LETTERS---
               SUBSCRIPT      LETTER
               0              I 
               1              R 
               2              D 
               3              B 
               4              C 
               5              S 
               6              P 
               7              O 
               8              X 
               9              U 
              10              A                                          MIS
               #
  
SWITCH ON7S    #THIS SWITCH DEFINES JUMP POINTS FOR THE DIFFERENT 
               COMBINATIONS OF THE LETTER AND DESFLG# 
  
#FOR DESFLG=1: I    R    D    B    C    S    P    O    X    U    A     # MIS
               ON7A,ON7A,ON7A,ON7A,ON7A,ON7A,ON7B,ON7B,ON7B,ON7A,ON7B,   MIS
  
#FOR DESFLG=2: I    R    D    B    C    S    P    O    X    U    A     # MIS
               ON7B,ON7B,ON7B,ON7B,ON7B,ON7A,ON7A,ON7B,ON7B,ON7C,ON7D;   MIS
  
          FOR TPYA = 0 STEP 1                                            MIS
            UNTIL NDLTR            #NUMBER OF DESCRIPTOR LETTERS       # MIS
          DO                                                             MIS
            BEGIN                                                        MIS
            IF DLTR[TPYA] EQ NSEC                                        MIS
            THEN                                                         MIS
              BEGIN                                                      MIS
              GOTO ON7S [ (NDLTR + 1) * (DSFTP - 1) + TPYA ];            MIS
              END                                                        MIS
            END                                                          MIS
                                                                         MIS
ON7B:     #FAILURE# 
          RETURN; 
ON7A:     #SUCCESS# 
          CSRF[POZN]=DLTT[TPYA];                  #TYPE#
          ITMTYP = DLTT[TPYA];                                           PF11C
          RPLI=1; 
          RETURN; 
  
ON7C:     #SUCCESS FOR UNALIGNED STRUCTURE                             # MIS
          ALOC = S"UNALIGN";                                             MIS
          GOTO ON7D1;                                                    MIS
                                                                         MIS
ON7D:     #SUCCESS FOR ALIGNED STRUCTURE                               # MIS
          ALOC = S"ALIGN";                                               MIS
                                                                         MIS
ON7D1:                                                                   MIS
          AORU = TRUE;             #A OR U DESCRIPTOR LETTER SEEN      # MIS
          RPLI = 1;                #PERFORM REPLACEMENT                # MIS
          MISFBIT = 0;             #NEXT MIS BIT POSITION TO ALLOCATE  # MIS
          MISEP = 0;               #NEXT MIS WORD IN WHICH TO ALLOCATE # MIS
          RETURN;                                                        MIS
  
  
  
ON11:     #    TEST (LETTER)(LPOINT)==(BFHEAD)        B OR C     #
          IF NSEC EQ DLTR[DLTRB] THEN RPLI=QBEADC"BIT"; 
                 ELSE 
          IF NSEC EQ DLTR[DLTRC] THEN RPLI=QBEADC"BYTE";
          IF RPLI NQ 0 THEN CSRF[POZN]=RPLI;
          RETURN; 
  
  
  
  
ON12:     #TEST(LETTER)(LPOINT)==(PHFEAD)    P# 
          IF NSEC EQ DLTR[DLTRP] THEN RPLI=1; 
          RETURN; 
  
  
  
  
# NOW TEST FOR VALID PRIOR DECLARATION #
ON84:     #TEST(POSLBL)==(ANY)# 
ON13:     #    TEST(LETTER)==(ANY)      # 
          IF PVDF EQ 0 THEN RETURN;     #MISS#
          RPLI=CSTR[PVDF];
          CSRF[POZN]=PVDF;
          PLNAM=LNAME[  BRKLEV];                  #SAVE LAST NAME#
          LNAME[BRKLEV]=PVDF;                     #FOR STAT CONST REC#
          RETURN; 
  
  
  
  
ON73:     #    (SSDTLP)(UND)==(SSDTLP)(LABNAM)         #
ON75:     #    (SWDDCN)(UND)==(SWDDCN)(LABNAM)    # 
ON76:     #    (SSDT)(UND)==(SSDT)(LABNAM)   #
ON77:     #    (SSDH)(STLNAM)(UND)==(SSDH)(STLNAM)(LABNAM)  # 
ON72:     #(GOTO)(UND)==(GOTO)(LABNAM)# 
ON74:     #(SWTOP)(UND)==(SWTOP)(LABNAM)# 
          #NOTE THAT NAMES WHICH ARE USED BEFORE DECLARATION ARE TREATED
          SYNTACTICALLY IN A MANNER IDENTICAL WITH THAT USED FOR FPARS--
          ACCORDINGLY, FPARS ARE GIVEN A CSTR OF (UND) AND COME HERE
          ALONG WITH NORMAL FORWARD REFERENCES# 
          TPYA=CSRF[POZN];                        #NAME OR OTHER DEC# 
          #NOTE--   IF THE (UND) ARISES AS A FALL-THRU CASE, FOR AN 
                    UNDEFINED NAME, THEN TPYA IS SET TO THE POINTER TO
                    THE NAME ENTRY.  IF IT ARISES AS THE RESULT OF A
                    SUCCESSFUL LOOKUP OF AN FPAR OR DUMY, THEN TPYA 
                    WILL POINT TO THAT ENTRY.  THEREFORE, NSEC IS THE 
                    SAME AS TPYA ONLY FOR THE FORMER CASE#
          POW(NSEC,LABWDS,QCLAS"LABL",CLIST"LABNAM"); 
          DECL[DSEC]=S"NONE"; 
ON74Y:  
          IF NSEC NQ TPYA THEN                    #IT WAS OTHER#
               BEGIN
               IF CLAS[TPYA] EQ S"FPAR" THEN
                    BEGIN 
                    FPLINK(TPYA,DSEC);       #GOTO FORMAL PAR LABEL#
                    IF FPRI[TPYA] EQ S"VALU" THEN DIAG0(D152);           PF11 
ON74W:              IF CLAS[DSEC] EQ S"DUMY" THEN RETURN;#DONT ASEQ#
                    ASEQ[LENT[DPLC]]=DSEC;   #ADD TO DATA CHAIN#
                    LENT[DPLC]=DSEC;
                    RETURN; 
                    END 
      IF CLAS[TPYA] NQ S"DUMY"
      THEN
          SYMABT(J817,"BAD UNDEF ID AT ON74W(PF11)",27);                 PF11 
               RLNK[TPYA]=DSEC;         #RESOLVE DUMMY TO LABEL#
               LREF[DSEC] = LREF[DSEC] + LREF[TPYA];
               FPRI[DSEC]=FPRI[TPYA];   #CARRY PAR STATUS OF DUUMY# 
               IF FPRI[DSEC] NQ 0 THEN GOTO ON74W;     #DATA CHAIN# 
      IF FPRI[TPYA] EQ S"VALU"
      THEN
          DIAG0(D152);                                                   PF11 
               END
          #THE NEW ENTRY MUST NOW BE CHAINED INTO FLCH, SINCE IT IS 
               A FORWARD LABEL REFERENCE AND MUST BE CHECKED AT END OF
               SCOPE# 
          #NEW DUMMY ENTRIES ARE ALSO PUT ON FLCH HERE# 
          IF FLCH[DSEC] EQ 0 THEN BEGIN  #DONT DARE LOOP FLCH CHAIN#     NEWFEAT
          FLCH[DSEC]=FLCHED[SCOPE]; 
          FLCHED[SCOPE]=DSEC; 
          END                                                            NEWFEAT
          RETURN; 
  
  
  
  
ON78:     #    (UND)==(UNDNAM)          # 
          #THE NAME MAY BE LATER DISCOVERED (BY SCAN THREE) TO BE IN
          LEGITIMATE CONTEXT FOR PROCEDURE NAMES--BUT FOR NOW IT WILL 
          BE POSTED AS A DUMMY, WHICH WILL POINT TO THE PROCEDURE ENTRY 
          IF AND WHEN IT ARISES--ALL THIS BECAUSE TO SAVE ENOUGH
          INFORMATION FOR SCAN THREE TO POST A DUMMY IS HARD# 
          IF CLAS[CSRF[POZN]] EQ S"DUMY" AND
             SBEG[CSRF[POZN]] EQ SCOPE       THEN RETURN;  #OLD DUMMY#
          TPYA=CSRF[POZN];
          POW(NSEC,DUMWDS,QCLAS"DUMY",CLIST"UND");
          SBEG[DSEC]=0;                           #NOT VALIDATED# 
          GOTO ON74Y; 
  
  
  
#OCTAL AND HEXADECIMAL CONSTANT HANDLING# 
  
ON9:      #TEST(LETTER)(PRIME)==(OXHEAD)# 
          IF NSEC EQ DLTR[DLTRO] THEN RPLI =1;    #OCTAL# 
                 ELSE 
          IF NSEC EQ DLTR[DLTRX] THEN RPLI =2;    #HEX# 
          IF RPLI EQ 0 THEN RETURN;               #NOTHING# 
          PGIX=2;                                 #FIX PRICOG FOR SCAN# 
          DIVAL=0;
          TPYA=RPLI;                    #1=O,2=X# 
          RETURN; 
  
  
  
  
OX33:     #    (OXHEAD)(DDIGIT)==(OXHEAD)    #
OXC3:     #(OXHEAD)(XDIGIT)==(OXHEAD)  MUST BE HEX# 
          IF TPYA EQ 1 THEN TPYA=3;     #ERROR CODE#
  
  
  
  
OXC2:     #    (OXHEAD)(ODIGIT)==(OXHEAD)    #
##       IF TPYA EQ 1 THEN #OCTAL#
              DIVAL=DIVAL*8 LOR SCVL[CCHAR];
         ELSE#HEX#
              DIVAL=DIVAL*16 LOR SCVL[CCHAR]; 
          RETURN; 
  
  
  
  
OX34:     #    (OXHEAD)(QUOTE)==(OXHEAD)     #
          PGIX=6;                  #SET TO DESTRUCTIVE PRECOGNITION#
          RETURN; 
  
  
  
  
OXC5:     #    (OXHEAD)(ANY)==(DICON)   RESTORE--ERROR CASE#
          TPYA=3;                       #ERROR CODE#
  
  
  
  
OXC4:     #    (OXHEAD)(PRIME)==(DICON)      #
          PGIX=0;                       #RESTORE PRECOGNITION#
          IF TPYA EQ 3 THEN             #BAD CONSTANT#
               BEGIN
          DIAG0(D004);                                                   PF11 
               TPYB=0;                  #0 VALUE FOR ERROR FORMS# 
               END
          ELSE TPYB=DIVAL;
          PCONS(TPYB,CMPR12,QTYPE"IGR");
          RETURN; 
  
  
  
  
ONTR1:    #    (NOTERM)==(TERM)    #
ONTR2:    #    (BADSTR)==(TERM)    #
ONTR3:    #    (BADCOM)==(TERM)    #
OPS25:    #    (CSH)(BADSTR)==(TERM)    # 
OQS25:    #    (DSTRHD)(BADSTR)==(TERM) # 
OXC6:     #    (OXHEAD)  ==   (TERM)    # 
          DIAG0(D005);                                                   PF11 
          RETURN; 
  
  
  
  
ODNE41:  #             (DEFMAC) == (NULL)          #                     NEWFEAT
ODNE45:  #             (DFMLHP) == (DFMBAD)        #                     NEWFEAT
ODNE49:  #             (DFMLPP) == (DFMBAD)        #                     NEWFEAT
ODNE51:  #             (DFMLPQ) == (DFMBAD)        #                     NEWFEAT
ODNE54:  #             (DFMLPL) == (DFMBAD)        #                     NEWFEAT
ODNE56:  #             (DFMLQQ) == (DFMBAD)        #                     NEWFEAT
          DIAG0(D165);                                                   PF11 
        RETURN;                                                          NEWFEAT
  
  
  
ODNE57:  #     (DFMBAD)(SEMI)   == (NULL)          #                     NEWFEAT
          DIAG0(D164);                                                   PF11 
        RETURN;                                                          NEWFEAT
  
  
  
  
#CHARACTER CONSTANT HANDLING# 
  
OQS2:     #    (DDECSG)(QUOTE)==(DDECSG)(DSTRHD)  # 
OPS13:    #    (PRIME)==(CSH) # 
          PGIX=1;                  #FOR CHARACTER COLLECTION# 
          MACRO = FALSE;                                                 NEWFEAT
OQS2A:     #JOINED BY(DMACSG)#                                           NEWFEAT
          NCAR=0; 
          TPYA=0; 
          TPYB=0; 
          CHRBUF[0]=BLANKW;   #WORD OF BLANKS#
          CHRBUF[1]=BLANKW;        #WORD OF BLANKS# 
          CHRBUF[2]=BLANKW; 
          RETURN; 
  
  
  
  
  
  
  
OQS23:    # (DMACSG)(QUOTE)   ==  (DMACSG)(DSTRHD) #                     NEWFEAT
          PARAMM = FALSE;                                                NEWFEAT
OQS23A:                                                                  NEWFEAT
          PGIX = 8 ;    #SET PRECOG TO RETURN ID S UNLESS IN QUOTES OR   NEWFEAT
                        PRIMES, OTHERWISE SINGLE CHARACTERS#             NEWFEAT
          SPQR = 0;   #START AT OPEN QUOTE LEVEL#                        NEWFEAT
           MCAR = 0 ;                                                    NEWFEAT
          MACRO = TRUE; #ITS A MACRO#                                    NEWFEAT
          NCAR = 0;                                                      NEWFEAT
          TPYA =0;                                                       NEWFEAT
          TPYB =0;                                                       NEWFEAT
          CHRBUF[0] = HALFBW;                                            NEWFEAT
          CHRBUF[1] = HALFBW;                                            NEWFEAT
          CHRBUF[2] = HALFBW;                                            NEWFEAT
          RETURN;                                                        NEWFEAT
  
  
  
  
OPS24:    #    (CSH)(ANY)     ==   (CSH)     #
          NCAR=NCAR+1;
##       IF NCAR LQ CHRLEN THEN C<TPYA>CHRBUF[TPYB] = CCHAR;
               TPYA=TPYA+1; 
               IF TPYA GQ CMPR12 THEN  #  NEXT WORD#
                    BEGIN 
                    TPYA=0; 
                    TPYB=TPYB+1;
                    IF TPYB+2 LQ CMPR13 THEN CHRBUF[TPYB+2]=BLANKW; 
                    END 
          RETURN; 
  
  
  
  
OQS22:    #    (DSTRHD)(ANY)==(CSTRHD)  # 
ODNE60:        #  (DFNPLQ)  (ANY)      == (DFMPLQ )   # 
          IF NOT MACRO THEN BEGIN                                        NEWFEAT
          NCAR=NCAR+1;
          IF NCAR LQ CHRLEN THEN PACKCCHAR;                              NEWFEAT
          RETURN; 
                            END                                          NEWFEAT
                       ELSE  #MACRO#                                     NEWFEAT
                       BEGIN
                       PGIX = 8;                                         NEWFEAT
          IF NOT PGIX8LTR THEN                                           NEWFEAT
                BEGIN   #SINGLE CHARACTER #                              NEWFEAT
                   IF CCHAR EQ "?" THEN BEGIN 
                                              DIAG0(D148);               PF11 
                                            RETURN;                      NEWFEAT
                                      END                                NEWFEAT
                 MCAR = MCAR + 1 ;                                       NEWFEAT
          IF MCAR LQ CHRLEN - 2 THEN PACKCCHAR;                          NEWFEAT
                                #LEAVE ROOM FOR 2 EXTRA#                 NEWFEAT
                 RETURN;                                                 NEWFEAT
                 END                                                     NEWFEAT
          # PLTR MEANS A PARAMETER THAT MAY BE SUBSTITUTABLE#            NEWFEAT
          PGIX8LTR = FALSE;                                              NEWFEAT
          ASAVECCHAR = CCHAR ;  #SAVE TERMINATING SYMBOL#                NEWFEAT
          IF NCAR GR IDLEN THEN TMP1 = IDLEN;                            NEWFEAT
                           ELSE TMP1 = NCAR;                             NEWFEAT
          PNAM(ZNAMR,TMP1,NSEC);  #PUT ID INTO SYMBOL TABLE#             NEWFEAT
      IF NCAR GR IDLEN
      THEN
          DIAG(D001,NSEC);
          NCAR = TMP1;                                                   NEWFEAT
          IF NOT PARAMM THEN                                             L428 
          BEGIN                                                          L428 
            # IF NOT IN DEFINITION - CHECK FOR SUBSTITUTABLE APARAM   #  L428 
          #NOW LOOK FOR ANY OF THE DEF PARAM IDS #                       NEWFEAT
          FOR TMP1 = 1 STEP 1 UNTIL NPAR DO   #FOR EACH PARAM#           NEWFEAT
          IF NSEC EQ DPNAM [TMP1] THEN                                   NEWFEAT
                     BEGIN NSEC = DPGEN [TMP1];                          NEWFEAT
                           NCAR = NCHR[NSEC] ; #FIND NO OF CHARS IN      NEWFEAT
                                                ACTUAL NAME#             NEWFEAT
                     END                                                 NEWFEAT
          END                                                            NEWFEAT
          TMP2 = 0;                                                      NEWFEAT
          TMP3  = NAME[NSEC];      #I AM ABOUT TO ASSUME THAT 2 WORDS    NEWFEAT
                                    HOLD A NAME #                        NEWFEAT
          FOR TMP1 = 1 STEP 1 UNTIL NCAR DO                              NEWFEAT
                    BEGIN                                                NEWFEAT
                 CCHAR =  C<TMP2> TMP3 ;                                 NEWFEAT
                 IF CCHAR EQ "?" THEN CCHAR =SPECCHAR ;                  NEWFEAT
                 TMP2  =  TMP2 +1 ;                                      NEWFEAT
               IF TMP2 EQ CMPR12 THEN BEGIN      TMP2=0;
                                           TMP3 = NAME[NSEC + 1];        NEWFEAT
                                     END                                 NEWFEAT
                 MCAR = MCAR + 1 ;                                       NEWFEAT
              IF MCAR LQ CHRLEN-2 THEN PACKCCHAR;                        NEWFEAT
                     END                                                 NEWFEAT
            # THUS SAVING EITHER THE ORIGINAL ID OR THE MANUFACTURED     NEWFEAT
                                                          ONE #          NEWFEAT
          CCHAR = ASAVECCHAR ;   # RESTORE TERMINATOR FOR NEXT INPUT#    NEWFEAT
          RETURN;                                                        NEWFEAT
                       END                                               NEWFEAT
  
  
  
  
OPS22:    #    TEST(CSH)==(CONST)  #
          IF NCAR LS CHRLEN THEN RETURN;     #OK# 
          DIAG0(D009);             # CHARACTER STRING TRUNCATED        # PF11 
          GOTO OPS23;    #TRUNCATE CONSTANT--TOO LONG#
  
  
  
  
OPS21:    #    TEST(CSH)(PRIME)==(CONST)     #
          NXTCHR;   #INSPECT NEXT CHARACTER FOR PRIMITUDE#
          IF CCHAR EQ CCPRIM THEN GOTO OPS24;  # GOTO STRING COLLECT# 
OPS23:    RPLI=1;        #END OF CONSTANT STRING# 
          PGIX=0;                       #RESTORE PRECOGNITION#
          IF NCAR EQ 0 THEN NCAR =1;
          PCONS(ZCHRB,NCAR,QTYPE"EBCD");
          IF PRSFLG NQ 0                                                 PF11C
          THEN                                                           PF11C
            BEGIN  # PRESET #                                            PF11C
            IF ITMTYP NQ QTYPE"EBCD"                                     PF11C
            THEN  # CHARACTER CONSTANT PRESET AND NON-CHAR ITEM        # PF11C
              BEGIN  # ISSUE DIAG #                                      PF11C
              DIAG0(D195);                                               PF11C
              END  # ISSUE DIAG #                                        PF11C
            END  # PRESET #                                              PF11C
          RETURN; 
  
  
  
  
#BOOLEAN CONSTANT HANDLING# 
  
OBC30:    #    (TRUE)==(CONST)     #
          TPYA=1; 
          GOTO OBC32; 
  
  
  
  
OBC31:    #(FALSE)==(CONST)#
          TPYA=0; 
OBC32:    PCONS(TPYA,CMPR12,QTYPE"BOOL");     #POST BOOLEAN CONSTANT# 
          IF PRSFLG NQ 0                                                 PF11C
          THEN                                                           PF11C
            BEGIN  # PRESET #                                            PF11C
            IF ITMTYP NQ QTYPE"BOOL"                                     PF11C
            THEN  # BOOLEAN CONSTANT PRESET AND NON-BOOLEAN ITEM       # PF11C
              BEGIN  # ISSUE DIAG #                                      PF11C
              DIAG0(D195);                                               PF11C
              END    # ISSUE DIAG #                                      PF11C
            END  # PRESET #                                              PF11C
          RETURN; 
  
  
  
  
#DEF NAME EXPANSION#
  
ODNE58:  #     (DFMEXP)(ANY)    == (NULL)          #                     NEWFEAT
           TPYC = 12;   #MACROS STORED AS 12 BIT CHARS#                  NEWFEAT
          MACRO =TRUE;                                                   NEWFEAT
           CSRF [BLNK [ POZN ] ] =DEFNAM ;                               NEWFEAT
           GOTO ODNE2A;                                                  NEWFEAT
  
  
  
  
ODNE2:    #(DEFNAM)(ANY)==(NULL)# 
           TPYC = 12;  MACRO = FALSE;                                    NEWFEAT
ODNE2A:                                                                  NEWFEAT
          TPYA=CCHAR; 
          TPYB=CSRF[BLNK[POZN]];                  #LINK TO DEFNAM#
          DEFEXP; 
          RETURN; 
  
  
  
  
ODNE59:  #             (DFMEXP) == (NULL)               #                NEWFEAT
            CSRF [POZN] =DEFNAM;                                         NEWFEAT
          MACRO =TRUE;                                                   NEWFEAT
           TPYC = 12;   #MACROS STORED AS 12 BIT CHARS#                  NEWFEAT
           GOTO ODNE3A;                                                  NEWFEAT
  
  
  
  
ODNE3:    #(DEFNAM)==(NULL)#
           TPYC = 12;  MACRO = FALSE;                                    NEWFEAT
ODNE3A:                                                                  NEWFEAT
          TPYA=" "; 
          TPYB=CSRF[POZN];
          DEFEXP; 
          RETURN;   #SEE MIKE LITTLEJOHN, PLEASE, FOR COMPLAINTS# 
  
#         WAIT FOR IT  ......                                            NEWFEAT
               HERE IT COMES  .....                                      NEWFEAT
            *** *** *** *** *** *** *** *** *** *** *** *** *** *** ***  NEWFEAT
                   SALLYS                                                NEWFEAT
                          OWN                                            NEWFEAT
                                MACRO                                    NEWFEAT
                                    EXPANDER                             NEWFEAT
                                      (BOM-BOM) *** *** *** *** *** ***  NEWFEAT
                      AH                            *** *** *** *** ***  NEWFEAT
                  A---AHH                               *** *** *** ***  NEWFEAT
              A---A---AHHH                                  *** *** ***  NEWFEAT
                                                                *** ***  NEWFEAT
                                                                    ***  NEWFEAT
                                                                      *  NEWFEAT
                              (UGH)                                   #  NEWFEAT
ODNE40:    #   (DEFMAC)(LPAREO) == (DFMLHP)        #                     NEWFEAT
                PARAMM = TRUE;   # INDICATE MACRO EXPANSION  #           L428 
           DEFNAM = CSRF[BLNK[POZN]];                                    NEWFEAT
           DLIM = 0;           LAST = FALSE;                             NEWFEAT
           CURPAR = PARLNK[DEFNAM];                                      NEWFEAT
           NPAR = 0;           NPCNT=NPMC[DEFNAM];                       NEWFEAT
         MACNAMED[SPTRW] = DEFNAM;
          TPYB = PARLNK[DEFNAM];
          FOR TPYA = SPTRW + 1 STEP 1 UNTIL SPTRW + NPCNT DO
            BEGIN 
            DTXTENTRY[TPYA] = SPTR[TPYB]; 
            TPYB = PARLNK[TPYB];
            END 
            DTXTENTRY[TPYA] = SPTRW ; # LINK UP TO NEXT EMPTY SLOT  # 
          SPTRW = TPYA; 
           GOTO OQS23A;        #PROCESS LIKE DSTRHD#                     NEWFEAT
  
  
  
  
ODNE61:     #  (DEFMAC)  (BLANK)  == (DEFMAC)   # 
          CSRF[POZN] = CSRF[ BLNK[POZN] ] ; 
                   # CARRY ACCROSS DEF NAME  #
          RETURN; 
  
  
  
  
ODNE47:  # TEST(DFMLPP)(RPAREN) == (DFMEXP)        #                     NEWFEAT
          IF DLIM GR 0 THEN RETURN;  #LET 48 DO THE WORK#                NEWFEAT
          RPLI = 1;                                                      NEWFEAT
          GOTO ODNE42;                                                   NEWFEAT
  
  
  
  
ODNE46:  # TEST(DFMLPP)(COMMA)  == (DFMLHP)        #                     NEWFEAT
          IF DLIM GR 0 THEN RETURN;  #LET 48 DO THE WORK#                NEWFEAT
          RPLI = 1;                                                      NEWFEAT
          GOTO ODNE43;                                                   NEWFEAT
ODNE44:    #  TEST(DFMLHP)(ANY) == (DFMLPP)        #                     NEWFEAT
ODNE48:  # TEST(DFMLPP)(ANY)    == (DFMLPP)        #                     NEWFEAT
          IF SPQR NQ 0 THEN                                              L428 
            BEGIN                                                        L428 
            RPLI = 1;                                                    L428 
            GOTO OQS22;                                                  L428 
            END                                                          L428 
          IF NOT PGIX8LTR THEN                                           NEWFEAT
          BEGIN                                                          NEWFEAT
               FOR TMP1 = 1 STEP 1 UNTIL NBRK DO                         NEWFEAT
               BEGIN                                                     NEWFEAT
                   IF CCHAR EQ LBRK[TMP1] THEN BEGIN                     NEWFEAT
      IF DLIM GR DFMBRKD - 2
      THEN
          DIAG0(D160);                                                   PF11 
                                      ELSE                               NEWFEAT
                                          DLIM = DLIM + 1;               NEWFEAT
                                          RBRKT[DLIM] = RBRK[TMP1];      NEWFEAT
                                               END                       NEWFEAT
               END                                                       NEWFEAT
          END                                                            NEWFEAT
          IF DLIM GR 0 THEN#WITHIN PARENTHESES #                         NEWFEAT
                      BEGIN                                              NEWFEAT
                IF NOT PGIX8LTR AND CCHAR EQ RBRKT[DLIM] THEN            NEWFEAT
                               #UNSTACK TO NEXT OPEN BRACKET#            NEWFEAT
                                       DLIM = DLIM - 1;                  NEWFEAT
          IF CCHAR EQ ";" THEN RPLI = 0 ;   #DONT REPLACE SEMI#          NEWFEAT
                          ELSE RPLI = 1;                                 NEWFEAT
               GOTO OQS22;  #DONT CHECK SYNTAX OF ANYTHING IN            NEWFEAT
                                PARENTHESIS#                             NEWFEAT
                       END                                               NEWFEAT
           IF CCHAR EQ "]" OR CCHAR EQ ">" OR CCHAR EQ ";" THEN          NEWFEAT
                                   BEGIN
                                    DIAG0(D161);                         PF11 
                                           RETURN; #DONT REPLACE#        NEWFEAT
                                   END                                   NEWFEAT
           RPLI = 1;   #REPLACE ALL OTHERS#                              NEWFEAT
          GOTO OQS22;                                                    NEWFEAT
  
  
  
  
                                     #AS A NORMAL DEF#                   NEWFEAT
ODNE42:  #     (DFMLHP)(RPAREN) == (DFMEXP)        #                     NEWFEAT
ODNE53:  #     (DFMLPL)(RPAREN) == (DFMEXP)        #                     NEWFEAT
  
  
  
  
           LAST = TRUE;                                                  NEWFEAT
ODNE52:  #     (DFMLPL)(COMMA)  == (DFMLHP)        #                     NEWFEAT
ODNE55:  #     (DFMLQQ)(QUOTE)  == (DFMLPQ)        #                     NEWFEAT
ODNE43:  #     (DFMLHP)(COMMA)  == (DFMLHP)        #                     NEWFEAT
           #AND ALL OTHER PARAMETER TERMINATORS #                        NEWFEAT
          IF MCAR GR CHRLEN THEN
                                  BEGIN 
                                    DIAG0(D162);                         PF11 
                                        RETURN;                          NEWFEAT
                                  END                                    NEWFEAT
           IF MCAR NQ 0 THEN BEGIN  #NON-NULL PARAM#                     NEWFEAT
                           DTXTNAM(ZCHRB,MCAR,NSEC); #MAKE SURE ITS IN
                                                           SYMBOL TABLE# NEWFEAT
                             SPTR[CURPAR] = NSEC ;                       NEWFEAT
                             END                                         NEWFEAT
                        ELSE  #NULL PARAMETER#                           NEWFEAT
                             SPTR[CURPAR] =1;                            NEWFEAT
           NPAR = NPAR + 1 ;  #READY FOR NEXT PARAM#                     NEWFEAT
           IF LAST THEN  BEGIN                                           NEWFEAT
ODNE43A:       IF NPAR LS NPCNT THEN #SOME NULL PARAMETERS #             NEWFEAT
                                BEGIN  NPAR = NPAR + 1;                  NEWFEAT
                                       CURPAR = PARLNK[CURPAR] ;         NEWFEAT
                                       SPTR [CURPAR] = 1 ;               NEWFEAT
                                       GOTO  ODNE43A ;                   NEWFEAT
                                END                                      NEWFEAT
           PGIX = 9;   #A CRUDE FIX TO STOP SPREGC SWALLOWING (AND LOSIN NEWFEAT
                       ) RESERVED WORDS AFTER A MACRO EXPANSION#         NEWFEAT
           PARLNK[CURPAR] = CURMAC;    #SAVE NEXT OUTER MACRO NAME#      NEWFEAT
               CURMAC =DEFNAM;                                           NEWFEAT
               RETURN;                                                   NEWFEAT
                         END                                             NEWFEAT
           #A COMMA#                                                     NEWFEAT
          IF NPAR GQ NPCNT THEN 
                                BEGIN 
                                    DIAG0(D163);  # PARAM COUNT ERROR  # PF11 
                                       RETURN;                           NEWFEAT
                                 END                                     NEWFEAT
           CURPAR = PARLNK[CURPAR];                                      NEWFEAT
           GOTO OQS23A;  #PROCESS NEXT PARAM STRING#                     NEWFEAT
  
  
  
  
ODNE50:  # TEST(DFMLPQ)(QUOTE)  == (DFMLPL)        #                     NEWFEAT
           NXTCHR;  #LOOK AHEAD FOR NEXT CHAR #                          NEWFEAT
           IF CCHAR EQ CCQUOT THEN BEGIN                                 NEWFEAT
                     RETURN;                                             NEWFEAT
                                   END                                   NEWFEAT
           RPLI = 1;   # REPLACE IF NOT A QUOTE#                         NEWFEAT
           RETURN;                                                       NEWFEAT
  
  
  
  
#QUOTED STRINGS:    DEF DECLARATIONS, COMMENTARY# 
  
#    FOR OQS2--SE ON1#
OQS3:     #    (QUOTE)==(CHEAD)    #
          PGIX=3;                       #SET PRECOGNITION TO ZAP ALL# 
          RETURN;                       #WONT EVERYONE BE SURPRISED#
  
OQS21:    #(DSTRHD)(QUOTE)==(DSTR)# 
##        NXTCHR;  #INSPECT NEXT CHAR FOR QUOTE#
##        IF CCHAR EQ CCQUOT THEN BEGIN 
##           CSTAKP = CSTAKP - 1;  #DISCARD CHAR (QUOTE)# 
##           RETURN;
##        END 
##        RPLI = 1;  #END OF DEF STRING#
          PGIX=0;                       #DEF STRING DONE-RESTORE# 
          IF NOT MACRO THEN BEGIN                                        NEWFEAT
          IF NCAR EQ 0 THEN 
               BEGIN
               DIAG0(D120);                                              PF11 
               CSRF[POZN]=0;
               RETURN;
               END
##       IF NCAR GR CHRLEN THEN BEGIN 
             DIAG0(D144);                                                PF11 
##           NCAR = CHRLEN; 
##       END
          DTXTNAM (ZCHRB , NCAR , NSEC);
          CSRF[POZN]=NSEC;
          RETURN; 
                            END                                          NEWFEAT
                              #MACRO#                                    NEWFEAT
          IF MCAR EQ 0 THEN BEGIN                                        NEWFEAT
                            DIAG0(D120);                                 PF11 
                            NSEC =0 ;                                    NEWFEAT
                            END                                          NEWFEAT
                       ELSE BEGIN                                        NEWFEAT
                            IF MCAR GR CHRLEN THEN BEGIN                 NEWFEAT
                                                   MCAR = CHRLEN;        NEWFEAT
                                                   DIAG0(D144);          PF11 
                                                   END                   NEWFEAT
                            CCHAR = " " ; 
                            PACKCCHAR;
                            CCHAR = ENDDEF;    # OUTPUT END OF MACRCO # 
                            PACKCCHAR;
                            MCAR = MCAR + 2 ; 
                             DTXTNAM (ZCHRB , MCAR , NSEC );
                             # 2 DISPLAY CHARS TO EACH MACRO CHAR#       NEWFEAT
                            END                                          NEWFEAT
          CSRF[POZN] = NSEC;                                             NEWFEAT
   $BEGIN                                                                NEWFEAT
 IF DEBFLG EQ 1 THEN BEGIN                                               NEWFEAT
   CDUMP(LOC(DPGEN[1] ),10,"DPGEN--");                                   NEWFEAT
  CDUMP( LOC(TMP1),7," TMP1----");                                       NEWFEAT
   END   $END                                                            NEWFEAT
          RETURN;                                                        NEWFEAT
  
  
  
  
#STATUS CONSTANT--STATUS FUNCTION HANDLING: 
     WHEN ANY NAME IS LOOKED UP, IT IS PUT INTO LNAME[BRKLEV].  BRKLEV
     AT SEMICOLONS AND OTHER PROPITIOUS PLACES.  IF THE LAST NAME HAS 
     CLAS OF FUNC, OR DATA, AND TYPE STTS, THEN THE VALUE OF SLLK IS SET
     INTO THE HEADER CONSTRUCT, AND WILL BECOME THE CONTROLLING 
     STATUS LIST NAME#
ON10:     #    TEST(LETTER)(PRIME)==(SCHEAD)      S"   #
          IF NSEC   NQ DLTR[DLTRS] THEN RETURN;   #CHECK FOR ST CONST#
          RPLI=1;                                 #FOUND# 
          CSRF[POZN]=0; 
          LNAM$ = LNAME [BRKLEV]; 
          IF CLAS[LNAM$] EQ SUICLS THEN GOTO ON10G;  #TO CHK TYPE#
                 ELSE 
          IF CLAS[LNAM$] EQ S"DATA" THEN GOTO ON10G;  #TO CHK TYPE# 
                 ELSE 
          IF CLAS[LNAM$] NQ S"FUNC" THEN GOTO ON10H;
                 ELSE 
ON10G:    IF TYPE[LNAM$] EQ S"STTS" THEN
               BEGIN
               CSRF[POZN]=SLLK[LNAM$];            #SUCCESSFUL MATCH#
               XRUSE(CSRF[POZN],CRDN);
               END
ON10H:  
          IF CLAS[LNAM$] EQ S"STSL" THEN CSRF[POZN]=LNAM$;
          IF PRSFLG NQ 0 THEN 
               IF TYPE[ITMLOC]EQ S"STTS"THEN
                    BEGIN 
                    CSRF[POZN]=SLLK[ITMLOC];
                    XRUSE(CSRF[POZN],CRDN); 
                    END 
          SCXFLG=1; 
          RETURN; 
  
  
  
  
OPS12:    #    (STLNAM)(PRIME)==(SCHEAD)     #
          CSRF$;
          SCXFLG=1; 
          LNAME[BRKLEV]=PLNAM;                    #RESTORE PREVIOUS NM# 
          XUSE(1);
          RETURN; 
  
  
  
  
OPS2:     #    (SSDTLC)(STSNAM)==(SSDTLC)(SSWPT)  # 
OPS1:     #    (SCHEAD)(STSNAM)==(SCBODY)    #
          DSEC=NLNK[NSEC];         #FIRST ATTRIBUTE SECTION#
OPS1A:    IF DSEC EQ NSEC THEN #FAILURE-NO SUCH STATUS CONST# 
               BEGIN
                DIAG(D006,NSEC);   #BAD SCON MESSAGE# 
               CSRF[POZN]=-1;           #ERROR FLAG#
               RETURN;
               END
          IF CLAS[DSEC] NQ S"SCON" THEN           #NOT THIS ONE#
               BEGIN
OPS1B:         DSEC=NLNK[DSEC];         #GET NEXT ENTRY THIS NAME#
               GOTO OPS1A;    #TEST FOR USEFULNESS# 
               END
          IF SMOM[DSEC] NQ CSRF[BLNK[POZN]] THEN GOTO OPS1B;#WRONG LIST#
          CSRF[POZN]=SYSV[DSEC];   #SUCCESS#
          XRUSE(DSEC,CRDN);   #CROSSREFERENCE ENTRY FOR CONSTANT# 
          RETURN; 
  
  
  
  
OPS11:    #    (SCBODY)(PRIME)==(DICON) # 
          TLD1=CSRF[BLNK[POZN]];
          IF TLD1 LS 0 THEN TLD1=0; 
          PCONS(TLD1,CMPR12,QTYPE"IGR");
          CSDF[POZN] = TRUE;
          IF PRSFLG NQ 0                                                 PF11C
          THEN                                                           PF11C
            BEGIN  # PRESET #                                            PF11C
            IF ITMTYP NQ QTYPE"STTS"                                     PF11C
            THEN  # STATUS CONSTANT PRESET AND NON-STATUS ITEM         # PF11C
              BEGIN  # ISSUE DIAG #                                      PF11C
              DIAG0(D195);                                               PF11C
              END  # ISSUE DIAG #                                        PF11C
            END  # PRESET #                                              PF11C
          RETURN; 
  
  
  
  
OSS9:     #    (LPAREN)==(LPARE2)  #
OSS12:    #    (LSQUA0)==(LSQUAR)  #
          BRKLEV=BRKLEV+1;
          IF BRKLEV GR NBRKLV THEN
               BEGIN
               DIAG0(D123);                                              PF11 
               SYMABT(J818,"BRACKET/PAREN NEST TOO DEEP(PF11)",33);      PF11 
               END
          LNAMW[BRKLEV]=0;
          RETURN; 
  
  
  
  
OSS8:     #    (RPAREN)==(RPARE2)  #
OSS13:    #    (RSQUA0)==(RSQUAR)  #
          BRKLEV=BRKLEV-1;                        #IF IT GOES NEG TOO 
                                                  BAD--IT WILL NEVER
                                                  COME BACK#
          IF BRKLEV LS 0 THEN 
               BEGIN
               DIAG0(D007);                                              PF11 
               BRKLEV=0;
               END
          RETURN; 
  
  
  
  
OW21:     EOFI=1;             #TERM ENCOUNTERED#
  
  
  
  
OW16: 
OW17: 
OW18: 
OSS7:     S$EMI;
          RETURN; 
  
  
  
  
  
OW19:     #    (BEGIN)==(BEGIN2)   #
      BEMATCH(TRUE);
      GOTO L$$$;
  
  
  
  
##       GOTO L$$$; 
OW20:     #    (END)==(END2)  # 
      BEMATCH(FALSE); 
L$$$: 
          CSRF[POZN]=1;       #DO NOT INHIBIT CODE# 
OW20A:    #ENTRY FROM DEBUG8 AND DEBUG9      #
          S$EMI;         #PERFORM SEMICOLON PROCESSING# 
          RETURN; 
  
  
  
  
#THERE IS A WHOLE SCHLOCK OF SITUATIONS WHICH CAUSE THE 
     BRACKET COUNT TO BE RESET.  THE DEFINITIONS ARE NOT
LISTED EXCEPT BY NAME#
OW1:  
OW2:  
OW3:  
OW4:  
OW5:  
OW6:  
OW7:  
OW8:  
OW9:  
OW12: 
OW13: 
OW14: 
OW15: 
OW99: 
          B$KT; 
          RETURN; 
  
  
  
  
OW22:     #    (OR)==(BOP)    # 
          OP=S"OR"; 
          GOTO OW24A; 
  
  
  
  
OW23:     #    (AND)==(BOP)   # 
          OP=S"AND";
          GOTO OW24A; 
  
  
  
  
OW24:     #    (NOT)==(BOP)   # 
          OP=S"NOT";
OW24A:    CSRF[POZN]=OP;
          CSRFL[POZN]=BRKLEV; 
          RETURN; 
  
  
  
SYMV21:   #    (DDECHD) (FASTFR)  ==  (DDECHD) (DECNAM) UP             #
          PVDF = 0;                # NO PRIOR VALID DECLARATION EXISTS #
          CSRF [POZN] = NSEC;      # SAVE NAME LINK                    #
          NMCSTR [NSEC] = 0;       # REMOVE FASTFR FROM RESVD WORD LIST#
          DIAG0 (D200);            # NEW RESERVED WORDS IN SYMPL 2     #
          RETURN; 
  
  
  
SYMV22:   #             (FASTFR)  ==  (PLTR)                           #
SYMV25:   #             (MODULE)  ==  (PLTR)                           #
          NMCSTR [NSEC] = 0;       # REMOVE FROM THE RESERVED WORD LIST#
          DIAG0 (D200);            # NEW RESERVED WORD IN SYMPL 2      #
          DESFLG = DSFTP;          # RESTORE DESCRIPTOR CONTEXT FLAG   #
          SCXFLG = SCFTP;          # RESTORE STATUS CONST CONTEXT FLAG #
          DCXFLG = DXFTP;          # RESTORE DECLARATIVE CONTEXT FLAG  #
          RETURN; 
  
  
  
  
OSS3:     #    (FUNNY)==(NULL)     #
          PNAM( C<CW-1>CCHAR, 1, TPYA);   # POST ILLEGAL CHARACTER     #
          DIAG( D008, TPYA ); 
          RETURN; 
  
  
  
  
OSS4:     #    (PLUS)==(SIGN) # 
          CSRF[POZN]=0; 
          RETURN; 
  
  
  
  
OSS5:     #    (MINUS)==(SIGN)     #
          CSRF[POZN]=1; 
          RETURN; 
  
  
  
  
OW10:     #    (XREF)==(XDEC)      #
          CSRF[POZN]=QXTRN"EXT";
          RETURN; 
  
  
  
  
OW11:     #    (XDEF)==(XDEC)      #
          CSRF[POZN]=QXTRN"ENT";
          RETURN; 
  
  
  
  
#DECIMAL AND REAL CONSTANT RECOGNITION       #
  
#DECIMAL CONSTANTS: FOR STARTER, SEE ON1# 
  
ODC10:    #    RULE (DINT     )              #
          IF  DIVERR NQ 0                                                SMPA029
          THEN                                                           SMPA029
            BEGIN                                                        SMPA029
            DIAG0(D060);                                                 F1 
            END                                                          SMPA029
          IF DEFINT                                                      PF11C
          THEN                     # DECIMAL INTEGER CAME FROM A DEF   # PF11C
            BEGIN                                                        PF11C
            CSDF[POZN] = TRUE;     # CARRY ALONG IN CONSTRUCT          # PF11C
            DEFINT = FALSE;        # RESET DEFINT                      # PF11C
            END                                                          PF11C
          RETURN; 
  
  
  
  
ODC11:    #    (RCHEAD)(DINT)==(IPDFP)  # 
          TPYRF = DIVAL;           # FRACTIONAL PART OF REAL           # SMPA029
          TPYRFU = DIVALU;                                               SMPA029
          IF  TPYA NQ 0      # C.F. INTEGER PART TO THIS NUMBER        # SMPA029
          THEN                                                           SMPA029
            BEGIN                                                        SMPA029
            TPYB = NCAR - TRZERO;                                        SMPA029
            END                                                          SMPA029
          ELSE               # FRACTION ONLY NUMBER....                # SMPA029
            BEGIN                                                        SMPA029
            TPYB = NCAR - (TRZERO + LDZERO);  # IGNORE ZERO CHARS      # SMPA029
            END                                                          SMPA029
          IF  NOT DPFLG                                                  SMPA029
          THEN                                                           SMPA029
            BEGIN                                                        SMPA029
            TPYREX = 0;                                                  SMPA029
            END                                                          SMPA029
          ELSE                                                           SMPA029
            BEGIN                                                        SMPA029
            TPYREX = (NCAR - LDZERO) - INTMAX;                           SMPA029
            END                                                          SMPA029
          TPYRFL=NCAR;
          PGIX=1; 
          RETURN; 
  
  
  
  
ODC12:    #    (REHEAD)(DINT)==(CONST)  # 
          TPYRE = DIVAL;           # EXPONENT PART OF REAL             # SMPA029
          GOTO ORCK;                              #CONVERT# 
  
  
  
  
ODC13:    #    (DINT)(DOT)==(IPD)  #
          TPYRI = DIVAL;           # INTEGER PART OF REAL              # SMPA029
          TPYRIU = DIVALU;                                               SMPA029
          TPYA = NCAR - LDZERO;    # CORRECT CHARACTER COUNT           # SMPA029
          TPYC = TRZERO;                                                 SMPA029
          IF  NOT DPFLG                                                  SMPA029
          THEN                                                           SMPA029
            BEGIN                                                        SMPA029
            TPYRIEX = 0;                                                 SMPA029
            END                                                          SMPA029
          ELSE                                                           SMPA029
            BEGIN                                                        SMPA029
            TPYRIEX = (NCAR - LDZERO) - INTMAX;                          SMPA029
            END                                                          SMPA029
          GOTO ORC1A; 
  
  
  
  
ODC14:    #    (DINT)==(DICON)     #
          IF  NOT DPFLG                                                  SMPA029
          THEN                                                           SMPA029
            BEGIN                                                        SMPA029
            TPYA = DIVAL;                                                SMPA029
            END                                                          SMPA029
          ELSE                                                           SMPA029
            BEGIN                                                        SMPA029
            IF  NCAR - LDZERO GR MAX$DIGITS                              SMPA029
            THEN                                                         SMPA029
              BEGIN                                                      SMPA029
              DIAG0(D060);                                               F1 
              END                                                        SMPA029
            TPYB = ( NCAR - LDZERO ) - INTMAX;    # NR DIGITS IN DIVAL # SMPA029
            FOR  TPYC = 1 STEP 1   # MULT BY 10**TPYC                  # SMPA029
              UNTIL TPYB                                                 SMPA029
            DO                                                           SMPA029
              BEGIN                                                      SMPA029
              DIVALU = (DIVALU*8) + (DIVALU*2);  # MULTIPLY BY 10      # SMPA029
              END                                                        SMPA029
            TPYA = DIVAL + DIVALU;                                       SMPA029
            END                                                          SMPA029
          PCONS(TPYA,CMPR12,QTYPE"IGR");    #POST AS CONSTANT#
          IF PRSFLG NQ 0                                                 PF11C
          THEN                                                           PF11C
            BEGIN  # PRESET #                                            PF11C
            IF ITMTYP NQ QTYPE"IGR"                                      PF11C
              AND ITMTYP NQ QTYPE"USI"                                   PF11C
              AND ITMTYP NQ QTYPE"STTS"                                  PF11C
              THEN
#             EITHER 1) INTEGER CONSTANT PRESET AND NON-INTEGER ITEM   #
#                 OR 2) ARRAY ITEM PRESET REPEAT COUNT                 #
                BEGIN  # CHECK FOR REPEAT COUNT  #
                IF CSNR[FLNK[POZN]] NQ CLIST"LPARE0"
                THEN               # NOT REPEAT COUNT                  #
                  BEGIN  # ISSUE DIAG  #
                  DIAG0(D195);
                  END    # ISSUE DIAG  #
                END    # CHECK FOR REPEAT COUNT # 
            END  # PRESET #                                              PF11C
          RETURN; 
  
  
  
  
#    REAL AND DOUBLE PRECISION REAL NUMBER HANDLING 
     TPYRI IS THE INTEGER PART
     TPYRF IS THE FRACTION PART 
     TPYRE IS THE EXPONENT PART 
     TPYRT IS THE TYPE
          0 FOR SINGLE PRECISION REAL 
          1 FOR DOUBLE PRECISION REAL 
     TPYRS IS THE SIGN OF THE EXPONENT
          1 FOR POSITIVE
          -1 FOR NEGATIVE 
ALL OF THE ABOVE ARE INTEGER ITEMS# 
  
ORC1:     #    (DOT)==(IPD)   # 
          TPYRI=0;                                #DEFAULT ZERO INT#
          TPYA = 0;                                                      SMPA029
          TPYRIEX = 0;                                                   SMPA029
  
  
  
  
ORC5:     #    (IPD)(DINT)==(RCHEAD)(DINT)     #
ORC1A:    NXTCHR;                       #PEER AT NEXT CHAR IN FILE# 
          IF CCHAR EQ "D" OR CCHAR EQ "E" THEN PGIX=1;
          RETURN; 
  
  
  
  
ORC4:     #    (IPD)==(IPDFP) # 
          TPYRT=0;                                #USUALLY REAL#
          TPYRFL=0; 
          TPYRF=0;                                #DEFAULT ZERO FRACT#
          TPYB = 0;                                                      SMPA029
          TPYREX = 0;                                                    SMPA029
          TPYA = TPYA - TPYC;                                            SMPA029
          RETURN; 
  
  
  
  
ORC12:    #    (IPDFP)==(CONST)    #
          TPYRE=0;                                #DEFAULT ZERO EXP#
          TPYRS=0;                                #DEFAULT POSITIVE#
          TPYRT=0;       #DEFAULT REAL# 
          PGIX=0;                  #RESTORE#
          GOTO ORCK;                              #CONVERT# 
  
  
  
  
ORC11:    #    TEST (IPDFP)(XDIGIT)==(RCBODY)     # 
          PGIX=0; 
          IF CCHAR EQ "D" THEN
               BEGIN
               TPYRT=1; 
               GOTO ORCHIT; 
               END
          IF CCHAR NQ "E" THEN
               BEGIN               #BAD LETTER# 
               DIAG0(D138);                                              PF11 
               RETURN;
               END
ORCHIT:   RPLI=1;                                 #SUCCESS# 
          RETURN; 
  
  
  
  
ORC21:    #    (RCBODY)(PLUS)==(RETOP)  # 
ORC23:    #    (RCBODY)==(RETOP)    DEFAULT#
          TPYRS=1;                                #POSITIVE EXPONENT# 
          RETURN; 
  
  
  
  
ORC22:    #    (RCBODY)==(MINUS)   ==(RETOP)      # 
          TPYRS=-1;                               #NEGATIVE EXPONENT# 
          RETURN; 
  
  
  
  
ORC32:    #    (RETOP)==(CONST)    #
          TPYRE=0;                                # ZERO EXPONENT#
  
  
  
  
#    CONVERSION OF REAL AND DOUBLE NUMBERS   #
  
ORCK:                                                                    NOV04
          IF  TPYA + TPYB  GR SIG$DIGITS                                 SMPA029
          THEN                                                           SMPA029
            BEGIN                                                        SMPA029
            DIAG0(D060);                                                 F1 
            END                                                          SMPA029
          BLDREAL;                                                       NOV04
          IF  REALERR NQ 0                                               NOV04
          THEN                                                           NOV04
             DIAG0(D182);                                                PF11 
          PCONS ( DUBL1 , CMPR12 , QTYPE"REAL" ); 
          IF PRSFLG NQ 0                                                 PF11C
          THEN                                                           PF11C
            BEGIN  # PRESET #                                            PF11C
            IF ITMTYP NQ QTYPE"REAL"                                     PF11C
            THEN  # REAL CONSTANT PRESET AND NON- ITEM                 # PF11C
              BEGIN  # ISSUE DIAG #                                      PF11C
              DIAG0(D195);                                               PF11C
              END  # ISSUE DIAG #                                        PF11C
            END  # PRESET #                                              PF11C
          # LETS CALL DOUBLE CONSTANTS REALS - SINCE NOBODY KNOWS WHAT
            TO DO WITH THEM      #
          RETURN; 
  
  
  
  
OW98:      # TEST (CONDSK)(ANY)  == (CONDSK) #                           NEWFEAT
             PGIX =10;    # SPECIAL SCAN MODE - IGNORES COMMENTS AND
                           STRINGS# 
           WCHAR4[-1] = "-";                                             NEWFEAT
           SKIPOF$ = 0;                                                  NEWFEAT
          IF AWAITSEMI THEN GOTO BACKTONORM;                             NEWFEAT
          IF NOT PGIX8LTR THEN GOTO NBLYGD;                              NEWFEAT
          PGIX8LTR = FALSE;                                              NEWFEAT
          #STAR ALL SKIPPED LINES#                                       NEWFEAT
          TPYA = NCAR;                                                   NEWFEAT
          IF NCAR GR IDLEN THEN TPYA = IDLEN;                            NEWFEAT
          LOOKUP(ZNAMR,TPYA,TPYB);                                       NEWFEAT
          IF TPYB EQ 0 THEN GOTO NBLYGD; #IGNORE WHAT WE DONT KNOW#      NEWFEAT
          IF NCSR[TPYB] EQ CLIST"TERM" OR NCSR[TPYB] EQ CLIST"NOTERM"    NEWFEAT
                        THEN GOTO ITISBLYGD;                             NEWFEAT
          IF NCSR[TPYB] EQ CLIST"CONTRL" THEN BEGIN SETCNTL = TRUE;      NEWFEAT
                                                     GOTO NBLYGD;        NEWFEAT
                                               END                       NEWFEAT
          IF NOT SETCNTL THEN GOTO NBLYGD;                               NEWFEAT
          SETCNTL = FALSE;                                               NEWFEAT
          IF TPYB EQ CNTLNK[CNTRL"FI"]                                   TFEAT
          OR TPYB EQ CNTLNK[CNTRL"ENDIF"] THEN BEGIN                     TFEAT
                                     CONDPTH = CONDPTH- 1;               NEWFEAT
                      IF CONDPTH LS 0 THEN GOTO ITISBLYGD;               NEWFEAT
                                      ELSE GOTO NBLYGD;                  NEWFEAT
                                          END                            NEWFEAT
          FOR TPYA =1 STEP 1 UNTIL CND"IFNQ" DO                          NEWFEAT
                    IF TPYB EQ CNDLNK[TPYA]   THEN                       NEWFEAT
                                      CONDPTH = CONDPTH + 1;             NEWFEAT
                 GOTO NBLYGD; 
ITISBLYGD:                                                               NEWFEAT
         AWAITSEMI = TRUE;                                               NEWFEAT
NBLYGD:   RPLI = 1;  RETURN;                                             NEWFEAT
BACKTONORM:   IF CCHAR EQ " " THEN GOTO ITISBLYGD;  #SKIP OVER BLANKS#   NEWFEAT
             AWAITSEMI = FALSE;      #ONE SEMI IS ENOUGH FOR ANYONE#     NEWFEAT
             IF CCHAR NQ ";" OR PGIX8LTR THEN 
                 DIAG0(D158);                                            PF11 
             S$EMI;      #NORMAL SENI PROC#                              NEWFEAT
          SKIPOF$ = 1 ;                                                  NEWFEAT
          PGIX = 0;                                                      NEWFEAT
          RETURN;                                                        NEWFEAT
  
  
  
  
#         READ THIS ITEM AGAIN AND REMOVE SKIPPED CODE FLAG #            NEWFEAT
WCDH41:    #      (CONDST)(SEMI2)  == (CONDSK) DOWN  #                   NEWFEAT
          DHIF [DEFN] = 0;    #ONCE IS ENOUGH        #
          RETURN;                                                        NEWFEAT
  
  
  
                                                                         NEWFEAT
OW97:      #      (CONDSK)       == (CDEC)   #                           NEWFEAT
         DIAG0(D158);                                                    PF11 
          RETURN;                                                        NEWFEAT
END 
TERM
