*DECK CODGJ2
USETEXT   TSOURCE 
USETEXT   TTARGET 
USETEXT   TCEXECQ 
USETEXT   TSYMCNS 
USETEXT   TREGNOS 
USETEXT   TCOMTF
USETEXT   TCOM39Q 
USETEXT   TCOM78Q 
USETEXT   TCEXEC
USETEXT   TCOM88
USETEXT   TCOM88J 
PROC CODGJ2;
BEGIN 
  
  
  
  
*CALL COMEX 
  
  
  
  
#     DEFS                                                             #
  
      DEF J804 #804#;        #JOVABT DIAG 804#
      DEF J812 #812#;        #JOVABT DIAG 812#
      DEF J817 #817#;        #JOVABT DIAG 817#
  
  
  
  
        XDEF PROC PCOU; 
        XDEF PROC PSTOU;
        XDEF PROC POS;
      XREF PROC POST; 
        XDEF PROC PSTOS;
        XDEF PROC SHORTBLD; 
        XDEF PROC RELOAD; 
  
        XREF FUNC FTEMP;
        XREF FUNC ACSTYPE;
        XREF PROC PNAM; 
        XREF PROC DB; 
        XREF PROC ENTRAU; 
        XREF PROC LSTPRD; 
        XREF PROC LSTADD; 
        XREF PROC IINST;
        XREF PROC MPRED;
        XREF PROC CPBRT;
        XREF PROC CG2ABT; 
        XREF PROC VACATE; 
        XREF PROC ADDARRY;
  
        STATUS UNBEHAVD  NULL,GLOBAL,PARM,BADLY;
  
        ITEM T1,T2,T3,T4,T5;
        ITEM T6,T7,T8,T9; 
        ITEM WELLBEHAVED B,                         #UTILITY FLAGS FOR #
             INERT       B,                         #PSTOS AND PSTOU   #
             BOFFS       B, 
             FOUND       B, 
             FIRST       B,                         #T IF FIRST ON USES#
             MOTHER       ,                         #MAMA              #
             XITEM        ,                         #ITEM FOR ENTRAU   #
             OFFSET       ,                         #OFFS VAL FOR TITM #
             LOADPT       ,                         #ICFT OF LOAD      #
             LINKPT       ;                         #ICFT OF M OR REPL #
        ITEM STYPE S:UNBEHAVD;
  
        DEF  VACATTE(ARG) #IF ARG NE 0 THEN VACATE(ARG)#; 
        DEF  REDREFCT(I)  #IF REFCT[I] GR 0 THEN REFCT[I] = REFCT[I]-1#;
        DEF J852 #852#;            # SYMABT DIAGNOSTIC 852             # CODGJ2 
        DEF J853 #853#;            # SYMABT DIAGNOSTIC 853             # CODGJ2 
        DEF J854 #854#;            # SYMABT DIAGNOSTIC 854             # CODGJ2 
CONTROL EJECT;
  
# NOTE                                                                 #
# ----                                                                 #
#     THE CURRENT IMPLEMENTATION OF VARIABLE LOAD/STORE PROCESSING IN  #
#     SYMPL 1.2 HAS THREE CLASSES OF BEHAVIOR                          #
#               -WELLBEHAVED                                           #
#               -BADLYBEHAVED                                          #
#               -UNBEHAVED                                             #
#                                                                      #
#     UNBEHAVED IS THE SAME PROCESSING AS 1.1 AND IS INCLUDED TO       #
#     AVOID INCREASING OBJECT CODE SIZE FOR USERS NOT USING CONTROL    #
#     BADLY/WELLBEHAVED STATEMENTS.                                    #
#                                                                      #
#     UNBEHAVED IS DETECTED BY THE ABSENCE OF ANY NEW CONTROL          #
#     STATEMENT OF THE TYPE "CONTROL INERT"                            #
#                                                                      #
#     UNBEHAVED PROCESSING IS MORE COMPLEX THAN WELL/BADLY             #
#     BEHAVED PROCESSING AND MAINTAINS THE USES LISTS.                 #
#                                                                      #
#     TO REMOVE THIS PROCESSING                                        #
#               1. REMOVE ANY BLOCK OF CODE GOVERNED BY "UNBEHAVED"    #
#                  IN PSTOS AND PSTOU                                  #
#               2. REMOVE THE VARIABLES                                #
#                     -PUSES     -GUSES     -GSTORE                    #
#                     -LPS       -LAS       -LGS                       #
#                  FROM PCOM88                                         #
#               3. REMOVE "UNBEHAVED" FROM CEXEC AND FROM              #
#                  THE "CONTROL" STATEMENT PROCESSING AND              #
#                  FROM CODGJ1                                         #
#               4. REMOVE STYPE FROM CODGJ2 AND ALL "PARM              #
#                  AND "GLOBAL" PROCESSING, SINCE THESE                #
#                  ARE UNBEHAVED TYPES OF PROCESSING                   #
  
CONTROL EJECT;
# PCOU -- PROCESS COMPUTATION OPERAND USE                              #
#     PCOU BUILDS DEPENDENCY LINKS FOR AN OPERAND USE                  #
#     INPUTS --                                                        #
#        I      - OPERAND POINTER. IF I LT 0, I IS THE ICF INDEX OF THE#
#                 OPERAND INSTRUCTION. IF I GT 0, I IS THE ST INDEX    #
#                 OF THE OPERAND.                                      #
#        J      - ICFT INDEX OF INSTRUCTION THAT USES OPERAND          #
#     OUTPUT --                                                        #
#        I      - NEW OPERAND POINTER                                  #
  
PROC PCOU;
BEGIN  #PCOU# 
  
$BEGIN
DB("(9X, 8HPCOU  I= O6, 4H  J= O6)", I, J, ".");
$END
      ITEM PCUT1, PCUT2;
  
      # IF THE OPERAND IS A SCALAR THEN LOAD IT                        #
PCU8: IF I GE 0 THEN
         BEGIN  #SCALAR#
         PSTOU; 
         GOTO PCU90;
         END  #SCALAR#
  
      # CHECK IF OPERAND IS COMPUTED IN THE CURRENT SEQUENCE           #
      PCUT1 = BI - I; 
      IF PCUT1 GE 0 THEN
         BEGIN  #ICF# 
         IF OPCD[PCUT1] EQ QICFOP"NULL" THEN
            BEGIN  #RELAY#
            I = OPN1[PCUT1];
            MPRED(BI-LSM,J);                   #PLAY IT SAFE FOR NULLS #
  
            GOTO PCU8;                              #PROCESS NEW OPND  #
            END  #RELAY#
         PCUT2 = BI - LSM;
         IF PCUT1 GT PCUT2 THEN 
            PCUT2 = PCUT1;
         MPRED(PCUT2,J);
         REFCT[PCUT1] = REFCT[PCUT1] + 1; 
         GOTO PCU90;
         END  #ICF# 
  
      # IF HERE WE NEED TO LOCATE THE TEMP ENTRY IN THE SYMBOL TABLE   #
      I = FTEMP(I); 
      PSTOU;                                        #NOW PROCESS TEMP  #
PCU90:  
END  #PCOU# 
  
CONTROL EJECT;
# PSTOU -- PROCESS SYMBOL TABLE OPERAND USE                            #
#     PSTOU INSERTS THE DEPENDENCY TREE LINKS FOR USES OF SYMBOL TABLE #
#     OPERANDS. LOAD INSTRUCTIONS ARE INSERTED IF NECESSARY.           #
#     INPUTS --                                                        #
#        I      - SYMBOL TABLE INDEX OF OPERAND                        #
#        J      - ICFT INDEX OF INSTRUCTION THAT USES OPERAND.         #
#                 DEPENDENCY LINKS WILL CONTAIN J.                     #
#        XLOAD  - TRUE IF CURRENT INSTRUCTION IS A LOAD OF THIS OPND   #
#     OUTPUTS --                                                       #
#        I      - NEW OPERAND POINTER - I CONTAINS THE COMPLEMENT OF   #
#                 THE ICF INDEX OF THE INSTRUCTION THAT LOADS THE OPND #
#     IMPORTANT VARIABLES --                                           #
#        LINKPT - ICFT INDEX OF VALID LOAD (BECOMES I AT EXIT)         #
#        FOUND  - TRUE IF A PREVIOUS LOAD WAS FOUND TO LINK TO         #
#                                                                      #
#                                                                      #
#    THE PROCESSING IN PSTOU IS PERFORMED IN SEVERAL INDEPENDENT STEPS #
#        1. CALCULATE THE POINT IN THE ICF WE CANNOT LINK PAST         #
#           (USING BEHAVED/UNBEHAVED CONCEPTS)                         #
#        2. TRY TO FIND A VALID LOAD STILL EXTANT                      #
#        3. INSERT A NEW LOAD IF AN OLD ONE IS NOT FOUND, OR           #
#           IF THE CURRENT INSTRUCTION (J) IS NOT ALREADY A LOAD       #
#        4. UPDATE THE USES LISTS.  NOTE THAT THE ONLY USES            #
#           WHICH SHOW UP NOW ARE BONA FIDE LOADS                      #
  
PROC PSTOU; 
BEGIN  #PSTOU#
  
  
      # THIS IS A NESTED PROCEDURE WHICH PERFORMS THE FUNCTION OF      #
      #   SETTING K AND MAKING THE CURRENT INSTRUCTION A NULL IF       #
      #   THE CURRENT INSTRUCTION IS AN EXPLICIT LOAD                  #
      # THIS PROCEDURE IS CALLED FOR TITMS AND SCALARS IF A PREVIOUS   #
      #   LOAD IS FOUND TO WHICH THEY CAN LINK                         #
  
      PROC REMOVE;
      BEGIN  #REMOVE# 
  
      $BEGIN
      DB("(9X,16HREMOVE(IN PSTOU))","."); 
      $END
  
  
      FOUND = TRUE;                                 #SET FLAG FOR FOUND#
      IF  CLASS EQ S"TITM"
      AND OPCD[T1] EQ QICFOP"REPL"
         THEN LOADPT = BI - OPN2[T1]; 
         ELSE LOADPT = T1;
  
      IF XLOAD THEN                                 #IF J IS NOW A LOAD#
         BEGIN                                      #WE MUST REMOVE IT #
         OPCD[J] = QICFOP"NULL";
         OPN1[J] = BI - LOADPT;                     #SET LINK TO LOAD  #
         END
      END  #REMOVE# 
  
  
