*DECK             PF13
USETEXT   TSOURCE 
USETEXT   TSYMCNS 
USETEXT   TCEXECQ 
USETEXT   TSYMC5Q 
USETEXT   TSTABLE 
USETEXT   TCOM37Q 
USETEXT   TCEXEC
USETEXT   TSYMC5
      PROC PF13;                                                         DON/D
      BEGIN                                                              DON/D
#**********************************************************************# DON/D
#                                                                      # DON/D
#     PF13 -                                                           # DON/D
#         SYMPL SCAN3 PRAGMATIC FUNCTIONS (PF13)                       # DON/D
#         SYMPL SCAN4 PRAGMATIC FUNCTIONS (PF14)                       # DON/D
#                                                                      # DON/D
#**********************************************************************# DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
#     COMDECKS                                                         # DON/D
                                                                         DON/D
*CALL COMEX 
                                                                         DON/D
*CALL SPFSW3
                                                                         DON/D
*CALL SPFSW4
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
#     XREFS                                                            # DON/D
                                                                         DON/D
XREF BEGIN
     PROC ABORT;
     PROC CODCLR; 
     PROC CSAV; 
     PROC DEBUG;
     PROC DIAG;                                                          PF13 
     PROC DIAG0;                                                         PF13 
     PROC DUMP; 
     PROC ENDSAV; 
     PROC ESCOPE; 
     PROC FIND; 
     PROC FLUSH;
     PROC GENLAB; 
     PROC GNLEND; 
     PROC HATCHK; 
     PROC HATEND; 
     PROC OPERND; 
     PROC OPRNDV; 
     PROC OSAV; 
     PROC PNAM; 
     PROC POPN; 
     PROC POPR; 
     PROC POST; 
     PROC POSTNN; 
     PROC POW;
     PROC RESTR;
     PROC SYMABT;                                                        PF13 
     PROC T$ERM;
     PROC VALID;
     PROC XRFCLS; 
     PROC XRSET;
     PROC XRUSE;
     PROC XSET; 
     PROC XUSE; 
      PROC FPLINK;                                                       DON/D
      PROC SRCH;                                                         DON/D
      PROC XRDEF;                                                        DON/D
      PROC GTSRC; 
       ITEM PREREAD ; 
     END
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
#     DEFS                                                             # DON/D
                                                                         DON/D
      DEF CSRF$ #CSRF[POZN] = CSRF[BLNK[POZN]];#; 
      DEF  D003  #  3#;      #DIAGNOSTIC 003#                            DON/D
      DEF  D012  # 12#;      #DIAGNOSTIC 012#                            DON/D
      DEF  D016  # 16#;      #DIAGNOSTIC 016#                            DON/D
      DEF  D017  # 17#;      #DIAGNOSTIC 017#                            DON/D
      DEF  D021  # 21#;      #DIAGNOSTIC 021#                            DON/D
      DEF  D026  # 26#;      #DIAGNOSTIC 026#                            DON/D
      DEF  D073  # 73#;      #DIAGNOSTIC 073#                            DON/D
      DEF  D074  # 74#;      #DIAGNOSTIC 074#                            DON/D
      DEF  D075  # 75#;      #DIAGNOSTIC 075#                            DON/D
      DEF  D076  # 76#;      #DIAGNOSTIC 076#                            DON/D
      DEF  D077  # 77#;      #DIAGNOSTIC 077#                            DON/D
      DEF  D083  # 83#;      #DIAGNOSTIC 083#                            DON/D
      DEF  D084  # 84#;      #DIAGNOSTIC 084#                            DON/D
      DEF  D085  # 85#;      #DIAGNOSTIC 085#                            DON/D
      DEF  D088  # 88#;      #DIAGNOSTIC 088#                            DON/D
      DEF  D089  # 89#;      #DIAGNOSTIC 089#                            DON/D
      DEF  D090  # 90#;      #DIAGNOSTIC 090#                            DON/D
      DEF  D091  # 91#;      #DIAGNOSTIC 091#                            DON/D
      DEF  D092  # 92#;      #DIAGNOSTIC 092#                            DON/D
      DEF  D093  # 93#;      #DIAGNOSTIC 093#                            DON/D
      DEF  D094  # 94#;      #DIAGNOSTIC 094#                            DON/D
      DEF  D095  # 95#;      #DIAGNOSTIC 095#                            DON/D
      DEF  D096  # 96#;      #DIAGNOSTIC 096#                            DON/D
      DEF  D097  # 97#;      #DIAGNOSTIC 097#                            DON/D
      DEF  D100  #100#;      #DIAGNOSTIC 100#                            DON/D
      DEF  D101  #101#;      #DIAGNOSTIC 101#                            DON/D
      DEF  D102  #102#;      #DIAGNOSTIC 102#                            DON/D
      DEF  D103  #103#;      #DIAGNOSTIC 103#                            DON/D
      DEF  D104  #104#;      #DIAGNOSTIC 104#                            DON/D
      DEF  D105  #105#;      #DIAGNOSTIC 105#                            DON/D
      DEF  D106  #106#;      #DIAGNOSTIC 106#                            DON/D
      DEF  D111  #111#;      #DIAGNOSTIC 111#                            DON/D
      DEF  D112  #112#;      #DIAGNOSTIC 112#                            DON/D
      DEF  D124  #124#;      #DIAGNOSTIC 124#                            DON/D
      DEF  D125  #125#;      #DIAGNOSTIC 125#                            DON/D
      DEF  D126  #126#;      #DIAGNOSTIC 126#                            DON/D
      DEF  D127  #127#;      #DIAGNOSTIC 127#                            DON/D
      DEF  D128  #128#;      #DIAGNOSTIC 128#                            DON/D
      DEF  D129  #129#;      #DIAGNOSTIC 129#                            DON/D
      DEF  D130  #130#;      #DIAGNOSTIC 130#                            DON/D
      DEF  D131  #131#;      #DIAGNOSTIC 131#                            DON/D
      DEF  D132  #132#;      #DIAGNOSTIC 132#                            DON/D
      DEF  D134  #134#;      #DIAGNOSTIC 134#                            DON/D
      DEF  D143  #143#;      #DIAGNOSTIC 143#                            DON/D
      DEF  D145  #145#;      #DIAGNOSTIC 145#                            DON/D
      DEF  D152  #152#;      #DIAGNOSTIC 152#                            DON/D
      DEF  D173  #173#;      #DIAGNOSTIC 173#                            DON/D
      DEF  D176  #176#;      #DIAGNOSTIC 176#                            DON/D
      DEF  D177  #177#;      #DIAGNOSTIC 177#                            DON/D
      DEF  D181  #181#;      #DIAGNOSTIC 181# 
      DEF  D189  #189#;      #DIAGNOSTIC 189#                            PF13C
      DEF  D190  #190#;      #DIAGNOSTIC 190#                            PF13C
      DEF  D191  #191#;      #DIAGNOSTIC 191#                            PF13C
      DEF  D192  #192#;      #DIAGNOSTIC 192#                            PF13C
      DEF  D193  #193#;      #DIAGNOSTIC 193#                            PF13C
      DEF  D194  #194#;      #DIAGNOSTIC 194#                            PF13C
      DEF  D196  #196#;      #DIAGNOSTIC 196#                            PF13C
      DEF  D197  #197#;      #DIAGNOSTIC 197#                            PF13C
      DEF  D198  #198#;      #DIAGNOSTIC 198#                            PF13C
      DEF  D218  #218#;      #DIAGNOSTIC 218# 
      DEF J822 #822#;        # SYMABT DIAGNOSTIC 822                   # PF13 
      DEF J823 #823#;        # SYMABT DIAGNOSTIC 823                   # PF13 
      DEF J824 #824#;        # SYMABT DIAGNOSTIC 824                   # PF13 
      DEF J825 #825#;        # SYMABT DIAGNOSTIC 825                   # PF13 
      DEF  UNBEHAVED # B<1,1>OPTION #;  #  USE OF BEHAVIOR CONTROL     #
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
#     STATUS LISTS                                                     # DON/D
                                                                         DON/D
STATUS QCBXSW R0,R1,RPR11A,REX40A;
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
#     LOCAL DATA                                                       # DON/D
                                                                         DON/D
ITEM RUNDSW B;
ARRAY PRECA[0:25]P(1);
ITEM PREC(0,0,CMPAR3)=[0,4(10),2(11),7(0),12,9,8,7,6,5,4,3,2,1];
ITEM TYPETP;        #FOR TEMP TYPE# 
ITEM XCHPSB,        #BUFFER FOR PRESTATEMENT STORES INTO TEMP#
     XCHLSB,        #FOR LEFT SIDE CODE#
     XCHRSB;        #FOR RIGHT SIDE CODE# 
               ITEM TEMP; 
ITEM CBXFLG S:QCBXSW; 
ITEM REXPB B; 
      ITEM MACHCONS     I          # BIT N-1 SET IF N MACHINE DEP      #
          = O" 01040 10000 00010 00001 ";  # 6,10,18,42,60             #
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
#     SWITCHES                                                         # DON/D
                                                                         DON/D
SWITCH    AOPND:QTYPE    AOPC:EBCD,     #WITCH TO SET UP OPTYP# 
                    AOPI:NULL ,        # ERROR CASE  #
                    AOPI:IGR, 
                    AOPU:STTS,
                    AOPU:USI, 
                    AOPF:REAL,
                    RET4:BOOL;
                                                                         DON/D
SWITCH CBXSW:QCBXSW RET4:R1,
                    RET4:R0  ,         # ERROR CASE  #
                    RPR11A:RPR11A,
                    REX40A:REX40A;
                                                                         DON/D
SWITCH    RIT15S:QTYPE   RIT15A:IGR,
                    RIT15A:USI, 
                         RIT15A:NULL , # ERROR CASE  #
                         RIT15A:REAL, 
                         RIT15A:STTS, 
                         RIT15B:BOOL, 
                         RIT15B:EBCD; 
                                                                         DON/D
SWITCH RXP21S:QOP   RXP21L:LNO,         #SWITCH FOR ARITH OPERS#
                    RXP21B: NULL ,   # ERROR CASE  #
                    RXP21L:LAN, 
                    RXP21L:LOR, 
                    RXP21L:LXR, 
                    RXP21L:LIM, 
                    RXP21L:LQV, 
                    RXP21O:PLUS,
                    RXP21O:UPLUS, 
                    RXP21O:MINUS, 
                    RXP21O:UMINUS,
                    RXP21O:STAR,
                    RXP21O:SLASH, 
                    RXP21O:EQ,
                    RXP21O:NQ,
                    RXP21O:GR,
                    RXP21O:GQ,
                    RXP21O:LS,
                    RXP21O:LQ,
                    RXP21E:EXP; 
      CONTROL EJECT;                                                     DON/D
PROC ENDLOP;
          BEGIN 
          LOOPCW=LOOPCW-1;
          IF LOOPJB[LOOPCW] NQ 0 THEN 
               BEGIN
               POPN(LOOPJB[LOOPCW]);   #TEST STATEMENT LABEL# 
               POPR(QILOP"LABL"); 
               END
         IF LOOPST[LOOPCW] NQ 0 THEN RESTR(LOOPST[LOOPCW]);  #STEP# 
                   IF NOT LOOPTY[LOOPCW] THEN    # SLOW LOOP  # 
                     BEGIN
         IF LOOPLL[LOOPCW] NQ 0 THEN BEGIN  #WHILE/UNTIL LABEL# 
                   POPN(LOOPLL[LOOPCW]);
                   POPR(QILOP"LABL"); 
                   END
                     END
                   ELSE 
                     BEGIN
                     TLUS[LOOPLL[LOOPCW]] = FALSE;  # LIMIT TEMP# 
                     TLUS[LOOPSS[LOOPCW]] = FALSE;  # STEP TEMP  #
                     END
         RESTR(LOOPSL[LOOPCW]); 
      IF  LOOPTY[ LOOPCW ]         # FAST FOR LOOP                     #
      THEN
        BEGIN 
        IF  LOOPER[ LOOPCW ]       # ERROR IN "FOR" STMT               #
        THEN
          BEGIN 
          STERF = 1;               # SUPPRESS CODE FOR END OF LOOP     #
          END 
        POPR( QILOP"ENDL" );
        STERF = 0;
        END 
      END 
      CONTROL EJECT;                                                     DON/D
PROC FORCON(TP);              #CONVERT FOR EXPR TO TYPE OF IND VAR# 
          BEGIN 
          ITEM TP;            #TYPE OF EXPRESSION#
          IF TCONVF[TP,INVTYP] NQ 0 THEN     #INVTYP GIVES I V TYPE#
               BEGIN
               POPN(TCONVF[TP,INVTYP]); 
               POPR(QILOP"FUNI"); 
               END
          END 
      CONTROL EJECT;                                                     DON/D
PROC GENTMP(TMPLNK);          #TEMP GENERATOR#
BEGIN 
ITEM TMPLNK,        #TEMP LOCATION# 
     TYPEV S:QTYPE,      #FOR TYPE OF TEMP# 
     LINK,TLINK,I;  #ITEMRNAL TEMPS#
         ITEM FORTEMP B;
         FORTEMP = FALSE ;    # NOT A CALL FROM A LOOP #
GENTMPA:  
          TYPEV=S"IGR";            #DEFAULT INTEGER TYPE--SEE GENTMT# 
          GOTO GO;
         ENTRY PROC GENTMPF ( TMPLNK);
                  # ENTRY FROM FOR LOOP PROCESSOR  #
         FORTEMP = TRUE;
         GOTO GENTMPA;
     SWITCH TEMPSW:QTYPE
                    TEMPI:NULL  ,       #ERROR CASE  #
                    TEMPI:IGR,
                    TEMPR:REAL, 
                    TEMPB:BOOL, 
                    TEMPC:EBCD, 
                    TEMPS:STTS, 
                    TEMPU:USI;
TEMPI:    #INTEGER TYPE#
TEMPR:    #REAL TYPE# 
          NBIT[LINK]=IGRLEN ; 
SIGNON:   SIGN[LINK]=TRUE;
          GOTO TMPCHN;
TEMPB:    #BOOLEANS:# 
TEMPS:    #STATUS#
TEMPU:    #UNSIGNED#
          NBIT[LINK]=IGRLEN;
SIGNOF:   SIGN[LINK]=FALSE; 
          GOTO TMPCHN;
TEMPC:    #CHARACTERS#
          NBYT[LINK]=CHRLEN;
          GOTO SIGNOF;
  
# SWITCH TO CONVERT QOPTYP TO QTYPE # 
     SWITCH TYPOP:QOPTYP
                    TIGR:NULL  ,
                    TUSI :USI,
                    TCHAR:CHAR, 
                    TIGR:IGR, 
                    TREAL:REAL; 
  
ENTRY PROC GENTMT(TMPLNK,TMPTYP);  #ALT ENTRY--GIVES TYPE#
     ITEM TMPTYP; 
         FORTEMP = FALSE; 
          GOTO TYPOP[TMPTYP]; #CONVERT QOPTYP INPUT TO QTYPE VALUE# 
  
