*DECK             PHASBS
USETEXT   TSOURCE 
USETEXT   TCEXECQ 
USETEXT   TSYMCNS 
USETEXT   TCEXEC
USETEXT   TCOM37Q 
USETEXT   TCOM78Q 
USETEXT   TC7DECS 
         PROC PHASBS; 
 # THIS PHASE OF THE CODE GENERATOR IS RESPONSIBLE FOR THE TRANSLATION
   OF INTERMEDIATE LANGUAGE IL INTO TRIADS. EDITING OF OPERANDS THAT
   ARE CONSTANTS TAKES PLACE DURING THIS PHASE. # 
  BEGIN 
  
  
  
  
*CALL COMEX 
  
  
         XREF FUNC CIAOP; 
         XREF FUNC PSICON;
         XREF FUNC CIREL; 
         XREF PROC CLSS;
         XREF FUNC CRREL; 
         XREF FUNC KFIND; 
    XREF FUNC CRAOP;
         XREF FUNC GETRD; 
         XREF FUNC GTRSP; 
         XREF PROC DHASH; 
         XREF FUNC GHASH; 
         XREF FUNC IHASH; 
         XREF PROC BRKPT; 
         XREF PROC FIND;
         XREF PROC GTILN; 
         XDEF PROC GETIL; 
         XREF PROC INITCG;
         XREF FUNC INCRMT;                                               JANDRE 
         XREF PROC SYMABTL;                                              PHASBS 
         XREF PROC FINCG1;
         XREF PROC ICFGEN;
         XREF PROC ICFPUT;
         XREF PROC FILLTR;
         XREF PROC INTRX; 
          XREF FUNC PSCPRC;                                              JUNK 
  
         DEF   ZOPUP #50#;    # UPPER STACK LIMIT # 
         DEF J827 #827#;           # SYMABT DIAGNOSTIC 827             # PHASBS 
         DEF J828 #828#;           # SYMABT DIAGNOSTIC 828             # PHASBS 
         DEF J829 #829#;           # SYMABT DIAGNOSTIC 829             # PHASBS 
         DEF J830 #830#;           # SYMABT DIAGNOSTIC 830             # PHASBS 
         DEF J832 #832#;           # SYMABT DIAGNOSTIC 832             # PHASBS 
         DEF J841 #841#;           # SYMABT DIAGNOSTIC 841             # PHASBS 
         DEF J848 #848#;           # SYMABT DIAGNOSTIC 848             # PHASBS 
         DEF J867 #867#;           # SYMABT DIAGNOSTIC 867             # SMPA066
  
         ITEM  ZERO I = 0;    # VARIABLE ZERO # 
         ITEM  TSAVD B;       # TRIAD SAVD #
         ITEM  TSVNB I;       # TRIAD SVNB #
         ITEM  INT I;         # DEPOSIT INT # 
         ITEM  REAL R;        # DEPOSIT REAL #
         ITEM  T1 I=0;        # TEMPS # 
         ITEM  T2 I = 0;
         ITEM  T3 I = 0;
         ITEM  T4 I = 0;
         ITEM  T5 I = 0;
         ITEM  T6 I = 0;
         ITEM  T7 I = 0;
         ITEM  T8 I = 0;
         ITEM  T9 I = 0;
  
  
         SWITCH CGSW1:QIOP
               SW100:PRIM,
               SW120:EXP2,
               SW120M:EXPM, 
               SW120D:EXPD, 
               SW120R:EXPR, 
               SW120E:EXPE, 
               SW130:EXP1,
               SW150:COMP,
               CG00:NULL, 
               SW180:BAD, 
               SW200:FLX, 
               SW220:LFLX,
               SW230:RFLX,
               SW240:PTRM,
               CG01:PARM, 
               SW280:INFO,
               SW360:PAUS,
               SW380:PNOT,
               SW420:SUBS,
               SW440:FUNI,
               SW460:TSST,
              SW550: PLST , 
               SW520:FCAL,
               SW180:VALU,         #ILLEGAL -- GLOBAL OPTIMIZER INST   #
               SW180:VALB;         #ILLEGAL -- GLOBAL OPTIMIZER INST   #
SWITCH FUNISW:QFNBS                                                      JANDRE 
             FFNBS$:QFNBS$,    # JOVIAL ONLY #                           JANDRE 
               FIRX:IRX,
               FRIX:RIX,
               FRCX:RCX,                                                 JANDRE 
               CG00:CRX,
              FCIX:CIX, 
               FICX:ICX,                                                 JANDRE 
               FIDN:RDX,
               FKLSS:LOC, 
               BITF:BIT,                                                 JANDRE 
               FBYT:BYTE, 
              FKLSS:PFUN;                                                JANDRE 
      CONTROL EJECT;
#     CODE FOR PHASBS BEGINS HERE                                      # NOV04
  
  
         INITCG;    # INITIALIZATION #
         GOTO CG01; 
  
  
#     BUILD IL OPERAND STACK ENTRY.  AN ENTRY IS SIMPLY A POINTER TO   #
#     A TRIAD.  THE INDEX INTO THE STACK IS BUMPED AND THE INDEX TO    #
#     THE CURRENT TRIAD IS PUT IN THE STACK.                           #
  
CG00: 
         OPIX = OPIX + 1; 
         IF OPIX GQ ZOPUP                                                PHASBS 
         THEN                                                            PHASBS 
           BEGIN                                                         PHASBS 
           SYMABTL(J830,"STACK OVERFLOW(PHASBS) LINE XXXXX",33,LINUM);   PHASBS 
           END                                                           PHASBS 
         OPNR[OPIX] = OOIX;        # SET POINTER #
  
CG01: 
      OOIX = GETRD;          # GET INDEX TO NEXT AVAILABLE TRIAD.      #
         GETIL;     # GET IL WORD # 
  
         #BUILD TRIAD AND SWITCH ON OPERATOR #
  
  
      ILOPR = ILOP[ILIX];    # UNPACK IL OPERATOR                      #
  
#     SET OPERATOR, ACCENT AND MEMORY FIELDS OF CURRENT TRIAD FROM     #
#     THEIR RESPECTIVE IL FIELDS                                       #
  
         OPTR[OOIX] = ILOPR;
         ACME[OOIX] = ILACME[ILIX]; 
  
          IF OPAT8C[ILOPR] THEN 
          GOTO CGSW1[OPAT5[ILOPR]];    # SWITCH IF NONARY OPERATOR     #
  
#     OPERATOR IS EITHER BINARY OR UNARY.  IN EITHER CASE THE TRIAD    #
#     WHOSE POINTER IS ON TOP OF THE IL OPERAND STACK (E.G. THE FIRST  #
#     PREVIOUS TRIAD CREATED) IS AN OPERAND.                           #
  
      T1 = OPNR[OPIX];       # POINTER TO LAST TRIAD BUILT             #
  
         IF OPAT8A[ILOPR] THEN
          BEGIN 
  
