*DECK             CODGJ3
USETEXT   TSOURCE 
USETEXT   TTARGET 
USETEXT   TCEXECQ 
USETEXT   TSYMCNS 
USETEXT   TREGNOS 
USETEXT   TCOMTF
USETEXT   TCOM39Q 
USETEXT   TCOM78Q 
USETEXT   TCEXEC
USETEXT   TCOM88
USETEXT   TCOM88J 
PROC CODGJ3;
BEGIN 
  
  
  
  
*CALL COMEX 
  
  
  
  
#     DEFS                                                             #
  
    DEF J855 #855#;                # SYMABT DIAGNOSTIC 855             # CODGJ3 
    DEF J856 #856#;                # SYMABT DIAGNOSTIC 856             # CODGJ3 
    DEF J857 #857#;                # SYMABT DIAGNOSTIC 857             # CODGJ3 
  
  
  
  
    XDEF PROC BDT;
    XREF FUNC FTEMP;
    XREF FUNC GETLAB; 
    XREF FUNC PTAS; 
    XREF FUNC GETEMP; 
      XREF PROC FIND; 
     XREF FUNC ACSTYPE; 
    XREF PROC LSTPRD; 
    XREF PROC PSTOS;
    XREF PROC LSTADD; 
    XREF PROC CANNED; 
    XREF PROC PRIORITY; 
    XREF PROC IINST;
    XREF PROC BADIV;
    XREF PROC CGINVS; 
    XREF PROC LOOPCN; 
    XREF PROC JNSM; 
    XREF PROC ENTRAU; 
    XREF PROC CPBRT;
    XREF PROC PSTOU;
    XREF PROC POS;
    XREF PROC PCOU; 
      XREF PROC CG2ABT; 
    XREF PROC DB; 
    XREF PROC GICFB;
    XREF PROC MPRED;
    XREF PROC ADDARRY;
    XREF FUNC LOOPTEMP; 
XREF PROC SHORTBLD; 
XREF PROC RELOAD; 
    XREF PROC PNAM; 
        # REDUCE REFERENCE COUNT OF  I# 
    DEF REDREFCT (I) # IF REFCT[I] GR 0 THEN REFCT[I] = REFCT[I] -1  #; 
    ITEM INVIS;     #HEAD OF INVS (STEP) CHAIN  # 
    ITEM WHILEJP  ;    # MARK THE FIRST JP OF A WHILE CLAUSE  # 
        XREF PROC NODUPL;                                                SOPT 
CONTROL EJECT;
    PROC BDT; 
                                        #BDT READS THE ICF AND BUILDS  #
                                        # THE DEPENDENCY TREE FOR ONE  #
                                        # SEQUENCE. THE INSTRUCTIONS   #
                                        # ARE COMPLETED IN THE ICFT IN #
                                        # PREPARATION FOR SCHEDULING   #
                                        # AND REGISTER ASSIGNMENT.     #
                                        # BDT IS CALLED BY CODGJ1, THE #
                                        # CG2 CONTROL PROGRAM.         #
    BEGIN # BUILD DEPENDENCY TREE # 
       ITEM BDTT1, BDTT2, BDTT3, BDTT4; 
       ITEM PBRAI;  # ICFT INDEX OF PARAMETER "BRAJ" PREDECESSOR       #
       ITEM BNFC I=1;  # SET ZERO IF B-REG NEEDED FOR COMPUTATION      #
       ITEM NOAB I=6;  # NUMBER OF AVAILABLE B-REGISTERS               #
       ITEM ZTEMP;
       ITEM  DUMMY;                #DUMMY VARIABLE FOR BDT             #
       ITEM  NEXTICF;              #TEMP FOR ICFT BACKWARDS SEARCH     #
    SWITCH TERMOP 
        OPERR1,     # ILLEGAL SEQUENCE TERMINATING OP CODE             #
        SPRC,       # START PROCEDURE                                  #
        EPILOG,     # END PROCEDURE                                    #
        PCALL,      # PROCEDURE CALL                                   #
        PROLOG,     # ENTR                                             #
        DIRC,       # DIRECT CODE                                     # 
        BDT500;     # START PROGRAM (PRGM)                            # 
    SWITCH ICFOP
        OPERR,      # OP CODE ERROR                                    #
        BDT10,      # SAFE UNARY                                       #
        BDT13,      # SAFE BINARY                                      #
        BDT15,      # UNSAFE BINARY                                    #
        BDT17,      # REPL                                             #
        BDT20,      # LOAD                                             #
        BDT24,      # SAVE                                             #
        BDT26,      # DEAD                                             #
        BDT28,      # JUMP - UNCONDITIONAL                             #
        BDT32,      # TEST AND JUMP                                    #
        BDT35,      # LABEL                                            #
        BDT20,      # LOC  -  LOC NOW USES NORMAL LOAD PROCESSING      #
        BDT42,      # INVI                                             #
        BDT45,      # INVS                                             #
        BDT50,      # INVB                                             #
        RETRN,      # RETURN                                          # 
        BDT900,     # SEQUENCE TERMINATOR                              #
        BDT100,     # SELB                                             #
        BDT110,     # DRV                                              #
        BDT115,     # IJP                                              #
        BDT120,     # SRV, XMX6                                        #
        BDT5,       # IGNORE                                           #
        EPILOG,     # EPRC                                             #
        BDT600,     # CNTL                                             #
        BDT680,     # LINE                                             #
        BDT800,     # PTRM -- END OF ICF                               #
        BDT49M,     # INVT                                             #
        BDT12,      # BINARY B-REG USER                                #
        BDT9;       # UNARY  B-REG USER                                #
  
#**********************************************************************#
          ITEM PREAMBLE,LASTAMBLE;
        ITEM BR  ;   # S.T. INDEX OF AN ITEM/ARRAY IN A BRAI  # 
        ITEM PROCNAM; 
          PREAMBLE =0;
      ITEM BEGSEQ = 0 ;   # SEQ NUMBER AT BEGINING OF ICFT#              SOPT 
  #CLEAN UP USES LISTS OF ARRAYS AND ARRAY ITEMS#                        SOPT 
    XREF PROC CLEANARRY;                                                 SOPT 
  
       SEQ = SEQ+1;  # INCREASE SEQUENCE COUNTER           #
       IF ARLIST NQ 0 THEN CLEANARRY;     #FIX USES,LDST BEFORE NEW SEQ#
       BI = NBI;    # ICF INDEX OF ICFT[0]                             #
       LSM = BI+1;   # LAST SEQUENCE MARK                              #
       LRL = LSM;    # LAST REFERENCED LABEL ICF INDEX                 #
       BNFC = 1;   # ASSUME NO B-REGS NEEDED FOR COMPUTATIONS          #
       GUSES = 0;       # GLOBAL USES LIST HEAD LINK                  # 
       PUSES = 0;       # PARAMETER USES LIST HEAD LINK               # 
       GSTORE = 0;      # GLOBAL STORES LIST HEAD LINK                # 
       LBS = 0;         # INITIALIZE LAST STORES OF TYPE               #
       LGS = 0;         # (FOR PROTECTION ON RESCHEDULING SAME SEQ)    #
       LPS = 0; 
       LAS = 0; 
       FREEL = 0;       # FREE LIST HEAD LINK                         # 
       SUCTI = 0;       # LAST USED SUCCESSOR TABLE ENTRY             # 
       ICFTI = 0;       # ICFT TOP INDEX                              # 
       MARKCTR = 0; 
       MOPIT = 0;                                                        SOPT 
       BEGSEQ =SEQ ;                                                     SOPT 
       AVAIL = -1;
       LOPLAB = -1; # INITIALLY, THERE IS NO LOOP LABEL                #
       ICFTJ =  ICFTW1M1;# ICFT BOTTOM INDEX                           #
       GINVS = -1;
       BINVS = -1;
       INVIL = -1;   # NULL HEAD LINK FOR INVI LIST                    #
         INVIS = -1;           # HEAD OF INVS CHAIN  #
       WHILEJP = 0; 
       LASTAU = -1; 
       RPFN = FALSE;
       PBRAI = -1;
       LSI = -1;        # LAST SIG. INST. ICFT INDEX. FIRST USE LSM    #
       BRJ = 0; 
       NCON = 0;
       FREZA1 = FALSE;
         FREZA2 = FALSE;                                                 NEWFEAT
       NICLOP = FALSE;   # THIS ISNT A NICE LOOP YET                  # 
       FOL[ICFTW1] = -1;            #GUARANTEE AN END TO THE FOR CHAIN # LARRY-Y
       LASTODDSTUFF = 0;                                                 LCMISC 
       LASTOPTERM = OPTERM;    # SAVE FOR JAMM #
       SAVECLC = CLC[0];
       NUMPROB =0;
       BRCON[1] =  0; 
       BRCON[2] =  0; 
       BRCON[3] =  0; 
       BRCON[4] =  0; 
       BRCON[5] =  0; 
       BRCON[6] =  0; 
    # COMPLETE "NULL" ENTRY AT ICFT[-1]                                #
    #                                                                  #
       FOL[-1] = ICFTW1M1;
       STI[-1] = 0; 
    # COMPLETE "NULL" ENTRY AT ICFT[ICFTW1M1] -- IT REPRESENTS NSM     #
    #                                                                  #
       ICFW0[ICFTW1M1] = 0;  # MAKE WORD 0 NULL                        #
       BOL[ICFTW1M1] = -1;
       FOL[ICFTW1M1] = ICFTW1;
       STI[ICFTW1M1] = 0; 
       NPRED[ICFTW1M1] = 0; 
       CNO[ICFTW1M1] = ICFTW1M1;
       NSM = ICFTW1M1;
       CALL MPRED(-1,NSM);   # MAKE FIRST ENTRY PRECEED NSM            #
    # COMPLETE "EOS" ENTRY AT ICFT[ICFTW1]                             #
    #                                                                  #
       BOL[ICFTW1] = ICFTW1M1;
       NPRED[ICFTW1] = 0; 
    # GET NEXT ICF ENTRY                                              # 
         GOTO  BDT5A ;                                                   SOPT 
BDT5:     IF DUPOPC [OPCD[J] ] THEN NODUPL;   #CHECK IF INSTRUCTION      SOPT 
                                             REPLACEABLE#                SOPT 
BDT5A:   ICFBI =ICFBI + 1 ;                                              SOPT 
       IF ICFBI GE NICFB THEN 
           BEGIN  # NEW ICF BUFFER LOAD IS NEEDED   # 
               CALL GICFB;
            END 
       J = ICFTI; 
       ICFTI = J+1; 
  
    # MOVE ICF INSTRUCTION TO WORD 0 OF ICFT ENTRY J, THEN ZERO        #
    # REMAINING WORDS IN ENTRY.                                        #
       ICFW0[J] = ICFB[ICFBI];
       ICFW1[J] = 0;
       ICFW2[J] = 0;
       ICFW3[J] = 0;
       ICFW4[J] = 0;
       ICFW5[J] = 0;
       BCHN[J] = J;  # INITIALIZE BASE CHAIN ENTRY                     #
       BSCHN[J] = J;  #INITIALIZE BASE+SUBS CHAIN ENTRY                #
  
    # LINK NEW INST IN BETWEEN J-1 AND FOL[J-1]. NOTE THAT IF J-1 HAS  #
    # BEEN LINKED OUT OF THE BOL CHAIN, IT REMAINS OUT AFTER THIS      #
    # INSERTION.                                                       #
    #                                                                  #
  
       X = FOL[J-1];
       FOL[J] = X;
       BOL[J] = BOL[X]; 
       BOL[X] = J;
       FOL[J-1] = J;
       CNO[J] = J;  # INSTRUCTION COMPUTATION NO. POINTS TO ITSELF    # 
       MRKS [J] = MOPIT;                                                 SOPT 