CONTROL EJECT;
      # THIS NESTED FUNCTION GETS THE NEXT USE OUT OF THE USES LIST    #
      #   FOR PROCESSING BY THE CHECK FOR DUPLICATE LOADS              #
      # THE FUNCTION RETURNS A BOOLEAN STATING IF A NEW USE WAS FOUND  #
      #   THE FUNCTION RETURNS FALSE IF THE USES LIST IS EMPTY, OR     #
      #   IF THE NEXT USE IS BEYOND THE RELEVANCE POINT IN THE ICF (M) #
      # GETUSE USES GLOBAL VARIABLES - I, J, L, M, T1, T6              #
      #   AND SETS T1 (=ICFT OF USE) AND T6 (=ICFT PTR FOR USE)        #
      #   AND USES THE GLOBAL FLAG "FIRST" TO DETERMINE IF THIS IS     #
      #   THE FIRST ENTRY TO THE USES LIST                             #
  
      FUNC GETUSE B;
      BEGIN  #GETUSE# 
      ITEM GETFLG B;                                #TEMP              #
      GETFLG = TRUE;                                #INITIALLY SET TO T#
  
      # GET NEXT USE AND HANDLE SPECIAL PROCESSING FOR FIRST USE       #
      IF FIRST THEN 
         BEGIN  #FIRST USE# 
         L = USES[I];                               #GET HEAD OF USES  #
         FIRST = FALSE;                             #SET NEXT ENTRY SW #
         IF STYPE EQ S"NULL"
            THEN LINKPT = 0;                        #GOOD LINK TO BI   #
            ELSE LINKPT = BI - M;                   #BAD LINK TO M     #
         IF NOT CKUSES[CLASS] THEN                  #IF USES IS INVALID#
            GETFLG = FALSE;                         #THEN WE IGNORE LST#
         END  #FIRST USE# 
      ELSE
         L = LISTL[L];                              #GET FROM USES LIST#
  
      # TEST IF LAST USE OR IF HAVE GONE PAST THE LINKPOINT            #
      IF L EQ 0 THEN
         GETFLG = F;                                #END OF USES LIST  #
      ELSE
         BEGIN  #NEXTUSE# 
         T1 = BI - LISTI[L];                        #GET ICFT OF USE   #
         T6 = T1;                                   #ASSUME NOT INSERTD#
         IF LOADOP[OPCD[T1]]
         AND J LT T1 THEN                           #IF INSERTED LOAD  #
            T6 = BI - OPN2[T1];                     #THEN SET T6       #
  
         IF T6 LT LINKPT THEN                       #TEST IF WE WANT TO#
            GETFLG = F;                             #CONTINUE SEARCHING#
         END  #NEXTUSE# 
  
      GETUSE = GETFLG;                              #SET FOR EXIT      #
      END  #GETUSE# 
  
  
      CONTROL EJECT;
PARTI:  
      # CALCULATE THE RELEVANCE POINT IN THE ICFT                      #
  
      STYPE = S"NULL";                              #UNBEHAVED LOCALS  #
      CLASS = CLAS[I];
      OFFSET = 0; 
      XITEM = I;
      IF CLASS EQ S"TITM" 
         THEN MOTHER = MAMA[I]; 
         ELSE MOTHER = I; 
      INERT = INRT[MOTHER];                         #GET INFO FROM MOM #
      WELLBEHAVED = WELB[MOTHER]; 
      IF  CKUSES[CLASS] 
      AND LSEQ[I] NE SEQ THEN 
         BEGIN  #OLD USE# 
         LDST[I] = 0; 
         USES[I] = 0;                               #USES LIST INVALID #
         END
      IF NOT XLOAD THEN                             #INITIALIZE FIELDS #
         BEGIN  #INIT#                              #NOT SET BY J3     #
         XOFFS = -1;                                #SHOW NO OFFS      #
         XSUBS = J;                                 #OR SUBS           #
         END  #INIT#
  
      # NOW SET UP ACCESS TYPE IN CASE WE NEED TO INSERT LOAD          #
      # AND SET UP STYPE (GLOBAL,PARM,ETC.) WHICH APPLY ONLY TO        #
      #   UNBEHAVED VARIABLES - ALL BEHAVED VARIABLES ARE "NULL"       #
      ACSTP = ACSTYPE(I); 
      IF  ACSTP GT QAT"LCM"                                              LARRY-R
      AND XOFFS GQ 0                                #PFUN CAN BE AT 0  #
      AND OPCD[XOFFS] EQ QICFOP"PFUN" THEN
         ACSTP = LOCACS[ACSTP];                     #LOWER AT FOR PFUNC# LARRY-R
  
      # NOW SET UP M -  THE RELEVANCE POINT IN THE ICF PAST WHICH      #
      #   LOADS MUST NOT BE LINKED                                     #
      # NOTE THAT LOADS CAN LINK UP TO BI (BEHAVIOR AND LSM, ETC       #
      #   PERMITTING) BUT REPLS CAN ONLY LINK TO LSM                   #
      # THIS CONCESSION IS POSSIBLE ONLY BECAUSE OF THE CLEANARRAY     #
      #   MECHANISM AND THE AVAIL MECHANISM FOR SCALARS                #
      M = BI + 1;                                   #LOOK AS FAR AS CAN#
  
      # UNBEHAVED PARAMETERS GET THE FULL TREATMENT                    #
      # NOTE CONS AND ADCN ARE WELLB EVEN IF PROGRAM IS UNBEHAVED      #
      IF  UNBEHAVED 
      AND NOT WELLBEHAVED THEN
         BEGIN  #UNBEHAVED# 
         IF CLASS EQ S"TITM"                        #NO TITM LINKS PAST#
         AND LAS LT M                               #LAST BASED STORE  #
            THEN M = LAS; 
         IF  CKPARM[CLASS]                          #PARAMETER         #
         AND FPRI[MOTHER] EQ S"NAMC" THEN 
            BEGIN 
            IF LPS LT M 
               THEN M = LPS;
            STYPE = S"PARM";
            END 
         IF XTRN[I] NE S"LOC" 
         OR MEP NE SCPN[SBEG[I]] THEN               #GLOBAL            #
            BEGIN 
            STYPE = S"GLOBAL";
            IF LPS LT M 
               THEN M = LPS;
            END 
         END  #UNBEHAVED# 
  
      # BADLY BEHAVED ALL LINK TO LBS                                  #
      ELSE
         BEGIN  #BEHAVED# 
         IF WELLBEHAVED THEN
            STYPE = S"NULL";
         ELSE 
            BEGIN  #BADLY BEHAVED#
            STYPE = S"BADLY"; 
            IF LBS LT M THEN
               M = LBS; 
            END  #BADLYBEHAVED# 
         END  #BEHAVED# 
  
  
  
PARTII: 
      # FIND IF A PREVIOUS LOAD IS AVAILABLE                           #
      # FIRST CHECK IF WE NEED TO INSERT AN OFFS (ZEROTH ELT OF ARRAY) #
      # NOTE THAT A TABL HAS A DUAL IDENTITY AS A TITM AND A SCALAR    #
      #   SINCE CG1 PUTS OUT TABL"S FOR REFERENCES TO THE ZEROTH SINK  #
  
      LOADPT = J;                                   #SET ICFT OF LOAD  #
      FIRST = TRUE;                                 #SET GETUSE ENTRY  #
      FOUND = FALSE;                                #ASSUME NO PREV USE#
  
      IF  TORT[CLASS] 
      AND XLOAD THEN
         BEGIN  #PROCESS TORT#
         IF OPN1[J] EQ I THEN              #KLUDGE# #INSERT OFFS       #
            BEGIN  #INSERT OFFS#
            IINST(QICFOP"OFFS",I,0);
            XOFFS = K;                              #SHOW NEW OFFS     #
            OPN1[J] = BI - K;              #KLUDGE# #SET OPN1          #
            END  #INSERT OFFS#
         IF ACSTP GR QAT"LCM" THEN                                       LARRY-R
            CPBRT(XOFFS,XSUBS,XITEM); 
         IF XOFFS GT -1 THEN
            OFFSET = OPN2[XOFFS]; 
         END  #PROCESS TORT#
  
CHKDUPARRAY:  
      IF CLASS EQ S"TITM" 
      AND OPCD[J] EQ QICFOP"LOAD" THEN              #LOCS NOT LINKED   #
         BEGIN  #ARRAY PROCESSING#
  
         # SCAN THE USES LIST FOR THE ARRAY ITEM TO TRY TO FIND        #
         #   AN APPLICABLE PREVIOUS STORE                              #
         # NOTE THAT THE USES LIST SHOWS ALL APPLICABLE USES FOR       #
         #   THIS SINK, AND FOR THE ARRAY IF IT IS REACTIVE            #
         # ALSO, THAT BOTH LOADS AND STORES ARE APPLICABLE AND         #
         #   BOTH HAVE THE SAME TREE STRUCTURE FOR TITMS IN THE ICFT   #
         T3 = BI - OPN1[J];                         #OFFS/SUBS OF LOAD #
         ASLONGAS NOT FOUND AND GETUSE DO 
            BEGIN  #USES LIST SCAN# 
  
            T2 = BI - OPN1[T1];                     #OFFS/SUBS OF USE  #
            BOFFS = OPN1[T3] LT 0                   #TRUE IF BOTH HAVE #
                    AND OPN1[T2] LT 0;              #OFFS              #
            IF  OPCD[T2] EQ OPCD[T3]                #NOW COMPARE USE   #
            AND OPN2[T2] EQ OPN2[T3]                #OPCD,OPN2 EQUAL   #
            AND (NOT BOFFS AND (OPN1[T3] GT 0       #AND IF ONE IS OFFS#
                           AND  OPN1[T2] GT 0)      #THEN BOTH MUST BE #
                 OR  BOFFS AND (OPN2[BI-OPN1[T3]]   #SAME OFFS         #
                           EQ   OPN2[BI-OPN1[T2]]) )
            AND OPCD[T1] NE QICFOP"LOC"             #LOADS NOT NEEDED  #
            AND OPCD[J]  NE QICFOP"LOC"             #AND LINKING TRICKY#
            THEN
               BEGIN  #FOUND# 
  
               #WE HAVE FOUND A GOOD USE TO LINK TO IF HERE            #
               #TITM"S LINKING TO A REPL LINK TO ITS RIGHTHAND SIDE    #
               REMOVE;                              #LINK TO REAL LOAD #
               IF  OPCD[T3] EQ QICFOP"SUBS"         #REDUCE REFCT OF   #
               AND OPN2[T3] LT 0 THEN               #SUBS LOAD INDEX   #
                  BEGIN  #REDUCE# 
                  T5 = BI - OPN2[T3]; 
                  IF REFCT[T5] LE 1 
                     THEN REFCT[T5] = 0;
                     ELSE REFCT[T5] = REFCT[T5] - 1;
                  END  #REDUCE# 