TCHAR:    TYPEV=  S"EBCD";    GOTO GO;
TREAL:    TYPEV=  S"REAL";    GOTO GO;
TUSI: 
TIGR:     TYPEV=  S"IGR"; 
  
GO:       IF NTEMPU[SCOPE] LS NTEMPG[SCOPE] THEN#MAYBE USE OLD ONE# 
               BEGIN
               LINK=TMPHED[SCOPE];      #LINK TO FIRST USED ONE#
               FOR I=1 STEP 1 UNTIL NTEMPU[SCOPE] DO
                    LINK=TPCH[LINK];         #STEP BY THE ONES IN USE#
TYPTST: 
               IF TYPE[LINK] NQ TYPEV 
               OR ( FORTEMP AND NOT TPFO[LINK] )
               OR ( NOT FORTEMP AND TPFO[LINK] )
               OR TLUS [LINK]     THEN
                             # FOR-LOOP TEMPS MAY NOT BE REUSED IMMEDIA#
                    BEGIN          #REJECT THIS ONE#
                    LINK=TPCH[LINK];
                    IF LINK EQ 0 THEN GOTO NEWTMP;      #END OF CHAIN#
                    GOTO TYPTST;
                    END 
               #FOUND ENTRY OF PROPER TYPE# 
               IF TMPHED[SCOPE] NQ LINK THEN #CHAIN TO HEAD#
                    BEGIN 
                    TLINK=TMPHED[SCOPE];
LNKTST:             IF TPCH[TLINK] NQ LINK THEN 
                         BEGIN  #NOT OURS YET#
                         TLINK=TPCH[TLINK];       #GET NEXT ONE#
                         GOTO LNKTST; 
                         END
                    TPCH[TLINK]=TPCH[LINK];  #REMOVE FROM CHAIN#
                    GOTO TMPCHN;        #PUT AT HEAD# 
                    END 
               END
          ELSE BEGIN          #MUST GENERATE NEW ONE# 
NEWTMP:        POST(NONAM,TMPWDS,LINK);      #TEMP ENTRY# 
               CLAS[LINK]=S"TEMP";
               TYPE[LINK]=TYPEV;
                   TPFO [LINK] = FORTEMP; 
               NTEMPG[SCOPE]=NTEMPG[SCOPE]+1; 
               GOTO TEMPSW[TYPEV]; #SET NBIT AND SIGN#
TMPCHN:        TPCH[LINK]=TMPHED[SCOPE];
               TMPHED[SCOPE]=LINK;
               END
NTEMPU[SCOPE]=NTEMPU[SCOPE]+1;
          TMPLNK=LINK;
END 
      CONTROL EJECT;                                                     DON/D
#         ILLEGAL APPEARANCE OF RESERVED WORD#
  
PROC ILKEY(STR,LEN);
     BEGIN
     ITEM STR,LEN,TLINK;                          #STR IS REALLY
                                                  CH+RS-BUT WHO KNOWS#
          PNAM(STR,LEN,TLINK);                    #FIND SYMO LOC# 
       DIAG(D017,TLINK);                                                 DON/D
          GOTO ILNOUT;                            #RETURN TO ANALYZER#
     END
      CONTROL EJECT;                                                     DON/D
PROC SETTMP(EXPBUF,TYPE,TEMP);          #TEMP STORE GEEERATOR#
BEGIN 
ITEM EXPBUF,        #BUFFER CONTAINING EXPRESSION#
     TYPE,          #TEMP TYPE# 
     TEMP;     #FOR TEMP NAME#
  
          OSAV(XCHPSB);       #OPEN TEMP STORE STACKER# 
          GENTMT(TEMP,TYPE);
          POPN(TEMP);         #PUT OUT TEMP AS OPERAND OF STORE#
          RESTR(EXPBUF);      #PUT OUT EXPRESSION#
          POPR(QILOP"REPL");
          ENDSAV;        #CLOSE BUFFER# 
END 
      CONTROL EJECT;                                                     DON/D
PROC SINKIL(S,T);                  #OUTPUT SINK IL# 
#SINKIL PRODUCES IL FOR A LIFT SIDE ENTITY DESCRIBED IN A GIVEN 
SINK TABLE POSITION.  IT PASSES BACK THE OPERAND TYPE OF THE SINK#
          BEGIN 
          ITEM I,                  #TEMP# 
               S,                  #SINK TABLE INDEX# 
               T    S:QOPTYP;      #SINK TYPE--OUTPUT PARAMETER#
          SWITCH SINK:QSINK   ISINK:ITEM,         #ITEM SINK# 
                              F$INK:FUNC,         #FUNCTION RESULT# 
                              BSINK:BEAD,         #B OR C SINK# 
                              PSINK:P;            #POINTER# 
          GOTO SINK[SINKC[S]];                    #SPLIT PROCESS #
  
#SINK IS SIMPLE OR SUBSCRIPTID ITEM#
ISINK:    OPERND(SINKL[S]);             #PUT OUT ITEM NAME# 
          IF SINKX[S] NQ 0 THEN                   #IS THERE A SUBSCRIPT#
               BEGIN                              #YES# 
               RESTR(SINKX[S]);                   #SUBS FUNCTION CODE#
               POPR(QILOP"SUBS"); 
               END
ISK1:     T=OPTYP[TYPE[SINKL[S]]];                #QOPTYP SETTING#
          RETURN; 
  
#SINK IS FUNCTION NAME# 
F$INK:    #FSINK IS USELESS SINCE IT RESOLVES TO GLOBAL SCOPE#
FSINK:    POPN(SINKL[S]);                         #FUNC NAME# 
          GOTO ISK1;
  
#SINK IS B<> OR C<>  #
BSINK:    I=SINKB[S];                             #BEAD TABLE SLOT# 
          RESTR(BEADXA[I]);                       #FIRST EXPRESSION#
          RESTR(BEADXB[I]);                       #SECOND # 
          POPR(QILOP"FLST");
          OPERND(BEADL[I]);                       #DATA NAME# 
          IF BEADSX[I] NQ 0 THEN                  # SUBSCRIPT EXISTS# 
               BEGIN
               RESTR(BEADSX[I]);
               POPR(QILOP"SUBS"); 
               END
               POPR(QILOP"FLST"); 
          IF BEADC[I] EQ S"BIT" 
          THEN BEGIN
               I=QFNBR"BIT";       #INTRINSIC IDENTIFIER# 
               T=S"USI";      #OPERAND TYPE#
               END
          ELSE BEGIN
               I=QFNBR"BYTE";           #CHAR MODIFIER# 
               T=S"CHAR";               #OPERAND TYPE#
               END
          POPN(INIFT[I]) ;
          POPR(QILOP"FUNI");
          RETURN; 
  
#SINK IS P<># 
PSINK:    OPERND(SINKL[S]);                       #BASED ARRAY NAME#
          POPN(INIFT[QFNBR"PFUN"]); 
          POPR(QILOP"FUNI");
          T=S"USI";           #SINK TYPE U# 
END  #OF PROC SINKIL# 
      CONTROL EJECT;                                                     DON/D
PROC SINKXL(S,A);   #GENERATE EXCH SINK CODE, ADDRESS CODE IN BUFFER A# 
          BEGIN 
          ITEM S,        #SINK NUMBER#
               A,        # FOR SAVE BUFFER FOR ADRESS CODE #
               I,J,K;    #TEMPS#
          SWITCH SINK:QSINK   BSINK:BEAD, 
                              PSINK:P,
                              ISINK:FUNC ,   # ONLY IN ERROR CASES #
                              ISINK:ITEM;         #FUNCS DO NOT ARRIVE# 
          GOTO SINK[SINKC[S]];
BSINK:    I=SINKB[S];                   #BEAD TABLE SLOT# 
          SETTMP(BEADXA[I],QOPTYP"IGR",J);  #SAVE FIRST EXPRESSION# 
          SETTMP(BEADXB[I],QOPTYP"IGR",K);  #SAVE 2ND   EXPRESSION# 
          POPN(J);            #NAME OF TEMP OF FIRST EXPR#
          POPN(K);       #DITTO SECOND #
          POPR(QILOP"FLST");
          OPERND(BEADL[I]);             #NAME#
          CSAV(A);                      #SAVE BUFFER FOR ADDRESS# 
          POPN(J);       #NAME OF FIRST TEMP# 
          POPN(K);       #SECOND# 
          POPR(QILOP"FLST");
          OPERND(BEADL[I]); 
          ENDSAV; 
          IF BEADSX[I] NQ 0 THEN        # THE DATA IS SUBSCRIPTED#
               BEGIN
               SETTMP(BEADSX[I],QOPTYP"IGR",J);   #SAVE SUBSCRIPT#
               POPN(J);                 #NAME OF TEMP#
               POPR(QILOP"SUBS"); 
               OSAV(A);                 #ADRESS BUFFER# 
               POPN(J);       #NAME OF SUBSCRIPT EXPR TEMP# 
               POPR(QILOP"SUBS"); 
               ENDSAV;
               END
          POPR(QILOP"FLST");
          IF BEADC[I] EQ S"BIT"    THEN K=QFNBR"BIT"; 
                                   ELSE K=QFNBR"BYTE";
          POPN(INIFT[K]); 
          POPR(QILOP"FUNI");
          OSAV(A);                      #REOPEN ADDRESS BUFFER# 
          POPR(QILOP"FLST");
          POPN(INIFT[K]); 
          POPR(QILOP"FUNI");
          ENDSAV; 
          RETURN; 
ISINK:    OPERND(SINKL[S]);             #PUT OUT ITEM NAME# 
          CSAV(A);                      #GET BUFFER FOR ADDRESS#
          OPERND(SINKL[S]);             #ARRGH# 
          ENDSAV; 
          IF SINKX[S] NQ 0 THEN         # THERE IS A SUBSCRIPT# 
               BEGIN
               SETTMP(SINKX[S],QOPTYP"IGR",J);    #SUBSCRIPT EXP# 
               POPN(J);       #PUT OUT TEMP NAME# 
               POPR(QILOP"SUBS"); 
               OSAV(A); 
               POPN(J);       #NAME OF SUBS EXPR TEMP#
               POPR(QILOP"SUBS"); 
               ENDSAV;
               END
          RETURN; 
PSINK:    OPERND(SINKL[S]);                  #BASED ARRAY NAME# 
          POPN(INIFT[QFNBR"PFUN"]); 
          POPR(QILOP"FUNI");
          CSAV(A);                      #SAVE BUFFER FOR ADDRESS CODE#
          OPERND(SINKL[S]);             #FAMILIAR FACE# 
          POPN(INIFT[QFNBR"PFUN"]); 
          POPR(QILOP"FUNI");
          ENDSAV; 
          END 
      CONTROL EJECT;                                                     DON/D
PROC SNKTYP(S,T);             #GIVES QOPTYP SETTING IN T FOR SINK S # 
          BEGIN 
          ITEM S,   T    S:QOPTYP;
          SWITCH SINK:QSINK        USINK:P,       #UNSIGNED INTEGER#
                                   BSINK:BEAD,      #BEAD:DEPENDS#
                                   ISINK:FUNC ,   # EXCEPT FOR ERRORS # 
                                   ISINK:ITEM;    #DEPENDS ON TYPE# 
          GOTO SINK[SINKC[S]];
BSINK:    IF BEADC[SINKB[S]] EQ S"BYTE" THEN
               BEGIN
               T=S"CHAR"; 
               RETURN;
               END
USINK:    T=S"USI"; 
          RETURN; 
ISINK:    T=OPTYP[TYPE[SINKL[S]]];
          END 
      CONTROL EJECT;                                                     DON/D
PROC TSTLAB(X);    #PUTS OUT JMP TO APPROPRIATE LBL FOR TEST STMT#
BEGIN 
ITEM X;  #POINTER TO ENTRY FOR LABEL --MAY BE ZERO# 
      ITEM Y; 
      IF LOOPJB[X] EQ 0 THEN BEGIN     #GENERATE LABEL FOR TEST # 
               GENLAB(TPYB);
               LREF[TPYB]=0;
               LOOPJB[X]=TPYB;
              END 
      Y=LOOPJB[X];
      OPERND(Y);
      POPR(QILOP"GOTO");
      LREF[Y]=LREF[Y]+1;
END 
      CONTROL EJECT;                                                     DON/D
#     THIS IS THE BEGINNING OF CODE FOR PF13.  IT IS SIMPLY A SWITCH   # DON/D
#     TO THE APPROPRIATE PRAGMATIC FUNCTION.                           # DON/D
  
          $BEGIN IF DMPFLG EQ 1 THEN PRINTLABEL3;   $END
  
GOTO SWDF13[DEFN-SWOF13]; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
REXP20:   REXP26:   REXP30:   RSUB20:   RSUB30: 
RPAR33:   RPAR34:   RPAR30:   RPAR31:   RAIT10: 
RSUB40:   RSUB42:   RBF20:    RLOC20:   RARR10:   FCHK10: 
FCHK11:   FCHK12:   FCHK13:   FCHK14:   FCHK15:   FCHK16:   FCHK17: 
FCHK18:   FCHK19:   FCHK21:   FCHK22:   FCHK27: 
FELSE:    FPROG:    FPROG1:   FEND4:    FPREF:    FPREF1:   FPREF2: 
FSPTP:    FRTRN1:   FRTRN2:   FSTOP1:   FSTOP2: 
FGOTO:    FGOTO5:   FGOTO6:   FGOTO7: 
FTEST3:   FTEST4:   FTEST5:   FSINK:    FREPL:    FREPL1:   FREPL2: 
      DHIF[DEFN]=0;  #ONCE IS ENOUGH# 
RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
DFER:                                                                    PF13 
      SYMABT(J822,"NO PRAGMATIC FUNC(PF13)",23);                         PF13 
  
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
ILNOUT:   #OUTER RETURN FOR INNER PROCS                                # DON/D
      RETURN;                #TO ANALYSIS#                               DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
      CONTROL EJECT;                                                     DON/D
REX351:   #    (BOPND)(RELOP)==(LRELT)  # 
REX353:   #    (BOPND)==(AOPND)    #
          CSRFL[POZN]=QOPTYP"IGR";
          DIAG0(D112);                                                   PF13 
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
REX352:   #    (BOPND)(AOP)==(AOPND)(AOP)    #
          CSRFL[BLNK[POZN]]=QOPTYP"IGR";
          DIAG0(D112);                                                   PF13 
          RETURN;                                                        PF13 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
#CROSSREF CALLS#
                                                                         DON/D
RITM14:   #    (TEST)(ITMNAM)==(TEST)(TESTN)      #                      DON/D
      XUSE(0);                                                           DON/D
      RETURN;                                                            DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
RLAB12:   #    (GOTO)(LABNAM)==(GOTO)(TAG)        # 
          XUSE(0);            #USE CROSAREF ENTRY#
          TPYB = CSRF[POZN];
          LREF[TPYB] = LREF[TPYB] + 1; # INCREMENT REFERENCE COUNT     #
          IF SBEG[TPYB] NQ SCOPE       # CHECK FOR BACKWARD REFERENCE  #
          THEN
            BEGIN 
            DIAG(D197, TPYB);          # OUT OF SCOPE GOTO -- BACKWARDS#
            END 
          RETURN; 
                                                                         DON/D
                                                                         DON/D
  
  