$BEGIN
 DB("(2XO6,16H NEXT ICF, INST=O20,5H FOL=O4,5H BOL=O4)",J,ICFW0[J],      PSRSIA 
    FOL[J],BOL[J],"."); 
$END
       IF OPTERM THEN # START THIS SEQ WITH OP THAT TERMINATED LAST    #
           BEGIN
               OPTERM = FALSE;
               LSM = BI;
               CALL MPRED(-1,0);
               GOTO TERMOP[TERMKEY[OPCD[J]]]; 
           END
  
       # REMOVE ANY CODE OCCURRING BETWEEN AN UNCONDITIONAL JUMP       #
       # AND THE NEXT LABEL                                            #
       IF DEADCODE THEN 
  
         # FIRST CHECK TO SEE IF CODE REMOVAL SHOULD BE STOPPED        #
         # NOTE THAT LINE AND UNREFERENCED LABELS ARE SPECIAL CASES    #
         # AND DO NOT STOP CODE REMOVAL, BUT OTHER LABELS, ETC DO      #
          IF LABLETC[OPCD[J]] 
             THEN IF OPCD[J] EQ QICFOP"LINE"
                THEN GOTO BDT680;              #PROCESS LINE NORMALLY  #
                ELSE IF OPCD[J] EQ QICFOP"LABL" #IF UNREF"D LABEL      #
                   AND XTRN[OPN1[J]] EQ S"LOC"      #AND NOT XREF/XDEF # LARRY-V
                   AND LREF[OPN1[J]] EQ 0 
                   AND LFSR[OPN1[J]] EQ 0 THEN
                   BEGIN  #REMOVE UNREFERENCED LABEL# 
                   OPCD[J] = QICFOP"NULL";
                   OPN12[J] = 0;
$BEGIN
DB("(9X,37H**UNREFERENCED LABEL REMOVED - LINE = I5 )", LINE, "." );     LARRY-V
$END
                   GOTO BDT5A;                 #NULL=ERROR IN NORM SWCH#
                   END  #REMOVE UNREFERENCED LABEL# 
                ELSE DEADCODE = F;             #RESET FLAG AND EXIT    #
  
             # HERE IF NOT TERMINATOR OR SPECIAL CASE - WHICH MEANS    #
             # THAT WE NEED TO REMOVE THE INSTRUCTION                  #
             # HOWEVER IF THE INSTRUCTION TO BE REMOVED IS A JUMP      #
             # WE MUST FIRST DECREMENT THE REF COUNT OF THE LABEL      #
             ELSE BEGIN  #REMOVE#              #INST NOT LABL, ETC     #
                M = OPN1[J];
                IF OPJUMP[OPCD[J]] THEN 
                   IF LREF[M] LQ 0
                      THEN LREF[M] = 0; 
                      ELSE LREF[M] = LREF[M] - 1; 
                OPCD[J] = QICFOP"NULL"; 
                OPN12[J] = 0;                  #JUST TO BE SAFE        #
$BEGIN
DB("(9X,42H**UNREACHABLE INSTRUCTION REMOVED - LINE = I5)", LINE, "." ); LARRY-V
$END
                GOTO BDT5A;                    #NULL=ERROR IN NORM SWCH#
                END  #REMOVE# 
  
    # SWITCH ON ICF OP CODE                                           # 
       GOTO ICFOP[OPCDKEY[OPCD[J]]];
  
#**********************************************************************#
  
OPERR:                   # ILLEGAL OP-CODE                             #
      CG2ABT(J855,"ILLEGAL OPCODE(CODGJ3) LINE XXXXX", 33); 
        GOTO BDT800;
OPERR1:                  # ILLEGAL SEQUENCE TERMINATING OP-CODE        #
      CG2ABT(J856,"ILLEGAL SEQ TERMINATING OPCODE(CODGJ3) LINE XXXXX",
             49); 
        GOTO BDT800;
  
#**********************************************************************#
  
    # UNARY COMPUTATION THAT NEEDS A B-REGISTER                        #
    #                                                                  #
BDT9:  BNFC = 0;
  
#**********************************************************************#
  
    # UNARY COMPUTATION --- INCLUDES FOLLOWING ICF OPS ---            # 
    #     COMP, NORM, UNPK, SUM1, NRMR, BXND, ADSC, LSHC, RSHC,       # 
    #     SELB, PACK                                                  # 
    #                                                                 # 
BDT10:  
       I = OPN1[J]; 
       CALL PCOU; 
       OPN1[J] = I; 
       GOTO BDT5; 
    # END OF UNARY COMPUTATION PROCESSING                             # 
  
#**********************************************************************#
  
    # BINARY COMPUTATION THAT NEEDS A B-REGISTER                       #
    #                                                                  #
BDT12: BNFC = 0;
  
#**********************************************************************#
  
    # BINARY COMPUTATION --- INCLUDES FOLLOWING ICF OP"S ---          # 
    #     LAND, LOR , LXOR, LIMP, LNND, LEQV, LSHV, RSHV, PAKB, IADD, # 
    #     ISUB, FADD, FSUB, DADD, DSUB, RADD, RSUB, FMUL, RMUL, DMUL, # 
    #     FDIV, RDIV                                                  # 
    #                                                                 # 
BDT13:  
BDT15: I = OPN1[J]; 
       CALL PCOU;   # DO FIRST OPERAND  # 
       OPN1[J] = I; 
       IF OP1UBR[OPCD[J]] THEN CIBR[BI-I] = TRUE; 
       I = OPN2[J]; 
       CALL PCOU; 
       OPN2[J] = I; # DO SECOND OPERAND # 
       GOTO BDT5; 
    # END OF BINARY OP PROCESSING  #
  
#**********************************************************************#
  
    # REPLACE  INSTRUCTION                                            # 
    #                                                                 # 
BDT17:  
      LSI = J;          # THIS IS A SIGNIFICANT INST.                  #
       I = OPN2[J]; 
       CALL PCOU;   # DO FETCHED OPERAND  # 
       OPN2[J] = I; 
       BDTT1 = BI-I;
           I = OPN1[J];                                                  LARRY-R
           POS;          # PROCESS STORE OPERAND  #                      LARRY-R
           IF     REFSCM[AT[J]]  THEN   # SCM REFS NEED COMPUTE IN       LARRY-R
                                          STORE REG  #                   LARRY-R
             BEGIN                                                       LARRY-R
       DCISR[BDTT1] = UCISR[BDTT1]*2+1; # COMPUTE OPERAND IN STORE REG.#
       BDTT2 = OPCD[BDTT1]; 
       IF BDTT2 EQ QICFOP "LSHC" OR BDTT2 EQ QICFOP"RSHC" THEN
       BEGIN # SET CISR FOR CONSTANT SHIFT OPERAND                     #
           BDTT4 = BI-OPN1[BDTT1];
           DCISR[BDTT4] = UCISR[BDTT4]*2+1; 
       END
             END                                                         LARRY-R
       GOTO BDT5; 
    # END OF REPLACE INSTRUCTION PROCESSING                           # 
  
#**********************************************************************#
  
    # LOAD INSTRUCTION                                                # 
    #                                                                 # 
    # LOAD PROCESSING ALSO HANDLES LOCS                               # 
    # THE NEW ICF OPERATOR "PFUN" IS TREATED AS ANOTHER FORM OF OFFS  # 
    #   - IT MAY BE DESIRED TO ADD FURTHER CHECKING ON PFUNS LATER    # 
    #                                                                 # 
BDT20:  
       BDTT1 = OPN1[J]; 
       IF BDTT1 LT 0 THEN # OPCODE IS EITHER "SUBS" OR "OFFS"         # 
           BEGIN
               BDTT1 = BI-BDTT1;  # CONVERT TO ICFT INDEX             # 
               BDTT3 = 0; # OFFSET VALUE  # 
               IF OPCD[BDTT1] EQ QICFOP"SUBS" THEN
                   BEGIN
                       I = OPN2[BDTT1]; 
BDT21A:  IF I LS BI AND OPCD[BI-I] EQ QICFOP"NULL" THEN BEGIN            SOPT 
          OPN2[BDTT1] = OPN1[BI-I];                                      SOPT 
          I = OPN1[BI-I];                                                SOPT 
          GOTO BDT21A;     END                                           SOPT 
                                                                         SOPT 
                       XOFFS = 0;              #SUBSCR HAS NO OFFSET...#
                       XLOAD = FALSE; 
                       CALL PCOU; # DO SUBSCRIPT OPERAND              # 
                       OPN2[BDTT1] = I; 
                       BDTT4 = -1; # INDICATES NO OFFSET ENTRY        # 
                       I = OPN1[BDTT1]; 
                       IF I GE 0 THEN # OPERAND IS S.T. POINTER       # 
                           BEGIN
BDT22:  
                               BDTT2 = I; 
                               IF I EQ 0 THEN # IT IS A NULL OPERAND   #
                               BEGIN
                                   CALL MPRED(BI-LSM,J);
                                   GOTO BDT5; 
                               END
                               XOFFS = BDTT4; 
                               XSUBS = BDTT1; 
                               XLOAD = TRUE;        #SHOW TITM AS LOAD #
                               PSTOU;               #GET THE TITM NOW  #
                               GOTO  BDT5;
                           END
                       BDTT1 = BI-I;
                   END # OF SUBS PROCESSING                           # 
               IF  OPCD[BDTT1] NE QICFOP"OFFS"
               AND OPCD[BDTT1] NE QICFOP"PFUN" THEN 
                   BEGIN # ICF IS BADLY FORMED   #
                   CG2ABT(J857,"BADLY FORMED ICF(CODGJ3) LINE XXXXX", 
                          35);
                       GOTO BDT5; 
                   END
               BDTT3 = OPN2[BDTT1]; 
               I = OPN1[BDTT1]; 
               BDTT4 = BDTT1; 
               GOTO BDT22;
           END # OF SUBSCRIPTED LOAD PROCESSING # 
  
       # SCALAR LOAD PROCESSING -                                      #
       # THIS LOAD WILL BE REMOVED IF IT CAN BE LINKED TO ANOTHER LOAD #
       I = BDTT1; 
       XOFFS = -1;
       XSUBS = J; 
       XLOAD = TRUE;                   # SHOW OPERAND AS OBJECT OF LOAD#
       CALL PSTOU;
       GOTO BDT5; 
    # END OF LOAD INSTRUCTION PROCESSING                              # 
  
#**********************************************************************#
  
    # SAVE INSTRUCTION                                                # 
    #                                                                 # 
BDT24:  
       I = OPN2[J]; 
       LSI = J;         # THIS IS A SIGNIFICANT INST.                  #
       OPCD[J] = QICFOP"REPL";  # CHANGE TO "REPL" UNTIL "DEAD" IS SEEN#
       CALL PCOU;   #  DO SAVED OPERAND  #
       OPN2[J] = I; #  REDEFINE OPN2 IN CASE IT WAS A SCALAR   #
       DCISR[BI-I] = UCISR[BI-I]*2+1; # COMPUTE "SAVE" VALUE IN STR REG#
       OPN1[J] = 0; # FORCE SCHEDULER TO GET TEMP IF NEEDED            #
       CALL MPRED(J,NSM); 
       GOTO  BDT5;
    # END OF SAVE INSTRUCTION PROCESSING  # 
  