$BEGIN
DB("(9X, 35HARRAY LOAD ALREADY AVAILABLE AT T1= O6 )", LOADPT, ".");
$END
               END  #FOUND# 
            END  #USESLIST SCAN#
         END  #ARRAY PROCESSING#
  
  
CHKDUPSCALAR: 
      ELSE
      IF CKSCALAR[CLASS] THEN 
         BEGIN  #SCALAR PROCESSING#                 #(OTHER THAN TITM) #
  
         # SCAN THE USES LIST FOR SCALAR ITEMS AND TRY TO FIND         #
         #   AN APPLICABLE OUTSTANDING LOAD TO LINK TO                 #
         # NOTE THAT ONLY LOADS OF THE SCALAR SHOW UP,SO THERE IS NO   #
         #   FUNNY STUFF ABOUT WHAT SHOWS UP ON THE USES LISTS         #
         # NOTE ALSO THAT PFUNCS SHOW UP AS SCALARS HERE               #
         ASLONGAS NOT FOUND AND GETUSE DO 
            BEGIN  #USES SEARCH#
            T2 = BI - OPN1[T1];                                          LARRY-R
            T3 = BI - OPN1[J];                                           LARRY-R
            BOFFS = XLOAD                           #T IF BOTH SAME OFF# LARRY-R
                    AND T2 GT 0                                          LARRY-R
                    AND T3 GT 0                                          LARRY-R
                    AND OPCD[T2] EQ QICFOP"OFFS"                         LARRY-R
                    AND OPCD[T3] EQ QICFOP"OFFS"                         LARRY-R
                    AND OPN2[T2] EQ OPN2[T3] ;                           LARRY-R
            IF  LSEQ[I] EQ SEQ                      #TEST IF IN SEQ    #
            AND B<TSYM[T1]>AVAIL NE 0               #AND AVAILABLE     #
            AND (OPCD[J] NE QICFOP"LOC"             #AND NOT LOC       #
               OR NOT XLOAD)                        #(OR SUBSCR OF LOC)#
            AND OPCD[T1] NE QICFOP"LOC" 
            AND ((XLOAD AND OPN1[J] EQ OPN1[T1])    #NORMAL AND XLOAD  # LARRY-R
               OR(NOT XLOAD AND OPN1[T1] EQ I)      #NORMAL SCALAR LOAD# LARRY-R
               OR BOFFS                             #BOTH SAME OFFSET  # LARRY-R
               OR(CLASS EQ S"CONS"                  #OR CONSTANT LOAD  # LARRY-R
                  AND NOT XLOAD                     #NORMAL CONS LOAD  # LARRY-R
                  AND OPCD[T1] EQ COPC[CONL[I]])) THEN                   LARRY-R
               BEGIN  #FOUND# 
  
               #HAVE FOUND GOOD STORE WE CAN LINK TO                   #
               REMOVE;                              #LINK TO REAL LOAD #
$BEGIN
DB("(9X, 36HSCALAR LOAD ALREADY AVAILABLE AT T1= O6 )", LOADPT, "."); 
$END
               END  #FOUND# 
            END  #USES SEARCH#
         END  #SCALAR PROCESSING# 
  
      # ELSE WE HAVE AN UNKNOWN TYPE PASSED TO US                      #
      # SINCE THIS COULD BE A LOOK AT THE ENTRY POINT OF A PROC OR     #
      #   SOME SUCH CASE WE DON"T PROHIBIT FURTHER PROCESSING -        #
      #   ALL WE DO IS PRINT OUT A DEBUG MESSAGE                       #
  
      ELSE
         BEGIN  #MISC#
$BEGIN
DB("(9X, 27HMISCELLANEOUS CASE - CLASS= A4)", BCDCLASS[CLASS], "." ); 
$END
  
         # ANY BEAST SUCH AS THIS WOULD PROBABLY GENERATE BAD CODE     #
         IF  CLASS EQ S"TITM" 
         AND NOT XLOAD
         AND ACSTP GT QAT"LCM" THEN                                      LCMISC 
            BEGIN 
            CG2ABT(J852,"UNEXPECTED TYPE(PSTOU IN CODGJ2) LINE XXXXX",
                   43); 
            END 
         END  #MISC#
  
  
PARTIII:  
      # INSERT A NEW LOAD IF NECESSARY                                 #
  
      # DECIDE IF WE NEED TO INSERT A LOAD - WE DON"T NEED TO IF       #
      #   ANOTHER GOOD LOAD WAS FOUND OR IF THE INSTRUCTION USING      #
      #   THE OPERAND IS ITSELF A LOAD OR A LOC                        #
      # CODGJ3 SETS XLOAD=T WHEN PROCESSING NON-SUBSCRIPTED            #
      #   PART OF LOADS OR LOCS                                        #
      # NOTE THAT FOR INSERTED LOADS OPN2 IS NEG ICF INDEX OF THE      #
      #   INSTRUCTION CAUSING THE LOAD                                 #
      IF CLASS EQ S"TITM"                           #CALC X = OFFSET   #
         THEN X = LOCN[I];                          #FOR AU AND OFFS   #
         ELSE X = 0;
      IF OPCD[J] EQ QICFOP"REPL"                    #IF OPCD IS A REPL #
         THEN W = BI - J + 1;                       #INSERTED LOAD PTS #
         ELSE W = BI - J;                           #BEHIND REPL       #
  
      IF  NOT FOUND                                 #IINST IF NOT LINKD#
      AND NOT XLOAD THEN                            #AND J IS NOT LOAD #
         BEGIN  #INSERT LOAD# 
  
         IF CLASS EQ S"CONS" THEN 
            BEGIN  #CONS LOAD#
            Y = COPC[CONL[I]];                      #CONS LOAD OP CODE #
            Z = C1NL[I];                            #          OPN1    #
            IINST(Y,I,W);                           #INSERT INSTRUCTION#
            KDES[K] = Z*64 + C2NL[I];               #SPECIAL CONS FIELD#
            IF Y EQ QICFOP"MASK" THEN 
               OPN1[K] = Z; 
            END  #CONS LOAD#
  
         ELSE 
            BEGIN  #NORMAL LOADS# 
            Y = I;                                  #OPN1 FOR LOAD     #
            IF TORT[CLASS] THEN                     #TITM TO BE LOADED #
               BEGIN  #INSERT OFFS#                 #ALSO NEEDS OFFS   #
               IINST(QICFOP"OFFS",MOTHER,X);        #NOTE THAT OFFS IS #
               Y = BI - K;                          #INSERTED BEFORE   #
               OFFSET = X;                          #OFFS FOR ENTRAU   #
               END  #INSERT OFFS#                   #THE LOAD          #
            IINST(QICFOP"LOAD",Y,W);                #NOW INSERT LOAD   #
            END  #NORMAL LOADS# 
         LOADPT = K;                                #SET LOADPT        #
         END  #INSERT LOAD# 
  
      # INCREASE THE REFCT AND LINK THE USE TO THE LOAD (UNLESS THEY   #
      # ARE THE SAME INSTRUCTION) WHETHER OF NOT WE INSERTED THE LOAD  #
      IF NOT XLOAD THEN 
         BEGIN  #MPRED# 
         MPRED(LOADPT,J); 
         REFCT[LOADPT] = REFCT[LOADPT] + 1; 
         END  #MPRED# 
      LINKPT = LSM; 
      IF M LT LINKPT THEN 
         LINKPT = M;
      IF FOUND THEN                                 #BUILD LINK FOR    #
         MPRED(BI-LINKPT,J);                        #CURRENT SEQ       #
  
      # NOW HANDLE INFORMATION FOR ALL LOADS WHICH WERE NOT LINKED OUT #
      # WE LINK NEW LOADS TO M (RELEVANCE PT) OR LDST (LAST REPL)      #
      #   OR LSM - WHICHEVER IS THE CLOSEST TO THE LOAD                #
      IF NOT FOUND THEN 
  
         BEGIN  #COMMON INFO# 
         MPRED(BI-LINKPT,LOADPT);                   #LINK LOAD TO RELPT#
  
         IF  STYPE EQ S"PARM" 
         AND UNBEHAVED THEN 
            LSTPRD(GSTORE,LOADPT);                  #NOTE GLOB/PARM LNK#
  
         IF CKUSES[CLASS] THEN
            BEGIN  #UPDATE LSEQ#
            LSEQ[I] = SEQ;                          #SHOW USE IN SEQ   #
            IF LDST[I] NE 0 THEN
               MPRED(BI-LDST[I],LOADPT);            #LINK TO LAST REPL #
            END 
         ELSE                                                            LCMISC 
            BEGIN  #ODD STUFF#                                           LCMISC 
            IF LASTODDSTUFF NQ 0 THEN                                    LCMISC 
               MPRED(BI-LASTODDSTUFF,LOADPT);       #LINK ALL ODDSTUFF # LCMISC 
            LASTODDSTUFF = BI - J;                                       LCMISC 
            END  #ODD STUFF#                                             LCMISC 
         TSYM[LOADPT] = MARKCTR;                    #SUBSEQ OF LOAD    #
         AT[LOADPT] = ACSTP;
         IF CLASS NE S"CONS" THEN                   #ENTRAU FOR ALL    #
            ENTRAU(XITEM,OFFSET,ACSTP);             #EXCEPT CONS       #
         END  #COMMON INFO# 
  