AOPI:                                                                    PF13C
          IF CLAS[CSRF[POZN]] EQ S"CONS"                                 PF13C
          THEN                                                           PF13C
            BEGIN  # CONS #                                              PF13C
            FIND(CSRF[POZN], TPYC);  # GET NAME ENTRY                  #
            TPYC = CONS[TPYC];     # VALUE OF CONSTANT                 #
            IF  NOT CSDF[POZN]     # NOT FROM DEF OR STATUS CONSTANT   #
              AND (TPYC GR 0
              AND  TPYC LQ 60)
              AND  B<TPYC-1,1>MACHCONS EQ 1 
            THEN                                                         PF13C
              BEGIN                                                      PF13C
              DIAG0(D198);                                               PF13C
              END                                                        PF13C
            CSRFL[POZN]=QOPTYP"IC";                                      PF13C
            END  # CONS #                                                PF13C
          ELSE                                                           PF13C
            BEGIN                                                        PF13C
            CSRFL[POZN]=QOPTYP"IGR";                                     PF13C
            END                                                          PF13C
                                                                         DON/D
AOPH:     RPLI=1;   RETURN; 
                                                                         DON/D
AOPU:     CSRFL[POZN]=QOPTYP"USI";      GOTO AOPH;
                                                                         DON/D
AOPF:     CSRFL[POZN]=QOPTYP"REAL";          GOTO AOPH; 
                                                                         DON/D
AOPC:     COPLEN=NBYT[CSRF[POZN]];
          CSRFL[POZN]=QOPTYP"CHAR"; 
          GOTO AOPH;
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
#CONSTANTS# 
                                                                         DON/D
RCONS1:   #    TEST(CONST)==(AOPND)     # 
          POPN(CSRF[POZN]); 
          GOTO AOPND[TYPE[CSRF[POZN]]]; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
RITM17:   #    TEST(ITMNAM)==(AOPND)    # 
          XUSE(0);
          OPERND(CSRF[POZN]); 
          IF  LEVL[CSRF[POZN]]   EQ  S"LEV3" THEN                        LARRY-R
            DIAG(D176,CSRF[POZN]);                                       DON/D
          GOTO AOPND[TYPE[CSRF[POZN]]]; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
RITM18:   #    (ITMNAM)==(BOPND)   #
          IF  LEVL[CSRF[POZN]]   EQ  S"LEV3" THEN                        LARRY-R
            DIAG(D176,CSRF[POZN]);                                       DON/D
          RETURN; 
                                                                         DON/D
                                                                         DON/D
  
  
#    SCAN THREE--UNDEFINED NAME PROCESSING--- 
  
          THESE NAMES HAVE ALREADY BEEN  POSTED AS DUMMIES BY SCAN ONE. 
          IF THEY ARE DISCOVERED TO BE IN AMBIGUOUS CONTEXT, NOTHING
          FURTHER IS DONE.  IF THEY ARE IN PROC CONTEXT, THEY ARE 
          REPOSTED AS SUCH, AND THE DUMMY IS LINKED TO THE NEW ENTRY# 
  
RUND10:   #    (PARLHD)  (UNDNAM)  (COMMA2)  ==   (PARLT)   (COMMA2)  # 
RUN100:   #    (PARLHD)  (UNDNAM)  (RPARE2)  ==   (PARLT)   (RPARE2)  # 
          ENDSAV;                            #STOP EXPRESSION SAVE# 
          TPYA=CSRF[BLNK[BLNK[POZN]]];
          PPNP[TPYA]=PPNP[TPYA]+1;
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
RUND11:  #    (LFHD)(UNDNAM)(RPARE2)==(LFBODY)(RPARE2)  # 
               TEMP = CSRF [BLNK[POZN]];
               IF FPRI [TEMP] EQ S"VALU"
               THEN                                                      PF13 
                 BEGIN                                                   PF13 
                 DIAG0(D152);                                            PF13 
                 END                                                     PF13 
                    IF FPRI[TEMP] EQ S"NAMC"
                    AND FLCH[TEMP] EQ 0 
                      THEN
                      BEGIN 
                      FLCH[TEMP] = FLCHED[SCOPE]; 
                      FLCHED[SCOPE] = TEMP; 
                      END 
          OPERND(CSRF[BLNK[POZN]]);          #PUT OUT NAME# 
          XUSE(1);
          SBEG[CSRF[BLNK[POZN]]]=SCOPE;           #VALIDATE DUMMY#
   LREF[CSRF[BLNK[POZN]]] = LREF [CSRF [BLNK [POZN ]]] + 1 ;
    #HOPE PROCS WONT MIND THIS ONE# 
          CSRF[BLNK[POZN]]=TPYA;
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
RUND13:   #    (STHEAD)(UNDNAM)(LPARE3)==(STHEAD)(PRCRFP)(LPARE3)      # DON/D
          RUNDSW=TRUE;
          GOTO RND12A;
  
  
                                                                         DON/D
                                                                         DON/D
RUND12:   #    (STHEAD)(UNDNAM)(SEMI3)==(STHEAD)(PRCRFP)(SEMI3)        # DON/D
          RUNDSW=FALSE; 
  
#     ISSUE DIAGNOSTIC IF UNDNAM IS AN UNDECLARED FORMAL PARAMETER     #
#     NOTE- THIS TEST WON"T WORK IF UNDNAM HAS PARAMETERS SINCE PVDF   #
#           REFLECTS THE LAST PARAMETER AND NOT THE PROC NAME          # DON/D
  
      IF CLAS[PVDF] EQ S"FPAR" THEN DIAG(D104,CSRF[POZN]);               DON/D
RND12A:   TLD1=CSRF[BLNK[POZN]];
          FIND(TLD1,NSEC);
          POW(NSEC,PRCWDS,QCLAS"PROC",CLIST"PRCNAM"); 
          CSRF[BLNK[POZN]]=DSEC;
          DECL[DSEC]=S"NONE"; 
          FLCH[DSEC]=FLCHED[SCOPE]; 
          FLCHED[SCOPE]=DSEC; 
          RLNK[TLD1]=DSEC;
          FPRI[DSEC]=FPRI[TLD1];
          IF FPRI[DSEC] NQ 0 THEN #ADD PARS TO DATA CHAIN#
               BEGIN
               ASEQ[LENT[DPLC]]=DSEC;        #TAKE ME TO YOUR LEADER# 
               LENT[DPLC]=DSEC; 
               END
          IF RUNDSW THEN GOTO RPRC10; 
         GOTO RPRC13; 
  
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
RUND14:   #    (UNDNAM)==(NULL)         # 
      IF FPRI[CSRF[POZN]] EQ S"NAMC" THEN DIAG(D104,CSRF[POZN]);         DON/D
                                     ELSE DIAG(D003,CSRF[POZN]);         DON/D
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
#         BOOLEAN EXPRESSION OPERATOR CODE GENERATION  #
  
  
  
  
REXP31:   #    TEST(PBOP)(BOPND)(BOP)==(BOPND)(BOP)    #
          OP=CSRFR[BLNK[BLNK[POZN]]];             #OP NUMBER# 
          IF PREC[OP]LS PREC[CSRFR[POZN]]THEN RETURN; 
          RPLI=1; 
          OPLEV=CSRFL[BLNK[BLNK[POZN]]];          #BRK LEVEL OF OP# 
  
REX31A:   IF OP NQ S"NOT" THEN RETURN;
          FOR TPYA=LEVLOP STEP -1 UNTIL OPLEV+1 DO
               #A NOT MUST REVERSE THE TURE AND FALSE CONDITION 
               LABELS OF ALL PRENTHESIS LABELS INTERIOR TO THE CURRENT
               ONE.  LEVLOP IS THE LEVEL OF THE LAST AND OR OR# 
               TLABL[TPYA]==FLABL[TPYA];
          POPR(QILOP"PNOT");                      #NOT LAST OPERAND#
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
REXP33:   #    (PBOP)(BOPND)==(BOPND)   # 
          OP=CSRFR[BLNK[POZN]]; 
          OPLEV=CSRFL[BLNK[POZN]];                #LEVEL# 
          GOTO REX31A;
  
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
REXP32:   #    (PBOP)(BOPND)(BOP)==(PBOP)(PBOP)   # 
REXP34:   #    (BOPND)(BOP)==(PBOP)     # 
          CBXFLG=0; 
          OPLEV=CSRFL[POZN];                      #PAR LEVEL OF NEW OP# 
          IF CSRFR[POZN]EQ QOP"OR" THEN           #OR OPERATOR# 
               BEGIN
               IF TLABL[OPLEV]EQ 0 THEN           #NO TRUE LAB YET# 
                    BEGIN 
                    CSAV(TLD1);                   #NEW BUFFER#
                    TLABL[OPLEV]=TLD1;
                    END 
               ELSE OSAV(TLABL[OPLEV]);           #REOPEN OLD BUFFER# 
               GENLAB(TPYB);                      #GENERATE LABEL#
               POPN(TPYB);                        #PUT IN BUF#
                    POPR(QILOP"LABL");
                    ENDSAV; 
               CSAV(TPYC);                        #NEW BUF FOR FALSES#
               FOR TPYA=LEVLOP STEP -1 UNTIL OPLEV+1 DO 
                    #    ALL TRUE LABELS AT INTERIOR LEVELS MUST BE 
                         MERGED WITH THE TRUE LABELS AT THE CURRENT 
                         LEVEL, AND ALL FALSE LABELS AT INTERIOR
                         LEVELS(AS WELL AS FALSE LABELS AT THIS LEVES)
                         MUST BE COLLECTED TO BE DROPPED IN AFTER THE 
                         OR OPERATOR# 
                    BEGIN 
                         OSAV(TLABL[OPLEV]);      #REOPEN CURR TRUE BUF#
                         RESTR(TLABL[TPYA]);      #MERGE# 
                         ENDSAV;
                         RESTR(FLABL[TPYA]);      #SAVE FOR AFTER OR# 
                         BLABL[TPYA]=0; 
                    END 
               RESTR(FLABL[OPLEV]); 
               FLABL[OPLEV]=0;
               ENDSAV;                            #GOT ALL FALSES#
               POPR(QILOP"PNOT");                 #IN ABSENCE OF TSSF#
                                                                         DON/D
REX34A:        POPN(TPYB);                        #GENERATED LABEL# 
               POPR(QILOP"TSST"); 
               RESTR(TPYC);                       #DROP IN LABELS#
               LEVLOP=OPLEV;
               IF CBXFLG EQ 0 THEN RETURN;
               RESTR(TLABL[OPLEV]); 
               CSRFL[POZN]=FLABL[OPLEV];     #FALSE CASES#
               BLABL[OPLEV]=0;
               GOTO CBXSW[CBXFLG];
               END
          IF CSRFR[POZN] NQ QOP"AND" THEN 
               BEGIN
               DIAG0(D126);                                              PF13 
               RETURN;
               END
           TLD2 = QILOP"LABL" ; 
  
REX34B:   #THIS SECTION PROCESSES AND OPERATORS AND EXPRESSION ENDS#
          IF FLABL[OPLEV]EQ 0 THEN
               BEGIN                              #NO FALSE YET#
               CSAV(TLD1);                        #NEW BUFFER#
               FLABL[OPLEV]=TLD1; 
               END
          ELSE OSAV(FLABL[OPLEV]);                #USE OLD BUFFER#
          GENLAB(TPYB);                           #GEN FALSE LABEL# 
          POPN(TPYB); 
           POPR(TLD2);
          ENDSAV; 
          CSAV(TPYC);                             #NEW ONE FOR TRUES# 
          FOR TPYA=LEVLOP STEP -1 UNTIL OPLEV+1 DO
               BEGIN
               # FOR ANDS---EACH INTERIOR TURE LABEL MUST BE BROUGHT IN 
               FOLLOWING THE ADN, AND EACH INTERIOR FALSE LABEL 
               MUST BE MERGED WITH THE FALSE LABESL OF THE
               CURRENT LEVEL# 
                    OSAV(FLABL[OPLEV]);           #OPEN FOR MERGE#
                    RESTR(FLABL[TPYA]); 
                    ENDSAV; 
                    RESTR(TLABL[TPYA]);           #MERGE WITH OTHERS# 
                    BLABL[TPYA]=0;
               END
          ENDSAV;                                 #GOT ALL THE TRUES# 
          GOTO REX34A;
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
RBX10:  # (FWHILE)(BOPND) == (FWHILE)(SBX) #
##       OPLEV=0; 
##       FOR TPYA=LEVLOP STEP -1 UNTIL OPLEV   DO 
                TLABL[TPYA]==FLABL[TPYA]; 
         POPR(QILOP"PNOT"); 
           IF FASTLOOP THEN 
             TLD2 = QILOP"SLOP" ; 
           ELSE 
             TLD2 = QILOP"LABL" ; 
          OPLEV=0;
          CBXFLG=S"REX40A"; 
          GOTO REX34B;
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
RBX12:    #    (FIF)(BOPND)==(FIF)(IFX)      #
REX40:    #    (SINK)(EQUALS)(BOPND)==(SINK)(EQUALS)(BX)    # 
           TLD2 = QILOP"LABL";
          OPLEV=0;
          CBXFLG=S"REX40A"; 
          GOTO REX34B;
                                                                         DON/D
REX40A:   ENDSAV; 
          CSRFR[POZN]=CSRFL[BLNK[POZN]];
          RETURN; 
  
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
BCONS1:   #  (SINK)(EQUALS)(CONST)(SEMI3)==(SINK)(EQUALS)(SIMBX)(SEMI3)# DON/D
RITM19:   #    SAME THING FOR BOOLEAN ITEM NAME (ITMNAM)         #
RFNC16:   #    SAME THING FOR FUNC NAME [FNCNAM)# 
RSUB36:   #    (SAME THING FOR ARIREF)  ARRAY REFERENCE     # 
          #THIS SECTION MAKES A SPECIAL CASE OF BOOLEAN EXPRESSIONS 
          WHICH CONSIST OF JUST ONE OPERND--THESE HAVE NO JUMPL OR
          OTHER COMPLICATIONS, AND IT POSSIBLE TO MAKE ASSIGNMENTS OF 
          THEM WITHOUT USING A TEMP AS IN FSINK2       #
          ENDSAV; 
          CSRF[BLNK[POZN]]=0; 
          TPYA=BLNK[BLNK[BLNK[POZN]]];
          IF  LEVL[CSRF[POZN]]   EQ  S"LEV3" THEN                        LARRY-R
            DIAG(D176,CSRF[POZN]);                                       DON/D
          IF TYPE[SINKL[CSRF[TPYA]]]NQ S"BOOL" THEN 
      DIAG(D124,SINKL[CSRF[TPYA]]);                                      DON/D
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
#    ITEM AND FUNCTIONA NAME HANDLING        #
  