#**********************************************************************#
  
    # DEAD INSTRUCTION -- FIND TEMP THAT CONTAINS THIS VALUE AND MARK # 
    #                     DEAD                                        # 
    #                                                                 # 
BDT26:  I = OPN1[J];     # THIS IS ICF INDEX OF "SAVE" INSTRUCTION    # 
        K = BI-I;   # CONVERT TO ICF" INDEX                            #
        IF K GT LOPLAB THEN # SAVE IS IN CURRENT SEQUENCE              #
            BEGIN 
            # ONLY COMPUTE VALUE IN STORE REGISTER IF SAVE IS STORED  # 
               DCISR[BI-OPN2[K]] = DCISR[K];
               OPCD[K] = QICFOP"SAVE";
                IF LRL GT I THEN # NO REF. LABEL BETWEEN "DEAD", "SAVE"#
                BEGIN 
                    IF CIBR[K] THEN CIBR[BI-OPN2[K]] = TRUE;
                    OPCD[K] = QICFOP"TMWR"; 
                    OPN1[K] = OPN2[K];
                END 
            END 
        ELSE
        BEGIN 
            IF I LE BI THEN OPN1[K] = GETEMP(I); # GET TEMP IF NEEDED  #
            TLUS[FTEMP(I)] = TRUE ;  # MARK TEMP ALL USES HAVE OCCURED #
        END 
        GOTO BDT5;
    # END OF DEAD INSTRUCTION PROCESSING.  #
  
#**********************************************************************#
  
    # UNCONDITIONAL BRANCH INSTRUCTION.                               # 
    #                                                                 # 
BDT28: CALL JNSM;  # MAKE NSM A PREDECESSOR OF J, THEN SET LSM=BI-J    #
       XNOJUMP = T;                #CHECK IF JUMP IS TO NEXT INST      #
       IF OPCD[J] EQ QICFOP"JP" THEN  #SET FLAG TO REMOVE INST AFTER JP#
          DEADCODE = T; 
           MRKS [ BOL [ J] ]  = MRKS [J];   #UPGRADE OLD LSM TO ITS NEW  STOPT
                                              STATUS IN LIFE#            STOPT
               MOPIT = MOPIT + 1 ;                                       STOPT
       LSI = J;         # THIS IS A SIGNIFICANT INST.                  #
       IF WHILEJP EQ 0 THEN 
         WHILEJP = J;   # WANT TO KNOW 1ST JUMP AFTER INVS  # 
  
      IF CLAS[OPN1[J]] EQ S"PROC" THEN     # IT WAS A RETURN  # 
        IF MUEN[MEP]  THEN
          OPN1[J] = RETEMP; 
       BDTT1 = OPN1[J]; 
       IF BDTT1 LT 0 THEN GOTO BDT5;
          IF CLAS[BDTT1] EQ S"SWCH" THEN GOTO BDT720; 
    # BREAK SEQUENCE ON SWTICH JUMPS SINCE THEY RESERVE REGISTERS#
       IF CLAS[BDTT1] EQ  S"PROC" THEN
             MARKCTR = MARKCTR +1;   # START NEW SUBSEQ  #
       IF CLAS[BDTT1] NE S"LABL" THEN GOTO BDT5; # SKIP NON-LABEL JUMPS#
       LRC[BDTT1] = LRC[BDTT1]-1; 
       IF NOT LBSN[BDTT1] THEN # THIS IS A FORWARD BRANCH              #
            BEGIN 
 FORWARDLAB:                                                             NEWFEAT
               MARKCTR = MARKCTR+1; 
               IF LFSR[BDTT1] EQ 0 THEN 
                   BEGIN
                       LFSR[BDTT1] = SEQ; 
                       LICF[BDTT1] = MARKCTR; 
                   END
               IF MARKCTR GT 58 THEN GOTO BDT720; # TERMINATE SEQUENCE #
               GOTO BDT5; 
            END 
    # THIS IS A BACKWARD BRANCH. DELETE ALL CLOSED LOOPS FROM LOOP    # 
    # LIST. TERMINATE SEQUENCE IF THIS BRANCH ENDS NICE INNERMOST LOOP.#
BDT29: IF LOOPL NE 0 AND LRC[LOOPL] EQ 0 THEN 
           BEGIN
               LOOPL = LBNL[LOOPL]; 
               GOTO BDT29;
           END
       IF NICLOP AND LBIL[BDTT1] AND LRC[BDTT1] EQ 0 THEN 
    #  BRANCH ENDS NICE INNERMOST LOOP.                                #
           GOTO BDT60;
       GOTO BDT5;  # SINCE BRANCH DOESNT STOP INNER LOOP, CONTIN. SEQ. #
    # END OF UNCONDITIONAL BRANCH PROCESSING #
  
#**********************************************************************#
  
    # TEST AND BRANCH INSTRUCTIONS --- OP CODES INCLUDE --            # 
    #     IR,  OR,  DF,  ID,  ZR,  NZ,  PL,  NG                       # 
    #                                                                 # 
BDT32:  
       I = OPN2[J]; 
       CALL PCOU;  # DO TEST QUANTITY OPERAND  #
       OPN2[J] = I; 
       GOTO BDT28; # UNCONDITIONAL BRANCH CODE COMPLETES PROCESSING  #
    # END OF TEST AND BRANCH PROCESSING   # 
  
#**********************************************************************#
  
    # LABEL ENTRY ---                                                 # 
    #                                                                 # 
BDT35: BDTT1 = OPN1[J]; 
  
       # CHECK IF LAST INSTRUCTION WAS A JUMP TO THE NEXT INST (HERE)  #
       IF XNOJUMP THEN
          BEGIN  #CHECK#
          XNOJUMP = F;             #FIRST RESET FLAG (AT LABL AFT JUMP)#
          NEXTICF = J - 1;
  
          # NOTE THAT WE MUST CHECK TWICE SINCE "GQ" ISSUES TWO JUMPS  #
          FOR DUMMY = 1 STEP 1 WHILE (DUMMY LE 2) AND (NEXTICF GE 0) DO 
             BEGIN  #CHAIN SEARCH#
             ASLONGAS (NEXTICF GE 0) AND ((OPCD[NEXTICF] EQ 
               QICFOP"NULL") OR (OPCD[NEXTICF] EQ QICFOP"LINE")) DO 
                   NEXTICF = BOL[NEXTICF];
  
             # NOW HAVING FOUND NON-NULL, CHECK IF IT IS JUMP TO HERE  #
             IF OPJUMP[OPCD[NEXTICF]] THEN
                IF OPN1[NEXTICF] EQ OPN1[J] THEN
  
                   # DECREMENT REFCT OF COND JUMP OPND AND REMOVE INST #
                   BEGIN  #REMOVE JUMP# 
                   IF LABLETX[OPCD[NEXTICF]] THEN 
                      REFCT[BI - OPN2[NEXTICF]] = 
                         REFCT[BI - OPN2[NEXTICF]] - 1; 
                   OPCD[NEXTICF] = QICFOP"NULL";      #NOW REMOVE INST #
                   OPN12[NEXTICF] = 0;
$BEGIN
DB("(9X,41H**PREVIOUS JUMP HAS BEEN DELETED - LINE = I5)", LINE, "." );  LARRY-V
$END
                   NEXTICF = BOL[NEXTICF];
                   END  #REMOVE#
             END  #CHAIN# 
          END #CHECK# 
  
       IF CLAS[BDTT1] NE S"LABL" THEN GOTO BDT36A; # STOP IF NON-LABEL #
       FRGT[BDTT1] = FALSE; 
       BDTT2 = LICF[BDTT1]; # SAVE MARKCTR OF 1ST BRANCH GOING TO LABEL#
        LICF[BDTT1] = BI-J; 
       LBSN[BDTT1] = TRUE;  # SET LABEL SEEN INDICATOR                # 
    IF XTRN[BDTT1] EQ QXTRN"ENT" THEN GOTO BDT36A;   #TERMINATE SEQUENCE NEWFEAT
                                    FOR ENTRY LABELS#                    NEWFEAT
          IF (XTRN[BDTT1] EQ QXTRN"ENT") OR (XTRN[BDTT1] EQ QXTRN"EXT")  NEWFEAT
          OR (XTRN[BDTT1] EQ S"WEAK") 
                  THEN GOTO   FORWARDLAB;                                NEWFEAT
       IF LRC[BDTT1] NE 0 THEN # LABEL BEGINS LOOP                    # 
           BEGIN # ADD LABEL TO LOOP LIST                             # 
               LSI = J;      # THIS IS A SIGNIFICANT INST.             #
               LRL = BI-J;   # THIS IS CURRENTLY THE LAST REF. LABEL   #
               FRGH[J] = TRUE;
               LBNL[BDTT1] = LOOPL; 
               LOOPL = BDTT1; 
               IF LBIL[BDTT1] AND NOT NICLOP THEN # LABEL BEGINS INLOOP#
                   BEGIN
                       SEQ = SEQ+1;  # CHANGE SEQUENCE NO. AT LABEL   # 
          MRKS[J] =64;   #MARK A LABEL FOR WHAT IT IS#                   STOPT
                       NICLOP = TRUE; # THIS IS A NICE LOOP           # 
                       LOPLAB = J;
                       LABPRD = NSM;
                       GOTO  BDT36; 
                   END
               GOTO BDT36A;   # TERMINATE SEQUENCE AFTER LABEL         #
           END
        IF LFSR[BDTT1] EQ 0 THEN # THIS IS AN UNREFERENCED LABEL       #
            BEGIN 
                UNRLB[J] = TRUE;
                GOTO BDT740; # INCLUDE IN DEP. TREE THERE              #
            END 
       LSI = J;    # THIS IS A SIGNIFICANT INST.                       #
        MOPIT = MOPIT + 1;                     #IGNORE UNREFED LABELS  # SMP0088
        LRL = BI-J;    # THIS IS CURRENTLY THE LAST REFERENCED LABEL.  #
        IF LFSR[BDTT1] NE SEQ THEN # LABEL TERMINATES SEQUENCE         #
            BEGIN 
BDT36A:         FRGH[J] = TRUE; 
                CALL JNSM;
                GOTO BDT720;  # TERMINATE SEQUENCE                     #
            END 
    # LABEL IS REFERENCED ONLY FROM ABOVE AND WITHIN SEQUENCE          #
        IF OPCD[BOL[J]] NE QICFOP"JP" THEN # THERE IS A FALL THRU      #
            FTHRU[J] = TRUE;
       MARKCTR = MARKCTR+1; 
       B<BDTT2,MARKCTR-BDTT2> AVAIL = 0; # RECORD BRANCHED AROUND PARTS#
BDT36:  
       CALL JNSM;    # MAKE LABEL LSM, ETC.                            #
       IF MARKCTR GT 58 THEN GOTO BDT720; # TERMINATE SEQUENCE         #
          IF ARLIST NQ 0 THEN CLEANARRY;                                 SOPT 
       GOTO  BDT5;
    # END OF LABEL PROCESSING                                         # 
  
#**********************************************************************#
  
    # INVI ENTRY                                                      # 
    #                                                                 # 
BDT42: KDES[J] = INVIL;  # LINK INVI TO INVI LIST                     # 
       INVIL = J; 
       GOTO BDT17;  # DO REPL PROCESSING  ON INVI  #
  