PARTIV: 
      # UPDATE THE USES LISTS FOR ANY LOAD NOT LINKED TO PREV LOAD     #
      # NOTE THIS AVOIDS REDUNDANT OR SUPERFLUOUS USES ON THE LISTS    #
      # THE TABL SHOWS ALL USES FOR THE ARRAY, AND EACH  SINK SHOWS    #
      #   ONLY THE VALID USES FOR THE SINK                             #
  
      IF NOT FOUND THEN 
         BEGIN  #ADD USES#
  
         IF TORT[CLASS] THEN
            BEGIN  #NOPREUSE# 
            # IF INST. IS A LOAD OR A LOC OF AN INDIRECT VARIABLE THEN #
            # PROCESS OLD CHAINS IF USES LIST NON-EMPTY.               #
            IF XLOAD AND ACSTP GT QAT"LCM" THEN 
               BEGIN
               IF USES[MOTHER] NQ 0 THEN OLDCHAINS; 
               END
  
            #IF NO PREVIOUS USE WAS FOUND WE MUST UPDATE THE USES LISTS#
      # NOTE THAT USES OF TABL IS TREATED THE SAME AS ITS TITMS        #
            W = MOTHER; 
            ADDARRY(W); 
            Z = BABY[W];                            #NOW GET BABY CHAIN#
  
            ASLONGAS W NE 0 DO
               BEGIN  #SCAN TITM CHAIN# 
               IF LOCN[W] EQ LOCN[I]                #ONLY GET SAME SINK#
               OR W EQ MOTHER THEN                  #ALWAYS GET MOTHER #
                  BEGIN  #PROCESS USES LIST#        #OR SAME SINK      #
                  L = USES[W];
                  LSTADD(L,LOADPT); 
                  USES[W] = L;                      #ADD USES          #
                  IF LSEQ[W] NQ SEQ THEN            #INVALIDATE GARBAGE# LARRY-Y
                     LDST[W] = 0;                                        LARRY-Y
                  LSEQ[W] = SEQ;                    #USED IN THIS SEQ  #
                  END  #PROCESS USES LIST#
               W = Z;                               #TABL/TITM CHAINING#
               Z = ASEQ[Z]; 
               END  #SCAN TITM CHAIN# 
  
            END  #NOPREUSE# 
  
         IF CKSCALAR[CLASS] THEN
            BEGIN  #SCALAR USES#
  
            # ELSE ADD USES TO SCALAR ITEM                             #
            L = USES[I];
            LSTADD(L,LOADPT); 
            USES[I] = L;
            END  #SCALAR USES#
  
         #PROCESS USES LISTS FOR UNBEHAVED VARIABLES                   #
         #NOTE THAT STYPE CAN ONLY REFER TO BADLY BEHAVED VARIABLES    #
         IF STYPE EQ S"PARM" THEN 
            LSTADD(PUSES,LOADPT); 
         IF STYPE EQ S"GLOBAL" THEN 
            LSTADD(GUSES,LOADPT); 
         END  #ADD USES#
  
STU90:  
$BEGIN
DB("(9X,9HPSTOU  I=O6,5H  ST=O6,10H   CALLER=O16)",(BI-LOADPT),I, 
     PSTOU,".");
DB("(16X,2HM=O6,8H  CLASS=A4,8H  STYPE=O1,5H  AT=O1,8H  INERT=O1)", 
     M,BCDCLASS[CLASS],STYPE,ACSTP,INERT,".");
$END
     XLOAD = FALSE;                                 #AVOID ANY PROBLEMS#
     I = BI - LOADPT;                               #SET I FOR EXIT    #
END  #PSTOU#
  
CONTROL EJECT;
# POS -- PROCESS OPERAND STORE                                         #
#     POS IS CALLED DURING REPLACE AND SWAP PROCESSING TO BUILD        #
#     DEPENDENCY LINKS FOR BOTH SYMBOL TABLE AND ICF OPERANDS THAT     #
#     ARE REDEFINED                                                    #
#                                                                      #
#     INPUTS --                                                        #
#        I      - OPERAND POINTER.  IF I LT 0, I IS ICF INDEX OF SUBS  #
#                 OR OFFS ENTRY THAT COMPUTES THE OPERAND NAME.        #
#                 IF I GT 0, I IS THE S.T. INDEX OF OPERAND            #
#        J      - ICFT INDEX OF INSTRUCTION THAT CAUSES REDEFINITION   #
#                                                                      #
  
PROC POS; 
BEGIN  #POS#
  
$BEGIN
DB("(9X, 8HPOS   I= O6, 5H   J= O6)", I, J, "."); 
$END
      ITEM  PST1,PST2,PST3; 
  
      # IF THE OPERAND IS A SCALAR THEN HANDLE IT                      #
      IF I GE 0 THEN
         BEGIN  #SCALAR#
         IF CLAS[I] EQ S"TITM" THEN                 #ZEROTH ELT OF ARRY#
            BEGIN  #ZEROTH ELT# 
            IINST(QICFOP"OFFS",I,0);                #SO INSERT OFFS    #
            OPN1[J] = BI - K;                       #POINT OPN1 TO OFFS#
            I = BI - K;                             #GO PROCESS AS TITM#
            END  #ZEROTH ELT# 
         ELSE 
            BEGIN  #SCALAR# 
            PSTOS;                                  #PROCESS SCALR REPL#
            IF NOT FOUND THEN                       #ENTER PARCEL SAVNG#
               ENTRAU(I,0,ACSTP); 
            GOTO PS90;                              #SAY GOODNIGHT DICK#
            END  #SCALAR# 
         END  #SCALAR#
  
      # NOW PROCESS THE TITMS                                          #
      PST2 = 0;                                     #OFFS USED         #
      PST1 = BI - I;
      PST3 = -1;                                    #INDICATES NO OFFS #
      IF OPCD[PST1] EQ QICFOP"SUBS" THEN
         BEGIN  #SUBS#
         I = OPN2[PST1];
         ASLONGAS I LS BI 
         AND OPCD[BI-I] EQ QICFOP"NULL" DO
            BEGIN  #NULL CHAIN# 
            OPN2[PST1] = OPN1[BI-I];
            I = OPN1[BI-I]; 
            END  #NULL CHAIN# 
  
         PCOU;                                      #PROCESS SUBSCRIPT #
         OPN2[PST1] = I;
         MPRED(BI-I,J); 
         I = OPN1[PST1];                            #GET S.T. INDEX    #
         IF I LT 0 THEN                             #CHECK FOR OFFS    #
            BEGIN  #OFFS#                           #AND PROCESS       #
            PST3 = BI - I;                          #OFFS ICFT INDEX   #
            PST2 = OPN2[PST3];                      #INITIAL OFFS VALUE#
            I    = OPN1[PST3];                      #TITM S.T. INDEX   #
            END  #OFFS# 
         GOTO PS20; 
         END  #SUBS#
  
      ELSE
      IF  OPCD[PST1] NE QICFOP"OFFS"
      AND OPCD[PST1] NE QICFOP"PFUN" THEN 
         BEGIN  #ERROR# 
         CG2ABT(J853,"BADLY FORMED ICF(POS IN CODGJ2) LINE XXXXX",42);
         GOTO PS90; 
         END  #ERROR# 
  
      # NOW CONVERTPARM AND BASED ITEM REFERENCES TO TABLE REFS        #
      # AND CALL PSTOS, AND ENTER PARCEL SAVINGS                       #
      PST3 = PST1;
      I = OPN1[PST1];                               #GET TITM STI      #
      PST2 = OPN2[PST1];                            #OFFS OF INST      #
PS20: MOTHER = I; 
      IF CKPARM[CLAS[I]] AND FPRI[I] EQ S"NAMC" 
      OR CLAS[I] EQ S"TITM" AND TTYP[MAMA[I]] EQ S"BASED" THEN
         CPBRT(PST3,PST1,MOTHER); 
  
      PSTOS;                                        #PROCESS STORE     #
  
      IF NOT FOUND THEN                             #IF STORE NOT FOUND#
         ENTRAU(MOTHER,PST2,ACSTP);                 #ENTER PARCEL SAVNG#
  
PS90: 
  
END  #POS#
  
CONTROL EJECT;
#  PSTOS -- PROCESS SYMBOL TABLE OPERAND STORE                         #
#     PSTOS INSERTS DEPENDENCY LINKS FOR STORES OF SYMBOL TABLE        #
#     OPERANDS AND TRYS TO FIND A PREVIOUS REPL OF THE SAME VARIABLE   #
#     IN THE SAME SEQUENCE THAT IT CAN REMOVE                          #
#                                                                      #
#     INPUTS --                                                        #
#        I      - SYMBOL TABLE INDEX OF OPERAND                        #
#        J      - ICFT INDEX OF INSTRUCTION THAT REDEFINES OPERAND     #
#     OUTPUT --                                                        #
#        ACSTP  - 0 - USE DIRECT ADDRESSING                            #
#               - 1 - USE INDIRECT ADDRESSING (BASED OR PARAMETER)     #
#               - 2 - USE DBL IND ADDRESSING (BASED PARAMETER)         #
#        FOUND  - TRUE IF STORE WAS LINKED TO A PREVIOUS STORE         #
#                                                                      #
#     NOTE THAT THIS ROUTINE CONSIDERS EVERYTHING LOCAL EXCEPT         #
#        P-FUNCTIONS OR BADLY BEHAVED GLOBALS OR CALL BY REFERENCE     #
#        PARAMETERS                                                    #
#     NOTE THAT IN THIS CONTEXT LPS,LGS, AND LAS REFER TO THE LAST     #
#        BADLY BEHAVED STORE OF THAT TYPE                              #
#                                                                      #
  