RIT101:   #    (PARLHD)(ITMNAM)(COMMA2) ==(PARLT) (COMMA2)       #
RIT102:   #    (PARLHD)(ITMNAM)(RPARE2) ==(PARLT) (RPARE2)       #
          XSET(1);                                #CROSSREF#
                                                                         DON/D
RIT10A:   ENDSAV;                                 #END EXPRESSION SV# 
          TPYA=CSRF[BLNK[BLNK[POZN]]];
          OPERND(CSRF[BLNK[POZN]]); 
          PPNP[TPYA]=PPNP[TPYA]+1;                #LIST COUNT#
          CSRF[BLNK[POZN]]=TPYA;
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
RFN111:   #    (PARLHD)(FNCNAM)(COMMA2)==(PARLT)(COMMA2)    # 
RFN112:   #    (PARLHD)(FNCNAM)(RPARE2)==(PARLT)(RPARE2)    # 
          XUSE(1);                                #CROSSREF#
          GOTO RIT10A;
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
RITM16:   #    (ITMNAM)(EQUALS)==(SINK)(EQUALS)   # 
          CSAV(TPYA); 
          CSRFL[POZN]=TPYA; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
RITM12:   #    (ITMNAM)(EXCH)==(SINK)(EXCH)  #
          XSET(1)                      ;          #CROSSREF#
          TPYB=CSRF[BLNK[POZN]];                  #ITMLOC#
          CSRF[BLNK[POZN]]=NPARLS;                #TABLE SLOT#
      SINKX[NPARLS] = 0;                                                 DON/D
          GOTO RSU32B;                       #SHARE CODE WITH ARRITM# 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
RITM13:   #    (EXCH)(ITMNAM)==(EXCH)(SINK)  #
          XSET(0);
          TPYB=CSRF[POZN];
          CSRF[POZN]=NPARLS;
      SINKX[NPARLS] = 0;                                                 DON/D
          GOTO RSU32B;                       #SHARE CODE WITH ARRITM# 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
RFNC12:   #    (FNCNAM)(EQUALS)==(SINK)(EQUALS)        #
          XSET(1)   ;                             #CROSSREF#
          SINKL[NPARLS]=CSRF[BLNK[POZN]]; 
          SINKC[NPARLS]=S"FUNC";                  #SINK TYPE# 
          CSRF[BLNK[POZN]]=NPARLS;
          CSAV(TPYA);                   #OPEN FOR EXP#
          CSRFL[POZN]=TPYA; 
          GOTO RSU32C;
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
RFNC15:   #    TEST(FNCNAM)==(AOPND)    # 
          XUSE(0);                           #CROSSREF# 
  
#     CHECK FOR MOST BLATANT RECURSIVE CASE - THAT OF A FUNCTION       #
#     CALLING ITSELF.                                                  #
  
      IF SCPN[SCOPE] EQ CSRF[POZN] THEN DIAG(D181,CSRF[POZN]);
          OPERND(CSRF[POZN]); 
          POPR(QILOP"NULL");
          POPR(QILOP"FCAL");
          GOTO AOPND[TYPE[CSRF[POZN]]]; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
#    PARAMETER HANDLING#
  
RARR12:   #    (PARLHD)(ARRNAM)==(PARLT)          # 
          IF (LEVL[CSRF[POZN]] EQ S"LEV3")                               SMPA077
            AND (TTYP[CSRF[POZN]] EQ S"BASED")                           SMPA077
          THEN                                                           SMPA077
            BEGIN                      #LEVEL3 BASED ARRAY NAME AS     # SMPA077
            DIAG(D176,CSRF[POZN]);     #ACTUAL PARAM IS ILLEGAL.       # SMPA077
            END                                                          SMPA077
          XSET(0);
                                                                         DON/D
RAR12A:   ENDSAV;                            #END EXPRESSION SAVE#
          OPERND(CSRF[POZN]); 
          CSRF$;
          PPNP[CSRF[POZN]]=PPNP[CSRF[POZN]]+1;
          RETURN; 
                                                                         DON/D
                                                                         DON/D
  
  
RARR14:   #    (PARLHD)(ARRNAM)(LSQUAR)  == (PARLHD)(ARERFP)(LSQUAR)   #
          XSET (1) ;    #MARK CROSS-REF FILE #
          OPERND(CSRF[BLNK[POZN]]) ;    #PUT ARRAY NAME ON IL-FILE     #
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
RSUB43:   #    (PARLHD)(AREREF)     ## (PARLT)      # 
          RESTR( SSBXB ) ;
          POPR (QILOP"SUBS" ) ; 
          GOTO RPAR10;     # FINISH OFF EXPR   #
  
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
RLAB10:   #    (PARLHD)(LABNAM)==(PARLT)     #
      LREF[CSRF[POZN]] = LREF[CSRF[POZN]] + 1;
      XUSE(0);               #-USE- CROSSREF ENTRY#                      DON/D
      GOTO RAR12A;                                                       DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
RPRC11:   #    (PARLHD)(PRCNAM)==(PARLT)     #
      XUSE(0);               #-USE- CROSSREF ENTRY#                      DON/D
          GOTO RAR12A;
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
#    LOC FUNCTION PROCESSING       #
  
RLAB11:  #   (LFHD)(LABNAM)==(LFBODY)   # 
            LREF[CSRF[POZN]] = LREF[CSRF[POZN]] + 1;                     PF13C
            DIAG0(D189);                                                 PF13C
            GOTO RITM11;
                                                                         DON/D
                                                                         DON/D
RFNC14:   #    LFHD)(FNCNAM)==(LFBODY)       #
            DIAG0(D192);                                                 PF13C
            GOTO RPRC12A;                                                PF13C
RSWI11:   #    (LFHD)(SWINAM)==(LFBODY) # 
            DIAG0(D190);                                                 PF13C
            GOTO RPRC12A;                                                PF13C
RPRC12:   #    (LFHD)(PRCNAM)==(LFBODY) # 
            DIAG0(D191);                                                 PF13C
RPRC12A:                                                                 PF13C
                                                                         DON/D
  
RITM11:  #    (LFHD)(ITMNAM)==(LFBODY)  # 
RARR11: #    (LFHD)(ARRNAM)==(LFBODY)   # 
          XUSE(0);
          OPERND(CSRF[POZN]);      #DATA REFERENCE# 
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
RSUB41:   #    (LFHD)(AREREF)==(LFBODY)      #
RSUB34:   #    (LFHD)(ARIREF)==(LFBODY)      #
          OPERND(CSRF[POZN]); 
          RESTR(SSBXB);                      #SUBSCRIPT EXPRESSION)   # 
          POPR(QILOP"SUBS");
          XUSE(0);
          RETURN; 
  
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
RLOC21:   #    (LFBODY)(RPARE2)==(AOPND)          #                      DON/D
          POPN(INIFT[QFNBR"LOC"]);
          POPR(QILOP"FUNI");                 #PUT OUT SPEC MODIFIER#
          CSRFL[POZN]=QOPTYP"USI";           #OPERAND TPYE UNI# 
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
RLOC22:   #    (LFBODY)==(NULL)         # 
          DIAG0(D128);                                                   PF13 
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
#    ABS  FUNCTIONS#
                                                                         DON/D
RABS1:    #    (AFBODY)(RPARE2)==(AOPND)          # 
          CSRF$;
               # DONT OUTPUT AN ABS OPERATOR FOR CHARACTERS- THEY ARE 
                 ALREADY ABSOLUTE VALUES IN ARITH EXPRESSIONS#
          IF CSRFL[POZN] NQ QOPTYP"CHAR" THEN 
          POPR(AOPR[QOP"ABS",CSRFL[POZN]]); 
          IF CSRFL[POZN] EQ QOPTYP"IGR" THEN CSRFL[POZN]=QOPTYP"USI"; 
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
RABS2:    #    (AFBODY)==(NULL)         # 
          DIAG0(D129);                                                   PF13 
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
#    P-FUNCTIONS# 
                                                                         DON/D
RBAR10:   #    (PFHEAD)(BARNAM)(RPOINT)==(PFUNC)  # 
          CSRF$;
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
RBAR11:   #    (PFHEAD)(BARNAM)==(PFUNC)          # 
      DIAG(D130,CSRF[POZN]);                                             DON/D
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
RBAR12:   #    (PFHEAD)==(NULL)         # 
          DIAG0(D143);             # MALFORMED P-FUNCTION              # PF13 
          RETURN; 
  
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
RPF101:   #    (PARLHD)(PFUNC) (RPARE2)==(PARLT)(RPARE2)         #
RPF102:   #    (PARLHD)(PFUNC) (COMMA2)==(PARLT)(COMMA2)         #
          XSET(1);
          ENDSAV;                       #CLOSE EXPRESSION BUFFER# 
          OPERND(CSRF[BLNK[POZN]]); 
          POPN(INIFT[QFNBR"PFUN"]); 
          POPR(QILOP"FUNI");
          TPYA=BLNK[POZN];                        #POINTER TO NEW PARLT#
          TPYB=CSRF[BLNK[TPYA]];                  #PAR LIST GOODIES#
          CSRF[TPYA]=TPYB;
          PPNP[TPYB]=PPNP[TPYB]+1;
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
RPFU14:   #    (PFUNC)==(AOPND)         # 
RPFU15:   #    (LFHD)(PFUNC) == (LFBODY)          # 
          XUSE(0);       #MAKE -USE-TYPE CROSSREFERENCE ENTRY#
          OPERND(CSRF[POZN]); 
          POPN(INIFT[QFNBR"PFUN"]); 
          POPR(QILOP"FUNI");
          CSRFL[POZN]=QOPTYP"USI";      #THESE GUYS ARE ALWAYS UNSIGNED#
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
RPFU13:   #    (PFUNC)(EQUALS)==(SINK)(EQUALS)         #
          CSAV(TPYA);                   #OPEN EXPRESSION SAVE BUFFER# 
          CSRFL[POZN]=TPYA; 
          IF NOT CSDF[FLNK[POZN]]                                        PF13C
          THEN                                                           PF13C
            BEGIN                                                        PF13C
            DIAG0(D196);                                                 PF13C
            END                                                          PF13C
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
RPFU12:   #    (PFUNC)(EXCH)==(SINK)(EXCH)        # 
          XSET(1);
          SINKL[NPARLS]=CSRF[BLNK[POZN]]; 
          CSRF[BLNK[POZN]]=NPARLS;           #SAVE LINK SLOT# 
      SINKC[NPARLS] = S"P";  #SINK TYPE IS P#                            DON/D
          GOTO RSU32C;                  #SET UP NEW SLOT# 
  
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
RPFU11:   #    (EXCH)(PFUNC)==(EXCH)(SINK)        #                      DON/D
          XSET(0);
          SINKL[NPARLS]=CSRF[POZN]; 
          CSRF[POZN]=NPARLS;
      SINKC[NPARLS] = S"P";  #SINK TYPE IS P#                            DON/D
      GOTO RSU32C;           #SET UP NEW SLOT#                           DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
RPAR32:   #    TEST(FNCRFP)(PARLST)==(AOPND)      # 
          OPERND(CSRF[BLNK[POZN]]); 
          RESTR(PPLS[CSRF[POZN]]);
          POPR(QILOP"FCAL");
          CSRF$;
          GOTO AOPND[TYPE[CSRF[POZN]]]; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
RFNC10:   #    (FNCNAM)(LPARE3)    ==   (FNCRFP)(LPARE3)    # 
          TPYB=QPARTY"FUNC";
                                                                         DON/D
RFN10A:   XUSE(1);
  
#     CHECK FOR MOST BLATANT RECURSIVE CASE - THAT OF A PROC OR FUNC   #
#     CALLING ITSELF.                                                  #
  
      IF SCPN[SCOPE] EQ CSRF[BLNK[POZN]]  THEN
          DIAG(D181,CSRF[BLNK[POZN]]);
          CSRF[POZN]=NPARLS;
          PPNP[NPARLS]=0; 
          CSAV(TPYA); 
          PPLS[NPARLS]=TPYA;            #SAVE FOR PARAMETER LIST# 
          CSAV(TPYA); 
          PPXS[NPARLS]=TPYA;                 #SAVE FOR ITS FIRST EXP# 
          PTYP[NPARLS]=TPYB;                 #PAR LIST TYPE#
          GOTO RSU32C;
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
RPRC10:   #    (PRCNAM)(LPARE3)==(PRCRFP)(LPARE3)      #
          TPYB=QPARTY"PROC";                 #SEE RFNC10 FOR CONTRAST#
          GOTO RFN10A;
  
  
                                                                         DON/D
                                                                         DON/D
RSWI10:   #    (SWINAM)(LSQUAR)==(SWIRFP)(LSQUAR) #                      DON/D
      XUSE(1);                                                           DON/D
      RETURN;                                                            DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
RPRC13:   #    (PRCNAM)(SEMI3)==(PRCRFP)(SEMI3)   # 
      XUSE(1);                                                           DON/D
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
RPAR20:   #    RULE(PARLT)    # 
          IF PPNP[CSRF[POZN]] GR 1 THEN 
               POPR(QILOP"PLST");  #LIST OPERATOR#
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
RPAR21:   #    (PARLT)(COMMA2)==(PARLHD)          # 
          CSRF$;
          CSAV(TPYA);                        #FOR NEXT EXPR#
          PPXS[CSRF[POZN]]=TPYA;
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
RPAR22:   #    (PARLT)(RPARE2)==(PARLST)          # 
          CSRF$;
          ENDSAV;             #CLOSE LIST BUFFER# 
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
RPAR23:   #    (PARLT)==(PARLST)        BAD LIST-TRUNCATE#
          DIAG0(D111);             # BAD LIST                          # PF13 
          ENDSAV;             #CLOSE LIST BUFFER# 
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
RPAR10:   #    (PARLHD)(AX)==(PARLT)         #
          ENDSAV; 
          RESTR(PPXS[CSRF[BLNK[POZN]]]);
      CSRF$;                 #SAVE CSRF#                                 DON/D
          PPNP[CSRF[POZN]]=PPNP[CSRF[POZN]]+1;
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
RPAR11:   #    (PARLHD)(BOPND)==(PARLT)      #
           TLD2 = QILOP"LABL";
          CBXFLG=S"RPR11A";                  #SWITCH SETTING# 
          OPLEV=0;
          GOTO REX34B;
                                                                         DON/D
RPR11A:   ENDSAV;                                 #EXPR BUFFER# 
          CSAV(TPYA);                        #PRESTATEMENT CODE#
          RESTR(PSTCS);                      #OLD ONE#
          PSTCS=TPYA;                        #NEW ONE#
          GENTMP(TPYB); 
          #A BOOL IN A PAR LIST MUST BE GENERATED INTO A TEMP 
          OUTSIDE, AND THE TEMP PASSED# 
          POPN(TPYB);                        #FIRST:  TEMP=FALSE# 
          POPN(ZERO$);
          POPR(QILOP"REPL");
          RESTR(PPXS[CSRF[BLNK[POZN]]]);     #DROP IN BOOLEAN#
          POPN(TPYB);                        #NOW TEMP=TRUE#
          POPN(ONE$); 
          POPR(QILOP"REPL");
          RESTR(CSRFL[POZN]);                #FALSE CASE LABELS#
          ENDSAV;                            #DONE WITH STACKER#
          POPN(TPYB);                        #PUT TEMP INTO LIST# 
      CSRF$;                 #SAVE CSRF#                                 DON/D
          PPNP[CSRF[POZN]]=PPNP[CSRF[POZN]]+1;
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
#AXIS     # 
                                                                         DON/D