#**********************************************************************#
  
    # INVS ENTRY                                                      # 
    #                                                                 # 
BDT45:              #SYMPL V1.2 ALWAYS HAS STEP AND LIMIT CONSTANT
                     OVER THE LOOP                         #
       ITEM STEPP , NEGAT B, INDIV; 
       ITEM TEMPLOD;
       ITEM INDREDEF B;       #INDUCTION VARIABLE REDEFINED IN SEQ #
       WHILEJP = 0 ;
       INDREDEF = FALSE;
       STEPP = J; 
       KDES[J] = INVIS ;      #ADD TO INVS CHAIN   #
       INVIS = J; 
       BDTT2 = OPN1[J]; 
       I = BDTT2; 
       CALL PCOU;   # DO INDUCTION VARIABLE LOAD  # 
       OPN1[J] = I; 
       I = OPN2[J]; 
       IF I GR BI THEN
          # SAVE OF STEP IS NOT IN THIS SEQUENCE   #
         BEGIN
         BDTT3 = J ;      #SAVE J # 
         IF LOPLAB NQ -1 THEN 
         J = LOPLAB;    # INSERT INSTRUCTION BEFOR LOPLAB#
  
         RELOAD (I);
         J = BDTT3;    # RESTORE J #
         OPN2[J] = BI - K;
          END   #IT GOT SAVED # 
BDT49: I = BDTT2; 
       IF OPCD[BI-OPN1[J]] EQ QICFOP"REPL" THEN                          LARRY-R
         INDREDEF = TRUE;                                                LARRY-R
       BDTT2 = STI[BI-OPN1[J]];                                          LARRY-R
       BDTT3 = ISUC[BDTT2];                                              LARRY-R
               # SUCCESSORS OF INVAR.   #                                LARRY-R
STEPPRED:                                                                LARRY-R
       IF OPCD[BDTT3] EQ QICFOP"REPL"                                    LARRY-R
       AND OPN1[BDTT3] EQ I THEN   # INDVAR IS REDEFINED  #              LARRY-R
         INDREDEF = TRUE;                                                LARRY-R
         IF OPCD[BDTT3] NQ QICFOP"NULL"  THEN                            LARRY-R
         MPRED ( BDTT3 , J );                                            LARRY-R
       IF LSUC[BDTT2] NQ 0 THEN                                          LARRY-R
         BEGIN                                                           LARRY-R
         BDTT2 = LSUC[BDTT2];                                            LARRY-R
         BDTT3 = ISUC[BDTT2];  # LOOK FOR NEXT SUCCESSOR  #              LARRY-R
         GOTO STEPPRED;                                                  LARRY-R
         END                                                             LARRY-R
  
         MPRED (J,NSM );
       GOTO BDT5; 
  
#**********************************************************************#
  
    # INVT ENTRY  -- JUST MAKE INVT THE LAST SEQUENCE MARK             #
    #                                                                  #
BDT49M: 
       REFCT[J] = 1;
    #  MAKE INSTRUCTION PRECEEDING "INVT" THE LAST SEQUENCE MARK.      #
       CALL MPRED(BI-LSM,J);
       GOTO BDT5; 
  
#**********************************************************************#
  
    # INVB ENTRY                                                      # 
    #                                                                 # 
BDT50:  
       BDTT1 = BI-OPN2[J];    # ICFT INDEX OF INVT INSTRUCTION         #
       CALL MPRED(BDTT1,J);   # MAKE "INVT" PRECEDE "INVB"             #
       BDTT4 = J; 
       I = OPN1[BDTT1]; 
   #   UNSTACK OUTSTANDING STEP EXPRESSION   #
       IF INVIS NQ -1 THEN
         INVIS = KDES[ INVIS] ; 
       NEGAT = FALSE ;   # +VE STEP#
       INDIV = OPN2[BDTT1]; 
       IF I GR 0
       AND  CLAS[I] EQ S"DATA"  THEN
          # LIMITS ARE ICF INDEX , TEMP OR CONS  #
         BEGIN
           # NEGATIVE STEP - OPN1 IS IND.VAR. - OPN2 IS TEST VALUE# 
         NEGAT = TRUE;
         I ==INDIV; 
         END
              # AT THIS POINT LIMIT IS BOUND TO BE INVARIANT - SYMPL
                 SAYS SO - BUT - BUT - IS THE SAVE IN THIS ICF SEQUENCE#
                BDTT2 = STEPP;
                BDTT3 = BI - I ;
         IF I GR BI THEN
           BEGIN
                    # NO ITS GONE AND GOT SAVED      #
           RELOAD (I);
           I = BI - K;
           BDTT3 = K; 
           IF NEGAT THEN
             OPN2[BDTT1] = BI - K;
           ELSE 
             OPN1[BDTT1] = BI - K;
           END
  
         IF NOT INDREDEF
         AND INVIL NQ -1 THEN 
                GOTO BDT56; 
  
  
             # THIS LOOP MUST BE MATERIALISED INTO CORE   # 
  
           IF INVIL NQ -1 THEN
             OPCD[INVIL] = QICFOP"REPL";
  
           IF NEGAT THEN
             BEGIN
             K = BI -OPN2[BDTT1]; 
             OPN2[BDTT1] = OPN2[K]; 
             OPN1[BDTT1] = BI -STEPP; 
             END
           ELSE 
             BEGIN
             K = BI -OPN1[BDTT1]; 
             OPN1[BDTT1] = OPN2[K]; 
             OPN2[BDTT1] = BI -STEPP; 
             END
  
           OPCD[K] = QICFOP"NULL";
           OPN1[K] = 0; 
           OPN2[K] = 0; 
               OPCD[J] = QICFOP"PL";
               OPCD[BDTT1] = QICFOP"ISUB";
            # INSERT LOADS FOR INVT OPERANDS                           #
               J = BDTT1; 
               I = OPN1[BDTT1]; 
               CALL PCOU; 
               OPN1[J] = I; 
               I = OPN2[J]; 
               CALL PCOU; 
               OPN2[J] = I; 
           OPCD[STEPP] = QICFOP"IADD";
           REFCT[STEPP]= REFCT[STEPP] + 1 ; 
           I = BI -OPN2[STEPP]  ; #INCREMENT   #
  
           IF OPCD[I] EQ QICFOP"REPL" 
           AND OPN1[I] EQ 0 THEN
             BEGIN      # DESTROY SAVE  # 
             OPN2[STEPP] = OPN2[I] ;
                    # LINK INVS TO LOAD DIRECT  # 
             OPCD[I] = QICFOP"NULL";
             OPN1[I] =0 ; 
             OPN2[I] =0 ; 
             END
  
           IINST(QICFOP"REPL" , INDIV , BI-STEPP ); 
           CISR[K] = TRUE;
           MPRED (STEPP ,K ); 
           MPRED (K , J );
               GOTO BDT58;
BDT56:  
           ITEM INVIT;
           ITEM LIMLOD; 
#          AT THIS POINT WE HAVE A GOOD LOOP -- 
           ASSIGN REGISTERS B1,B2B... TO THE IV,LIMIT (,STEP) 
  
           ON ENTRY --
           STEPP IS INVS               ICFT 
           J , BDTT4  IS INVB          ICFT 
           BDTT1  IS INVT              ICFT 
           NEGAT IMPLIES NEAGATIVE STEP 
           I IS REPL TO TEMP FOR LIMIT ICF
           BDTT3 IS ICFT OF I 
# 
  
       BRSUB[1] = INDIV;             # ASSIGN IV LOAD TO BI  #
       IDES[INVIL] =1;
       PFFMH[STEPP] =1;                #GIVE INVS MEDIUM PRIORITY  #
       LIMLOD = BI - OPN2[INVIL]; 
       SHORTBLD ( LIMLOD ) ;
       IF OPCD[LIMLOD] EQ QICFOP"LDSC" THEN 
         BEGIN
         REDREFCT ( BI-OPN2[INVIL]);
         OPN2[INVIL] = OPN1[LIMLOD];
         END
  
       J = LOPLAB ;                    #INSERT NEW INSTS OUTSIDE LOOP # 
       #        PROCESS LIMIT      #
       LIMLOD = BI - OPN2[BDTT3] ;     #ICFT OF LIMIT CALCULATION   # 
  
       OPN1 [BDTT3] = OPN1[LIMLOD]; 
  
       SHORTBLD ( LIMLOD);    # TRANSFORM ALL SHORT LOADS TO LDSC  #
       IF OPCD [LIMLOD] EQ QICFOP"LDSC" THEN
         BEGIN
             #LIMIT IS A CONSTANT  #
         FIND ( OPN1[LIMLOD] , K);      #FIND VALUE OF CONSTANT  #
         TEMPLOD = LIMLOD;
         INVIT = OPN1[TEMPLOD]; 
         REDREFCT ( BI - OPN2[BDTT3] ); 
         IF CONS[K] EQ 0 THEN 
           BEGIN
            # DO NOT USE INVI FOR LIMIT - B0 WILL BE USED  #
           OPCD [BDTT3] = QICFOP"NULL" ;    #CANCEL OUT REPL  # 
           OPN2[BDTT3] =0;
           BRJ =1;
           GOTO BDT57;   #GO PROCESS STEP#
           END
         END
  
       ELSE 
         BEGIN
         TEMPLOD = LOOPTEMP ( LIMLOD);
           INVIT = OPN2[BDTT3]; 
           END
         IF NEGAT THEN
           OPN2[BDTT1] = OPN1 [TEMPLOD];
         ELSE 
           OPN1[BDTT1] = OPN1 [TEMPLOD];
  
       # TRANSFORM REPL TO NULL -- ADD INVI  #
       IINST ( QICFOP"INVI" , OPN1[TEMPLOD] , INVIT );
       MPRED ( LABPRD,K); 
       MPRED ( K , LOPLAB );
       OPCD[BDTT3] = QICFOP"NULL";
       OPN1[BDTT3] = BI - TEMPLOD;
       OPN2[BDTT3] =0;
       IDES[K] = 2;                    #USE B2 FOR THIS VALUE#
       PFFMH[K] = 1;                   # GIVE INVI MEDIUM PRIORITY #
       BRSUB[2] = INVIT;
       BRJ =2;
  
#            NOW PROCESS STEP      #
BDT57:  
  
       I = BI - OPN2[STEPP];           #ICFT OF REPL OF STEP VALUE# 
  
       LIMLOD = BI - OPN2[I] ;         #ICFT OF R.H.S.OF REPL  #
       OPN1[I] = OPN1[LIMLOD];
  
       SHORTBLD ( LIMLOD);    # TRANSFORM ALL SHORT LOADS TO LDSC  #
       IF OPCD[LIMLOD] EQ QICFOP"LDSC" THEN 
        BEGIN 
                 #   CONSTANT STEP   #
                  # ADD TO CONSTANT CONTENDER TABLE   # 
         NCON = NCON + 1 ;
         CONCON[NCON] = OPN1[LIMLOD]; 
         OPCD[I] = QICFOP"NULL";
         OPN1[I] = BI - LIMLOD; 
         REDREFCT( BI-OPN2[I] );
         OPN2[I] = 0; 
         OPN2[STEPP] = OPN1[LIMLOD];
         END
  
       ELSE 
              # NOT A CONSTANT ASSIGN NEXT B-REG TO IT   #
         BEGIN
         TEMPLOD = LOOPTEMP ( LIMLOD);
         OPCD[I] = QICFOP"NULL"  ;
         OPN1[I] = BI - TEMPLOD ; 
         OPN2[I] =0;
         BDTT2 = TEMPLOD; 