PROC PSTOS; 
BEGIN   #PSTOS# 
  
      # THIS LITTLE ROUTINE HANDLES ALL THE MESSY LITTLE DETAILS OF    #
      # REMOVING A PREVIOUS REPL (WHOSE ADDRESS IS IN T1)              #
      PROC REMOVE;
         BEGIN  #REMOVE#
  
         $BEGIN 
         DB("(9X,21HREMOVE(IN PSTOS)  T1=O6)",T1,".");
         $END 
  
         FOUND = TRUE;                              #SET FOUND FLAG    #
         OPCD[T1] = QICFOP"NULL";                   #SET OPCD = NULL   #
         OPN1[T1] = OPN2[T1];                       #MOVE OPN2 OVER    #
         OPN2[T1] = BI - J;                         #NEW OPN2 IS LINK  #
  
         # NOW DECR REFCT OF LOAD REFERENCED BY THE REPL WE REMOVED    #
         IF OPN1[T1] LT 0 THEN
            BEGIN  #REDUCE OPN2#
            T4 = BI - OPN1[T1]; 
            IF REFCT[T4] LE 1 
               THEN REFCT[T4] = 0;
               ELSE REFCT[T4] = REFCT[T4] - 1;
            UCISR[T4] = 0;                          #RESET CISR BITS   #
            END  #REDUCE OPN2#
  
         END  #REMOVE#
  
CONTROL EJECT;
  
      CLASS = CLAS[I];
      IF  CKUSES[CLASS] 
      AND LSEQ[I] NE SEQ THEN                       #USES LIST INVALID #
         BEGIN                                      #ACROSS A SEQUENCE # LARRY-R
         USES[I] = 0;                                                    LARRY-R
         LDST[I] = 0;                                                    LARRY-R
         END                                                             LARRY-R
      IF CLASS EQ S"TITM" 
         THEN MOTHER = MAMA[I]; 
         ELSE MOTHER = I; 
      INERT = INRT[MOTHER];                         #GET INFO FROM MOM #
      WELLBEHAVED = WELB[MOTHER]; 
      M = LSM;                                      #DEFAULT FOR WELLB #
  
      # NOW SET THE ACCESS TYPE                                        #
      ACSTP = ACSTYPE(I); 
  
  
      # NOW HANDLE THE UNBEHAVED VARIABLES                             #
  
      # UNBEHAVED VARIABLES ARE THE CLASS OF VARIABLES USED IN 1.1     #
      # THE UNBEHAVED FLAG IS TRUE IF NO WELLBEHAVED/INERT OPTIONS     #
      #    WERE USED IN THE PROGRAM AT ALL                             #
      # IF THE VARIABLE IS WELL BEHAVED, WE DO NOT WANT TO PRUNE       #
      #    GUSES OR PUSES SO WE CAN REMEMBER FURTHER BACK              #
      # IF A PARAMETER IS BY VALUE WE TREAT IT LIKE A LOCAL, SO        #
      #    THE TERM PARAMETER REFERS ONLY TO CALL BY REFERENCE HERE    #
      # NOTE THAT AN UNBEHAVED LOCAL IS TREATED AS A NON-LOCAL         #
      IF UNBEHAVED THEN 
         BEGIN  #UNBEHAVED# 
  
         # FIRST DECIDE WHERE STORE SHOULD BE LINKED BY CALCULATING M  #
         # NOTE THAT FURTHER TESTS ON M OCCUR THROUGHOUT UNBEHAVED     #
         IF CLASS EQ S"TITM" THEN 
            BEGIN  #TITMS#
            IF LAS LT M                             #DON"T LINK ACROSS #
               THEN M = LAS;                        #A BASED STORE     #
            IF TTYP[MOTHER] EQ S"BASED"             #SET LAS FOR NEW   #
               THEN LAS = BI - J;                   #BASED STORE       #
            END  #TITMS#
  
         # NOW HANDLE CASE OF PARAMETERS                               #
         # FOR PARAMETERS MAKE J A SUCCESSOR IN USES LISTS (PUSES,     #
         #   GUSES,GSTORE) AND THEN VACATE THEM SINCE AN UN-           #
         #   BEHAVED PARAMETER STORE IS MOST LIKELY TO DO HARM         #
         IF  CKPARM[CLASS]
         AND FPRI[MOTHER] EQ S"NAMC" THEN 
            BEGIN  #PARAMETER PROCESSING# 
            LSTPRD(PUSES,J);                        #PRUNE USES LISTS  #
            LSTPRD(GUSES,J);
            LSTPRD(GSTORE,J); 
            VACATTE(PUSES); 
            VACATTE(GUSES); 
            VACATTE(GSTORE);
            LSTADD(PUSES,J);                        #SHOW STORE AS USE #
            IF LPS LT M                             #REFINE M          #
               THEN M = LPS;
            IF LGS LT M 
               THEN M = LGS;
            LPS = BI - J;                           #UPDATE LAST STORE #
            END  #PARAMETER PROCESSING# 
  
         # HERE IF PROCESSING A GLOBAL  - ADD J TO GLOBALS LIST AND    #
         #   MAKE J A SUCCESSOR OF PUSES SINCE PARAMETERS CAN INTERACT #
         #   WITH GLOBALS.  DO NOT EMPTY PUSES SINCE ALL GLOBAL STORES #
         #   HAVE THE SAME PUSES PREDECESSORS AND HAVE NO LINKS        #
         #   BETWEEN THEMSELVES BECAUSE THEY DO NOT INTERACT.          #
  
         ELSE 
         IF XTRN[I] NQ S"LOC"                       #COMMON OR EXTERNAL#
            OR MEP NE SCPN[SBEG[I]]                 #NOT CURRENT SCOPE #
         THEN 
            BEGIN  #GLOBAL PROCESSING#
            LSTPRD(PUSES, J);                       #LINK IN PARM USES #
            LSTADD(GSTORE,J); 
            IF LPS LT M                             #REFINE M          #
               THEN  M = LPS; 
            LGS = BI - J;                           #UPDATE LAST STORE #
            END  #GLOBAL PROCESSING#
         END  #UNBEHAVED# 
  
  
      # BEHAVED VARIABLES                                              #
  
      # SINCE BADLYBEHAVED VARIABLES INTERACT WITH ANY OTHER BB        #
      # VARIABLES, ONLY THE LAST BB STORE IS REMEMBERED (IN LBS)       #
      ELSE
         BEGIN  #BEHAVED# 
         IF NOT WELLBEHAVED THEN
            BEGIN  #BADLYBEHAVED# 
            IF LBS LT M                             #LINK TO OLD LBS   #
               THEN M = LBS;
            LBS = BI - J;                           #SET NEW LBS       #
            END  #BADLYBEHAVED# 
         END  #BEHAVED# 
  
  
      # LINK THE STORE IN PREDECESSOR CHAIN AND SET SYMTAB FIELDS      #
      MPRED(J,NSM); 
      MPRED(BI-M,J);
      AT[J] = ACSTP;
      TSYM[J] = MARKCTR;                            #(FOR SCALARS)     #
      IF CKUSES[CLASS] THEN                                              LCMISC 
         BEGIN  #NORMAL#                                                 LCMISC 
         IF  USES[I] EQ 0                                                LCMISC 
         AND LDST[I] NQ 0 THEN                                           LCMISC 
            MPRED(BI-LDST[I],J);                    #LINK TO PARM INIT # LCMISC 
         END  #NORMAL#                                                   LCMISC 
      ELSE                                                               LCMISC 
         BEGIN  #ODD STUFF#                                              LCMISC 
         IF LASTODDSTUFF NQ 0 THEN                  #LINK ALL ODDSTUFF # LCMISC 
            MPRED(BI-LASTODDSTUFF,J);                                    LCMISC 
         LASTODDSTUFF = BI - J;                                          LCMISC 
         END  #ODD STUFF#                                                LCMISC 
  
      # HANDLE P-FUNCTIONS  -  EVERYTHING OUTSTANDING IN THAT ARRAY    #
      #   MUST PRECEDE THE P-FUNCTION                                  #
      # NOTHING MUST BE REMEMBERED PAST P-FUNC - VACATE USES LISTS     #
      #    AND NOTE THAT NOTHING IS ENTERED INTO THE LISTS             #
      # NOTE THAT "TABL" IS ASSUMED TO BE A PFUN, BUT THAT THE ACTUAL  #
      #   PFUN OPERATOR IS NOT CHECKED FOR                             #
      IF CLASS EQ S"TABL" THEN
         BEGIN  #P-FUNCTION#
         # NOTE THAT THE TABL AND ALL TITMS ARE PROCESSED              #
         # AND  THAT THE NEXT USE OF ANY BASED TITM AUTOMATICALLY      #
         #   LINKS TO THIS STORE VIA THE LDST MECHANISM                #
         IF ACSTP GT QAT"LCM" THEN                                       LARRY-R
            AT[J] = LOCACS[AT[J]];                  #LOWER AT FOR PFUNC# LARRY-R
         Z = I; 
         W = BABY[I]; 
         LSTPRD(USES[I],J);                         #LINK ALL USES IN  #
         ASLONGAS Z NE 0 DO                         #LOOP ON TITM CHAIN#
            BEGIN  #TITM CHAIN# 
            VACATTE(USES[Z]);                       #VACATE USES LIST  # LARRY-R
            L = 0;                                                       LARRY-R
            LSTADD(L,J);                                                 LARRY-R
            USES[Z] = L;                            #PUT PFUNC ON USES # LARRY-R
            LDST[Z] = BI - J;                       #MARK REPL FOR ALL #
            LSEQ[Z] = SEQ;                          #AND SHOW THIS SEQ #
            Z = W;                                  #GET NEXT TITM     #
            W = ASEQ[Z];
            END  #TITM CHAIN# 
  
         ADDARRY(I);                                                     LCMISC 
         # TELL ENTRAU ITS A REPL INTO A PFUN ONLY IF OCCURENCE IS IN  #
         # FIRST SUBSEQUENCE(MARKCTR=0). IF OCCURENCE IS NOT IS FIRST  #
         # SUBSEQUENCE THEN IT MIGHT BE IN A SECTION OF CONDITIONALLY  #
         # EXECUTED CODE. IN THAT CASE WE DO NOT WANT A DRV INSTEAD OF #
         # A BRAI.                                                     #
         IF MARKCTR EQ 0 THEN RPFN = TRUE;
         FOUND = FALSE;      #WE DON"T REMOVE PFUNS#
         GOTO STS90;                                #FINISHED FOR PFUNC#
         END  #P-FUNCTION#
  
      # END OF MAINLINE PROCESSING                                     #
      # GOTO SCALAR PROCESSING FOR DATA, LOOP, OR TEMP                 #
      IF DLAT[CLASS] THEN 
         GOTO CHKDUPSCALAR; 
      IF CLASS EQ S"TITM" THEN
         GOTO CHKDUPARRAY;
  