RAX1:     #    (SINK)(EQUALS)(AX)==(SINK)(EQUALS)(SAX) #
          ENDSAV; 
          TPYA=BLNK[BLNK[POZN]];
      IF TYPE[SINKL[CSRF[TPYA]]] EQ S"BOOL" THEN                         DON/D
          DIAG(D124,SINKL[CSRF[TPYA]]);                                  DON/D
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
#SUBSCRIPT CODE HANDLING      # 
  
RSUB31:   #    (ARIREF)(EQUALS)==(SINK)(EQUALS)        #
          CSAV(TPYA);                        #FOR EXPR# 
          CSRFL[POZN]=TPYA; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
RSUB32:   #    (ARIREF)(EXCH)==(SINK)(EXCH)       # 
          XSET(1);
          TPYB=CSRF[BLNK[POZN]];
          CSRF[BLNK[POZN]]=NPARLS;
                                                                         DON/D
RSU32A:   SINKX[NPARLS]=SSBXB;
          IF  LEVL[MAMA[TPYB]]  EQ S"LEV3"  THEN    # CHECK LEVEL OF     LARRY-R
                                                          MAMA       #   LARRY-R
      DIAG(D176,TPYB);                                                   DON/D
                                                                         DON/D
RSU32B:   SINKC[NPARLS]=S"ITEM";
          SINKL[NPARLS]=TPYB; 
          IF  LEVL[TPYB]  EQ  S"LEV3"   THEN      # ITEM ITSELF   #      LARRY-R
      DIAG(D176,TPYB);                                                   DON/D
                                                                         DON/D
RSU32C:   NPARLS=NPARLS+1;
##       IF NPARLS GQ NPRLST THEN 
          SYMABT(J823,"PARAM LIST TABLE OVERFLOW(PF13)",31);             PF13 
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
RSUB33:   #    (EXCH)(ARIREF)==(EXCH)(SINK)       # 
          XSET(0);
          TPYB=CSRF[POZN];
          CSRF[POZN]=NPARLS;
          GOTO RSU32A;
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
RSUB35:   #    TEST(ARIREF)==(AOPND)         #
          XUSE(0);
          POPN(CSRF[POZN]             );
          RESTR(SSBXB);                      #SUBSCRIPT EXPR# 
          POPR(QILOP"SUBS");
          IF  LEVL[CSRF[POZN]]  EQ  S"LEV3"                              LARRY-R
          OR  LEVL[MAMA[CSRF[POZN]]]  EQ  S"LEV3"    THEN                LARRY-R
            DIAG(D176,CSRF[POZN]);                                       DON/D
                                                                         DON/D
          GOTO AOPND[TYPE[CSRF[POZN]]]; 
  
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
#              FOR LOOPS      # 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
RIT15B:                                                                  DON/D
      DIAG(D130,CSRF[BLNK[POZN]]);     #BAD IND VAR TYPE#                DON/D
RIT15A:   IF  LEVL[CSRF[BLNK[POZN]]]   NQ   S"LEV1"  THEN                LARRY-R
      DIAG(D177,CSRF[BLNK[POZN]]);                                       DON/D
          RETURN;                                                        LARRY-R
  
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
RITM15:   #    (FOR)(ITMNAM)(EQUALS)==(FOR)(INDV)(EQUALS)        #
          XSET(1);
          CSAV(TPYA);                   #FOR INITIAL EXPRESSION#
          CSRFL[POZN]=TPYA; 
          GOTO RIT15S[TYPE[CSRF[BLNK[POZN]]]];
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
RFOR9:    #    (STEP)(AOP)==(FSTEP)(AOP)          # 
          IF CSRF[POZN] EQ QOP"MINUS" THEN STEPS=1; 
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
RFOR8:    #     RULE          (STEP)         #
          STEPS=0;
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
RFOR11:   #    (WHILE)==(FWHILE)        # 
RFOR12:   #    (UNTIL)==(FUNTIL)        # 
RIF1:               #    (IF)==(FIF)         #
          CSAV(TPYA); 
          CSRFL[POZN]=TPYA; 
          #THIS IS THE PLACE TO SAVE THE UPCOMING BOOLEAN EXPRESSION# 
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
#SCAN CONTROL DELIMITERS WHICH PASS CONTROL TO SCAN FOUR# 
                                                                         DON/D
RMIS13:   #    (DO3)==(DO4)                       #                      DON/D
RMIS14:   #    (END3)==(END4)                     #                      DON/D
RMIS15:   #    (SEMI3)==(SEMI4)                   #                      DON/D
RMIS16:   #    (TERM3)==(TERM4)                   #                      DON/D
RMIS17:   #    (THEN3)==(THEN4)                   #                      DON/D
RMIS18:   #    (ELSE3)==(ELSE4)                   #                      DON/D
RMIS19:   #    (BEGIN3)==(BEGIN4)                 #                      DON/D
          ENDSAV; 
          RETURN;                            #SCAN 4 CAN GENERATE CODE #
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
RFOR13:   #    (INDV)(EQUALS)(AX)==(INDV)(EQUALS)(SAX) #
RFOR14:   #    (FSTEP)(AX)==(FSTEP)(SAX)          # 
RFOR15:   #    (FUNTIL)(AX)==(FUNTIL)(SAX)        # 
          ENDSAV; 
          RETURN; 
  
  
                                                                         DON/D
                                                                         DON/D
#    BEAD FUNCTIONS#
  
RIT100:   #    (BFUNCT)(ITMNAM)==(BFUNC)          # 
          SSBXB=0;
  
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
RSB301:   #    (BFUNCT)(ARIREF)==(BFUNC)          #                      DON/D
          IF BEADC[CSRF[BLNK[POZN]]] EQ QBEADC"BIT"                      PF13C
            AND TYPE[CSRF[POZN]] EQ QTYPE"EBCD"                          PF13C
          THEN                                                           PF13C
            BEGIN                                                        PF13C
            DIAG0(D193);                                                 PF13C
            END                                                          PF13C
          IF BEADC[CSRF[BLNK[POZN]]] EQ QBEADC"BYTE"                     PF13C
            AND TYPE[CSRF[POZN]] NQ QTYPE"EBCD"                          PF13C
          THEN                                                           PF13C
            BEGIN                                                        PF13C
            DIAG0(D194);                                                 PF13C
            END                                                          PF13C
          BEADL[CSRF[BLNK[POZN]]]=CSRF[POZN]; 
          CSRF$;
          BEADSX[CSRF[POZN]]=SSBXB; 
          IF  LEVL[CSRF[POZN]]   EQ  S"LEV3" THEN                        LARRY-R
            DIAG(D176,CSRF[POZN]);                                       DON/D
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
RBF21:    #    (BFUNC)(EQUALS)==(SINK)(EQUALS)         #
          CSAV(TPYA); 
          CSRFL[POZN]=TPYA; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
RBF24:    #    (BFUNC)(EXCH)==(SINK)(EXCH)   #
          SINKB[NPARLS]=CSRF[BLNK[POZN]]; 
          CSRF[BLNK[POZN]]=NPARLS;
          XRSET(BEADL[SINKB[NPARLS]],CRNO[BLNK[POZN]]); 
      SINKC[NPARLS] = S"BEAD";     #NEW ENTRY   TYPE BEAD#               DON/D
          GOTO RSU32C;
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
RBF22:    #    (EXCH)(BFUNC)==(EXCH)(SINK)        # 
          SINKB[NPARLS]=CSRF[POZN];          #PUT BEAD NUMBER IN SINK#
          CSRF[POZN]=NPARLS;                 #SINK NUMBER#
          XRSET(BEADL[SINKB[NPARLS]],CRNO[POZN]); 
      SINKC[NPARLS] = S"BEAD";     #NEW ENTRY   TYPE BEAD#               DON/D
      GOTO RSU32C;                                                       DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
RBF23:    #    (BFUNC)==(AOPND)         # 
          XRUSE(BEADL[CSRF[POZN]],CRNO[POZN]);
          RESTR(BEADXA[CSRF[POZN]]);              #FIRST EXPR#
          RESTR(BEADXB[CSRF[POZN]]);              #2ND   EXPR#
          POPR(QILOP"FLST");
          OPERND(BEADL[CSRF[POZN]]);
          IF BEADSX[CSRF[POZN]] NQ 0 THEN 
               BEGIN     #PUT OUT SUBSCRIPT#
               RESTR(BEADSX[CSRF[POZN]]); 
               POPR(QILOP"SUBS"); 
               END
          POPR(QILOP"FLST");
          IF BEADC[CSRF[POZN]] EQ S"BIT" THEN 
               BEGIN
               TPYA=QFNBR"BIT"; 
               TPYB=QOPTYP"USI";
               END
          ELSE BEGIN
               TPYA=QFNBR"BYTE";
               TPYB=QOPTYP"CHAR"; 
               COPLEN=0;
               END
          POPN(INIFT[TPYA]);
          POPR(QILOP"FUNI");
          CSRFL[POZN]=TPYB; 
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
RBF9:     #    (BFHEAD)==(BFTOP)        # 
          BEADC[NPARLS]=CSRF[POZN]; 
          CSRF[POZN]=NPARLS;
          BEADNX[NPARLS]=0; 
          CSAV(TPYA);                        #OPEN BUFFER FOR EXPR# 
          BEADXA[NPARLS]=TPYA;
          NPARLS=NPARLS+2;
##       IF NPARLS GQ NPRLST THEN 
          SYMABT(J823,"PARAM LIST TABLE OVERFLOW(PF13)",31);             PF13 
          RETURN; 
  
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
RBF10:    #    (BFTOP)(AX)==(BFTAX)          #
          IF TCONVF[CSRFL[POZN],QOPTYP"IGR"] NQ 0 THEN
               BEGIN
               POPN(TCONVF[CSRFL[POZN],QOPTYP"IGR"]); 
               POPR(QILOP"FUNI");       #CONVERT TO IGR IF BEED BE# 
               END
          CSRF$;
          ENDSAV;                            #CLOSE EXPRESSION SAVE#
          BEADNX[CSRF[POZN]]=BEADNX[CSRF[POZN]]+1;
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
RBF11:    #    (BFTAX)(RPOINT)==(BFUNCZ)     #
          CSRF$;
          IF BEADNX[CSRF[POZN]] EQ 2 THEN RETURN; 
          IF BEADNX[CSRF[POZN]] GR 2 THEN GOTO RBF13; 
          # DEFAULT NUMBER OF ONE#
          CSAV(TPYA); 
          BEADXB[CSRF[POZN]]=TPYA;
          POPN(ONE$); 
          ENDSAV; 
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
RBF12:    #    (BFTAX)(COMMA2)==(BFTOP)      #
          CSRF$;
          CSAV(TPYA);         #OPEN NEW BUFFER FOR UPCOMING EXPRESSION# 
          BEADXB[CSRF[POZN]]=TPYA;
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
RBF13:    #    (BFTAX)==(BFUNCT)        # 
          DIAG0(D125);                                                   PF13 
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
RBF30:    #    (BFUNCZ)  ==(NULL)  #
          DIAG0(D134);                                                   PF13 
          RETURN; 
  
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
#EXPRESSION FORMATION#
  
REXP10:   #    (PAOP)(AOP)==(PAOP)(PAOP)          # 
          IF PREC [CSRFR [BLNK [POZN]]] LS PREC [CSRF [POZN]] THEN       SMPA085
               BEGIN
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
RXP100:   #    (AOP)==(PAOP)       #
               IF CSRF[POZN] EQ QOP"LNO" THEN RETURN; 
               IF CSRF[POZN] EQ QOP"PLUS" THEN
                    BEGIN 
                    CSRF[POZN]=QOP"UPLUS";
                    RETURN; 
                    END 
               IF CSRF[POZN] EQ QOP"MINUS" THEN 
                    BEGIN 
                    CSRF[POZN]=QOP"UMINUS"; 
                    RETURN; 
                    END 
               END
          DIAG0(D126);                                                   PF13 
               RETURN;
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
REXP11:   #    (BOP)==(PBOP)                      #                      DON/D
          IF  CSRFR[POZN] NQ QOP"NOT" THEN
          DIAG0(D126);                                                   PF13 
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
REXP21:   #    TEST(PAOP)(AOPND)(AOP)==(AOPND)(AOP)         # 
          TLD1=CSRFR[BLNK[BLNK[POZN]]];      #LEFT OPERATOR#
          IF PREC[TLD1]LS PREC[CSRFR[POZN]] THEN RETURN;
          RPLI=1;                            #IF PRECEDENCE DECREASING# 
          TPYA=CSRFL[BLNK[POZN]];            #TYPE OF RIGHT OPERAND#
          TPYB=CSRFL[BLNK[BLNK[POZN]]];      #TYPE OF LEFT OPERAND# 
          TLD3=1;                            #FOR LATER#
                                                                         DON/D
  
#         DETECT CHARACTER OPERANDS AND CONVERT, IF NECESSARY.         #
#         CONVERTION IS NOT NECESSARY IF THE OPERATION IS RELATIONAL.  #
  
RXP21A: 
          IF  AOPR[TLD1, QOPTYP"CHAR"] EQ 0 
          THEN                     # OPERATION NOT DEFINED FOR CHAR    #
            BEGIN 
            IF  TPYB EQ QOPTYP"CHAR"
            THEN
              BEGIN  # CONVERT LEFT OP #
              POPR( QILOP"LFLX" );
              POPN( TCONVF[QOPTYP"CHAR", QOPTYP"IGR"] );
              POPR( QILOP"FUNI" );
              POPR( QILOP"RFLX" );
              TPYB = QOPTYP"IGR"; 
              END    # CONVERT LEFT OP #
            IF  TPYA EQ QOPTYP"CHAR"
            THEN
              BEGIN  # CONVERT RIGHT OP # 
              POPN( TCONVF[QOPTYP"CHAR", QOPTYP"IGR"]); 
              POPR( QILOP"FUNI" );
              TPYA = QOPTYP"IGR"; 
              END    # CONVERT RIGHT OP # 
            END 
          REXPB = TPYA GR TPYB; 
          GOTO RXP21S[TLD1];
  
RXP21L:   #ENTRY HERE FOR LOGICAL OPERATORS#
          POPR(LOGOPR[TLD1]); 
          TPYB=QOPTYP"USI"; 
                                                                         DON/D
RXP21Z:   TPYA=POZN;
          IF TLD3 EQ 1 THEN TPYA=BLNK[TPYA];
          CSRFL[TPYA]=TPYB;                  #SET NEW TYPE INOT OPND# 
                                                                         DON/D
RXP21B: 
          RETURN; 
  