NULLLINK: 
         IF OPCD[BDTT2] EQ QICFOP"NULL" THEN
           BEGIN
           BDTT2 = BI - OPN1[BDTT2];
           GOTO NULLLINK; 
           END
         OPN2[STEPP] = BI -BDTT2; 
         IINST ( QICFOP"INVI" , OPN1[TEMPLOD] , OPN2[STEPP] );
         MPRED ( LABPRD , K );
         MPRED ( K , LOPLAB); 
         PFFMH[K] =1; 
         BRJ = BRJ + 1 ;
         IDES[K] = BRJ; 
         BRSUB[BRJ] = OPN2[STEPP];
  
         END
  
         # WE WANT TO POINT ALL USES OF THE INDUCTION VARIABLE TO INVI #
         BDTT1 = USES[OPN1[INVIL]]; 
         ASLONGAS BDTT1 GT 0 DO 
             BEGIN  #LINK OUT#
             BDTT2 = BI - LISTI[BDTT1]; 
             IF OPCD[BDTT2] EQ QICFOP"LOAD" THEN
                 BEGIN  #REMOVE#
                 OPCD[BDTT2] = QICFOP"NULL";   #REMOVE LOAD            #
                 OPN1[BDTT2] = BI - INVIL;     #AND POINT TO INVI      #
                 END  #REMOVE#
             BDTT1 = LISTL[BDTT1];
             END  #LINK OUT#
  
BDT58: J = BDTT4; 
       CALL JNSM; 
       IF INVIL NQ -1 THEN
       INVIL = KDES [INVIL] ;     # UNSTACK INVIL  #
BDT60:  
       NOAB = 4 + BNFC;  # NUMBER OF AVAILABLE B-REGS                  #
  
#**********************************************************************#
  
 #         CHANGE INITIALIZATION OF INCOMPLETE LOOPS TO REPLS  #
  
         I = INVIL; 
NEXTINV:  
         IF I NQ -1 THEN
           BEGIN
             OPCD[I] = QICFOP"REPL" ; 
           I = KDES[I] ;
           GOTO NEXTINV;
           END
         I = INVIS; 
         IF WHILEJP EQ 0 THEN 
           WHILEJP = NSM; 
NEXTINVS: 
         IF I NQ -1 THEN
           BEGIN
           IF IDES[I] EQ 0 THEN 
                 # INVS FROM A WHILE  # 
             BEGIN
             BDTT1 = OPN1[ BI -OPN1[I] ] ;
             OPCD[I] = QICFOP"IADD" ; 
             CISR[I] = TRUE;
             REFCT[I] = REFCT[I] + 1 ;
             M = J; 
             J = I + 1 ;
             REFCT[ BI-OPN1[I] ] = REFCT[ BI-OPN1[I] ] + 1 ;
  
             IF OPCD[BI-OPN2[I] ] EQ QICFOP"REPL" 
             AND OPN1[BI-OPN2[I] ] EQ 0 THEN
                 # DESTROY SAVE  #
               BEGIN
               BDTT3 = BI-OPN2[I] ; 
                     # BDTT3 IS ICFT OF SAVE/REPL  #
               OPN2[I] = OPN2[BDTT3]  ; 
               OPN2[BDTT3] =0;
               OPCD[BDTT3] = QICFOP"NULL";
               END
  
             IINST ( QICFOP"REPL" , BDTT1   , BI - I ); 
             MPRED ( I,K) ; 
             MPRED ( K , WHILEJP ); 
             IF LSEQ[BDTT1] EQ SEQ
             AND USES[BDTT1] NQ 0 
                                   THEN 
               MPRED ( BI-LISTI[USES[BDTT1]] , K ); 
             J = M; 
             END
           I = KDES[I]; 
           GOTO NEXTINVS; 
  
           END
#**********************************************************************#
  
BDT75: # COMPUTE PRIORITIES OF ICFT INSTRUCTIONS                       #
          IF PREAMBLE NQ 0 THEN 
          BEGIN 
              # MY SINCERE APPOLOGIES FOR THE WAY THIS FIX WORKS
                    THE PREAMBLE CODE (IF ANY)WILL HAVE BEEN INSERTED 
                    JUST BEFORE THE NSM RATHER THAN AFTER INST 0
                    SO NOW WE MOVE IT TO ITS PROPER POSN. .... #
                   # FUTURE MODIFIERS OF CGJ3 - I AM SORRY BUT  - THE 
                    OTHER METHOD IS TIME CONSUMING #
            FOL [BOL [ PREAMBLE ] ] = FOL [LASTAMBLE];  #LINK OUT#
            BOL [FOL [ LASTAMBLE ] ] = BOL [PREAMBLE];
  
            FOL[LASTAMBLE] = FOL[0];    #LINK IN# 
            BOL [FOL [0] ] = LASTAMBLE; 
            BOL [PREAMBLE] =0;
            FOL [0] = PREAMBLE; 
          END 
       CALL PRIORITY; 
  
#**********************************************************************#
     PROC LINKPBRAI;
      BEGIN 
#   LINK IN A BRAI TO TREE
       POSITION DEPENDS OF FPRI OF BRAID ITEM AND PROLOGUE
# 
 #    BR= S.T. INDEX OF BRAID ITEM     #
  
      PBRAI = -1; 
      IF PREAMBLE NQ 0 THEN 
        BEGIN  # LOOK FOR A BRAI OF A FORMAL PARAMETER IN THIS SEQUENCE#
        PBRAI = PREAMBLE;  # ALL BRAIS MUST FOLLOW X1 USEAGE  # 
        PROCNAM = OPN1[0];   # SPRC IS ALWAYS INSTRUC 0  #
        IF CLAS[BR] EQ S"TITM" THEN 
          BR = MAMA[BR];  # USE TABL FOR TITMS  # 
  
        IF FPRI[BR] EQ S"NAMC" THEN 
          BEGIN 
          N = FPLN[PROCNAM] ;   # FPAR ENTRY FOR 1ST PARAMETER #
  
NEXTFP: 
          IF N NQ 0 THEN
            BEGIN 
            IF FDFP[N] EQ BR
            AND FSEQ[N] EQ BEGSEQ THEN         #SAME SEQ AS PROLOG CODE#
              # THIS ITEM/ARRAY IS DEFINED IN THE PREAMBLE  # 
              PBRAI = FINS[N];
            N = NFPR[N];   # GET NEXT FORMAL IN FPAR CHAIN #
            GOTO NEXTFP;
  
            END  # OF FORMAL PARAMETER LIST  #
  
        END   # OF NAMC TYPE  # 
  
        END  # PREAMBLE EXISTS  # 
  
      MPRED (PBRAI , K );  # MAKE BRAI/DRV SUCCESSOR OF PBRAI  #
      END  # LINKPBRAI  # 
  
  
      $BEGIN
      PROC AUDUMP(ARG); 
      BEGIN # AUDUMP #
      ITEM ARG; 
  
      IF LASTAU EQ -1 THEN RETURN;
      DB("(9X,15HAU TABLE  CALL ,I1)",ARG,"."); 
      DB("(9X,58H I   PSAVE  IDRV  AUISSU  QSAVE  AUIL  ACTP  AUOFF   AU
ADD)","."); 
  
      CONTROL FASTLOOP; 
      FOR I=0 STEP 1 UNTIL LASTAU DO # MOVE TO FULL WORDS FOR DB #
      BEGIN 
          DB("(9X,I3,3X,I4,4X,I1,5X,I1,6X,I3,4X,I1,5X,I1,4X,O6,2X,O6)", 
          I,PSAVE[I],IDRV[I],AUISSU[I],QSAVE[I],AUIL[I],ACTP[I],
      AUOFF[I],AUADD[I],"."); 
      END 
      CONTROL SLOWLOOP; 
      END # AUDUMP #
      $END
  
    # PROCESS AU TABLE TO ASSIGN ADDRESSES TO B-REGISTERS.            # 
    #                                                                 # 
      $BEGIN
      AUDUMP(1); # PRINT AU TABLE # 
      $END
       BRI = BRJ+1; # BRI IS INDEX OF 1ST ADDRESS ENTRY IN BRCON       #
       IF LASTAU LQ AUFUDGE THEN                                         LARRY-R
           GOTO BDT90;  # DONT ISSUE BRAIS(OR DRVS) FOR SMALL SEQUENCES#
       FOR X = BRI STEP 1 UNTIL NOAB DO 
           BEGIN
               BDTT1 = 0; # CONTAINS MAXIMUM PARCEL SAVINGS  #
               FOR I = 0 STEP 1 UNTIL LASTAU  DO
                   BEGIN
                       IF PSAVE[I] GT BDTT1 THEN
                           BEGIN
                               BDTT1 = PSAVE[I];
                               L = I; 
                           END
                   END
           #  STOP ASSIGNING ADDRESSES IF SAVINGS IS TOO SMALL        # 
               IF BDTT1 LT MINPS THEN GOTO BDT78; 
               BDTT1 = AUADD[L];
               BDTT2 = AUOFF[L];
            # DO NOT GENERATE "BRAI" FOR INDUCTION VARIABLES           #
               FOR I = BRI-1 STEP -1 UNTIL 1 DO 
               BEGIN
                   IF BDTT1 EQ BRSUB[I] THEN
                   BEGIN
BDT76:  
                       X = X-1; 
                       GOTO BDT77;
                   END
               END
            # DO NOT GENERATE "BRAI" IF ADDRESS USED IN LOOP AND LOOP  #
            # IS NOT NICE, I.E. NICLOP = FALSE.                        #
               IF AUIL[L] AND NOT NICLOP THEN  GOTO BDT76;
               BRJ = BRJ+1; 
           #  ENTER "BRAI" ITEM IN ICFT  #
               J = 0; 
               IF BDTT2 NE 0 OR ACTP[L] GT QAT"LCM" THEN # OFFS REQUIR.#
                   BEGIN # ENTER "OFFS" ENTRY IN ICFT                  #
                       CALL IINST(QICFOP"OFFS",BDTT1,BDTT2);
                       BDTT1 = BI-K;
                   END
               IF IDRV[L] THEN BDTT3 = QICFOP"DRV"; 
                  ELSE BDTT3 = QICFOP"BRAI";
               IF CLAS[AUADD[L]] EQ S"TABL" 
                 AND TTYP[AUADD[L]] EQ S"BASED" 
                 AND ACTP[L] NQ ACSTYPE(AUADD[L]) 
               THEN  # FORCE BRAIS FOR POINTER WORD BUT NOT FOR BA REFS#
                 BEGIN
                 BDTT3 = QICFOP"BRAI";
                 END
               IINST(BDTT3,BDTT1,BRJ);
               PFFMH[K] = 1;  # GIVE "BRAI" MEDIUM HIGH PRIORITY       #
               W = ACTP[L]; 
               AT[K] = W; 
        BR = AUADD[L];
        LINKPBRAI;  # LINK TO CORRECT INSTRUCTION  #
               CALL MPRED(K,FSM); 
                                                                         LARRY-R
                #ASSIGN THE USES COUNT TO PSAVE WHEN BRAI ISSUED       # LARRY-R
                #THIS IS TRUE COUNT OF NEW SAVINGS WITH BRAI ASSIGNED  # LARRY-R
                AUISSU[L] = TRUE;                                        LARRY-R
                FOR I=0 STEP 1 UNTIL LASTAU DO   #LOOK DOWN AU TABLE   # LARRY-R
                    BEGIN  #ENTRY#                                       LARRY-R
                    IF  NOT AUISSU[I]            #REDUCE SINK ONCE ONLY# LARRY-R
                    AND AUADD[I] EQ AUADD[L] THEN                        LARRY-R
                        BEGIN  #MARK#                                    LARRY-R
                        AUISSU[I] = TRUE;        #BRAI ISSUED FOR SINK # LARRY-R
                        PSAVE[I] = QSAVE[I];     #SHOW NEW SAVINGS     # LARRY-R
                        END  #MARK#                                      LARRY-R
                    END  #ENTRY#                                         LARRY-R
                                                                         LARRY-R