$BEGIN
DB("(9X,29HUNEXPECTED OPERAND FOR STORE= A4)", BCDCLASS[CLASS], "."); 
$END
      CG2ABT(J854,"UNEXPECTED OPERAND FOR STORE(PSTOS IN CODGJ2) LINE XX
XXX", 56);
      GOTO STS90;                                   #ABNORMAL EXIT     #
  
  
CHKDUPARRAY:  
      # CHECK TO SEE IF THIS ARRAY STORE IS A DUPLICATE                #
      #   IF IT IS, THEN REMOVE THE PREVIOUS STORE                     #
      L = USES[I];                                  #HEAD OF USES LIST #
      FOUND = FALSE;
      T3 = BI - OPN1[J];                            #ADDR OF OFFS/SUBS #
      IF T3 LT 0 THEN                                                    LCMISC 
         BEGIN  #STRANGE ICF#                                            LCMISC 
         IINST(QICFOP"OFFS",I,0);                   #OFFS IS NOT PRESNT# LCMISC 
         T3 = K;                                                         LCMISC 
         OPN1[J] = BI - K;                                               LCMISC 
         END  #STRANGE ICF#                                              LCMISC 
      ASLONGAS L NE 0 AND NOT FOUND DO
         BEGIN  #USES LIST SCAN#
  
         # SCAN DOWN USES LIST TO FIND A DUPLICATE STORE               #
         T1 = BI - LISTI[L];                        #ICFT OF USE       #
         T2 = BI - OPN1[T1];                        #OFFS/SUBS OF USE  #
         IF OPCD[T1] EQ QICFOP"REPL" THEN 
            BEGIN  #FURTHER SEARCH# 
  
            # FIRST LINK THIS STORE BEFORE FURTHER SEARCH              #
            #   THEN CHECK LIST OF QUALITIES FOR A MATCH. NOTE         #
            #   WE DON"T RISK REMOVING A STORE ACROSS ANY JUMP         #
            MPRED(T1,J);
            BOFFS = OPN1[T3] LT 0                   #TRUE IF BOTH OFFS #
                    AND OPN1[T2] LT 0;
            IF  OPCD[T2] EQ OPCD[T3]                #OPCD"S EQUAL      #
            AND OPN2[T2] EQ OPN2[T3]                #OPERANDS EQUAL    #
            AND BI - M LE T1                        #NO INTERMED STORES#
            AND MRKS[T1] EQ MRKS[J]                 #SAME SUBSEQUENCE  #
            AND (NOT BOFFS AND (OPN1[T3] GT 0       #AND IF ONE IS OFFS#
                           AND  OPN1[T2] GT 0)      #THEN BOTH MUST BE #
                 OR  BOFFS AND (OPN2[BI-OPN1[T3]]   #THE SAME OFFS     #
                           EQ   OPN2[BI-OPN1[T2]]) )
            THEN
                  BEGIN  #REMOVE# 
  
                  # WE HAVE FINALLY FOUND A STORE WE CAN REMOVE        #
                  # FIRST MAKE PREVIOUS REPL NULL AND FIX OPERANDS     #
                  REMOVE; 
$BEGIN
DB("(9X12HARRY-REPL J=O6,4H T2=O6,6H ICFT=O20)",J,T2,ICFW0[J],"."); 
$END
                  IF OPCD[T2] EQ QICFOP"SUBS" THEN  #REDUCE REF COUNT  #
                     BEGIN  #REDUCE#                #OF SUBS INDEX     #
                     T5 = BI - OPN2[T2];
                     IF REFCT[T5] LE 1
                        THEN REFCT[T5] = 0; 
                        ELSE REFCT[T5] = REFCT[T5] - 1; 
                     END  #REDUCE#
                  END  #REMOVE# 
            END  #FURTHER SEARCH# 
  
         L = LISTL[L];                              #GET NEXT LIST MEMB#
         END  #USES LIST SCAN#
      # IF ACCESS TYPE IS INDIRECT THEN PROCESS OLD CHAINS IF USES     #
      # LIST NON-EMPTY.                                                #
      IF ACSTP GT QAT"LCM" THEN 
         BEGIN
               IF USES[MOTHER] NQ 0 THEN OLDCHAINS; 
               IF FOUND THEN   # A PREVIOUS REPL WAS NULLED OUT        #
                  BEGIN # LINKOUT # 
                  LINKOB(T1); # REMOVE NULLED REPL FROM BASE AND       #
                  LINKOBS(T1); # BASE-PLUS-SUBSCRIPT CHAINS            #
                  END # LINKOUT # 
         END
  
  
      # NOW CHECK THE USES LIST AND MAKE ALL ENTRIES PREDECESSORS OF J #
      # AFTER WHICH THE USES LIST IS EMPTIED                           #
      # NOTE THAT ONLY TITMS ARE SEARCHED - NOT THE TABL               #
      # SINCE THE USES SHOWS ALL USES FOR THE SINK WE NEED TO LSTPRD   #
      #   ONLY ONE LIST                                                #
      LSEQ[MOTHER] = SEQ;                           #VALIDATE TABL USES#
      L = USES[MOTHER]; 
      LSTPRD(L,J);                                  #LINK IN PREV USES #
      LSTADD(L,J);                                  #ADD USE TO TABL   #
      USES[MOTHER] = L; 
      W = BABY[MOTHER];                             #GET FIRST TITM    #
      ASLONGAS W NE 0 DO
         BEGIN  #SCAN TITM CHAIN# 
  
         #SCAN TITM USES LISTS AND EMPTY APPROPRIATE LISTS             #
         #NOTE THAT FOR INERT ARRAYS ONLY ITEMS SHARING THE ONE        #
         #  COMMON SINK ARE INVOLVED IN ANY OF THESE CHECKS            #
         IF NOT INERT 
         OR LOCN[W] EQ LOCN[I] THEN 
            BEGIN  #PROCESS USES LIST#
  
            VACATTE(USES[W]); 
            L = 0;                                  #EMPTY USES LIST   #
            IF LOCN[W] EQ LOCN[I] THEN              #ADD NEW USE ONLY  #
               LSTADD(L,J);                         #TO SAME SINK      #
            LDST[W] = BI - J; 
            LSEQ[W] = SEQ;
            USES[W] = L;
            END  #PROCESS USES LIST#
  
         # GET NEXT ENTRY FROM USES LIST                               #
         W = ASEQ[W];                               #SET NEW LINKS     #
         END  #SCAN TITM CHAIN# 
  
      ADDARRY(MOTHER);                              #ADD ARRAY USE     #
      GOTO STS90;                                   #FINISHED FOR ARRAY#
  
  
CHKDUPSCALAR: 
      # CHECK FOR DUPLICATE SCALAR REPL"S                              #
      # NOTE THAT THE TECHNIQUE FOR SCALARS IS ANALAGOUS TO            #
      #   THE METHOD USED FOR FINDING DUPLICATES FOR ARRAYS            #
      L = USES[I];
      FOUND = FALSE;
      ASLONGAS L NE 0 AND NOT FOUND DO
  
         BEGIN  #USES SCAN# 
         T1 = BI - LISTI[L];                        #GET NEXT USE      #
         IF  OPCD[T1] EQ QICFOP"REPL"               #IF OPCD IS REPL   #
         AND OPN1[J] EQ OPN1[T1]                    #AND USE NOT SUBS  #
         AND BI - M LE T1                           #NO INTERMED STORES#
         AND LSEQ[I] EQ SEQ                         #AND USE IN SEQ    #
         AND MRKS[T1] EQ MRKS[J]                    #SAME SUBSEQUENCS  #
         THEN 
            BEGIN  #REMOVE# 
  
            #REMOVE THE PREVIOUS REPL                                  #
$BEGIN
DB("(9X12HSCLR-REPL J=O6,4H T2=O6,6H ICFT=O20)",J,T1,ICFW0[J],"."); 
$END
            REMOVE; 
            END  #REMOVE# 
  
         L = LISTL[L];                              #GET NEXT TITM     #
         END  #USES SCAN# 
                                                                         SMP0088
      # MARK ALL PREVIOUS USES IN THE SAME SUBSEQUENCE TO SHOW THAT    # SMP0088
      # THIS LOAD CANNOT BE DROPPED SAFELY AND REINSERTED              # SMP0088
      IF CKUSES[CLASS] THEN                                              SMP0088
         BEGIN  #SCAN#                                                   SMP0088
         T1 = USES[I];                                                   SMP0088
         ASLONGAS T1 NQ 0 DO                                             SMP0088
            BEGIN  #USES LIST#                                           SMP0088
            T2 = BI - LISTI[T1];                                         SMP0088
            IF MRKS[T2] EQ MRKS[J] THEN                                  SMP0088
               RLISS[T2] = TRUE;                                         SMP0088
            T1 = LISTL[T1];                                              SMP0088
            END  #USES#                                                  SMP0088
         END  #SCAN#                                                     SMP0088
  
      # NOW MAKE ALL ENTRIES IN THE USES LIST PREDECESSORS OF J        #
      # THEN VACATE THE LIST AND START A NEW ONE WITH THE REPL         #
      # USES FOR LONG STRINGS IS SLIGHTLY DIFFERENT - THE USES         # LARRY-R
      #   LIST MAY CONTAIN MULTIPLE REPLS (FOR DIFFERENT OFFSETS INTO  # LARRY-R
      #   THE STRING) - THE ENTIRE LIST IS VACATED AS USUAL WHEN A     # LARRY-R
      #   REPL IS FOUND FOR A SINK ALREADY ON THE LIST                 # LARRY-R
      # THE FLAG "FIRST" IS USED FOR LONG STRINGS TO DETERMINE IF SINK # LARRY-R
      #   IS ALREADY ON LIST AND OUTSIDE OF STRINGS TO INDICATE IF     # LARRY-R
      #   LIST SHOULD BE VACATED OR NOT                                # LARRY-R
      FIRST = T;                                    #SET FLAG          # LARRY-R
      IF  CLASS EQ S"DATA"                          #LOOK FOR LONG STR # LARRY-R
      AND TYPE[I] EQ QTYPE"EBCD"                                         LARRY-R
      AND NBYT[I] GR 10                                                  LARRY-R
      AND USES[I] NQ 0 THEN                         #FIRST USE IS NORML# LARRY-R
         BEGIN  #LONG STRINGS#                                           LARRY-R
         L = USES[I];                                                    LARRY-R
         T3 = BI - OPN1[J];                         #OFFS/SUBS OF J    # LARRY-R
         ASLONGAS L NE 0 DO                         #SCAN USES LIST    # LARRY-R
            BEGIN  #USES SCAN#                                           LARRY-R
            T1 = BI - LISTI[L];                     #PTR TO USE        # LARRY-R
            T2 = BI - OPN1[T1];                     #OFFS/SUBS OF USE  # LARRY-R
            IF  OPCD[T1] EQ QICFOP"REPL"            #LOOK FOR REPLS    # LARRY-R
            AND (T2 EQ T3                           #NO OFFS/SUBS      # LARRY-R
                OR (  T2 GQ 0                                            LARRY-R
                  AND T3 GQ 0                                            LARRY-R
                  AND OPCD[T2] EQ OPCD[T3]          #BOTH OFFS OR SUBS # LARRY-R
                  AND OPN2[T2] EQ OPN2[T3])) THEN   #AND SAME OFFS/SUBS# LARRY-R
                     FIRST = F;                     #SAME REPL ON LIST # LARRY-R
            L = LISTL[L];                           #GET NEXT USE      # LARRY-R
            END  #USES SCAN#                                             LARRY-R
                                                                         LARRY-R
         IF FIRST THEN                              #NOT ON LIST = ADD # LARRY-R
            BEGIN  #ADD USE#                                             LARRY-R
            L = USES[I];                                                 LARRY-R
            LSTADD(L,J);                                                 LARRY-R
            USES[I] = L;                                                 LARRY-R
            END  #ADD USE#                                               LARRY-R
         FIRST = NOT FIRST;                         #RESET FOR VACATING# LARRY-R
         END  #LONG STRINGS#                                             LARRY-R
                                                                         LARRY-R
      IF  CKUSES[CLASS]                             #VACATE LIST       # LARRY-R
      AND FIRST THEN                                                     LARRY-R
         BEGIN  #UPDATE USES INFO#
         LSTPRD(USES[I],J); 
         VACATTE(USES[I]);
         L = 0; 
         LSTADD(L,J); 
         USES[I] = L;                               #NEW USES LIST     #
         RICS[I] = TRUE;                            #REDEFINED IN SEQ  #
         LSEQ[I] = SEQ;                             #USED IN SEQ       #
         LDST[I] = BI - J;                          #AND STORED IN SEQ #
         END  #UPDATE USES INFO#
  
  
STS90:  
$BEGIN
DB("(9X,9HPSTOS  I= O6,4H  J= O6,4H  M= O6,5H  AT= O1,8H  FOUND= O1,
     8H  CLASS= A4)", I,J,M,ACSTP,FOUND,BCDCLASS[CLASS], ".");
$END
END   #PSTOS# 
  
CONTROL EJECT;
XDEF PROC INTERRUPT;
PROC INTERRUPT; 
BEGIN  #INTERRUPT#
  
#     THIS PROC CAN BE INVOKED TO STOP THE SCHEDULING MECHANISM        #
#                                                                      #
#     IT IS PRIMARILY INTENDED FOR MPRED TO MAKE CG2 WELLBEHAVED       #
  
END  #INTERRUPT#
CONTROL EJECT ;                                                          NODUPLI
        XDEF PROC NODUPL ;                                               NODUPLI
PROC NODUPL;       #CALLED TO FIND A DUPLICATE ICF ENTRY TO THE ONE (A)  NODUPLI
                    BEING INSERTED. IF ONE IS FOUND (B) THEN REPLACE     NODUPLI
                    OPERATOR OF A BY NULL AND OPERAND 1 OF A TO LINK TO  NODUPLI
                    B. A BECOMES A SUCCESSOR OF B#                       NODUPLI
   BEGIN                                                                 NODUPLI
  ITEM MYOPN,MYOPRNS;                                                    NODUPLI
          ITEM JK,MYENTRY,LSEQA;                                         NODUPLI
     JK = J;                                                             NODUPLI
  MYOPN=OPCD[J]; MYOPRNS = OPN12[J];                                     NODUPLI
NEXTS:                                                                   NODUPLI
   JK = BOL[JK];       #SEARCH DOWN BOL CHAIN #                          NODUPLI
            IF MRKS[JK] EQ 64 THEN RETURN;  #DONT PASS LABELS#           NODUPLI
            IF MRKS[JK] NQ MRKS[FOL[JK]] THEN   #WHAT BROKE THAT SEQUEN# NODUPLI
                        IF NOT CONDITJMP [OPCD[JK] ] THEN RETURN;        NODUPLI
  IF MYOPN EQ  OPCD[JK] AND MYOPRNS EQ OPN12[JK]                         NODUPLI
      THEN                                                               NODUPLI
                                      # HAVE FOUND A LIKELY ENTRY --     NODUPLI
                                           AND ITS AVAILABLE#            NODUPLI
                                BEGIN                                    NODUPLI
          IF J EQ JK THEN RETURN;    #GOT ITSELF#                        NODUPLI
   $BEGIN                                                                NODUPLI
 DB ("( 9X9HDUPL  *J=O6,4H JK O6,7H ICFW0=O20)",J,JK,ICFW0[J],".");      NODUPLI
   $END                                                                  NODUPLI
                      OPCD [J] = QICFOP "NULL" ;                         NODUPLI
   IF OPN1 [J] LT 0 THEN                                                 NODUPLI
          REFCT[ BI - OPN1[J] ] = REFCT[ BI - OPN1[J] ] - 1 ;            NODUPLI
   IF OPN2 [J] LT 0 THEN                                                 NODUPLI
          REFCT[ BI - OPN2[J] ] = REFCT[ BI - OPN2[J] ] - 1 ;            NODUPLI
                     OPN1 [ J] = BI - JK;                                NODUPLI
                     OPN2[J] = 0 ;                                       NODUPLI
                   MPRED (JK , J);                                       NODUPLI
                     RETURN;                                             NODUPLI
                                END                                      NODUPLI
   IF BOL[JK] NE -1 THEN GOTO NEXTS;                                     NODUPLI
   END #NODUPL#                                                          NODUPLI
  
CONTROL EJECT;
                                                                         CGYYY
#**********************************************************************# CGYYY
                                                                         CGYYY
       PROC RELOAD (I);                                                  CGYYY
                                                                         CGYYY
#          RELOAD A TEMPORARY WHICH GOT SAVED IN A PREVIOUS SEQUENCE#    CGYYY
                                                                         CGYYY
         BEGIN                                                           CGYYY
         ITEM X;                                                         CGYYY
         ITEM I,M;                                                       CGYYY
                                                                         CGYYY
         IF I LS 0 THEN                                                  CGYYY
         I = FTEMP (I);           # FIND THE TEMP CONTAINING SAVED VAL#  CGYYY
         TLUS[I] = TRUE;                                                 CGYYY
         IF CLAS[I] EQ S"CONS" THEN                                      CGYYY
           BEGIN                                                         CGYYY
           X = CONL[I];                                                  CGYYY
           IINST ( COPC[X] , I, 0);                                      CGYYY
           KDES[K] = C1NL[I] * 64+ C2NL[I] ;                             CGYYY
           IF COPC[X] EQ QICFOP"MASK" THEN                               CGYYY
             OPN1[K] = C1NL[I];                                          CGYYY
           END                                                           CGYYY
         ELSE                                                            CGYYY
         IINST ( QICFOP"LOAD" ,I, 0 );                                   CGYYY
         REFCT[K] =1;                                                    CGYYY
         M = K;                                                          CGYYY
         MPRED ( -1 , M );                                               CGYYY
         MPRED ( M , J );                                                CGYYY
         IINST ( QICFOP"REPL" , 0 , BI-K );                              CGYYY
         MPRED ( M , K );                                                CGYYY
                 # GIVE BDT57  SOMETHIG TO OVERWRITE  #                  CGYYY
         END                                                             CGYYY
  
   CONTROL EJECT;                                                        CGYYY
                                                                         CGYYY
#**********************************************************************# CGYYY
                                                                         CGYYY
 PROC SHORTBLD (I);                                                      CGYYY
                                                                         CGYYY
  #  IF I GENERATES A CONSTANT LOAD VIA MASK,MSKL,MSKC --                CGYYY
     THEN TRANSFORM BACK TO LDSC --                                      CGYYY
     ITS QUICKER FOR A B REGISTER LOAD TO DO LDSC                      # CGYYY
                                                                         CGYYY
     BEGIN                                                               CGYYY
       ITEM I , CONS , J, KK;                                            CGYYY
     DEF BYTNWD #10# ;    #BYTES PER WORD  #                             CGYYY
     DEF ONES #O"77777777777777777777"#;                                 CGYYY
                                                                         CGYYY
         J = OPN1[I];                                                    CGYYY
         KK = OPN2[I];                                                   CGYYY
       CONS =0; 
  
       IF OPCD[I] EQ QICFOP"MSKL" THEN
           BEGIN
         IF J EQ KK THEN
           B< 60-J , J> CONS = ONES;
         ELSE 
  
         IF J LS KK THEN
           B< 60-KK , J> CONS = ONES; 
         ELSE 
         BEGIN
           CONS = ONES; 
           B< J-KK , 60-J> CONS =0; 
           END
         END  #MSKL#
     ELSE                                                                CGYYY
       IF OPCD[I] EQ QICFOP"MSKC" THEN                                   CGYYY
         B< J , 60-J > CONS = ONES;                                      CGYYY
       ELSE                                                              CGYYY
         IF OPCD[I] EQ QICFOP"MASK"                                      CGYYY
         AND J NQ 0 THEN                                                 CGYYY
           B< 0 , J> CONS = ONES ;                                       CGYYY
                                                                         CGYYY
         ELSE                                                            CGYYY
             # NONE OF THESE  #                                          CGYYY
           RETURN;                                                       CGYYY
                                                                         CGYYY
       # HAVE CALCULATED CONSTANT  -  ITS ONLY 18 BITS LONG  #           CGYYY
       # NOW POST IT IN THE SYMBOL TABLE #                               CGYYY
                                                                         CGYYY
     PNAM ( CONS , BYTNWD , KK );   # FIND NAME ENTRY  #                 CGYYY
                                                                         CGYYY
     POST ( KK , CONS$W , J);    # POST NEW ENTRY FOR CONS #             CGYYY
                                                                         CGYYY
     CLAS[J] = S"CONS";                                                  CGYYY
     TYPE[J] = S"IGR";                                                   CGYYY
     SIGN[J] = TRUE;                                                     CGYYY
     NBIT[J] = 18;                                                       CGYYY
     FBIT[J] = 42;                                                       CGYYY
                                                                         CGYYY
                                                                         CGYYY
     IINST ( QICFOP"LDSC" , J ,0);                                       CGYYY
     REFCT[K] =1;                                                        CGYYY
     I =K;   # WHERE IINST PUT THE INSTRUCTION#                          CGYYY
                                                                         CGYYY
      RETURN;                                                            CGYYY
     END                                                                 CGYYY
                                                                         CGYYY
      CONTROL EJECT;
      XDEF PROC OLDCHAINS;
      PROC OLDCHAINS; 
#**********************************************************************#
#                                                                      #
#     OLDCHAINS                                                        #
#                                                                      #
#     PURPOSE-                                                         #
#         LINKS J-TH ICFT ENTRY INTO BASE CHAIN, THE LAST LINK OF      #
#         WHICH IS POINTED TO BY LAST ENTRY ON USES LIST FOR MOTHER.   #
#         THEN SEARCHES DOWN BASE CHAIN LOOKING FOR EITHER (1)         #
#         MATCHING OFFS OR PFUN(NO SUBSCRIPTS IN EITHER CASE) OR (2)   #
#         MATCHING SUBSCRIPTS(OFFSETS NEED NOT MATCH). IF IT FINDS (1) #
#         OR (2) ABOVE J-TH ICFT ENTRY IS LINKED INTO BASE+SUBSCRIPT   #
#         CHAIN. OTHERWISE BASE+SUBSCRIPT CHAIN IS LEFT UNCHANGED,     #
#         I.E. POINTING TO ITSELF.                                     #
#                                                                      #
#     TEMP STORAGE-                                                    #
#         ITEMS L,X,Y,Z IN COMMON BLOCK COM88                          #
#                                                                      #
#**********************************************************************#
  
      BEGIN # OLDCHAINS # 
      Y = BI - LISTI[USES[MOTHER]]; # ICFT INDEX OF LAST USE           #
  
      # MOVE POINTER(TO FIRST LINK IN BASE CHAIN) FROM PREVIOUS LAST   #
      # LINK TO NEW LAST LINK.                                         #
      BCHN[J] = BCHN[Y];
  
      # SET PREVIOUS LAST LINK TO POINT TO NEW LAST LINK               #
      BCHN[Y] = J;
  
  
      $BEGIN
      DB("(9X,13HOLDCHAINS  J=O6,9H  MOTHER=O6, 
      25H  BI-LISTI[USES[MOTHER]]=O6)",J,MOTHER,Y,"."); 
      $END
  
      L = BCHN[J]; # START WITH L = ICFT INDEX OF FIRST BASE CHAIN LINK#
      X = BI-OPN1[J]; # ICFT INDEX OF INST. POINTED TO BY OPERAND 1    #
      Z = OPCD[X]; # OP CODE OF INST. POINTED TO BY OPERAND 1          #
  
      # BEGINNING WITH THE FIRST LINK IN THE BASE CHAIN, AND MOVING    #
      # DOWN THE CHAIN LINK BY LINK, LOOK FOR A MATCHING OFFSET OR PFUN#
      #(NO SUBSCRIPT IN EITHER CASE)  OR A MATCHING SUBSCRIPT(OFFSETS  #
      # NEED NOT MATCH).                                               #
      # IF A MATCH IS FOUND, THEN THE BASE+SUBSCRIPT LINK FOR J IS SET #
      # TO POINT TO THE LAST LINK OF THE BASE+SUBSCRIPT CHAIN OF THE   #
      # MATCHING OFFSET OR SUBSCRIPT. IF A MATCH IS NOT FOUND, THEN    #
      # BASE+SUBSCRIPT CHAIN IS LEFT UNCHANGED.                        #
  
      ASLONGAS L NQ J DO # L=J SIGNIFIES END OF CHAIN, HENCE NO MATCH  #
      BEGIN # SEARCH BASE CHAIN LOOP #
          Y = BI-OPN1[L]; # ICFT INDEX OF INST. POINTED TO BY OPERAND 1#
          IF((Z EQ QICFOP"OFFS" OR Z EQ QICFOP"PFUN") AND 
            (OPCD[Y] EQ QICFOP"OFFS" OR OPCD[Y] EQ QICFOP"PFUN")) OR
            ((Z EQ QICFOP"SUBS" AND OPCD[Y] EQ QICFOP"SUBS") AND
            (OPN2[X] EQ OPN2[Y])) 
          THEN GOTO MATCH;
          L = BCHN[L]; # NO MATCH, SO MOVE TO NEXT LINK                #
      END # SEARCH BASE CHAIN LOOP #
  
      # WE HAVE EXAMINED ALL LINKS IN THE BASE CHAIN AND A MATCHING    #
      # OFFSET OR SUBSCRIPT HAS NOT BEEN FOUND.                        #
      RETURN; 
  
MATCH:  
  
      Z = L; # Z = FIRST LINK IN BASE+SUBSCRIPT CHAIN                  #
      #  MOVE DOWN BASE+SUBSCRIPT CHAIN LINK BY LINK UNTIL WE ARE AT   #
      # END OF CHAIN.                                                  #
      ASLONGAS BSCHN[L] NQ Z  DO L = BSCHN[L];
      BSCHN[J] = Z; #SET BASE+SUBSCRIPT CHAIM TO POINT TO FIRST LINK   #
  
      # SET PREVIOUS LAST LINK IN BASE+SUBSCRIPT CHAIN TO POINT TO NEW #
      # LAST LINK.                                                     #
      BSCHN[L] = J; 
  
      END # OLDCHAINS # 
      CONTROL EJECT;
      XDEF PROC LINKOB; 
      PROC LINKOB((I)); 
#**********************************************************************#
#     LINKOB - LINK OUT FROM BASE CHAIN                                #
#                                                                      #
#     PURPOSE-                                                         #
#         LINKS AN ENTRY OUT OF THE BASE ONLY CHAIN.  IF THIS ENTRY IS #
#         THE ONLY ENTRY ON THE CHAIN, NOTHING IS DONE.                #
#                                                                      #
#     INPUT-                                                           #
#         I = ICFT INDEX OF ENTRY TO REMOVE FROM CHAIN.                #
#                                                                      #
#     OUTPUT-                                                          #
#         NONE                                                         #
#**********************************************************************#
  
  
      BEGIN 
      ITEM I;                #ENTRY TO REMOVE FROM CHAIN# 
      ITEM J;                #PREDECESSOR OF I ON CHAIN#
  
      $BEGIN
      DB("(9X,10HLINKOB  I=O6)",I,"."); 
      $END
  
      FOR J = I WHILE I NQ BCHN[J] DO    #NOTICE- CAN"T BE FASTLOOP#
          J = BCHN[J];       #LOOP FINDS PRED OF I ON CHAIN#
  
      BCHN[J] = BCHN[I];     #LINK I OUT OF CHAIN#
      END 
CONTROL EJECT;
      XDEF PROC LINKOBS;
      PROC LINKOBS((I));
#**********************************************************************#
#     LINKOBS - LINK OUT FROM BASE+SUBS CHAIN                          #
#                                                                      #
#     PURPOSE-                                                         #
#         LINKS AN ENTRY OUT OF THE BASE+SUBS CHAIN.  IF THIS ENTRY IS #
#         THE ONLY ENTRY ON THE CHAIN, NOTHING IS DONE.                #
#                                                                      #
#     INPUT-                                                           #
#         I = ICFT INDEX OF ENTRY TO REMOVE FROM CHAIN.                #
#                                                                      #
#     OUTPUT-                                                          #
#         NONE                                                         #
#**********************************************************************#
  
  
      BEGIN 
      ITEM I;                #ENTRY TO REMOVE FROM CHAIN# 
      ITEM J;                #PREDECESSOR OF I ON CHAIN#
  
      $BEGIN
      DB("(9X,11HLINKOBS  I=O6)",I,".");
      $END
  
      FOR J = I WHILE I NQ BSCHN[J] DO    #NOTICE- CAN"T BE FASTLOOP# 
          J = BSCHN[J];       #LOOP FINDS PRED OF I ON CHAIN# 
  
      BSCHN[J] = BSCHN[I];   #LINK I OUT OF CHAIN#
      END 
END # CODGJ2 #                                                           CODGJ2 
  
 TERM                                                                    CODGJ2 