RXP21E:   #ENTRY HERE FOR EXPONENTIATE OPERATOR#
      IF TPYB LQ QOPTYP"IGR" AND TPYA LQ QOPTYP"IGR" THEN 
               BEGIN
               #INTEGER TO THE INTEGER GEVES INTEGER# 
               POPR(QILOP"ICEXP");
               IF REXPB THEN TPYB==TPYA;
               GOTO RXP21Z; 
               END
          IF TCONVF[TPYB,QOPTYP"REAL"] NQ 0 THEN
               BEGIN
               POPR(QILOP"LFLX"); 
               POPN(TCONVF[TPYB,QOPTYP"REAL"]);   #CONV LEFT TO REAL# 
               POPR(QILOP"FUNI"); 
               POPR(QILOP"RFLX"); 
               END
          IF TCONVF[TPYA,QOPTYP"IGR"] NQ 0 THEN 
               BEGIN
               POPN(TCONVF[TPYA,QOPTYP"IGR"]);    #RIGT OPR TO IGR# 
               POPR(QILOP"FUNI"); 
               END
          POPR(QILOP"RIEXP"); 
          TPYB=QOPTYP"REAL";                 #REAL RESULT#
          GOTO RXP21Z;
  
RXP21O:   #ENTER HERE FOR ARITHMETIC OPS + - * / AND RELATIONALS# 
          IF REXPB THEN TPYA==TPYB;          #TPYB NOW = HIGH TYPE# 
          TPYC=TCONVF[TPYA,TPYB]; 
          IF TPYC NQ 0 THEN                  #CONVERSION NECESSARY# 
               BEGIN
               IF REXPB THEN POPR(QILOP"LFLX");   #CONVERT FIRST OPND#
                    #NOTE--THIS HAPPENS ONLY WHEN THE LEFT OPERAND
                    WAS OF THE INFERIOR TYPE# 
               POPN(TPYC);                   #CONVERTER#
               POPR(QILOP"FUNI"); 
               IF REXPB THEN POPR(QILOP"RFLX"); 
               END
  
          IF AOPR[TLD1,TPYB] EQ 0 
          THEN
            BEGIN 
            CSRFL[POZN] = TPYB; 
            RETURN; 
            END 
  
          POPR(AOPR[TLD1,TPYB]);
          GOTO RXP21Z;
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
REXP22:   #    (PAOP)(AOPND)(AOP)==(PAOP)(PAOP)        #
REXP27:   #    (AOPND)(RELOP)==(LRELT)       #
REXP24:   #    (AOPND)(AOP)==(PAOP)          #
         IF CSRF[POZN] EQ QOP"LNO" THEN                                  L414 
          DIAG0(D126);             # LNO NEEDS ONLY ONE OPND           # PF13 
          CSRFL[POZN]=CSRFL[BLNK[POZN]];
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
RREL10:   #    (LRELT)(AX)==(BOPND)          #
REXP23:   #    (PAOP)(AOPND)==(AOPND)        #
          TLD1=CSRFR[BLNK[POZN]];                 #OPERATOR NUMBER# 
          TPYA=CSRFL[POZN];             #TYPE OF RIGHT OPERAND# 
          TPYB=CSRFL[BLNK[POZN]];            #TYPE OF LEFT OPERAND# 
          TLD3=0; 
          GOTO RXP21A;
  
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
REXP25:   #    (LPARE3)(AOPND)(RPARE2)==(AOPND)   #                      DON/D
          CSRF$;
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
#         SUBSCRIPTS               #
  
RLIS12:   #    (ARIRFP)(LSQUAR)==(ARIRFP)(SUBLHD) # 
          CSRF[POZN]=SBSC[MAMA[CSRF[BLNK[POZN]]]];
      CSAV(TPYA);                                                        DON/D
      RETURN;                                                            DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
RLIS13:   #    (ARERFP)(LSQUAR)==(ARERFP)(SUBLHD)      #
          CSRF[POZN]=SBSC[CSRF[BLNK[POZN]]];
      CSAV(TPYA);                                                        DON/D
      RETURN;                                                            DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
RLIS14:   #    (SWIRFP)(LSQUAR)==(SWIRFP)(SUBLHD)      #
          CSRF[POZN]=1;       #SPECIAL FLAG FOR SWITCHES# 
                                                                         DON/D
      CSAV(TPYA);            #FOR SUBSCRIPT#                             DON/D
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
RSUB21:   #    (SUBLT)(COMMA2)==(SUBLHD)          # 
          TPYA=CSRF[BLNK[POZN]];
          IF TPYA GR 2 THEN        #NO ERROR OR SWITCH# 
               BEGIN
               TPYA=BPLK[TPYA]; 
               IF TPYA EQ 0 THEN
                    BEGIN 
                    TLD1=CSRF[BLNK[BLNK[POZN]]];
      DIAG(D073,TLD1);                                                   DON/D
                                                                         DON/D
      CSRF[POZN]=2;          #ERROR FLAG#                                DON/D
                    RETURN; 
                    END 
          CSRF[POZN]=TPYA;
               RETURN;
               END
          IF TPYA NQ 1 THEN RETURN;     #NOT A SWITCH#
          TLD1=CSRF[BLNK[BLNK[POZN]]];
      DIAG(D074,TLD1);                                                   DON/D
      CSRF[POZN]=2;          #ERROR FLAG#                                DON/D
      RETURN;                                                            DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
RSUB22:   #    (SUBLT)(RSQUAR)==(SUBLST)          # 
          TLD1=CSRF[BLNK[POZN]];
          CSRFL[POZN]=WD[WDPTR];
          IF TLD1 LQ 2 THEN RETURN;          #ERROR ALREADY OR SWITCH#
      IF BPLK[TLD1] NQ 0 THEN DIAG(D075,CSRF[BLNK[BLNK[POZN]]]);         DON/D
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
RSUB23:   #    (SUBLT)==(NULL)     #
          TLD1=CSRF[BLNK[POZN]];
      DIAG(D076,TLD1);                                                   DON/D
          RETURN; 
  
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
RSUB27:   #    (SWIRFP)(SUBLST)==(SWIREF)(SUBLST) #                      DON/D
          ENDSAV; 
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
RSUB25:   #    (ARIRFP)(SUBLST)==(ARIREF)         # 
          TPYA=MAMA[CSRF[BLNK[POZN]]];       #ARRAY#
          GOTO RSU26A;                  # ISN"T THAT ABSURD---# 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
RSUB26:   #    (ARERFP)(SUBLST)==(AREREF)         # 
          TPYA=CSRF[BLNK[POZN]];   #ARRAY LOCATION# 
                                                                         DON/D
RSU26A:   TPYB=BCOR[SBSC[TPYA]];        #CORRECTION FOR OFFSET# 
          IF TPYB NQ 0 THEN        #NONZERO CORRECTION# 
               BEGIN
               POPN(TPYB);         #POINTER TO CONST# 
               POPR(QILOP"ISUB"); 
               END
          TPYA=MCNS[TPYA];
          IF TPYA NQ 0 THEN   #NONZERO MULTIPLIER#
               BEGIN
               POPN(TPYA);                   #MULTIPLYING FACTOR# 
               POPR(QILOP"IMUL"); 
               END
          ENDSAV; 
          SSBXB=CSRFL[POZN];            #SAVED SUBSCRIPT# 
          CSRF$;
          RETURN; 
  
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
RSUB10:   #    (SUBLHD)(AX)==(SUBLT)              #                      DON/D
          TPYA=TCONVF[CSRFL[POZN],QOPTYP"IGR"]; 
          IF TPYA NQ 0 THEN        #CONVERSION NEEDED#
               BEGIN
               POPN(TPYA);
               POPR(QILOP"FUNI"); 
               END
          CSRF$;
          TPYA=CSRF[POZN];
          IF TPYA LQ 2 THEN RETURN;          #SWITCH#  #SWITCH OR DRROR#
          IF DMPY[TPYA] NQ 0 THEN            #NOT FIRST DIMENSION#
               BEGIN
          POPN(DMPY[TPYA]); 
          POPR(QILOP"IMUL");
               POPR(QILOP"IPLUS");
               END
          RETURN; 
                                                                         DON/D
                                                                         DON/D
  
  
RBX13:    #    (FIF)(AX)==(FIF)(IFX)    # 
          DIAG0(D084);                                                   PF13 
                                                                         DON/D
      CSRF[POZN]=0;                                                      DON/D
          ENDSAV; 
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
RBX14:    #    (FWHILE)(AX)==(FWHILE)(SBX)   #
          DIAG0(D085);                                                   PF13 
      CSRF[POZN]=0;                                                      DON/D
          ENDSAV; 
          RETURN; 
  
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
RSWI12:   #    (SWINAM)==(SWIRFP)                 #                      DON/D
          XUSE(0);
          TLD1 = CSRF[POZN];                                             L428 
          GOTO RAIT11B;                                                  L428 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
RAIT11:   #    (AITNAM)==(ARIREF)       # 
          TLD1=CSRF[POZN];
          # CHECK IF THIS IS A ONE-ELEMEMT ARRAY - ONLY OUTPUT
            DIAGNOSTIC IF IT ISNT      #
         TPYB = SBSC[MAMA[TLD1] ] ;   #1ST BOUNDS PAIR  (BPAR)  # 
                                                                         DON/D
RAIT11A:  
         IF DDEL[TPYB] LQ 1 THEN
           BEGIN
           TPYB = BPLK[TPYB];   # NEXT BPAR  #
           IF TPYB NQ 0 THEN
             GOTO RAIT11A;
           END
         ELSE    # DIAGNOSTIC  #
                                                                         DON/D
RAIT11B:                                                                 L428 
          DIAG(D145,TLD1);                                               PF13 
          CSAV(SSBXB);                 #PUT A ZERO SUBSCRIPT EXPRESSION#
          POPN(ZERO$);                 #IN A CODE BUFFER AND POINT     #
          ENDSAV;                      #SSBXB TO THE BUFFER            #
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
RARR13:   #    (ARRNAM)==(NULL)    #
          TLD1=CSRF[POZN];
          DIAG(D012,TLD1);                                               PF13 
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
RLAB13:   #    (LABNAM)==(NULL)    #
RPRC14:   #    (PRCNAM)==(NULL)         # 
          TLD1=CSRF[POZN];
      DIAG(D077,TLD1);                                                   DON/D
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
#ERROR CASES# 
                                                                         DON/D
RMIS09:   #    (CXBDLH)==(NULL)                   #                      DON/D
RMIS10:   #    (XDECLH)==(NULL)                   #                      DON/D
RMIS11:   #    (COMDLH)==(NULL)                   #                      DON/D
RMIS12:   #    (BASDLH)==(NULL)                   #                      DON/D
          DIAG0(D021);             # DISCARD BAD DECLARATION           # PF13 
          RETURN;                                                        L414 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
FSTM17:   #    (STMT)==(NULL)                     #                      DON/D
FELSE3:   #    (ELSE4)==(NULL)                    #                      DON/D
ERROR1:   #    (END4)==(NULL)                     #                      DON/D
ERROR2:   #    (GOTO)==(NULL)                     #                      DON/D
ERROR4:   #    (SINK)==(NULL)                     #                      DON/D
ERROR6:   #    (ABSTMT)==(NULL)                   #                      DON/D
ERROR7:   #    (ANY)(CSPDSC)==(NULL)              #                      DON/D
          SYMABT(J824,"SYNTAX ERROR(PF13)",18);                          PF13 
#***********************************************************************
                              END OF SCAN THREE 
#                                                                        DON/D
      CONTROL EJECT;                                                     DON/D
#     SYMPL SCAN 4 PRAGMATIC FUNCTIONS START HERE.                     # DON/D
#     NOTICE THAT ENTRY (E.G. THE SWITCH) IS AT THE END OF PF13 (HOW   # DON/D
#     CONVENIENT)                                                      # DON/D
                                                                         DON/D
ITEM ERFLAG;
ITEM D26FLG=0;          #INDICATES MISSING SEMI DIAG NOT TO BE ISSUED#
STATUS STHEAD SPDEC,PRGTOP,BEGHED,FORHED,IFHED, 
               IFLSHD,IFSTAT,ABIF,ABFOR;
  
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
RET4:     RETURN;             #OUTER RETURN FOR INNER PROCS#
  
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
PROC SHTYP(TYPE); 
          BEGIN 
          ITEM TYPE;
          CSRFR[POZN]=TYPE; 
          GOTO RET4;
          END 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
DEF SAVTYP#CSRF$#;
  
                                                                         DON/D
FMIS11:   #    (PRGTOP)==(STHEAD)                 #                      DON/D
      SHTYP(STHEAD"PRGTOP");                                             DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
FMIS12:   #    (BEGHED)==(STHEAD)                 #                      DON/D
      SHTYP(STHEAD"BEGHED");                                             DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
FMIS13:   #    (FORHED)==(STHEAD)                 #                      DON/D
      SHTYP(STHEAD"FORHED");                                             DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
FMIS14:   #    (IFHED)==(STHEAD)                  #                      DON/D
      SHTYP(STHEAD"IFHED");                                              DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
FMIS15:   #    (IFLSHD)==(STHEAD)                 #                      DON/D
      SHTYP(STHEAD"IFLSHD");                                             DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
FMIS16:   #    (IFSTAT)==(STHEAD)                 #                      DON/D
      SHTYP(STHEAD"IFSTAT");                                             DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
FMIS17:   #    (BEGIN4)==(BEGHED)  #
          IF CSRF[POZN] EQ 0 THEN DEBBRK = 1;     #INHIBIT CODE#
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
FSTM11:   #    TEST(SSTH)(STMT)==(CSPDEC)         #                      DON/D
          IF CSRFR[BLNK[POZN]]NQ STHEAD"SPDEC"THEN RETURN;
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
FABS0:    #    TEST(SSTH)(ABSTMT)==(STHEAD)--BUT SSTH IS SPDEC   #
          SAVTYP; 
          CSRFR[POZN]=STHEAD"SPDEC";
          RPLI=1; 
                                                                         DON/D
FABS0A:   ESCOPE; 
          STERF=0;
          POPR(QILOP"EPRC");
          HATCHK;             #MARK IL FILE#
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
FCSP12:   #    (CSPDEC)==(CSP2)    #
          CSRFR[POZN]=0;
          RETURN; 
  
                                                                         DON/D
                                                                         DON/D
FCSP10:   #    (SSTH)(CSPDEC)==(STHEAD)           #                      DON/D
      SAVTYP;                                                            DON/D
      RETURN;                                                            DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
SWITCH FABSW:STHEAD  FABS0:SPDEC, 
                     FABS1:PRGTOP,
                     FABS2:BEGHED,
                     FABS3:FORHED,
                     FABS4:IFHED, 
                     FABS5:IFLSHD,
                     FABS7:ABIF,
                     FABS8:ABFOR; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
FABST0:   #    RULE(ABSTMT)   # 
          IF  D26FLG EQ 0 THEN
          DIAG0(D026);                                                   PF13 
          D26FLG=0; 
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
FABST1:   #    TEST(SSTH)(ABSTMT)==(STHEAD)  #
          GOTO FABSW[CSRFR[BLNK[POZN]]];
  