BDT77:         PSAVE[L]= -PSAVE[L]; # ELIMINATE AU ENTRY               #
           END
BDT78:  
      $BEGIN
      AUDUMP(2); # PRINT AU TABLE # 
      $END
      IF BRJ EQ NOAB THEN GOTO BDT990; # JIF NO MORE B-REGS TO ASSIGN  #
  
#     ASSIGN B-REGISTERS ON THE BASIS OF MANY SMALL PARCEL SAVINGS     #
  
      FOR I=0 STEP 1 UNTIL LASTAU DO # INITIALIZE AU TABLE             #
      BEGIN # INITIALIZE #
          SSTI[I] = F;
      END   # INITIALIZE #
  
      # FOR ENTRIES IN THE AU TABLE OF ACCESS TYPE INDIRECT WITH NO    #
      # BRAI ALREADY ISSUED, COMPUTE TOTAL PARCEL SAVINGS FOR EACH SET #
      # OF ENTRIES HAVING SAME SYMBOL TABLE INDEX. FIND THE SET(BY     #
      # FINDING THE FIRST ENTRY IN THE SET) WITH THE LARGEST TOTAL     #
      # PARCEL SAVINGS.                                                #
  
      BDTT3 = -1; # INDEX OF FIRST ENTRY IN SET WITH MAX. TOTAL PARCEL #
      BDTT2 = 0; # MAXIMUM TOTAL PARCEL SAVINGS                        #
      FOR I=0 STEP 1 UNTIL LASTAU DO
      BEGIN # I LOOP #
          IF NOT AUISSU[I] AND ACTP[I] GT QAT"LCM" AND NOT SSTI[I] THEN 
          BEGIN 
              BDTT1 = QSAVE[I] + 1; # ACTUAL REF COUNT                 #
              SSTI[I] = T;  # INDICATE ENTRY COUNTED                   #
              FOR J=I+1 STEP 1 UNTIL LASTAU DO
              BEGIN # J LOOP #
                  IF AUADD[I] EQ AUADD[J] THEN
                  BEGIN # SAME S.T.I. # 
                      BDTT1 = BDTT1+QSAVE[J]+1; # TOTAL REF COUNT      #
                      SSTI[J] = T; # INDICATE ENTRY COUNTED            #
                  END   # SAME S.T.I. # 
              END   # J LOOP #
              IF BDTT1 GT BDTT2 THEN # NEW MAXIMUM TOTAL PARCEL SAVINGS#
              BEGIN # NEW MAX # 
                 BDTT2 = BDTT1; # MAX. TOTAL PARCEL SAVINGS            #
                 BDTT3 = I; # INDEX OF FIRST ENTRY IN SET WITH MAX TPS #
              END   # NEW MAX                                          #
          END 
      END   # I LOOP #
      IF BDTT2 LT MINTPS THEN GOTO BDT90; # IF TOTAL TOO SMALL, QUIT   #
      IF BDTT3 EQ -1 THEN GOTO BDT90; 
  
      # FIND ENTRY IN SET WITH LARGEST REFERENCE COUNT(QSAVE). IF      #
      # THERE IS MORE THAN ONE ENTRY WITH SAME LARGEST COUNT, THE      #
      # ALGORITHM FINDS THE FIRST ENTRY.                               #
  
      BDTT2 = 0;
      FOR I = BDTT3 STEP 1 UNTIL LASTAU DO
      BEGIN 
          IF AUADD[BDTT3] EQ AUADD[I] THEN
          BEGIN 
              AUISSU[I] = T;
              IF QSAVE[I] GT BDTT2 THEN 
              BEGIN 
                  BDTT2 = QSAVE[I]; # NEW LARGEST QSAVE                #
                  BDTT1 = I; # INDEX OF ENTRY HAVING LARGEST QSAVE     #
              END 
          END 
      END 
  
      # CHECK FOR A 2ND ENTRY WITH SAME LARGEST COUNT. IF ONE IS FOUND #
      # THEN SET OFFSET TO 0.                                          #
  
      BDTT2 = AUOFF[BDTT1]; # OFFSET FOR MAX QSAVE ENTRY               #
      FOR I = BDTT1+1 STEP 1 UNTIL LASTAU DO
      BEGIN 
          IF AUADD[BDTT1] EQ AUADD[I] AND QSAVE[BDTT1] EQ QSAVE[I] THEN 
          BEGIN 
              BDTT2 = 0; # NO MOST USED OFFSET, USE AN OFFSET OF 0     #
              GOTO BDT82; 
          END 
      END 
  
BDT82:  
      J = 0; # IINST LOGICALLY INSERTS BEFORE ICFT INDEX J             #
      IINST(QICFOP"OFFS",AUADD[BDTT3],BDTT2); # INSERT OFFS INST.      #
      BDTT1 =  BI - K; # NEG. ICF INDEX OF INSERTED OFFS, SET BY IINST #
  
      # IF FIRST ENTRY OF SET WAS FOR A REPL INTO A PFUN, ISSUE A DRV  #
      # INSTEAD OF A BRAI.                                             #
      IF IDRV[BDTT3] THEN BDTT2 = QICFOP" DRV"; 
         ELSE BDTT2 = QICFOP"BRAI"; 
      IF CLAS[AUADD[BDTT3]] EQ S"TABL"
        AND TTYP[AUADD[BDTT3]] EQ S"BASED"
        AND ACTP[BDTT3] NQ ACSTYPE(AUADD[BDTT3])
      THEN  # FORCE BRAIS FOR POINTER WORD BUT NOT FOR BASED ARRAY REFS#
        BEGIN 
        BDTT2 = QICFOP"BRAI"; 
        END 
      BRJ = BRJ+1; # INCREMENT B-REGISTER COUNTER                      #
      IINST(BDTT2,BDTT1,BRJ); # INSERT BRAI OR DRV INST.               #
      PFFMH[K] = 1; # GIVE BRAI OR DRV MEDIUM HIGH PRIOIRTY            #
      AT[K] = ACTP[BDTT3]; # SET ACCESS TYPE                           #
        BR = AUADD[BDTT3];
        LINKPBRAI;   # LINK BRAI FROM CORRECT PREDSESSOR  # 
      MPRED(K,FSM); # MAKE BRAI/DRV A PREDECESSOR OF FSM               #
      GOTO BDT78; 
  
    # ASSIGN "CONCON" ENTRIES TO UNASSIGNED B-REGISTERS.              # 
    #                                                                 # 
BDT90:  
      $BEGIN
      AUDUMP(3); # PRINT AU TABLE # 
      $END
       FOR I = 1 STEP 1 UNTIL NCON DO 
           BEGIN
               IF BRJ EQ NOAB THEN GOTO BDT990; # JIF NO MORE B-REGS   #
               BRJ = BRJ+1; 
               BDTT1 = CONCON[I]; 
               BRSUB[BRJ] = BDTT1;
           #  INSERT INVI FOR CONSTANT  # 
               J = LOPLAB;  # LOGICAL SUCCESSOR INDEX OF INVI # 
               CALL IINST(QICFOP"INVI",BDTT1,BDTT1);
               CALL MPRED(-1,K);
               CALL MPRED(K,FSM); 
               IDES[K] = BRJ; 
               PFFMH[K] = 1; # MAKE CONSTANT INVI PRECEDE VAR. INVI    #
           END
       GOTO BDT990; 
  
#**********************************************************************#
  
    # SELB --  MAKE OPERAND OF SELB POINT TO SELB                      #
    #                                                                  #
BDT100: BDTT1 = BI-OPN1[J]; 
        OPN2[BDTT1] = J;
        REFCT[BDTT1] = REFCT[BDTT1]-1;
        GOTO BDT9; # NOW PROCESS "SELB" AS UNARY B-REG USER            #
  
#**********************************************************************#
  
    # DRV -- DEFINE REGISTER VALUE --                                  #
    #     DONT ALLOW LATER STUFF TO MOVE BEFORE IT                     #
    #                                                                  #
BDT110: 
        GOTO BDT740;  # GIVE "DRV" VERY HIGH PRIORITY THERE            #
  
#**********************************************************************#
  
    # IJP -- INDEXED JUMP  -- THIS OP CONCLUDES A SEQUENCE            # 
BDT115: 
        DEADCODE = T;                      #REMOVE DEAD CODE AFTER IJP #
               MOPIT = MOPIT + 1 ;                                       STOPT
        I = OPN2[J];
        BDTT1 = I;                             #SAVE FOR AFTER PCOU    # LCMISC 
        CALL PCOU; # DO INDEX OPERAND # 
        IF  BDTT1 GT 0                     #CHECK JUMP TO FORMAL LABL  # LCMISC 
        AND CLAS[BDTT1] EQ QCLAS"LABL" THEN                              LCMISC 
            AT[BI-I] = QAT"SCM";                                         LCMISC 
        CIBR[BI-I] = TRUE;
        BNFC = 0;                          #SHOW THAT A B-REG IS NEEDED#
        OPN2[J] = I;
        CALL JNSM;
          IF  ARLIST NQ 0 THEN CLEANARRY; #DONT ELIM ARRAY ELMTS NOW#    SOPT 
        GOTO  BDT5; 
  
#**********************************************************************#
  
    # SRV -- SET REGISTER VALUE   (ALSO XMX6 -- A SPECIAL CASE )      # 
    #       1ST OPERAND IS VALUE,  2ND IS REGISTER                    # 
BDT120: 
        I = OPN1[J];
        CALL PCOU;
        OPN1[J] = I;
         CALL JNSM; 
         GOTO BDT5; 
  
#**********************************************************************#
  
    # PRGM ENTRY                                                       #
    #                                                                  #
BDT500: 
               MOPIT = MOPIT + 1 ;                                       STOPT
        MEP = OPN1[J];   # MAIN ENTRY POINT                            #
        ATEMP = 0;  # FORGET TEMPS KNOWN IN OTHER PROCS                #
        BTEMP = 0;
        TIAF = 0;   # INDICATES THIS IS NOT A FUNCTION                 #
        CCP1[0] = MEP;
        CCP1[1] = MEP;
        CALL CANNED(CNCD1); 
        MERV[MEP]=MEP;                                                   LCMISC 
        GOTO BDT5;
    # CNTL ENTRY                                                       #
    #                                                                  #
BDT600: 
        I = OPN1[J];
        GOTO BDT5;
    # LINE ENTRY                                                       #
    #                                                                  #