#     OPERATOR IS BINARY.  WE MUST SET THE APPROPRIATE FIELDS IN ALL   #
#     3 TRIADS (1 OPERATOR AND 2 OPERANDS) IN ORDER TO LINK THEM       # NOV04
#     TOGETHER.  WE ALSO UNSTACK THE 2 OPERAND ENTRIES FROM THE IL     #
#     OPERAND STACK                                                    #
  
          T2 = OPNR[OPIX - 1];     #POINTER TO OTHER OPERAND TRIAD     #
  
         IF OPAT13[ILOPR] THEN  BEGIN  # REFLEXIVE OPERATOR-MAKE SURE    SOPT 
                                       LEFT OPERAND LT RIGHT  OPERAND#   SOPT 
 COMU[OOIX] = COMU[T1] OR COMU[T2] OR NOT OPAT8F[OOIX]; 
 #            MAY NOT COMMUTE IF EITHER THIS OPERATION
              OR LOPD ORROPD CAUSES A SAVE.            #
          IF NOT COMU[OOIX] AND MEMR[T1] GR MEMR[T2] THEN 
                                       BEGIN     # SWAP OPERANDS# 
                                T1 == T2 ;                               SOPT 
                                       END                               SOPT 
                                END    #REFLEXIVE#                       SOPT 
  
#     WE LINK THE OPERATOR TRIAD TO ITS TWO OPERAND TRIADS BY STORING  #
#     THEIR TRIAD INDEXES IN THE LEFT HAND OPERAND AND RIGHT HAND      #
#     OPERAND FIELDS OF THE CURRENT OPERATOR TRIAD.                    #
  
               ROPD[OOIX] = T1; 
               LOPD[OOIX] = T2; 
  
#     WE LINK EACH OF THE OPERAND TRIADS TO ITS OPERATOR TRIAD BY      #
#     STORING THE TRIAD INDEX OF THE OPERATOR IN THE NEXT OPERATOR     #
#     FIELD OF EACH OPERAND TRIAD.                                     #
  
               NXOP[T1] = OOIX; 
               NXOP[T2] = OOIX; 
  
#     SET THE CLASS FIELD OF EACH OPERAND TRIAD ACCORDING TO THE       #
#     INTRINSIC TYPES OF THIS IL OPERATORS OPERANDS                    #
  
               KLSS[T1] = OPAT3[ILOPR]; 
               KLSS[T2] = OPAT2[ILOPR]; 
  
#     SET THE QUICK REPLACEMENT FLAG (NORMALIZATION NOT NECESSARY) IN  #
#     THE OPERATOR TRIAD IF BOTH OF ITS OPERAND TRIADS HAVE THEIR QUICK#
#     REPLACEMENT FLAGS SET AND IF THIS OPERATOR CAN INTRINSICALLY     #
#     SUPPORT UNNORMALIZED VALUES                                      #
  
               QREP[OOIX]=OPAT14[ILOPR] AND QREP[T1] AND QREP[T2];       JANDRE 
               CMPT[OOIX] = CMPT[T1] LOR CMPT[T2];
  
#     UNSTACK ENTRIES FOR THE 2 OPERANDS FROM THE IL OPERAND STACK BY  #
#     DECREMENTING THE INDEX INTO THE STACK.                           #
  
               OPIX = OPIX - 2; 
               IF OPIX LS 0                                              PHASBS 
               THEN                                                      PHASBS 
                 BEGIN                                                   PHASBS 
                 SYMABTL(J827,"STACK UNDERFLOW(PHASBS) LINE XXXXX",34,   PHASBS 
                         LINUM);                                         PHASBS 
                 END                                                     PHASBS 
  
#     SWITCH TO DO SPECIFIC PROCESSING FOR EACH OPERATOR.              #
  
               GOTO CGSW1[OPAT5[ILOPR]];
               END
  
  
#     PROCESS UNARY OPERATORS.  PROCESSING IS JUST LIKE THAT FOR BINARY#
#     OPERATORS EXCEPT, OF COURSE, THERE IS JUST ONE OPERAND           #
  
      LOPD[OOIX] = T1;       # LINK OPERATOR TO OPERAND                #
      NXOP[T1] = OOIX;       # LINK OPERAND TO OPERATOR                #
      KLSS[T1] = OPAT2[ILOPR];     # CLASS OF OPERAND = INTRINSIC TYPE #
                                   # OF IL OPERATORS LOPD              #
  
#     SET QUICK REPLACEMENT FLAG OF OPERATOR IF IT IS SET IN ITS       #
#     OPERAND AND IF THIS OPERATOR CAN INTRINSICALLY SUPPORT QUICK     #
#     REPLACEMENT                                                      #
  
         QREP[OOIX]=OPAT14[ILOPR] AND QREP[T1];                          JANDRE 
         CMPT[OOIX] = CMPT[T1]; 
      OPIX = OPIX - 1;       # REMOVE OPERATOR FROM IL OPERAND STACK   #
  
         IF OPIX LS 0                                                    PHASBS 
         THEN                                                            PHASBS 
           BEGIN                                                         PHASBS 
             SYMABTL(J827,"STACK UNDERFLOW(PHASBS) LINE XXXXX",34,       PHASBS 
                     LINUM);                                             PHASBS 
           END                                                           PHASBS 
  
#     SWITCH TO DO SPECIFIC PROCESSING FOR EACH OPERATOR               #
  
         GOTO CGSW1[OPAT5[ILOPR]];
      CONTROL EJECT;
SW100:   # PRIMITIVE OPERATORS #
         FILLTR(OOIX); #POST TRIAD VALUES#
         QREP[OOIX]=AC$S[OOIX] EQ S"LS";                                 JANDRE 
         GOTO CG00; 
  
SW120M:  # MULTIPLY # 
         IF KFLG[T1] THEN 
               BEGIN # RIGHT OPERAND CONSTANT # 
               T3=KONS[T1]; 
               IF T3 LOR CMPT[T2] EQ 0 THEN 
                    BEGIN # ZERO RESULT # 
                    OOIX = GETRD; 
                    MEMR[OOIX] = PZERO; 
                    FILLTR(OOIX); 
                    $CLG[OOIX] = $CLG[NXOP[T2]];
                    GOTO CG00;
                    END # ZERO RESULT # 
               IF KFLG[T2] THEN 
                    BEGIN # BOTH OPERANDS CONSTANT, NON-FIXED MUL # 
                    OOIX = GETRD; 
                    T5=KONS[T2];
                    IF ILOPR EQ QILOP"IMUL" THEN
                    T4 = CIAOP(T3,T5,QAOP"MUL");
                    ELSE T4 = CRAOP(T3,T5,QAOP"MUL"); 
                    MEMR[OOIX] = PSICON(T4);
                    GOTO SW100; 
                    END # BOTH OPERANDS CONSTANT #
               END # RIGHT OPERAND CONSTANT # 
         IF KFLG[T2] THEN 
               BEGIN # LEFT OPERAND CONSTANT #
               T3=KONS[T2]; 
               IF T3 LOR CMPT[T1] EQ 0 THEN 
                    BEGIN # ZERO RESULT # 
                    OOIX = GETRD; 
                    MEMR[OOIX] = PZERO; 
                    FILLTR(OOIX); 
                    $CLG[OOIX] = $CLG[NXOP[T1]];
                    GOTO CG00;
                    END # ZERO RESULT # 
               END # LEFT OPERAND CONSTANT #
         GOTO CG00; # STACK RESULT #