FABS1:    #PRGTOP#
FABS2:    #BEGHED#
          SAVTYP; 
                                                                         DON/D
FABS9:    RPLI=1; 
          RETURN; 
                                                                         DON/D
FABS3:    #FORHED#
FABS8:    #ABFOR# 
          ENDLOP;                       #PUT OUT LOOP-END CODE# 
                                                                         DON/D
FABST2:   RETURN; 
                                                                         DON/D
FABS7:    #ABIF#
FABS4:    #IFHED# 
          SAVTYP; 
          CSRFR[POZN]=STHEAD"IFSTAT"; 
          GOTO FABS9; 
                                                                         DON/D
FABS5:    #IFLSHD#
          RESTR(CSRFL[BLNK[POZN]]); 
          RETURN; 
  
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
FCHK20:   #    (STHEAD)(SEMI4)==(SSTH)(SEMI4)     #                      DON/D
          AWAITSEMI = FALSE;                                             NEWFEAT
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
SWITCH FEN40S:STHEAD
          RET4:PRGTOP,             #EXTRA END#
          FE40IC:ABIF,
          FE40IC:IFHED,            #HANGING IF# 
          FE40S:SPDEC,             #KILL SUBPROGRAM#
          FE40H:IFSTAT,            #LEGAL--NO ELSE# 
          FE40EC:IFLSHD,           #HANGING ELSE# 
          FE40FC:ABFOR, 
          FE40FC:FORHED,           #HANGING FOR#
          RET4:BEGHED;             #LEGAL#
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
FTERM1:   #    TEST(SSTH)(TERM4)==(ABSTMT)(TERM4)      #
FEND40:   #    TEST(SSTH)(END4)==(ABSTMT)(END4)   # 
          GOTO FEN40S[CSRFR[BLNK[POZN]]]; 
  
FE40IC:                                                                  DON/D
          DIAG0(D100);             # HANGING IF                        # PF13 
                                                                         DON/D
FE40IS:   RESTR(CSRFL[BLNK[POZN]]); 
                                                                         DON/D
FE40H:    RPLI=1; 
          D26FLG=1; 
          RETURN; 
                                                                         DON/D
FE40S:                                                                   DON/D
          DIAG0(D103);             # TERMINATE SPROG                   # PF13 
          GOTO FABS0A;
                                                                         DON/D
FE40EC:                                                                  DON/D
          DIAG0(D102);             # HANGING ELSE                      # PF13 
          GOTO FE40IS;
                                                                         DON/D
FE40FC:                                                                  DON/D
          DIAG0(D101);             # HANGING FOR                       # PF13 
               ENDLOP;                       #    PUT OUT END-LOOP CODE#
          GOTO FE40H; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
FEN40A:   #    TEST(SSTH)(END4)==(CSPDEC)    #
          IF CSRF[POZN] EQ 0 THEN DEBBRK=0;       #CEASE CODE INHIBIT#
          IF CSRFR[BLNK[POZN]]EQ STHEAD"SPDEC"THEN RPLI=1;
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
FEND41:   #    TEST(SSTH)(END4)==(STMT)      #
          IF CSRFR[BLNK[POZN]]EQ STHEAD"BEGHED"THEN RPLI=1; 
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
FELSE1:   #    TEST(SSTH)(ELSE4)==(IFLSHD)   #
          IF CSRFR[BLNK[POZN]]NQ STHEAD"IFSTAT"THEN RETURN; 
          RPLI=1; 
          CSAV(TPYA); 
          GENLAB(TPYB); 
          POPN(TPYB); 
          POPR(QILOP"LABL");
          ENDSAV; 
          VALID(TPYA);
          POPN(TPYB); 
          POPR(QILOP"GOTO");
                                                                         DON/D
#     IF WE ARE GENERATING TRACEBACK CODE WE PUT OUT THE LINE NUMBER   # DON/D
#     OTHERWISE ITS NOT IMPORTANT                                      # DON/D
                                                                         DON/D
      IF B<2>OPTION NQ 0 THEN                                            DON/D
          BEGIN                                                          DON/D
          POPR(QILOP"PAUS");                                             DON/D
          OPRNDV(CRDN);                                                  DON/D
          END                                                            DON/D
                                                                         DON/D
          CSRFL[POZN]=TPYA; 
          RESTR(CSRFL[BLNK[POZN]]);                    #FALSE LABELS# 
          RETURN; 
  
  
                                                                         DON/D
                                                                         DON/D
FCHK23:  #    (STHEAD)(ELSE4)==(SSTH)(ELSE4)     #                       DON/D
          RESTR(PSTLS);        #DUMP IN LABELS# 
          PSTLS=0;       #CLEAR STACKER ENTRY#
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
FCHK30:   #    TEST(STHEAD)==(ABSTMT)   # 
          IF CSRFR[POZN] NQ STHEAD"IFHED" THEN
               BEGIN
               POPR(QILOP"PAUS"); 
               OPRNDV(CRDN);
               END
          IF CSRFR[POZN] EQ STHEAD"IFSTAT" THEN 
               BEGIN
               RESTR(CSRFL[POZN]);
               CSRFL[POZN]=0; 
               RPLI=1;        #TRUE#
               D26FLG=1;      #SUPRESS MISSING SEMI DIAG# 
               RETURN;
               END
          RESTR(PSTLS);       #DUMP IN LABELS#
          PSTLS=0;       #CLEAR LABEL STACKER#
          RESTR(PSTCS);       #PRESTATEMENT STACKER#
          PSTCS=0;
          RETURN;             #WITH RPLI 0# 
  
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
FCHK24:   #    (STHEAD)(DO4)==(STHEAD)            #                      DON/D
      SAVTYP;                                                            DON/D
          IF CSRFR[POZN]NQ STHEAD"ABFOR"THEN ILKEY("DO",2); 
          DIAG0(D088);                                                   PF13 
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
FCHK25:   #    (STHEAD)(THEN4)==(STHEAD)          #                      DON/D
      SAVTYP;                                                            DON/D
          IF CSRFR[POZN]NQ STHEAD"ABIF"THEN ILKEY("THEN",4);
          DIAG0(D089);                                                   PF13 
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
FELSE2:   #    (SSTH)(ELSE4)==(STHEAD)            #                      DON/D
      SAVTYP;                                                            DON/D
      ILKEY("ELSE",4);                                                   DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
FEND42:   #    (SSTH)(END4)==(STHEAD)             #                      DON/D
      SAVTYP;                                                            DON/D
      ILKEY("END",3);                                                    DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
FSPTP1:   #    (SSTH)(SPTOP)==(SSTH)(STHEAD) #
FSPTP2:   #    (SPTOP)==(STHEAD)   #
          HATCHK;        #BLOCK FILE# 
          STERF=0;       #GUARANTEE IL# 
          POPN(CSRF[POZN]);        #SUBR NAME#
          POPR(QILOP"SPRC");
          CSRFR[POZN]=STHEAD"SPDEC";
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
FSTM12:   #    TEST(SSTH)(STMT)==(BEGHED)         # 
          IF CSRFR[BLNK[POZN]]EQ STHEAD"BEGHED" THEN RPLI=1;
          RETURN; 
  
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
FSTM14:   #    TEST(SSTH)(STMT)==(IFSTAT)         #                      DON/D
      SAVTYP;                                                            DON/D
          IF CSRFR[POZN]EQ STHEAD"IFHED"OR
             CSRFR[POZN]EQ STHEAD"ABIF" THEN RPLI=1;
          RETURN; 
  
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
SWITCH FST15S: STHEAD 
                         FST15B:IFLSHD, 
                         FST15C:ABFOR,
                         FST15D:FORHED, 
                         RET4:PRGTOP; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
FSTM15:   #    TEST(SSTH)(STMT)==(STMT)      #
          GOTO FST15S[CSRFR[BLNK[POZN]]]; 
                                                                         DON/D
FST15B:   RESTR(CSRFL[BLNK[POZN]]); 
                                                                         DON/D
FST15A:   RPLI=1; 
          RETURN; 
                                                                         DON/D
FST15C: 
FST15D:   ENDLOP;             #PUT OUT LOOP-END CODE# 
          GOTO FST15A;
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
FGOTO3:   #    (SSTH)(GOTO)==(STHEAD)             #                      DON/D
          SAVTYP;                                                        PF13 
          DIAG0(D096);                                                   PF13 
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
FSINK4:   #    (SSTH)(SINK)==(STHEAD)             #                      DON/D
          SAVTYP;                                                        PF13 
          DIAG0(D097);                                                   PF13 
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
FCHK:     #    RULE(STHEAD)   # 
          ERFLAG=0;      #CLEAR ERROR MARKER# 
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
FCHK26:   #    (STHEAD)(ANY)==(STHEAD)  # 
          IF ERFLAG EQ 0 THEN 
               BEGIN
               ERFLAG=1;
               DIAG0(D016);                                              PF13 
               END
          SAVTYP; 
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
FTERM:    #    (SSTH)(TERM4)==(PROG)              #                      DON/D
          IF CSRFR[BLNK[POZN]] NQ STHEAD"PRGTOP" THEN 
          DIAG0(D083);                                                   PF13 
          ESCOPE; 
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
FPROG2:   #    (PROG)==(SHAZAM)    #
      PREREAD=1;
      IF  UNBEHAVED EQ 0           # NO BEHAVIOR ATTRIBUTES SPECIFIED  #
      THEN
        BEGIN 
        DIAG0( D218 );
        END 
      GTSRC;  #LIST LAST CARD#
          HATEND;                  # REORDER ILFAT                     #
          T$ERM;
          XRFCLS; 
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
#                   FOR LOOPS           # 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
FFOR10:   #    (FOR)(INDV)(EQUALS)(SAX)==(FIS)    #                      DON/D
          WHILEX = FALSE; 
          LOOPTY[LOOPCW]=FASTLOOP;        #SAVE TYPE OF LOOP FOR END# 
          LOOPL[LOOPCW]=CSRF[BLNK[BLNK[POZN]]];        #INDUCT VAR# 
          INVTYP=OPTYP[TYPE[LOOPL[LOOPCW]]];      #IND VAR TYPE#
          CSAV(LOOPX1);       #FOR INITIALIZATION PACKAGE#
          OPERND(LOOPL[LOOPCW]);             #PUT IN IND VAR# 
          RESTR(CSRFL[BLNK[POZN]]);          #INITIAL EXPRESSION# 
          FORCON(CSRFL[POZN]);          #CONVERT IF APPROPRIATE#
          IF  FASTLOOP
          THEN
            BEGIN                  # CHECK TYPE OF INDUCTION VARIA@LE  #
            IF  TYPE[ LOOPL[ LOOPCW ]]  NQ  QTYPE"IGR"
              AND  TYPE[ LOOPL[ LOOPCW ]] NQ  QTYPE"USI"
            THEN                   # NOT A SIGNED OR UNSIGNED INTEGER  #
              BEGIN 
              DIAG0( D173 );
              LOOPER[ LOOPCW ]=TRUE; # SIGNALS ENDLOP TO SUPPRESS CODE #
              END 
            ELSE
              BEGIN 
              LOOPER[ LOOPCW ] = FALSE; 
              END 
            POPR( QILOP"INVI" );
            END 
          ELSE
            BEGIN 
            POPR( QILOP"REPL" );
            END 
          ENDSAV;        #END INITIALIZATION PACKAGE# 
          LOOPX2=0;           #FOR STEP PACKAGE#
          LOOPX3=0;           #FOR TEST PACKAGE#
          LOOPSL[LOOPCW]=0;        #FOR END/OF/LOOP LABELS# 
          LOOPJB[LOOPCW]=0;        #LABEL FOR TEST EXPRESSION#
         LOOPST[LOOPCW]=0;    #STEP BUFFER# 
         LOOPLL[LOOPCW]=0;    #WHILE/UNTIL CODE LABEL#
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
FFOR11:   #    (FOR)(INDV)==(STHEAD)              #                      DON/D
          DIAG0(D092);                                                   PF13 