BDT680: LINE = OPN1[J]; 
        PFFVH[J] = 1; # GIVE "LINE" VERY HIGH PRIORITY                 #
        CALL MPRED(LSI,J);
           IF CIDDB NQ 0 THEN                                            JUNK 
             # CID OPTION ON  #                                          JUNK 
               BEGIN                                                     JUNK 
               IINST ( QICFOP"NULL" , 0 , 0 );                           JUNK 
               I = J;                                                    JUNK 
               J = K;                                                    JUNK 
               JNSM;    # MAKE THE NULL A SEQUENCE MARK  #               JUNK 
               J =I;                                                     JUNK 
               MPRED (K,J);   # AND MAKE LINE FOLLOW NULL#               JUNK 
               END                                                       JUNK 
                                                                         JUNK 
    #                                                                  #
    # CHECK TO SEE IF ICFT IS FULL ---                                 #
    #     ICFTPAD IS THE SPACE THAT SHOUD BE LEFT TO CONTINUE SEQUENCE.#
    #     IF EITHER ICFT OR THE SUCCESSOR LIST TABLE HAS LESS THAN     #
    #     ICFTPAD ENTRIES LEFT, THEN TERMINATE THE SEQUENCE.           #
    #                                                                  #
    #     ALSO, IF SSDT IS SET, TERMINATE THE SEQUENCE.                #
    #                                                                  #
BDT700: 
      IF (ICFTJ - ICFTI) GT ICFTPAD 
          AND (ICFT5NE - ICFTPAD) GT SUCTI
            AND NOT SSDT THEN GOTO BDT5;
BDT720: # TERMINATE SEQUENCE ABRUPTLY                                  #
        NICLOP = FALSE; 
        GOTO BDT60; 
  
#**********************************************************************#
  
BDT740: # MAKE "LINE", "DRY", OR UNREF. "LABL" A SUCCESSOR OF LSI. GIVE#
        # INSTRUCTION LARGE PRIORITY.                                  #
        CALL MPRED(LSI,J);
        PFFVH[J] = 1;    # GIVE INSTRUCTION VERY HIGH PRIORITY.        #
        GOTO BDT5;
  
#**********************************************************************#
  
    # PTRM -- END OF ICF                                               #
    #                                                                  #
BDT800: PTRM = TRUE;
    # SEQUENCE TERMINATING OP                                         # 
BDT900: OPCD[J] = QICFOP"NULL";  # DELETE LAST ENTRY                  # 
        OPTERM = TRUE;
        ICFBI = ICFBI-1;
        GOTO BDT720;
  
#**********************************************************************#
  
    # RETURN                                                           #
    #                                                                  #
RETRN:  
        DEADCODE = T;                      #REMOVE DEAD CODE AFTER RTRN#
               MOPIT = MOPIT + 1 ;                                       STOPT
        LABRET = OPN1[J]; 
        LSI = J;         # THIS IS A SIGNIFICANT INSTRUCTION           #
          IF  ARLIST NQ 0 THEN CLEANARRY; #DONT ELIM ARRAY ELMTS NOW#    SOPT 
        IF LABRET EQ 0 THEN 
        BEGIN 
            GOTO EPILOG;
        END 
        IF FPRI[LABRET] NE S"NAMC" THEN GOTO RETRN10; 
        OPN2[J] = OPN1[J];
        OPN1[J] = 0;
        OPCD[J] = QICFOP"IJP";
        GOTO  BDT115;   # PROCESS AS "IJP"                             #
RETRN10: OPCD[J] = QICFOP"JP";
          GOTO BDT28; 
  
#**********************************************************************#
  
   # EPILOG                                                            #
   #                                                                   #
EPILOG: 
    # CHECK FOR MULTIPLE FUNCTION VALUES -- IF SO, LOAD VALUE ADDRESS  #
        DEADCODE = T;                      #REMOVE DEAD CODE AFTER EPRC#
               MOPIT = MOPIT + 1 ;                                       STOPT
          IF  ARLIST NQ 0 THEN CLEANARRY; #DONT ELIM ARRAY ELMTS NOW#    SOPT 
        IF MUFV[MEP] THEN # THERE ARE MULTIPLE FUNCTION VALUES  # 
            BEGIN 
                CALL IINST(QICFOP"LOAD",FVTEMP,0);
            # ONLY INDIRECT FOR ARITHMETIC OR CHARS LQ10  LONG #
         IF TYPE[MEP] NQ QTYPE"EBCD"
         OR NBYT[MEP] LQ 0 THEN 
                AT[K] = QAT"SSCM";  # MAKE LOAD INDIRECT  #              LARRY-R
          REFCT[K] = 1 ;
          W = K;   #SAVE K# 
          ITEM SW;
           SW = J ; 
            J =K ;
           JNSM ;    # MAKE LOAD SUCC OF ALL# 
           J = SW;
          IINST (QICFOP"SRV",BI-W, 6);
          MPRED (W,K);   #TIE IN SRV# 
          MPRED ( W,NSM );    #TIE IN LOAD# 
          MPRED ( BI-LSM , W);
         Z = K;   #SAVE K TOO#
          REFCT[K] = 1; 
               W = J;  # SAVE CURRENT VALUE OF J                       #
               J = K; 
               CALL JNSM; # MAKE LOAD SUCCESSOR OF EVERYTHING          #
               J = W; # RESTORE J                                      #
          MPRED(K,NSM); 
          K = Z ;   #RESTORE K# 
          GOTO  EP40; 
            END 
    # CHECK FOR SINGLE FUNCTION VALUE -- IF SO, LOAD VALUE            # 
        IF TIAF NE 0 THEN # THERE IS A SINGLE FUNCTION VALUE          # 
            BEGIN 
                Y = PTAS(TIAF); # NUMBER OF WORDS IN FUNCTION VALUE    #
                IF Y EQ 1 THEN
                BEGIN # SEE IF LAST INSTRUCTION STORES FUNCTION VALUE  #
                    K = J;
EP10: 
                    K = K-1;
                    IF K GE 0 THEN
                    BEGIN 
                        X = OPCD[K];
                        IF X EQ QICFOP"NULL" THEN GOTO EP10;
                        IF X EQ QICFOP"LINE" THEN GOTO EP10;
                        IF X EQ QICFOP"REPL" AND OPN1[K] EQ FVTP[TIAF]
                        THEN
                        BEGIN # LAST INST. DOES STORE FUNC VALUE       #
                            OPCD[K] = QICFOP"TMWR"; 
                            OPN1[K] = OPN2[K];
                            GOTO EP35;
                        END 
                    END 
                END 
                X = QICFOP"LOAD"; 
                IF Y NE 1 THEN X = QICFOP"LOC"; 
               W = FVTP[TIAF];
               CALL IINST(X,W,0); 
             # COMPUTE FUNCTION VALUE LOAD PREDECESSOR                 #
               Z = BI-LSM;
               Y = USES[W];                         #GET LAST USE OF W #
               IF Y NE 0 THEN 
                  Y = BI - LISTI[Y];
               IF Y GT Z AND SEQ EQ LSEQ[W] THEN Z = Y; 
               CALL MPRED(Z,K); 
EP30: 
                CALL MPRED(K,NSM);
EP35: 
                REFCT[K] = 1; 
EP37: 
                OPCD[NSM] = QICFOP"SRV";
                OPN1[NSM] = BI-K; 
                OPN2[NSM] = 6;
    # END OF SEQUENCE CODE WILL MAKE NSM ENTRY A PREDECESSOR OF EOS.  # 
            END 
EP40:   X = MEP;
    # IF MULTIPLE ENTRIES, RETURN TO SAVED ADDRESS                    # 
        IF MUEN[MEP] THEN X = RETEMP; 
        OPCD[J] = QICFOP"JP"; 
        OPN1[J] = X;
        CALL JNSM;
        GOTO BDT5;
  
#**********************************************************************#
  
    # SPRC -- START PROCEDURE --                                       #
    #       SPECIAL PROLOG PROCESSING FOR MAIN ENTRY POINT             #
    #                                                                  #
SPRC:   MEP =  IBOPN1[ICFBI]; 
               MOPIT = MOPIT + 1 ;                                       STOPT
        ATEMP = 0; # FORGET TEMPS KNOWN IN OTHER PROCS                 #
        BTEMP = 0;
#       FOR MULTIPLE ENTRY PROCS/FUNCS WE NEED TO GET TEMPS            #
#       FOR THE RETURN CELL OR THE RETURN VALUE (FOR FUNCS ONLY)       #
#                                                                      #
#       IF THERE HAS BEEN A JAM, WE SHOULD NOT GET THE TEMPS           #
#       SINCE WE ALREADY GOT THEM THE FIRST TIME BEFORE THE JAM        #
  
        IF NOT JAM
        THEN
          BEGIN  #GET TEMPS#
          IF MUEN[MEP]
          THEN
            BEGIN 
            RETEMP = GETEMP(0);    # GET TEMP FOR RETURN CELL          #
            END 
  
          IF MUFV[MEP]
          THEN
            BEGIN 
            FVTEMP = GETEMP(0);    # GET TEMP FOR MULT ENTRY FUNC      #
            END 
          END    #GET TEMPS#
        TIAF = 0; 
        EPILAB = 0; # INITIALLY, THERE IS NO EPILOG LABEL              #
        GOTO PROLOG;
  
#**********************************************************************#
  
    # PROLOG -- THIS GENERATES CODE FOR "SPRC" AND "ENTR" ENTRIES.    # 
    #     SOME PROLOG CODE IS CANNED (PUT DIRECTLY TO THE CODE FILE), # 
    #     BUT MOST OF IT IS PLACED IN THE DEPENDENCY TREE FOR THE     # 
    #     CURRENT SEQUENCE.                                           # 
    #                                                                 # 
      #   PROLOGUE PROCS#                                                NEWFEAT
        PROC VALSTORE;                                                   NEWFEAT
          BEGIN                                                          NEWFEAT
          ITEM LL;  #TREAT AS AN ORDINARY STORE#                         NEWFEAT
          LSEQ[L] = SEQ;                                                 NEWFEAT
          LL = 0;                                                        NEWFEAT
          LSTADD(LL,K);                                                  NEWFEAT
          USES[L] = LL;                                                  NEWFEAT
          RICS[L] = TRUE;                                                NEWFEAT
          END  #VAL STORE#                                               NEWFEAT
 PROC FETCHCODE ;                                                        NEWFEAT
            BEGIN                                                        NEWFEAT
                        J = NSM;   #LOGICAL SUCCESSOR OF NEW INST"S    #
                        IF PLO EQ 0 THEN # USE ADDRESS IN X1           #
                            BEGIN 
                                IINST(QICFOP"DRV",0,XREG1); 
          PREAMBLE =K;  # SAVE 1ST PREAMBLE INST# 
                                PFFVH[K] = 1; # GIVE VERY HIGH PRIORITY#
                                LSTADD(GSTORE,K);    #LINK DRV TO BRAIS#
                            END 
                        ELSE      # LOAD ADDRESS USING A1              #
                            BEGIN 
                                CALL IINST(QICFOP"LUAU",0,0); 
                               FREZA1 = TRUE; 
                                KDES[K] = PLO;
                            END 
                        CALL MPRED(BI-LSM,K); 
                        M = K;
                        REFCT[M] = 1; 
            END                                                          NEWFEAT
 PROC REPLCODE;   BEGIN                                                  NEWFEAT
                        #NOTE - WE MUST MAKE SURE THAT THIS PARAMETER  #
                        #REPL GETS SCHEDULED BEFORE ANY USES OF PARAM  #
                        CALL IINST(QICFOP"REPL",L,BI-K);
                        AT[K] = QAT"SCM";                                LARRY-R
                        CALL MPRED(M,K);
                        CALL MPRED(K,NSM);
  
                        #FOR TABL AND TITM WE MUST GET ALL ARRAY TITMS #
                        IF CLAS[L] EQ S"TITM" 
                            THEN W = MAMA[L]; 
                            ELSE W = L; 
                        IF CKUSES[CLAS[W]] THEN                          LCMISC 
                            BEGIN  #NORMAL PARMS#                        LCMISC 
                            USES[W] = 0;                                 LCMISC 
                            LSEQ[W] = SEQ;                               LCMISC 
                            LDST[W] = BI - K;                            LCMISC 
                            END  #NORMAL PARMS#                          LCMISC 
                        ELSE                                             LCMISC 
                            BEGIN  #ODD STUFF#                           LCMISC 
                            IF LASTODDSTUFF NQ 0 THEN                    LCMISC 
                                MPRED(BI-LASTODDSTUFF,K);                LCMISC 
                            LASTODDSTUFF = BI - K;     #LINK THIS STUFF# LCMISC 
                            END  #ODD STUFF#                             LCMISC 
                        IF CLAS[W] EQ S"TABL" THEN  #NOW GET ALL TITMS #
                            BEGIN #TITM CHAIN#
                            ADDARRY(W);             #SHOW ARRAY AS USED#
                            W = BABY[W];
                            FOR W=W WHILE W NQ 0 DO 
                                BEGIN  #TITMS#
                                USES[W] = 0;
                                LSEQ[W] = SEQ;
                                LDST[W] = BI - K; 
                                W = ASEQ[W];
                                END  #TITMS#
                            END  #TITM CHAIN# 
                    IF FPRI[L] NQ S"VALU" THEN
                      BEGIN 
                      FSEQ[N] = SEQ;   # SAVE SEQUENCE FOR BRAIS  # 
                      FINS[N] = K;      # AND  ICFT INDEX  #
                      END 
                  END                                                    NEWFEAT