SW120D:  # DIVIDE # 
         IF KFLG[T2] THEN 
               BEGIN # CONSTANT DIVIDEND #
               T3=KONS[T2]; 
               IF T3 LOR CMPT[T1] EQ 0 THEN 
                    BEGIN # AND = AND = 0 # 
                    OOIX = GETRD; 
                    MEMR[OOIX] = PZERO; 
                    FILLTR(OOIX); 
                    $CLG[OOIX] = $CLG[NXOP[T1]];
                    GOTO CG00;
                    END # ZERO RESULT # 
               IF KFLG[T1] THEN 
                    BEGIN # BOTH OPERANDS CONSTANT #
                    OOIX = GETRD; 
                    T5=KONS[T1];
                    IF ILOPR EQ QILOP"IDIV" THEN
                    T4 = CIAOP(T3,T5,QAOP"DIV");
                    ELSE T4 = CRAOP(T3,T5,QAOP"DIV"); 
                    MEMR[OOIX] = PSICON(T4);
                    GOTO SW100; 
                    END # BOTH OPERANDS CONSTANT #
               END # CONSTANT DIVIDEND #
         GOTO CG00; 
  
SW120R:  # RELATIONAL EXPRESSIONS # 
         RLTL[OOIX]=OPAT9[ILOPR]; 
         IF OPAT7[ILOPR] EQ S"J" THEN 
              BEGIN #INTEGER RELATIONAL#
              IF KFLG[T1] THEN
                   BEGIN #RIGHT OPERAND IS CONSTANT#
                   T3=T2; 
                   IF OPTR[T2] EQ QILOP"SUBS" THEN T3=LOPD[T2]; 
                   IF ENBT[T3] EQ 1 AND AC$S[T3] EQ S"LS" THEN
                        BEGIN #PART-WORD ITEM COMPARED AGAINST 0/1# 
                        $TST[T3]=T; 
                        T3=OPAT9[ILOPR];
                        IF KONS[T1] NQ 0 THEN T3=RCOM[T3];
                        RLTL[T2]=T3;
                        OOIX = T2;
                        GOTO CG00;
                        END #PART-WORD ITEM#
                   END #RIGHT OPERAND CONSTANT# 
              IF KFLG[T2] THEN
                   BEGIN #LEFT OPERAND IS CONSTANT# 
                   T3=T1; 
                   IF OPTR[T1] EQ QILOP"SUBS" THEN T3=LOPD[T1]; 
                   IF ENBT[T3] EQ 1 AND AC$S[T3] EQ S"LS" THEN
                        BEGIN #PART-WORD ITEM COMPARED AGAINST 0/1# 
                        $TST[T3]=T; 
                        T3=OPAT9[ILOPR];
                        IF KONS[T2] NQ 0 THEN T3=RCOM[T3];
                        RLTL[T1]=T3;
                        OPNR[OPIX-1]=OPNR[OPIX];
                        OOIX = T1;
                        GOTO CG00;
                        END #PART-WORD ITEM#
                   END #LEFT OPERAND CONSTANT#
              IF KFLG[T1] AND KFLG[T2] THEN 
                   BEGIN #CONSTANT INTEGER RELATIONAL#
                   OOIX=GETRD;
                   RLTL[OOIX]=RCOM[CIREL(KONS[T2],KONS[T1],OPAT9[ILOPR])
+6];
                   KFLG[OOIX]=T;
                   GOTO CG00; 
                   END #CONSTANT INTEGER RELATIONAL#
              END #INTEGER RELATIONAL#
         IF OPAT7[ILOPR] EQ S"S" AND KFLG[T1] AND KFLG[T2] THEN 
              BEGIN #CONSTANT REAL RELATIONAL#
              OOIX=GETRD; 
              RLTL[OOIX]=RCOM[CRREL(KONS[T2],KONS[T1],OPAT9[ILOPR])+6]; 
              KFLG[OOIX]=T; 
              GOTO CG00;
              END #CONSTANT REAL RELATIONAL#
         IF OPAT8F[ILOPR] THEN SETSV; #CHARACTER RELATIONAL#
         GOTO CG00; 
  
SW120E: #EXPONENTIALS#
         IF KFLG[T2] AND CMPT[T1] EQ 0 THEN 
              BEGIN #LEFT OPERAND IS CONSTANT#
              T4=KONS[T2];
              IF T4 EQ 0 THEN 
                   BEGIN #0 ** EXP=0# 
                   T3=0;
                   GOTO EXPLB;
                   END
              IF T4 EQ 1 AND ILOPR EQ QILOP"ICEXP" THEN 
                   BEGIN #1 ** EXP=1# 
                   T3=1;
                   GOTO EXPLB;
                   END
              #NEITHER 0 NOR 1# 
              IF KFLG[T1] THEN
                   BEGIN #BOTH OPERANDS CONSTANT# 
                   T5=KONS[T1]; 
                   IF ILOPR EQ QILOP"ICEXP" THEN T3=CIAOP(T4,T5,QAOP"IIE
X");               ELSE                          T3=CRAOP(T4,T5,OPAT6[IL
OPR]);             GOTO EXPLB;
                   END #BOTH OPERANDS CONSTANT# 
              #OPERANDS NOT CURRENTLY COMBINABLE# 
              END #LEFT OPERAND CONSTANT# 
         IF KFLG[T1] AND ILOPR NQ QILOP"RREXP" THEN 
              BEGIN #CONSTANT INTEGER EXPONENT# 
              T3=KONS[T1];
              IF T3 EQ 0 THEN 
                   BEGIN
                   IF ILOPR EQ QILOP"ICEXP" THEN T3=1;
                   IF ILOPR EQ QILOP"RIEXP" THEN T3=KFIND(PSICON(1.0)); 
                   IF T3 NQ 0 AND CMPT[T2] EQ 0 THEN
EXPLB:                  BEGIN 
                        OOIX=GETRD; 
                        MEMR[OOIX]=PSICON(T3);
                        GOTO SW100; 
                        END 
                   END
              GOTO CG00;
              END 
         SETSV; 
         GOTO CG00; #STACK RESULT#
  