FFOR90:   CSRFR[POZN]=STHEAD"ABFOR";
          DIAG0(D090);                                                   PF13 
          LOOPSL[LOOPCW]=0; 
          LOOPLL[LOOPCW] = 0; 
          LOOPJB[LOOPCW] = 0; 
          LOOPSL[LOOPCW] = 0; 
          LOOPST[LOOPCW] = 0; 
          LOOPX1 =0;
          LOOPX2 =0;
          LOOPX3 =0;
          GOTO FFO30C;
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
FFOR12:   #    (FOR)==(STHEAD)                    #                      DON/D
          DIAG0(D105);                                                   PF13 
          GOTO FFOR90;
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
FFOR15:   #    (FIS)(FSTEP)(SAX)==(FISSS)         #                      DON/D
          CSAV(LOOPX2);       #OPEN BFR FOR STEP PACKAGE# 
         LOOPST[LOOPCW]=LOOPX2; 
          OPERND(LOOPL[LOOPCW]);        #PUT OUT IND VAR--# 
          IF FASTLOOP THEN
            BEGIN 
             #FIRST GENERATE A TEMPORARY TO CONTAIN PRE-EVALUATED STEP #
             # C.G.1 MAY RELEASE TEMP  #
            GENTMPF(TPYA) ; 
            POPN(TPYA)  ; 
            TLUS[TPYA] = TRUE;
            LOOPSS[LOOPCW] = TPYA;
            IF STEPS EQ 1 THEN
              POPR(QILOP"INSM")  ;      #NEGATIVE STEP  # 
            ELSE
              POPR(QILOP"INSP")  ;      #POSITIVE STEP  # 
            ENDSAV;     #TERMINATE END-LOOP BUFFER  # 
                             #NOW OUTPUT I.L. FOR PRE-EVALUATION  # 
            POPN(TPYA) ;                  #TEMP  #
            RESTR(CSRFL[BLNK[POZN]])  ;   #STEP EXPRESSION  # 
            FORCON (CSRFL[POZN]);  # CONVERT TO TYPE OF IV IF NEED BE  #
            POPR(QILOP"REPL") ; 
            RETURN ;
            END 
          OPERND(LOOPL[LOOPCW]);             #TWICE#
          RESTR(CSRFL[BLNK[POZN]]);          #STEP EXPRESSION#
          FORCON(CSRFL[POZN]);     #CONVERT TO TYPE OF I V IF NEED BE#
          POPR(AOPR[QOP"PLUS",INVTYP]);      #OUTPUT RIGHT KIND OF +  # 
          POPR(QILOP"REPL");
          ENDSAV;             #DONE WITH STEP PACKAGE#
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
FFOR16:   #    (FIS)(FSTEP)==(STHEAD)             #                      DON/D
          DIAG0(D093);                                                   PF13 
          GOTO FFOR90;
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
FFOR17:   #    (FIS)(FWHILE)(SBX)==(FLDO)    #
FFOR27:   #    (FISSS)(FWHILE)(SBX)==(FLDO)  #
         LOOPX3=CSRFL[POZN];    #FALSE LABEL# 
         LOOPSL[LOOPCW]=CSRFL[BLNK[POZN]];  #WHILE CODE#
          WHILEX = TRUE;
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
FFOR19:   #    (FIS)==(FLDO)                      #                      DON/D
FFOR29:   #    (FISSS)==(FLDO)     #
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
FFOR28:   #    (FISSS)(FWHILE)==(STHEAD)          #                      DON/D
FFOR18:   #    (FIS)(FWHILE)==(STHEAD)            #                      DON/D
          DIAG0(D095);                                                   PF13 
          LOOPST[LOOPCW] = 0; 
          GOTO FFOR90;
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
FFOR25:   #    (FISSS)(FUNTIL)(SAX)==(FLDO)  #
          CSAV(TPYB);         #FOR TEST FAILURE LABEL#
          LOOPSL[LOOPCW]=TPYB;          #SAVE#
          GENLAB(TPYA);            #END LABL# 
          OPERND(LOOPL[LOOPCW]);             #IND VAR#
          IF NOT FASTLOOP OR WHILEX THEN  # SLOW AND WHILE LOOPS# 
            BEGIN 
          RESTR(CSRFL[BLNK[POZN]]);          #TEST EXPRESSION#
          FORCON(CSRFL[POZN]);          #CONVERT TO I V TYPE# 
         TPYB=QOP"GR";   #POSITIVE STEP#
         IF STEPS EQ 1 THEN TPYB=QOP"LS";   #NEGATIVE STEP# 
          POPR(AOPR[TPYB,INVTYP]);      #PUT OUT CORRECT RELATIONAL#
          POPN(TPYA);         #FAILURE LABEL# 
          POPR(QILOP"TSST");
            END 
          ELSE
            BEGIN 
            GENTMPF(TPYC);
            POPN (TPYC) ;     #OUTPUT LIMIT  #
            POPR ( QILOP"INVT" ) ;
            TLUS[TPYC] = TRUE;
            LOOPLL[LOOPCW] = TPYC;
            END 
          ENDSAV;        #END TEST PACKAGE# 
      CSAV(LOOPX3); 
          IF FASTLOOP THEN
            BEGIN 
            POPN (TPYC) ;    #TEMP CONTAINING LIMIT # 
            RESTR(CSRFL[BLNK[POZN]]) ;  # LIMIT EXPRESSION  # 
            FORCON (CSRFL[POZN]);  # CONVERT TO TYPE OF IV IF NEED BE  #
            POPR (QILOP"REPL") ;
            RESTR(LOOPX1);
            LOOPX1=0; 
            POPN(TPYA);            #PUT OUT THE TOP LABEL #              PF13-T 
            POPR (QILOP"SLOP") ;        #START LOOP LABEL   # 
            END 
          ELSE
            BEGIN                                                        PF13-T 
            POPN(TPYA);            #PUT OUT THE TOP LABEL #              PF13-T 
            POPR(QILOP"LABL");                                           PF13-T 
            END                                                          PF13-T 
      ENDSAV; 
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
FFOR26:   #    (FISSS)(FUNTIL)==(STHEAD)          #                      DON/D
          DIAG0(D094);                                                   PF13 
         LOOPST[LOOPCW] = 0;
          GOTO FFOR90;
  
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
FFOR30:   #    (FLDO)(DO4)==(FORHED)              #                      DON/D
         RESTR(LOOPX1);       #INITIALIZATION CODE# 
         IF LOOPSL[LOOPCW] NQ  0 THEN BEGIN     #WHILE OR UNTIL#
          IF NOT FASTLOOP THEN
            BEGIN 
               GENLAB(TPYA);
               POPN(TPYA);
               POPR(QILOP"GOTO"); 
               LOOPLL[LOOPCW] = TPYA; 
            END 
               RESTR(LOOPX3); 
               END
         ELSE  BEGIN
               GENLAB(LOOPX3);
               CSAV(TPYB);
               LOOPSL[LOOPCW]=TPYB; 
               POPN(LOOPX3);
               POPR(QILOP"GOTO");     #JUMP BACK, NO TERM CONDITION # 
               ENDSAV;
               POPN(LOOPX3);
                 IF FASTLOOP THEN                                        LARRY-R
                   POPR ( QILOP"SLOP");                                  LARRY-R
                 ELSE                                                    LARRY-R
               POPR(QILOP"LABL");     #LABEL START OF LOOP# 
               END
         VALID(LOOPST[LOOPCW]); 
          VALID(LOOPSL[LOOPCW]);             #VALIDATE LOOP-END-CODE# 
          CSRFL[POZN]=LOOPCW;           #THE FORHED REMEMBERS THE INDEX#
                                                                         DON/D
FFO30C:   LOOPCW=LOOPCW+1;
##       IF LOOPCW GR LOOPCP THEN 
            SYMABT(J825,"LOOP CONTROL TABLE OVERFLOW(PF14)",33);         PF13 
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
#TEST STATEMENT#
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
FTEST1:   #    (TEST)(TESTN)==(TESTS)        #
          FOR TPYA=0 STEP 1 UNTIL LOOPCW -1 DO
               IF LOOPL[TPYA] EQ CSRF[POZN] THEN
                    BEGIN 
                    TSTLAB(TPYA); 
                    RETURN; 
                    END 
      DIAG(D131,CSRF[POZN]); #BAD IND VAR NAME IN TEST STMT#             DON/D
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
FTEST2:   #    (TEST)==(TESTS)          # 
          #UNNAMED TESTS GO TO INNERMOST LOOP#
          IF LOOPCW NQ 0                                                 PF13 
          THEN                                                           PF13 
            BEGIN                                                        PF13 
            TSTLAB(LOOPCW-1);                                            PF13 
            END                                                          PF13 
          ELSE                                                           PF13 
            BEGIN                                                        PF13 
            DIAG0(D132);           # NO LOOP                           # PF13 
            END                                                          PF13 
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
FFOR31:   #    (FLDO)==(STHEAD)                   #                      DON/D
      GOTO FFOR90;                                                       DON/D
                                                                         DON/D
                                                                         DON/D
  
  
FIFST1:   #    (FIF)(IFX)(THEN4)==(IFHED)    #
          SAVTYP; 
          RESTR(CSRFR[POZN]); 
      VALID(CSRFL[POZN]);                                                DON/D
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
FIFST3:   #    (FIF)==(STHEAD)                    #                      DON/D
          DIAG0(D106);                                                   PF13 
          CSRFL[POZN]=0;
          GOTO FIFS2A;
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
FIFST2:   #    (FIF)(IFX)==(STHEAD)     # 
          RESTR(CSRFL[BLNK[POZN]]); 
                                                                         DON/D
FIFS2A: 
          CSRFR[POZN]=STHEAD"ABIF"; 
          DIAG0(D091);                                                   PF13 
          VALID(CSRFL[POZN]);                                            PF13 
          RETURN;                                                        PF13 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
#              REPLACEMENT STATEMENTS             # 
  
  
FSINK5:   #    (SINK)(EQUALS)(SIMBX)==(REPL)      # 
FSINK1:   #    (SINK)(EQUALS)(SAX)==(REPL)        #                      DON/D
          TPYA=CSRF[BLNK[BLNK[POZN]]];
          SINKIL(TPYA,TPYB);                 #SINK TYPE COMES INTO TPYB#
          RESTR(CSRFL[BLNK[POZN]]);          #EXPRESSION BUFFER#
          IF TCONVF[CSRFL[POZN],TPYB] NQ 0 THEN 
               BEGIN
               POPN(TCONVF[CSRFL[POZN],TPYB]);
               POPR(QILOP"FUNI"); 
               END
          GOTO FSK2A; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
FSINK2:   #    (SINK)(EQUALS)(BX)==(REPL)         # 
          GENTMP(TPYB);                 #GET TEMP#
          POPN(TPYB);                                  #TEMP=0# 
          POPN(ZERO$);
          POPR(QILOP"REPL");
          RESTR(CSRFL[BLNK[POZN]]);          #IF (BX) THEN  # 
          POPN(TPYB);                                  #TEMP=1# 
          POPN(ONE$); 
          POPR(QILOP"REPL");
          RESTR(CSRFL[POZN]);                #FALSE CASE LABELS#
          TPYA=CSRF[BLNK[BLNK[POZN]]];
          SINKIL(TPYA,TLD1);
          POPN(TPYB);                             #SINK=TEMP# 
                                                                         DON/D
FSK2A:    IF SINKC[TPYA] EQ S"FUNC"     THEN POPR(QILOP"FRES"); 
                                        ELSE POPR(QILOP"REPL"); 
          RETURN; 
                                                                         DON/D
                                                                         DON/D
  
  
#    MISERABLE EXCHANGE STATEMENTS      # 
                                                                         DON/D
  
FSINK3:   #    (SINK)(EXCH)(SINK)==(REPL)         # 
          TLD1=CSRF[BLNK[BLNK[POZN]]];
          TLD2=CSRF[POZN];              #SAVE TWO SINK SLOTS# 
          SNKTYP(TLD1,TPYA);            #TPYA=TYPE OF LEFT SINK#
          SNKTYP(TLD2,TPYB);            #TPYB=TYPE OF RIGHT SINK# 
          IF TPYA*TPYB EQ 0 THEN #AT LEAST ONE BOOLEAN# 
               BEGIN
               IF TPYA+TPYB NQ 0                                         PF13 
               THEN                                                      PF13 
                 BEGIN                                                   PF13 
                 DIAG0(D112);      # BOTH MUST BE BOOLEAN              # PF13 
                 END                                                     PF13 
               TPYA=QOPTYP"IGR";
               TPYB=QOPTYP"IGR";
               END
          IF SINKC[TLD1] EQ S"P" OR TPYB EQ QOPTYP"CHAR" THEN 
               BEGIN
               TPYA==TPYB;                   # P SINK MUST BE LAST# 
               TLD1==TLD2;
               END
          CSAV(XCHPSB);       #OPEN BUFFER FOR TEMP STORES# 
          ENDSAV;        #GOODIES SUPPLIED BY SETTMP# 
          CSAV(TPYC);    #FOR VALUE CODE FOR LEFT SIDE)#
          SINKXL(TLD1,XCHLSB);          #STORES ADDR CODE IN XCHLSB,
                                        VALUE COE IN TPYC#
          TYPETP=TPYA;        #LEFT SIDE TYPE, NOMINALLY# 
          IF TCONVF[TPYA,TPYB] NQ 0 THEN  #CONVERT TO R SIDE TYPE#
               BEGIN
               TYPETP=TPYB;        #RIGHT SIDE TYPE#
               POPN(TCONVF[TPYA,TPYB]); 
               POPR(QILOP"FUNI"); 
               END
          ENDSAV;        #CLOSE LEFT SIDE BUFFER# 
          SETTMP(TPYC,TYPETP,TLD3);     #SAVE LEFT SIDE#
          CSAV(TPYC);         #OPEN RIGHT SIDE BUFFER#
          SINKXL(TLD2,XCHRSB);          #SAVE ADDR CODE IN XCHRSB,
                                        VALUE CODE IN TPYC)#
          IF TCONVF[TPYB,TPYA] NQ 0 THEN
               BEGIN     #CONVERT TO LEFT SIDE TYPE#
               POPN(TCONVF[TPYB,TPYA]); 
               POPR(QILOP"FUNI"); 
               END
          ENDSAV;        #CLOSE RIGHT-SIDE VALUE BUFFER#
  
#THE EXCHANGE STATEMENT IS NOW READY FOR OUTPUT... CODE BUFFERS HAVE
BEEN PREPARED AS FOLLOWS: 
     XCHPSB:   CONTAINS ALL NECESSARY STORES INTO TEMP TO GUARANTEE 
               INSTANTANEITY, AS WELL AS STORING THE VALUE F THE LEFT 
               SIDE INTO TEMP, CONVERTED TO THE TYPE OF THE RIGHT SIDE
     XCHLSB    REPRESENTS THE ADDRESS OF THE LEFT SIDE
     XCHRSB    REPRESENTS THE ADDRESS OF THE RIGHT SIDE 
     TPYC      CONTAINS THE VALUE FO THE RIGHT SIDE, CONVERTED TO THE 
               TYPE OF THE LEFT SIDE
IN ADDITION, TLD3 CONTAINS THE NAME OF THE TIMP CONTAINING THE VALUE
OF THE LEFT SIDE# 
  
          RESTR(XCHPSB); #STORES INTO TEMP# 
          RESTR(XCHLSB); #LEFT SIDE ADDRESS#
          RESTR(TPYC);   #RIGHT SIDE VALUE# 
          POPR(QILOP"REPL");
          RESTR(XCHRSB);     #RIGHT SIDE ADDRESS# 
          POPN(TLD3);         #LEFT SIDE VALUE# 
          POPR(QILOP"REPL");
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
FPREF4:   #    RULE(PRCRFP)   # 
          OPERND(CSRF[POZN]); 
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
FPREF5:   #    (PRCRFP)(PARS)==(PRCREF) # 
          RESTR(PPLS[CSRF[POZN]]);
      POPR(QILOP"PCAL");
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
FPREF6:   #    (PRCRFP)==(PRCREF)                 #                      DON/D
          POPR(QILOP"NULL");
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
      POPR(QILOP"PCAL");
  
#     CHECK FOR MOST BLATANT RECURSIVE CASE - THAT OF A PROC           #
#     CALLING ITSELF.                                                  #
  
      IF SCPN[SCOPE] EQ CSRF[POZN] THEN DIAG(D181,CSRF[POZN]);
      RETURN; 
  
FGOTO1:   #    (GOTO)(TAG)==(GOTOS)     # 
          OPERND(CSRF[POZN]); 
          POPR(QILOP"GOTO");
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
FGOTO2:   #    (GOTO)(SWIREF)(SWISUB)==(GOTOS)    # 
          TPYB = CSRF[BLNK[POZN]];     # GET SWITCH NAME               #
          IF SBEG[TPYB] NQ SCOPE       # CHECK FOR BACKWARD REFERENCE  #
          THEN
            BEGIN 
            DIAG(D197, TPYB);          # GOTO OUT OF SCOPE SWITCH      #
                                       # BY DEFINITION IS BACKWARDS    #
            END 
          POPN(TPYB); 
          RESTR(CSRFL[POZN]); 
          POPR(QILOP"SSWC");
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
FSTOP:    #    RULE(STOP)     # 
          POPR(QILOP"NULL");
          POPR(QILOP"STOP");
          RETURN; 
                                                                         DON/D
                                                                         DON/D
                                                                         DON/D
  
FRTRN:    #    RULE(RETURN)        #
          POPR(QILOP"NULL");
          POPR(QILOP"RTRN");
          RETURN; 
      CONTROL EJECT;                                                     DON/D
#**********************************************************************# DON/D
#                                                                      # DON/D
#     PF14 - SCAN 4 PRAGMATIC FUNCTIONS                                # DON/D
#                                                                      # DON/D
#**********************************************************************# DON/D
                                                                         DON/D
ENTRY PROC PF14;
  
          $BEGIN IF DMPFLG EQ 1 THEN PRINTLABEL4;   $END
  
          GOTO SWDF14[DEFN-SWOF14]; 
END 
TERM