PROLOG: S = IBOPN1[ICFBI]; # OBTAINS PROC S.T. POINTER  # 
               MOPIT = MOPIT + 1 ;                                       STOPT
          IF  ARLIST NQ 0 THEN CLEANARRY; #DONT ELIM ARRAY ELMTS NOW#    SOPT 
        IF TRACEBACK                       #INSERT PROC TRACE WORD     #
        AND MEP EQ S THEN                  #BUT ONLY FOR MAIN ENTRY    #
            BEGIN  #INSERT TRACE# 
            CCP10[0] = S;                  #TRACE POINTS TO PROC NAME  #
            CANNED(CNCD10); 
            END  #INSERT TRACE# 
        MERV[S] = S;                       #NORMAL RETURN INFO IS IN S #
        CCP9[0] = S;
        CALL CANNED(CNCD9);   # PUT TO CODE FILE ENTRY PT WITH DATE    #
        VO = FALSE; # SO FAR, THERE ARE NO VALUE OUTPUT PARAMETERS #
        PLO = 0; # PARAMETER LIST OFFSET  # 
        TIALP = FALSE;  # SET TRUE WHEN LABEL PARAMETER SEEN          # 
        IF CLAS[S] EQ S"FUNC" THEN TIAF = S; # SAVE FUNC S.T. INDEX   # 
        N = FPLN[S]; # S.T. INDEX OF FIRST PARAMETER                  # 
        GOTO PL12;
PL10:   PLO = PLO+1;   # LOOK AT NEXT PARAMETER                       # 
PL11:   N = NFPR[N];
PL12:   IF N NE 0 THEN
            BEGIN # NEXT PARAMETER  # 
PL15:           L = FDFP[N];
                M = PTAS(L);
                 IF FPRI[L] NQ S"VALU" THEN                              FIXIV
                    BEGIN # COPY ADDRESS OF PARAMETER  #
        FETCHCODE ;                                                      NEWFEAT
    REPLCODE;                                                            NEWFEAT
                        CALL LSTADD(GSTORE,K); # CONSIDER IT A GLBL STR#
                        GOTO PL10;
                    END # OF CALL BY NAME PARAMETER # 
      #VALUE PARAM. PROCESSING#                                          NEWFEAT
    IF FPRI[L] EQ S"VALU" THEN   BEGIN                                   NEWFEAT
            ITEM  NOWORDVAL;   NOWORDVAL = M-1;                          NEWFEAT
            FETCHCODE;                                                   NEWFEAT
          ITEM INC,NN;                                                   NEWFEAT
          NN = K;                                                        NEWFEAT
          M = K ;                                                        NEWFEAT
          IINST(QICFOP"SUBS",0,BI-M);                                    NEWFEAT
          IINST(QICFOP"LOAD",BI-K,0);                                    NEWFEAT
          REFCT[K] = 1;                                                  NEWFEAT
          MPRED(M,K);                                                    NEWFEAT
            M = K;                                                       NEWFEAT
            REPLCODE;                                                    NEWFEAT
          VALSTORE;                                                      NEWFEAT
            IF NOWORDVAL EQ 0 THEN GOTO PL10;                            NEWFEAT
         INC = 1 ;                                                       NEWFEAT
          M = K;                                                         NEWFEAT
          IINST(QICFOP"DRV",0,XREG2); # RESERVE X2 JUST TO BE SAFE #
          MPRED(BI-LSM,K);
          CALL IINST(QICFOP"SRV",BI-NN,2);                               NEWFEAT
          PFFVH[K] = 1 ;  #SRV HAS VERY HIGH PRI#                        NEWFEAT
          MPRED(M,K);                                                    NEWFEAT
          REFCT[K] =0;                                                   NEWFEAT
          M = K;                                                         NEWFEAT
          FREZA2 = TRUE;                                                 NEWFEAT
          REFCT[NN] = REFCT[NN] + 1 ;                                    NEWFEAT
          NN = K;                                                        NEWFEAT
CHECKVAL:                                                                NEWFEAT
CHECKVALA:  NOWORDVAL = NOWORDVAL - 1 ;                                  NEWFEAT
          IINST(QICFOP"OFFS",0,INC);                                     NEWFEAT
          IINST(QICFOP"SUBS",BI-K,BI-NN);                                NEWFEAT
          REFCT[NN] = REFCT[NN] + 1 ;                                    NEWFEAT
          IINST(QICFOP"LOAD",BI-K,0);                                    NEWFEAT
          REFCT[K] = 1;                                                  NEWFEAT
          MPRED(M,K);                                                    NEWFEAT
          M = K ;                                                        NEWFEAT
          IINST(QICFOP"OFFS",L,INC);                                     NEWFEAT
          IINST(QICFOP"REPL",BI-K,BI-M);                                 NEWFEAT
          AT[K] = QAT"SCM";                                              LARRY-R
          MPRED(M,K);                                                    NEWFEAT
          MPRED(K,NSM);                                                  NEWFEAT
          INC = INC + 1 ;                                                NEWFEAT
          IF NOWORDVAL GR 0 
          THEN
            BEGIN 
            GOTO CHECKVAL;         # WE HAVE MORE WORDS OF STRING PARM #
            END 
  
          ELSE
            BEGIN 
            GOTO PL10;             # FINISHED THIS VAL PARM, GET NEXT  #
            END 
          END 
  
                GOTO PL11;
            END # NEXT PARAMETER                                      # 
PL20:  # CHECK FOR MULTIPLE ENTRY PROC -- IF SO, SAVE RETURN ADDRESS  # 
        IF MUEN[MEP] THEN # PROC HAS MULTIPLE ENTRIES  #
            BEGIN  # SAVE RETURN ADDRESS  # 
            MERV[S] = RETEMP;      # POINT TO RETURN CELL              #
            CCP11[0] = S;          # POINT CANNED CODE TO ENTRY POINT  #
            CCP11[2] = RETEMP;     # POINT CANNED CODE TO RETURN CELL  #
            CANNED( CNCD11 );      # GENERATE CODE FOR ALTERNATE ENTRY #
            END # SAVE OF RETURN ADDRESS #
    # CHECK FOR MULTIPLE FUNCTION VALUES  # 
        IF MUFV[MEP] THEN # SAVE FUNCTION RESULT LOCATION IN FVTEMP   # 
            BEGIN 
                X = S; # NON FUNCS WILL RETURN ENTRY LOC IN X6        # 
                IF CLAS[S] EQ S"FUNC" THEN X = FVTP[S]; 
                CALL IINST(QICFOP"LOC",X,0);
                              CISR [K] = TRUE;
                             REFCT[K] =1; 
                CALL MPRED(BI-LSM,K); 
                X = K;
                CALL IINST(QICFOP"REPL",FVTEMP,BI-X); 
                AT[K] = QAT"SCM";                                        LARRY-R
                CALL MPRED(X,K);
                CALL MPRED(K,NSM);
            END  # OF SAVE FUNCTION RESULT LOCATION # 
          LASTAMBLE = K;
      # ENTER "NULL" TO PRECEDE ALL PARAMETER "BRAI"S                  #
        CALL IINST(QICFOP"NULL",0,0); 
        PFFVH[K] = 1; # GIVE IT VERY HIGH PRIORITY                     #
        PBRAI = K;
        CALL LSTPRD(GSTORE,PBRAI);
        CALL MPRED(-1,PBRAI); 
            GOTO BDT5;
  
#**********************************************************************#
  
    # PCAL -- PROCEDURE CALL                                           #
    #         GENERATE CANNED CODE                                     #
    #                                                                  #
PCALL:  I = IBOPN2[ICFBI];
               MOPIT = MOPIT + 1 ;                                       STOPT
        K = IBOPN1[ICFBI];
        IF I NE 0 THEN # THERE IS A PARAMETER LIST                    # 
            BEGIN # GENERATE "SA1 PLISTLOC"                           # 
                CCP4[0] = I;
                CALL CANNED(CNCD4); 
            END 
        IF CLAS[K] NE S"SWCH" AND FPRI[K] EQ S"NAMC" THEN #PROC IS PARM#
            BEGIN # SET UP PROC EXIT AND BRANCH TO PROC ENTRY+1       # 
                CCP5[2] = K;
                QQOC5[10] = QCFOP"JP";
                CALL CANNED(CNCD5); 
            END 
        ELSE # DO STANDARD RETURN JUMP PROC CALL                      # 
            BEGIN 
                CCP6[0] = K;
                QQOC6[0] = QCFOP"RJ"; 
                FIND ( K ,I ) ;   # FIND NAME OF PROC  #                 JUNK 
                IF C<0,7>NAME[I] NQ "DBUG.LN"                            JUNK 
                AND TRACEBACK   THEN                                     JUNK 
                    QQOC6[0] = QCFOP"TRJ";
                CALL CANNED(CNCD6); 
            END 
          IF  ARLIST NQ 0 THEN CLEANARRY; #DONT ELIM ARRAY ELMTS NOW#    SOPT 
          IF CLAS[K] EQ S"FUNC" THEN JNSM;
        GOTO  BDT5;  # START BUILDING NEXT SEQUENCE  #
  
#**********************************************************************#
  
    # DIRECT CODE -- COPY TO CODE FILE                                # 
    #                                                                 # 
DIRC: #NOT USED#
        GOTO BDT5;
    # TERMINATE SEQUENCE                                               #
    #     MAKE  NSM A PREDECESSOR OF EOS ENTRY                         #
    #                                                                  #
BDT990: CALL MPRED(NSM,ICFTW1); 
        NBI = BI-ICFTI; 
        IF OPTERM THEN NBI = NBI+1; 
    END  #  BDT  #
END  # CODGJ3 # 
 TERM 