SW120:   # BINARY EXPRESSIONAL OPERATORS #
           IF KFLG[T1] AND KFLG[T2] THEN
               BEGIN # POSSIBLY COMBINABLE #
               IF OPAT8D[ILOPR] THEN
                    BEGIN # COMBINE INTEGERS BY CIAOP # 
                    OOIX = GETRD; 
                    MEMR[OOIX]=PSICON(CIAOP(KONS[T2],KONS[T1],OPAT6 
[ILOPR]));
                    GOTO SW100; 
                    END # END INTEGERS #
               IF OPAT8E[ILOPR] THEN
                    BEGIN # COMBINE REALS BY CRAOP #
                    OOIX = GETRD; 
                    MEMR[OOIX]=PSICON(CRAOP(KONS[T2],KONS[T1],OPAT6[
ILOPR])); 
                    GOTO SW100; 
                    END # END REALS # 
               END # END CONST #
           IF ILOPR EQ QILOP"IPLUS" THEN
           BEGIN                                                         JANDRE 
           IF KFLG[T1] AND ENBT[T1] LQ ENBT[T2] THEN
              IF KONS[T2] GR 0 THEN 
              BEGIN                                                      JANDRE 
              QREP[T1]=T;                                                JANDRE 
              QREP[OOIX]=QREP[T2] AND NOT $IGN[T2];                      JANDRE 
              END                                                        JANDRE 
           IF KFLG[T2] AND ENBT[T2] LQ ENBT[T1] THEN
              IF KONS[T1] GR 0 THEN 
              BEGIN                                                      JANDRE 
              QREP[T2]=T;                                                JANDRE 
              QREP[OOIX]=QREP[T1] AND NOT $IGN[T1];                      JANDRE 
              END                                                        JANDRE 
           END                                                           JANDRE 
           GOTO CG00; 
SW130:   # UNARY EXPRESSIONAL OPERATORS # 
         IF KFLG[T1] THEN 
               BEGIN # UNARY OP CONST # 
               T3=KONS[T1]; 
               T5 = 0;
               IF OPAT8D[ILOPR] THEN
                   BEGIN # CIAOP FOR INTEGERS # 
                   OOIX = GETRD;
                   MEMR[OOIX] = PSICON(CIAOP(T3,T5,OPAT6[ILOPR]));
                   GOTO SW100;
                   END # END INTEGERS # 
               IF OPAT8E[ILOPR] THEN
                   BEGIN # CRAOP FOR REALS #
                   OOIX = GETRD;
                   MEMR[OOIX] = PSICON(CRAOP(T3,T5,OPAT6[ILOPR]));
                   GOTO SW100;
                   END # END REAL # 
               IF ILOPR EQ QILOP"FMNUS" THEN
                   BEGIN #CONSTANT FMNUS DONE FOR ITEM SWITCH#
                   T4=PSICON(ZERO-KONS[T1]);
                   T5=MEMR[T1]; 
                   T6=NBIT[T4]; 
                   T7=FBIT[T4]; 
                   T8=NLNK[T4]; 
                   TSAVD=SIGN[T4];
                   FOR T9=CONS$W-1 STEP -1 UNTIL 0 DO 
                        SYM0[T4+T9]=SYM0[T5+T9];
                   NBIT[T4]=T6; 
                   FBIT[T4]=T7; 
                   SIGN[T4]=TSAVD;
                   NLNK[T4]=T8; 
                   OOIX=GETRD;
                   MEMR[OOIX]=T4; 
                   GOTO SW100;
                   END #CONSTANT FMNUS# 
               END # END UNARY OP # 
         GOTO CG00; 
SW150:  # PHASE 2 CALL POINT #
  
      IF OPAT8F[ILOPR] THEN 
          BEGIN              # OPERATOR CAN GENERATE SAVES             #
          SETSV;             # SAVE IL OPERAND STACK                   #
  
#     HERE IS WHERE WE OPTIMIZE OUT I=I                                #
  
          IF OPTR[T2] EQ S"PRIM"
              AND OPTR[T1] EQ S"PRIM" 
              AND MEMR[T1] EQ MEMR[T2]
              AND OFFS[T1] EQ OFFS[T2]
              AND ENBT[T1] EQ ENBT[T2]
              AND EFBT[T1] EQ EFBT[T2]
              THEN GOTO SW160;     # SUPRESS ICF GENERATION FOR I=I    #
          END 
  
SW155:   #VALD ENTRY# 
         BRKPT;     # CALL PHASE 2 #
  
# COMPUTE POINT RETURN FROM PHASE 2 # 
SW160:   IF OPIX EQ 0 THEN INTRX; 
         GOTO CG01; 
  
  
SW180:   # ILLEGAL #
         SYMABTL(J829,"ILLEGAL IL SEEN(PHASBS) LINE XXXXX",34,LINUM);    PHASBS 
  
SW200:   # REVR # 
         OPNR[OPIX] == OPNR[OPIX-1];
         GOTO CG01; 
SW220:   # LFLX # 
         TSVNB=OPNR[OPIX-1]; #SAVE FOR RFLX ADJUSTING#
         OPNR[OPIX-1]=OPNR[OPIX]; 
         OPNR[OPIX]=TSVNB;
         GOTO CG01; 
SW230:   # RFLX # 
         #ADJUST STACK HISTORY# 
         T4=OPNR[OPIX]; #LAST STACKED ITEM# 
         FOR T1=SHPTR STEP -1 UNTIL 1 DO
              BEGIN #LOOK THRU ALL HISTORIES# 
              T2=STKC[STKH[T1]]; #STACK SAVED IN THIS TRIAD#
              FOR T3=OOAR[T2] STEP -1 UNTIL 1 DO
                   IF TSVNB EQ OOAR[T2+T3] THEN 
                        BEGIN 
                        OOAR[T2+T3]=T4; 
                        TEST T1; #THIS HISTORY DONE#
                        END 
              END #ALL HISTORIES# 
         OPNR[OPIX]=OPNR[OPIX-1]; 
         OPNR[OPIX-1]=T4; 
         GOTO CG01; 
  
CGEOF:   # UNEXPECTED IL END OF FILE #
         SYMABTL(-J828,"UNEXPECTED END-OF-FILE(PHASBS) LINE XXXXX",41,   PHASBS 
                 LINUM);                                                 PHASBS 
         OPTR[OOIX] = QILOP"PTRM";
SW240:   # PTRM # 
         BRKPT;     # CALL PHASE 2 #
         FINCG1;
         RETURN;    # RETURN TO EXEC #
  
SW280:   # INFO # 
         FOR T1 = ILNBR[ILIX] STEP -1 UNTIL 1 DO
         GETIL;  # STEP IL POINTER PAST INFO WORDS #
         GOTO CG01; 
  
SW360:   # PAUS,SJOV #
      MEMR[OOIX] = ILNBR[ILIX]; 
         BRKPT; 
          FOR T1=OPIX STEP -1 UNTIL 1 DO
              IF OPTR[OPNR[T1]] NQ QILOP"NULL" THEN 
                 SYMABTL(-J832,"STACK NON-EMPTY AT BREAKPOINT(PHASBS) LI PHASBS 
NE XXXXX",48,LINUM);                                                     PHASBS 
         INTRX; 
         GOTO CG01; 
  
SW380:   # PNOT - REMOVE #
         T1 = OPNR[OPIX]; 
         RLTL[T1] = RCOM[RLTL[T1]]; 
         GOTO CG01; 
  
  
SW420:   # SUBS # 
         SFLG[T2] = T;
         QREP[OOIX]=AC$S[T2] EQ S"LS";                                   JANDRE 
         EFBT[OOIX]=EFBT[T2]; ENBT[OOIX]=ENBT[T2];
         $IGN[OOIX]=$IGN[T2]; 
         QREP[T1]=FALSE;                                                 JANDRE 
         IF KFLG[T1] THEN 
               BEGIN # RIGHT OP CONSTANT #
               OFFS[T2]=KONS[T1]; 
               OOIX = T2; 
               GOTO CG00; 
               END
         IF OPAT10[OPTR[T1]] THEN 
               BEGIN # IPLUS,ISUB # 
               IF KFLG[ROPD[T1]] THEN 
                    BEGIN # RIGHT OP CONSTANT # 
                    T3=KONS[ROPD[T1]];
                    IF OPTR[T1] EQ QILOP"IPLUS" THEN OFFS[T2]=T3; 
                    ELSE #ISUB#                      OFFS[T2]=ZERO-T3;
                    T4=LOPD[T1];
                    NXOP[T4]=OOIX;
                        QREP[T4]=F; 
                    ROPD[OOIX]=T4;
                    GOTO CG00;
                    END 
               IF KFLG[LOPD[T1]] THEN 
                    BEGIN # LEFT OP CONSTANT #
                    OFFS[T2]=KONS[LOPD[T1]];
                    IF OPTR[T1] EQ QILOP"IPLUS" THEN
                        BEGIN 
                        T4=ROPD[T1];
                        ROPD[OOIX]=T4;
                        NXOP[T4]=OOIX;
                        QREP[T4]=F; 
                        END 
                    ELSE BEGIN # ISUB # 
                         OPTR[T1] = QILOP"IMNUS"; 
                         LOPD[T1] = ROPD[T1]; 
                         ROPD[T1] = 0;
                         END
                    END 
               END
         GOTO CG00; 
  
SW440:   # FUNI # 
         T3=FNBR[MEMR[T1]]; 
         T3=FNBS[T3]; # CHANGE QFNBR/QFNBS WAITING CHANGES IN FNBR #     JANDRE 
         FNUM[OOIX]=T3; 
         GOTO FUNISW[T3]; 
                                                                         JANDRE 
FFNBS$:                                                                  PHASBS 
         SYMABTL(J848,"ILLEGAL FUNI BYTE(PHASBS) LINE XXXXX",36,LINUM);  PHASBS 
                                                                         JANDRE 
FICX:    # INT TO CHAR #                                                 JANDRE 
         IF OPTR[T2] EQ S"PRIM" AND ENBT[T2] GQ 6 THEN                   JANDRE 
              BEGIN                                                      JANDRE 
              T3=T2;                                                     JANDRE 
              IF AC$S[T2] EQ S"EQ" THEN                                  JANDRE 
                 BEGIN # I DON T KNOW WHY THEY ARE WRONG...#             JANDRE 
                   EFBT[T2]=0; ENBT[T2]=60;                              JANDRE 
                 END                                                     JANDRE 
FICX1:        # CONVERT BY MODYING TRIAD #                               JANDRE 
              OOIX=T2;                                                   JANDRE 
              QREP[T2]=TRUE;                                             JANDRE 
              IF KFLG[T3] THEN
                   BEGIN
                   B<0,6>KONS[T3]=B<54,6>KONS[T3];
                   B<6,54>KONS[T3]=O"555555555555555555"; 
                   EFBT[T3]=0; ENBT[T3]=60; 
                   EFBY[T3]=0; ENBY[T3]=10; 
                   ADJF[T3]=T;
                   END
              ELSE BEGIN
              EFBT[T3]=EFBT[T3]+ENBT[T3]-6;                              JANDRE 
              EFBY[T3]=EFBT[T3]/6;                                       JANDRE 
              ENBT[T3]=6;                                                JANDRE 
              ENBY[T3]=1;                                                JANDRE 
              END 
              AC$S[T3]=S"LS";                                            JANDRE 
              VFLG[T3]=S"LITR";                                          JANDRE 
              CTYP[T3]=S"H";                                             JANDRE 
              GOTO CG00;                                                 JANDRE 
              END                                                        JANDRE 
         IF KFLG[T2] THEN                                                JANDRE 
              BEGIN # VERY SHORT CONSTANT #                              JANDRE 
              ENBT[T2]=6; EFBT[T2]=54;                                   JANDRE 
              T3=T2;                                                     JANDRE 
              GOTO FICX1;                                                JANDRE 
              END                                                        JANDRE 
         IF OPTR[T2] EQ S"SUBS" THEN                                     JANDRE 
              BEGIN                                                      JANDRE 
              T3=LOPD[T2];                                               JANDRE 
              IF ENBT[T3] GQ 6 THEN GOTO FICX1;                          JANDRE 
              END                                                        JANDRE 
FRCX:    QREP[OOIX]=TRUE;                                                JANDRE 
         GOTO CG00;                                                      JANDRE 
FIRX:    # IRX #
         IF KFLG[T2] THEN 
               BEGIN
               REAL=KONS[T2]; 
               OOIX = GETRD;
               MEMR[OOIX] = PSICON(REAL); 
               GOTO SW100;
               END
         GOTO CG00; 
FRIX:    # RIX #
         IF KFLG[T2] THEN 
               BEGIN
               FIND(MEMR[T2],T3); 
               INT = FNME[T3];
               OOIX = GETRD;
               MEMR[OOIX] = PSICON(INT);
               GOTO SW100;
               END
         GOTO CG00; 
FCIX:    # CHARACTER-TO-INTEGER # 
         IF KFLG[T2] THEN 
              BEGIN 
              T3=ENBY[T2]*6;
              IF T3 GR 60 THEN T3=60; 
              T4=B<0,T3>KONS[T2]; 
              OOIX=GETRD; 
              MEMR[OOIX]=PSICON(T4);
              GOTO SW100; 
              END 
         T3=0;
         IF OPTR[T2] EQ S"PRIM" THEN T3=T2; ELSE
         IF OPTR[T2] EQ S"SUBS" THEN T3=LOPD[T2]; 
         IF T3 NQ 0 AND AC$S[T3] EQ S"GR" AND EFBY[T3] EQ 0 THEN
              BEGIN # TAKE ONLY 1ST WORD OF LONG STRING LEFT JUSTIFIED #
              ENBT[T3]=60;
              VFLG[T3]=S"NUMB"; 
              $IGN[T3]=F; 
              $TST[T3]=F; 
              OOIX=T2;  # SUPPRESS FUNI CIX TRIADS #
              END 
         ELSE 
         QREP[OOIX]=QREP[T2];                                            JANDRE 
         GOTO CG00; 
FIDN:    #DRX,RDX#
         OOIX=T2; 
         GOTO CG00; 
BITF:    # BIT FUNCTION B<T3,T4>OBJX #                                   JANDRE 
         CLSS(OOIX); #SET OBJX FBDX NBDX STRUC #                         JANDRE 
         IF KFLG[NBDX]                                                   SMPA066
         THEN                                                            SMPA066
           BEGIN                   #B<T3,CONS>OBJX                     # SMPA066
           IF KONS[NBDX] EQ 0                                            SMPA066
           THEN                                                          SMPA066
             BEGIN                                                       SMPA066
             SYMABTL(J867,"BEAD FUNC WITH LENGTH = 0 ILLEGAL(PHASBS) LIN F2 
E XXXXX",53,LINUM);                                                      F2 
             ;                                                           SMPA066
             END                                                         SMPA066
                                                                         SMPA066
           IF KFLG[FBDX]                                                 SMPA066
           THEN                                                          SMPA066
              BEGIN # B<CONS,CONS>OBJX#                                  JANDRE 
              T3=KONS[FBDX]; T4=KONS[NBDX];                              JANDRE 
              T5=EFBT[OBJX];                                             JANDRE 
              T6=T3+T5;                                                  JANDRE 
              T5=T6/60;     # NEW WORD NUMBER #                          JANDRE 
              IF AC$S[OBJX] NQ S"GR" OR T5 EQ (T4+T6-1)/60 THEN          JANDRE 
                   BEGIN # NO WORD CROSSING REPLACE PFUN BY 1 TRIAD #    JANDRE 
                   IF STRUC EQ S"C" THEN # ITEM #                        JANDRE 
                                         BEGIN                           JANDRE 
                                         OOIX=OBJX;                      JANDRE 
                                         SFLG[OOIX]=T; #IN CASE OF PCAL# JANDRE 
                                         END                             JANDRE 
                                    ELSE # SUBS# OOIX=NXOP[OBJX];        JANDRE 
                   VFLG[OBJX]=S"NUMB";
                   $IGN[OBJX]=F;                                         JANDRE 
                   $TST[OBJX]=F;                                         JANDRE 
                 EFBT[OBJX]=T6-T5*60;                                    JANDRE 
                 ENBT[OBJX]=T4;                                          JANDRE 
                 OFFS[OBJX]=OFFS[OBJX]+T5*INCRMT(OBJX);                  JANDRE 
                   IF T4 LS 60 THEN BEGIN AC$S[OBJX]=S"LS";              JANDRE 
                                          QREP[OOIX]=T;                  JANDRE 
                                    END                                  JANDRE 
                   GOTO CG00;                                            JANDRE 
                   END # ACSS " GR #                                     JANDRE 
              END # BOTH FIRST BIT AND NB CONSTANT#                      JANDRE 
           END                     #NB CONSTANT                        # SMPA066
         GOTO FBYT2;                                                     JANDRE 
FBYT:    #BIT,BYTE# 
         CLSS(OOIX);
         IF KFLG[NBDX] THEN                                              JANDRE 
           BEGIN                   #C<T3,CONS>OBJX                     # SMPA066
           IF KONS[NBDX] EQ 0                                            SMPA066
           THEN                                                          SMPA066
             BEGIN                                                       SMPA066
             SYMABTL(J867,"BEAD FUNC WITH LENGTH = 0 ILLEGAL(PHASBS LIN  F2 
E XXXXX",53,LINUM);                                                      F2 
             ;                                                           SMPA066
             END                                                         SMPA066
           IF KFLG[FBDX] THEN                                            JANDRE 
              BEGIN # C<T3,T4>OBJX T3,T4 CONSTANT #                      JANDRE 
              T3=KONS[FBDX]; T4=KONS[NBDX];                              JANDRE 
              T5=(EFBT[OBJX]+5)/6;                                       JANDRE 
              T6=T3+T5;                                                  JANDRE 
              T5=T6/10;     # NEW WORD NUMBER #                          JANDRE 
              IF AC$S[OBJX] NQ S"GR" OR T5 EQ (T4+T6-1)/10 THEN          JANDRE 
                 BEGIN # NO WORD CROSSING  REPLACE PFUN BY OBJX TRIAD#   JANDRE 
                   IF STRUC EQ S"C" THEN # ITEM #                        JANDRE 
                                         BEGIN                           JANDRE 
                                         OOIX=OBJX;                      JANDRE 
                                         SFLG[OOIX]=T; #IN CASE OF PCAL# JANDRE 
                                         END                             JANDRE 
                                  ELSE #SUBS# OOIX=NXOP[OBJX];           JANDRE 
                 ADJF[OBJX]=T;                                           JANDRE 
                 $IGN[OBJX]=F;                                           JANDRE 
                 VFLG[OBJX]=S"LITR";                                     JANDRE 
                 EFBY[OBJX]=T6-T5*10;                                    JANDRE 
                 ENBY[OBJX]=T4;                                          JANDRE 
           EFBT[OBJX] = (EFBT[OBJX] + T3*6) - 
                        (EFBT[OBJX] + T3*6) / 60 * 60;
                 ENBT[OBJX]=ENBY[OBJX]*6;                                JANDRE 
                 OFFS[OBJX]=OFFS[OBJX]+T5*INCRMT(OBJX);                  JANDRE 
                 IF T4 LS 10 THEN BEGIN AC$S[OBJX]=S"LS";                JANDRE 
                                        QREP[OOIX]=T;                    JANDRE 
                                  END                                    JANDRE 
                             ELSE AC$S[OBJX]=S"EQ";                      JANDRE 
                 GOTO CG00;                                              JANDRE 
                 END # C<CONS,CONS>1WORD #                               JANDRE 
              END # BOTH FBT,NBT CONSTANT #                              JANDRE 
           ELSE                                                          JANDRE 
              BEGIN # FBDX VAR, NBDX CONSTANT #                          JANDRE 
              $BEGIN GOTO FBYT2;  # NOT YET DEBUGGED #
              T4=KONS[NBDX];                                             JANDRE 
              QREP[FBDX]=F;                                              JANDRE 
              IF T4 EQ 1 THEN # C<I,1> #                                 JANDRE 
                   BEGIN                                                 JANDRE 
                   BWOR[OOIX]=T;                                         JANDRE 
                   POTE[OBJX]=NXOP[NBDX]; #FLST TRIAD #                  JANDRE 
                   GOTO FBYT2;                                           JANDRE 
                   END                                                   JANDRE 
              T3=0;                                                      JANDRE 
              T5=OPTR[FBDX];                                             JANDRE 
              IF T5 EQ QILOP"IMUL" THEN                                  JANDRE 
                   BEGIN # C<I*J,T4> #                                   JANDRE 
                   T6=ROPD[FBDX];                                        JANDRE 
                   T7=LOPD[FBDX];                                        JANDRE 
                   IF KFLG[T6] AND KONS[T6] EQ 10 THEN GOTO FBYT10;      JANDRE 
                   IF KFLG[T7] AND KONS[T7] EQ 10 THEN GOTO FBYT10;      JANDRE 
                   # ELSE:NOT C<10*K,T4> #                               JANDRE 
                   END # C<I*J,T4> #                                     JANDRE 
              ELSE                                                       JANDRE 
              IF T5 EQ QILOP"IPLUS" THEN                                 JANDRE 
                   BEGIN # C<I+J,T4> #                                   JANDRE 
                   T6=ROPD[FBDX];                                        JANDRE 
                   T7=LOPD[FBDX];                                        JANDRE 
                   IF KFLG[T6] THEN                                      JANDRE 
                      BEGIN                                              JANDRE 
                      T3=KONS[T6];                                       JANDRE 
                      IF OPTR[T7] EQ S"IMUL" THEN                        JANDRE 
                        BEGIN # C<I*J+T3,T4> #                           JANDRE 
                        T8=LOPD[T7];                                     JANDRE 
                        IF KFLG[T8] AND KONS[T8] EQ 10 THEN              JANDRE 
                           BEGIN                                         JANDRE 
FBYT10:                    # C<10*I+T3,T4>OBJX T3,T4 CONSTANT #          JANDRE 
                           T9=EFBY[OBJX]+T3;                             JANDRE 
                           IF T9/10 EQ (T9+T4-1)/10 THEN                 JANDRE 
                              BEGIN # NO WORD CROSSING #                 JANDRE 
                              T9=NXOP[NBDX];  # FLST TRIAD #             JANDRE 
                              IF T5 EQ QILOP"IPLUS" THEN                 JANDRE 
                                 BEGIN # DISCONNECT + TRIAD#             JANDRE 
                                 LOPD[T9]=T7;                            JANDRE 
                                 NXOP[T7]=T9;                            JANDRE 
                                 END                                     JANDRE 
                              POTE[OBJX]=T9;      # SAVE FLST #          JANDRE 
                              POTE[NBDX]=T3;      # SAVE T3 #            JANDRE 
                              FBDX=LOPD[T9];                             JANDRE 
                              BWOR[OOIX]=T;                              JANDRE 
                              END #NO WORD CROSSING #                    JANDRE 
                           END #C<10*I+T3,T4> #                          JANDRE 
                        END #C<I*J+T3,T4>#                               JANDRE 
                      END #C<I+T3,T4>#                                   JANDRE 
                   END #C<I+J,T4>#                                       JANDRE 
              $END
              END #C<VAR,CONS>  #                                        JANDRE 
           END                     #NB CONSTANT                        # SMPA066
FBYT2:   QREP[NBDX]=F; QREP[FBDX]=F;                                     JANDRE 
         IF AC$S[OBJX] EQ S"GR" THEN SETSV; 
         KLSS[ROPD[T2]]=S"ADDR";
FKLSS:   # RESET KLSS TO ADDR # 
         KLSS[T2]=S"ADDR"; #LEFT OPERAND# 
         GOTO CG00; 
  
SW460:   # TSST # 
                                                                         DON/D
#     IN ORDER TO TRY TO OPTIMIZE THE CASES OF IF B THEN GOTO LABEL    #
#     AND IF B THEN RETURN (FROM A PROC) WE                            #
#     SEARCH THE IL FOR THE APPROPRIATE SEQUENCE, THROWING AWAY PAUSES # DON/D
#     AS WE GO (THEY REALLY ARN"T BREAKPOINT OPERATORS IN THIS CONTEXT # DON/D
#     ANYWAY).  THIS IS FINE AND DANDY UNLESS WE ARE TRYING TO GENERATE# DON/D
#     TRACEBACK CODE IN WHICH CASE WE NEED THE PAUSES IN THE ICF.      # DON/D
                                                                         DON/D
SW462:     T3= ILOP[ILIX+1];
           IF T3 EQ QILOP"PAUS" THEN
              BEGIN 
              IF B<2>OPTION NQ 0 THEN                                    DON/D
                  BEGIN      #HAVE TO PUT OUT PAUS FOR TRACEBACK#        DON/D
                  ICFGEN(QICFOP"LINE",ILNBR[ILIX+1],0); 
                  IF CIDDB NQ 0 THEN   # CID DEBUG SET   #               JUNK 
                    BEGIN                                                JUNK 
                    ICFGEN ( QICFOP"PCAL" , PSCPRC("DBUG.LN"), 0);       JUNK 
                    END                                                  JUNK 
                  END                                                    DON/D
              ILIX=ILIX+1;
              GOTO SW462; 
              END 
           T3 = ILOP[ILIX+2]; 
           IF T3 NQ QILOP"GOTO" 
               AND T3 NQ QILOP"RTRN"
           THEN 
               GOTO SW150;
           IF T3 EQ QILOP"RTRN" 
           THEN 
               BEGIN
           IF CLAS[PROCITM] EQ QCLAS"FUNC" THEN 
             GOTO SW150;
           ILOPN[ILIX+1] = PROCITM;   # IT WAS NULL -- PASS 1 DIDNT 
                                        KNOW ANY BETTER # 
               END
               # ELSE TRY TO RECOGNIZE  IF B THEN GOTO L  #              JANDRE 
               T4=ILIX+3; 
SW464:         T3 = ILOP[T4]; 
               IF T3 EQ QILOP"PAUS" THEN
                   BEGIN
              IF B<2>OPTION NQ 0 THEN                                    DON/D
                  BEGIN      #HAVE TO PUT OUT PAUS FOR TRACEBACK#        DON/D
                  ICFGEN(QICFOP"LINE",ILNBR[T4],0); 
                  IF CIDDB NQ 0 THEN   # CID DEBUG SET   #               JUNK 
                    BEGIN                                                JUNK 
                    ICFGEN ( QICFOP"PCAL" , PSCPRC("DBUG.LN"), 0);       JUNK 
                    END                                                  JUNK 
                  END                                                    DON/D
                   T4=T4+1; 
                   GOTO SW464;
                   END
               INVERTLABL(T4-1); # IF LABELS INVERTED, JP SW150 #        JANDRE 
               T4=T4+1;                                                  JANDRE 
               IF ILOP[T4] NQ QILOP"GOTO" THEN GOTO SW150;
               T4=T4+1;                                                  JANDRE 
               INVERTLABL(T4+1); # IF OK, NEW ILIX=LABL+1 #              JANDRE 
               GOTO SW150;                                               JANDRE 
                                                                         JANDRE 
  
SW520:   # FCAL # 
         SETSV;     # SET SAVES # 
         FCMP[OOIX] = 1;  # EMBEDDED FCAL # 
         FUNC SUBARRY (I) B;
                # QUESTION -- IS I A SUBSCRIPTED ARRAY NAME      #
           BEGIN
           ITEM I;
           IF OPTR[I] EQ QILOP"PRIM"
           AND CLAS[MEMR[I]] EQ S"TABL" THEN
               # ARRAY NAME WITH CONSTANT SUBS  # 
             SUBARRY = TRUE;
           ELSE 
             IF OPTR[I] EQ QILOP"SUBS"
             AND CLAS[MEMR[LOPD[I]]] EQ S"TABL"    THEN 
                    # VARIABLE SUBS   # 
             SUBARRY = TRUE;
             ELSE 
                 SUBARRY = FALSE; 
           END
         IF ROPD[OOIX]  NQ 0
         AND OPTR[ROPD[OOIX ]] NQ S"PLST" 
         AND SUBARRY ( ROPD[OOIX] )    THEN 
           KLSS[ROPD[OOIX]] = S"ADDR" ; 
         GOTO CG00; 
  
  
  
  
          FUNC LONGSTR(I) B; #TRUE IF I WILL CAUSE A LIBRARY CALL      #
          ITEM I; 
          LONGSTR = (OPTR[I] EQ QILOP"SUBS" AND AC$S[LOPD[I]] EQ S"GR") 
                 OR (OPTR[I] NQ QILOP"SUBS" AND AC$S[I] EQ S"GR");
  
  
  
  
  
SW550:  
            # CHECK FOR THIS PARAM IS A SUBSCRIPTED ARRAY NAME   #
         IF ROPD[OOIX] NQ 0 
         AND SUBARRY ( ROPD[OOIX] )     THEN
           KLSS[ROPD[OOIX]] = S"ADDR" ; 
  
         IF OPTR[LOPD[OOIX]] NQ S"PLST" 
         AND SUBARRY ( LOPD[OOIX] )        THEN 
           KLSS[LOPD[OOIX]] = S"ADDR"  ;
  
         IF (ROPD[OOIX] NQ 0                                             NOV04
           AND LONGSTR (ROPD[OOIX]))                                     NOV04
           OR (OPTR[LOPD[OOIX]] NQ S"PLST"                               NOV04
             AND LONGSTR (LOPD[OOIX]))                                   NOV04
           OR SDEF[LOPD[OOIX]]                                           NOV04
         THEN                                                            NOV04
              BEGIN  #LONG STRINGS# 
              #IT IS NECESSARY TO STACK OPERATOR EARLY FOR SETSV HERE  #
              OPIX = OPIX + 1;
              OPNR[OPIX] = OOIX;               #OPNDS IN MORTAL DANGER #
              SETSV;                           #SAVE LONG STR LOADS    #
              OPIX = OPIX - 1;                 #RESTORE BEFORE EXIT    #
              SDEF[OOIX] = TRUE;               # PERPETUATE SAVES      # NOV04
              END  #LONG STRINGS# 
         GOTO CG00; 
  
      CONTROL EJECT;
PROC INVERTLABL(L); ITEM L; # TRY TO INVERT TSST LABELS #                JANDRE 
    BEGIN                                                                JANDRE 
               IF ILOP[T4+1] EQ QILOP"LABL" THEN
                 BEGIN #FOLLOWED BY#
                 IF MEMR[T1] EQ ILOPN[T4] THEN
                    BEGIN #MATCHING TSST LABEL# 
                    RLTL[T2]=RCOM[RLTL[T2]];
                    IF CLAS[MEMR[T1]] EQ S"LABL" THEN 
                    LREF[MEMR[T1]]=LREF[MEMR[T1]]-1;
                    MEMR[T1]=ILOPN[ILIX+1]; 
                    ILIX=L;  # NEW IL POINTER #                          JANDRE 
               GOTO SW150;                                               JANDRE 
                    END # MATCHING TSST LABL #
                 END # ILOP EQ LABL # 
    END # INVERTLABL PROC #                                              JANDRE 
CONTROL EJECT;
         PROC  GETIL; 
  
# RETURNS POINTER TO NEXT IL WORD. BOOKKEEPS IL ARRAY AND POINTER # 
   BEGIN
  
      ILIX = ILIX + 1;       #BUMP INDEX INTO IL ARRAY.                #
  
#     PROC GTILN GETS THE NEXT CHUNK OF IL.  IT RETURNS THE NUMBER OF  #
#     WORDS READ IN ILCP.  WHEN ILIX (THE INDEX INTO THE IL ARRAY) IS  #
#     GREATER THAN OR EQUAL TO ILCP WE MUST AGAIN CALL GTILN FOR MORE  #
#     IL.                                                              #
  
         IF ILIX GQ ILCP THEN 
               BEGIN
               ILIX = 0;
               GTILN(IL,ILCP,CGEOF);
               ILWRD[ILCP+0]=0; 
               ILWRD[ILCP+1]=0; 
               ILWRD[ILCP+2]=0; 
               ILWRD[ILCP+3]=0; 
               ILWRD[ILCP+4]=0; 
               END
##       $BEGIN 
  
#     PRINT IL WORD IF REQUESTED. (*=L ON CONTROL CARD)                #
  
      IF B<"L"-1>INTOPS NQ 0  THEN
               ILDUMP(ILWRD[ILIX],1); 
##       $END 
   END
CONTROL EJECT;
         PROC  SETSV; 
  
#     SETSV - SAVE IL OPERAND STACK                                    #
  
#     SAVES STACK IN TRIAD TABLE FREE SPACE.  THIS BLOCK IS CALLED A   #
#     STACK HISTORY.  LINKS CURRENT TRIAD TO STACK HISTORY.  PUTS ENTRY#
#     IN STACK HISTORY TABLE POINTING TO CURRENT TRIAD.                #
  
         BEGIN
         ITEM I,J;
  
#     GET ENOUGH SPACE FROM TRIAD TABLE TO HOLD IL OPERAND STACK + 1   #
#     WORD FOR SIZE OF STACK                                           #
  
         I=GTRSP(OPIX+1); 
      OOAR[I] = OPIX;        # PUT SIZE OF STACK IN TABLE              #
  
#     MOVE STACK TO TRIAD TABLE.                                       #
  
         FOR J=1 STEP 1 UNTIL OPIX DO 
              OOAR[I+J]=OPNR[J];
  
#     SAVE POINTER TO STACK HISTORY IN CURRENT TRIAD                   #
  
         STKC[OOIX]=I;
      SHPTR = SHPTR + 1;     # BUMP STACK HISTORY TABLE INDEX          #
         IF SHPTR GR SHSZ                                                PHASBS 
         THEN                                                            PHASBS 
           BEGIN                                                         PHASBS 
           SYMABTL(J841,"STACK HISTORY OVERFLOW(PHASBS) LINE XXXXX",41,  PHASBS 
                   LINUM);                                               PHASBS 
           END                                                           PHASBS 
  
#     SAVE POINTER TO CURRENT TRIAD IN STACK HISTORY TABLE             #
  
         STKH[SHPTR]=OOIX;
         END
  
  
  END 
         TERM 
