*DECK     GRA 
          IDENT  GRA
 GRA      TITLE  GRA - GLOBAL REGISTER ASSIGNMENT 
*CALL     SSTCALL 
 B=GRA    RPVDEF
*IF       DEF,GRA,1 
          TRACER (UDT,SEE,MTA,DXA,MFA,CLB,SUP,SXC)
 GRA      SPACE  2
**        GRA - GLOBAL REGISTER ASSIGNMENT
* 
*         S. I. JASIK - CDC - SUNNYVALE - SPRING 74 
* 
*         *GRA* IS CALLED BY *GPO* TO ASSIGN REGISTERS ACCROSS THE
*         BODY OF A LOOP AND SETUP APPROPIATE INITIALIZATION CODE.
* 
*         OPTIMIZATIONS PERFORMED BY *GRA* INCLUDE -
*         LOAD/STORE MOTION OF SCALAR VARIABLES AND CONSTANTS AND THEIR 
*         ASSIGNMENT TO REGISTERS.
*         PREFETCHING OF INDEXED LOADS ON THE CRITICAL PATH IN SMALL
*         INNERMOST LOOPS.
*         CODE SIZE REDUCTION IN THE LOOP BODY BY ASSIGNING *SCM* 
*         ADDRESS"S AND CONSTANTS TO B-REGISTERS. 
*         INCREMENT REDUCTION OF *IP*"S BY ASSIGNING THE DIFFERENCE OF
*         TWO SIMILAR INTEGER POLYNOMIALS TO A B-REGISTER.
*         TEST REPLACEMENT OF THE LOOP CONTROL VARIABLE WITH A LINEAR 
*         FUNCTION OF IT WHEN POSSIBLE. 
*         REMOVAL OF INCREMENT VARIABLES WHICH HAVE NO USES.
  
**        DEBUGGING SNAP LABELS - 
* 
*         TRACER (UDT,ERC,SEE,MTA,DXA,DAA,MFA,CLB,SUP,SXC)
* 
*         BASIC SNAPS - UDT,SEE,MTA,DXA,DAA,CLB,SUP,SXC 
  
          LIST   -R 
  
          TABLES (BIT,BST,IIT,MOD,PIT,PSI,RCT,RND,RXI,SEQ,TET,TXT)
  
          EXT#   (BSI,BSW,BVL,DMASK,L.HB,N.GT,HBI,PC,SRI) 
  
 MAX.INC  EQU    101B        MAX CONSTANT INCREMENT VALUE FOR PREFETCHS 
*                          OF ARRAYS IN LABELED COMMON OR LOCAL STORAGE.
  
 BA.BIP   EQU    36 
 BA.LENP  EQU    18 
 BA.BIL   EQU    18 
 BA.LENL  EQU    18 
  
*CALL     UDTBLD
*CALL     GPOCOM
 FLAGS    TITLE  LOCAL VARIABLES
          USE    /CCGSCR/ 
 SCR      BSS    100B        *IA* LIST ( DUM - MTA ), CON LIST  ( MFA ) 
*                            AND SCRATCH FOR *BDT/MCG*
  
 F.CLC    BSS    0          ?FWA OF CLEARED CELLS 
  
 RAT      BSS    24          REGISTER ASSIGNMENT TABLE ( INITIAL VALUES 
 RVT      BSS    24          REGISTER VALUE TABLE ( R-NUMBER IN REG ) 
  
*                        ERC
 IAI      BSS    1           *IA* LIST INDEX
 TRA      BSS    1           TEMP/RJRS REG ASSIGNMENTS ( BIT MASK ) 
 APF      BSS    1           APLN BITS OF BLOCK 
 FBA      BSS    1           "0 IF FINAL B-ASSIGNMENTS FROM INNER LOOP
 LCT      BSS    1           L.RCT AT END OF *ERC*
*                        SEE
 NVC      BSS    1           N. VALUE CANIDATES 
 TUD      BSS    1           SUSE[CI]-STC[UI] FOR LOOP CV 
*                        MTA
 ABR      BSS    1           SET OF AVAIL B-REGS ( PACK(0,377B) 
 NAB      BSS    1           N. AVAILABLE B-REGS
 NTA      BSS    1           N. TENATIVE B-ASSIGNMENTS
 TRD      BSS    1           TEST REPLACEMENT DECISION
*                        DXA
 NXC      BSS    1           N. X-CANIDATES 
 XCT      BSS    5           X-REG CANIDATE TABLE 
 MLW      BSS    1           MAX REG WIDTH AFTER X-ASSIGNMENT 
*                        CMR
 N.LD     BSS    2           N. REMAINING LOADS AFTER REGISTER ASSIGNMEN
 N.ST     EQU    N.LD+1      MAX NUMBER OF ST"S IN A BLOCK
*                        DAA
 MAA      BSS    1           MAX NUMBER OF A-ASSIGNMENTS
 NAA      BSS    1           N. A-ASSIGNMENTS 
 ACT      BSS    8           A-CANIDATE TABLE 
*                            24/,18/INC PTR,18/CANIDATE INDEX ( *RCT* ) 
*                        MFA
 CL       BSS    1           CON LIST POINTER 
 NAC      BSS    1           N. ADDRESS CANIDATES 
 ATI      BSS    1           INDEX TO *AI* TABLE ( LWA+1 )
 CAIH     BSS    1           CA,IH OF BASE REGISTER 
 PMF      BSS    1           PARTIAL MODIFICATION FLAG ( LD REG+CON "S )
 CIT      BSS    5           IH CLASS INDEX TABLE 
  
 L.CLC    EQU    *-F.CLC    'LWA+1 OF CLEARED CELLS 
  
*                        SUP
 N        BSS    1           N. WDS IN POLY FORMULA 
 RR       EQU    N           R-NUMBER OF LAST RESULT
*                        CLB
 NXS      BSS    1           N. EXTRA WORDS NEEDED
 MRU      BSS    1           MACHINE REGS USED BY *MCG* 
 NPS      BSS    1           N. POST STORES 
 PST      BSS    7+4         POST STORE LIST , 24/,18/REGNO,18/*RCT* ORD
*                        IRA
 LBN      BSS    1           R1 WORD OF LAST ENCOUNTERED BOS/EOS
 DTL      BSS    1           DEF TEXT LENGTH ( BOS + DEFS + EOQ ) 
 LBJF     BSS    1           LOOP BACK JUMP ENCOUNTERED 
          USE    0
 RCT      TITLE  RCT - REGISTER CANIDATE TABLE FORMAT 
**        RCT - REGISTER CANIDATE TABLE FORMAT
* 
*         THE *RCT* IS A DICTIONARY OF ALL EXPRESSIONS ( MEMORY 
*         REFERENCES, CONSTANTS AND ADDRESS"S ) THAT ARE CANIDATES FOR
*         REGISTER ASSIGNMENT. EACH ENTRY CONSISTS OF 3 WORDS.
 CA       SPACE  2
**        CA. - FIRST WORD OF CANIDATE TABLE
  
          DESCRIBE CA.,60 
 RA       DEFINE 1           REGISTER ASSIGNED OR ADDRESS MODIFIED
 IRA      DEFINE 1           INITIAL REGISTER ASSIGNMENT ( *ERC/RS* ) 
  
*         CANIDATE TYPE 
  
 VC       DEFINE 1           VALUE CANIDATE ( NOT SET FOR CONS )
 AC       DEFINE 1           ADDRESS CANIDATE 
 CON      DEFINE 1           CANDIATE IS A CONSTANT ( FMA, SET )
 FP       DEFINE 1           IH IS AN F.P.
  
*         USEAGE
  
          DEFINE 2
 EU       DEFINE 1           EXPLICIT USEAGE IN LOOP ( CANNOT BE SUBSUME
 RF       DEFINE 1           *RF* ( SHORT ) USEAGE
 ^RD      DEFINE 1           NON RECURSIVE DEFINITION 
 IA       DEFINE 1           IA/IS USEAGE 
 TU       DEFINE 1           TEST USEAGE ( IN LOOP TERMINATION TEST ) 
  
*         PROFIT CRITERIA 
  
 PRFT     DEFINE 3           PROFIT 
 APLN     DEFINE 2           APPEARENCE IN ARTICULATION PT/LATCH NODE 
 NOCC     DEFINE 9           NUMBER OF OCCURANCES 
 SUSE     DEFINE 9           SUM( USES ) + SUM( USES(INC)-1 ) 
  
*         ENTRY/EXIT CONDITIONS 
  
 PL       DEFINE 1           PRELOAD NECESSARY
 PSP      DEFINE 1           POST STORE POSSIBLE
 DEF      DEFINE 1           DEFINED IN REGION
 USE      DEFINE 1           USED IN REGION 
 LX       DEFINE 1           LIVE ON EXIT FROM REGION 
 KD       DEFINE 1           KILL DEFS ( STORES ) 
  
 UDI      DEFINE 18          INDEX TO *UDT* 
 CAW      SPACE  2
 RAF      DEQU   IRA,2       REGISTER ASSIGNMENT FIELDS 
 CT       DEQU   CON,3       CANIDATE TYPE  ( CON,AC,VC ) 
 DU       DEQU   USE,2       DEF AND USE BITS 
 SORT     DEQU   SUSE,CA.TUP+1-CA.SUSEP  SORT FIELDS
 IH       SPACE  3,14 
**        IH. - FORMAT OF SECOND *RCT* WORD 
  
          DESCRIBE IH.,60 
 MSK      DEFINE 1           MASK FLAG
 SLV      DEFINE 5           SPECIAL LOAD VALUE ( 0/1/2 = LD/LDC,LDV )
 RF       DEFINE 18          RCT INDEX OF *RF* OF REFERENCE 
 CA       DEFINE 18          BIAS OR CON VALUE OF *S* FOR *JK* OF MASK
 IH       DEFINE 18          SYMBOL ORDINAL 
 CC       SPACE  2,12 
**        CC. - FORMAT OF THIRD WORD OF AN *RCT* ENTRY
  
          DESCRIBE CC.,60 
 I1       DEFINE 1           INCREMENTED ONCE ( FOR A *RD* )
 I2       DEFINE 1           INCR MORE THAN ONCE ! INCR ON SIDE BRANCH
 IM       DEFINE 1           =1 IF INC VALUE IS MINUS VALUE OF *RCT* ENT
          DEFINE 3
 INC      DEFINE 18          *RCT* INDEX OF INCREMENT VALUE OF FIRST INC
  
 H2       DEFINE 18          SYMTAB ORDINAL OF SECOND SYM ( IH-H2 ) 
 REG2     DEFINE 6           REGNO OF SECOND REGISTER ( REG1+-REG2 )
 MIT      DEFINE 6           MACHINE INSTRUCTION TYPE FOR ADDRESS CANIDA
*                            0 - LD/ST/STT REG1+CA+IH-H2
*                            1 - PLD/PST/STT  REG1+CA , CA " 0
*                            2 - SLD/SST/SA  REG1+REG2
*                            3 - SDL/SDS/SS  REG1-REG2
*                            4 - SLD/SST/SA  REG1+REG2 , WHERE RJ IS
*                                  FROM RF OF OLD INST, NOT *RVT*.
 V.SRF    EQU    1S11        42 - SIMILAR *IP* ADDRESS DIFFERENCES
  
 REG1     DEFINE 6           REGNO OF REGISTER ASSIGNED 
  
 REGF     DEQU   REG1,18     REG1, REG2 AND MIT FIELDS
 RAT      SPACE  3,20 
**        RA. - REGISTER ASSIGNMENT TABLE FORMAT
* 
*         *RAT* HOLDS THE RCT ORDINALS OF THE VALUE THAT REGISTERS WILL 
*         BE INITIALIZED TO IN THE HOLDING BLOCK ( LOOP PROLOGUE ). 
* 
*         THE EVALUATION FORMULA IS - SET(R3) + R1 - R2 . 
*         AND THE *RF* FIELD IN THE *RCT* ENTRY OF R3 IS IGNORED. 
  
          DESCRIBE RA.,60 
 INV      DEFINE 1           =1 IF REGISTER IS *INV* IN LOOP
          DEFINE 5
 R3       DEFINE 18          RCT ORDINALS 
 R2       DEFINE 18 
 R1       DEFINE 18 
  
          LIST   R,-X 
 GRA      TITLE  DEBUGGING FACILITIES 
**        PRNT - PRINT OUT SELECTED STRUCTURES
* 
*         PRNT   LAB,(RCT,RAT,RVT)
  
 .1       SET    1
          ECHO   2,X=(RCT,RAT,RVT,SEE,MTA,DXA,DAA,MFA,SUP,SXC)
 Q.X      SET    .1 
 .1       SET    .1+1 
  
 PRNT     MACRO  LAB,LIST 
          LOCAL  APL
 O        IF     DEF,/DEBUG/LAB 
+         RJ     CPR
-         VFD    30/APL 
          USE    DEBUG
 APL      CON    10H LAB
          IF     DEF,Q.LAB,1
          VFD    6/Q.LAB
          IRP    LIST 
          VFD    6/Q.LIST 
          IRP 
          VFD    *P/0 
          USE    *
 O        ENDIF 
          ENDM
  
 .T       IFNE   TEST,0                                    *TEST MODE*
  
 CPR      ROUTINE 
          RJ     =XSVR= 
          SA1    CPR
          SA3    O.RCT
          LX1    30 
          SA2    X1-1 
          SX6    X2 
          BX7    X3 
          SA6    CPRA        LOC(LAB) 
          SA7    CPRA+1 
          SX6    X6+1 
          SA6    CPRA+3      LOC(INDEX) 
          SA1    CPRA 
          CALL   PRNTGRA
          RJ     =XRSR= 
          EQ     CPR
  
 CPRA     BSS    2
          VFD    42/,18/L.RCT 
          BSSZ   2
  
          USE    /RCTFMT/ 
          ECHO   1,X=(RA,VC,AC,CON,FP,EU,RF,^RD,IA,TU,PL,PSP,DEF,USE,LX,
,KD,IRA)
          VFD    42/0A_X,18/60-CA.X_P 
          USE    0
 .T       ENDIF                                            *TEST MODE*
 GRA      TITLE  GRA - CONTROL
**        GRA - GLOBAL REGISTER ASSIGNMENT ( CONTROL )
  
 MARA     DATA   4           MAX A-REGISTER ASSIGNMENTS 
 GRASRF   ENTRY. 0,#         =1 IF ADDRESS DIFFERENCING OF SIMILAR *IP"S* 
  
 GRA      ENTRY. **,# 
          SX7    0
          SA7    =XNBIP#     NBIP = 0    */ FOR BDT 
          SX7    4
          SA7    MARA        MARA = 4 
  
 GRA0     RJ     IRP         INITIALIZE REGION PROCESSING 
          IF     DEF,/DEBUG/UDT,1 
          DCALL  PRNTUDI,([O.UDT],L.UDT)
  
          SA1    MRA
          ZR     X1,GRA3     IF MRA = 0    */ USER OR I/O EXT REFS
  
          CLCM   DUM         DETERMINE USEAGE MODE
          CLCM   ERC         ENTER REGISTER CANIDATES 
          SA5    L.RCT
          SX6    X5+         LCT = L.RCT
          SA6    LCT
  
          RJ     SEE         SET ENTRY/EXIT CONDITIONS FOR VALUE CANIDAT
          PRNT   SEE
  
          RJ     MTA         MAKE TENATIVE B-ASSIGNMENTS, COUNTING METHO
          PRNT   MTA,(RAT,RCT)
  
          SA1    XRF
          NZ     X1,GRA2     IF XRF " 0    */ EXT REFS IN THE LOOP
          SA2    N.HB 
          NZ     X2,GRA1     IF N.HB " 0   */ NOT INNERMOST LOOP
  
          SA3    MAXW 
          SA4    NTA
          SB3    X3+
          SB4    X4+8 
          GT     B3,B4,GRA2  IF MAXW > NTA+8 */ LOOP IS TOO WIDE
  
          RJ     DXA         DETERMINE X-ASSIGNMENTS
          PRNT   DXA
  
          RJ     DAA         DETERMINE A-ASSIGNMENTS
          PRNT   DAA
          EQ     GRA2 
  
 GRA1     RJ     DXA         MOVE PREVIOUS X-ASSIGNMENTS OUT
  
 GRA2     RJ     MFA         MAKE FINAL B-ASSIGNMENTS 
          PRNT   MFA,(RAT,RCT)
  
 GRA3     RJ     CLB         CODE LOOP BODY 
  
          RJ     SUP         SETUP PRELOADS IN HOLDING BLOCK
          PRNT   SUP,RAT
  
          RJ     SXC         SET EXIT CONDITIONS ( POST STORES, ETC. )
          TRACE  SXC,TET
          PRNTABV  SXC,(LUV,LEA)
          SX6    0
          SA6    L.RCT       L.RCT = 0
          SA6    L.RXI       L.RXI = 0
          SA6    GRASRF      GRASRF = 0 
          EQ     GRA
 IRP      SPACE  3
**        IRP - INITIALIZE REGION PROCESSING
  
 IRP      ROUTINE 
  
          SETZERO F.CLC,L.CLC      ZERO SCRATCH AREA
  
*         INITIALIZE *RCT* , FIRST ENTRY IS AN EMPTY ONE, USED AS A 
*         SEARCH TERMINATOR, SECOND ENTRY IS THE CONSTANT *1* . 
  
          SA5    IRPA 
          ALLOC  RCT,6       ALLOC( RCT , 6 ) 
          MX6    0
          SA6    AXCT        AXCT = 0 
          SA6    X2 
          SA6    A6+B1
          SA6    A6+B1
          BX7    X5 
          SA7    A6+B1       RCT(4) = CAW(0,CON,RF,0)  */ CON 1 
          SX7    B1 
          LX7    IH.CAP 
          SA7    A7+B1       RCT(5) = IHW(0,0,1,0)
          SA6    A7+B1       RCT(6) = 0 
          SX7    100
          SA7    TUD         TUD = 100
  
          SA1    N.HB 
          ZR     X1,IRP1     IF N.HB = 0   */ INNERMOST LOOP
          SA4    LUV
          SX5    B1 
          LX5    UD.ISTP
          CALL   EBV#        EBV( LUV , IST )  */ SET *IST* FOR DUM/ERC 
  
*         RESERVE *B3* FOR ASSIGNED GOTO COMPARE TEST, IF A 
*         LABEL SWITCH WAS PERFORMED ( LGL " 0 ) .
  
 IRP1     SA1    N.LJ 
          LX1    1
          PL     X1,IRP      IF ^B58[N.LJ]
                                                                         A
          SA2    MRA
          SX7    1S3
          BX6    -X7*X2      MRA = MRA & ^1S3  */ MAKE *B3* UNAVAIL 
          SA6    A2 
          SA7    TRA         TRA = 1S3     */ INDICATE TEMP USE OF *B3* 
          EQ     IRP
  
 IRPA     BFMW   CA,(CON,RF)
 GRA      TTL    GRA - GLOBAL REGISTER ASSIGNMENT / CANIDATE ENTRY
 SEE      TITLE  SEE - SET ENTRY/EXIT CONDITIONS
**        SEE - SET ENTRY/EXIT CONDITIONS FOR VALUE CANIDATES IN *RCT*
  
 SEE      ROUTINE 
          SA5    O.RCT
          SA4    L.RCT
          SA3    BVL
          SA2    LEA
          SA1    O.UDT
          SB2    X4 
          SB7    X2 
          MX0    -CA.DUL
          SB6    X3+B1       VL = BVL + 1  */ BIT VECTOR LENGTH 
          SB5    59-CA.VCP
          SA5    X5+B2       CI = O.RCT + L.RCT 
          SB3    3
          SA0    X1+B1       UB = O.UDT + 1 
          SB4    B0          NV = 0 
          EQ     SEE2 
  
*         COMPILER TEMPORARY, SET PROFIT = DU[CI]+1 
  
 SEE1     SX7    X7+B1
          LX7    CA.PRFTP 
          SX4    B1 
          BX6    X7+X5       PRFT[CI] = DU[CI] + 1
          LX4    CA.PSPP
          BX6    X4+X6       PSP[CI] = 1
          SA6    A5+
  
*         SEARCH BACKWARDS FOR VALUE CANIDATES
  
 SEE2     SA5    A5-B3       CI = CI - 3
          ZR     X5,SEE6     IF [CI] = 0   */ END OF TABLE
          LX6    B5,X5
          PL     X6,SEE2     IF ^VC[CI] 
  
          SB2    X5          I = UDI[CI]
          LX6    1+CA.VCP-CA.DUP
          BX7    -X0*X6      DUB = DU[CI] 
          SB4    B4+B1       NV = NV + 1
          ZR     B2,SEE1     IF I = 0      */ COMPILER TEMP 
          GE     B2,B3,SEE2A IF I > 2      */ PROGRAMMER VAR
  
*         LOAD ONLY VARIABLE, SET PRFT = 1 AND PL = 1 
  
          SX4    B1 
          LX4    CA.PLP      PL[CI] = 1 
          BX5    X4+X5
          LX4    CA.PRFTP-CA.PLP
          BX6    X4+X5       PRFT[CI] = 1 
          SA6    A5 
          EQ     SEE2 
  
*         PROCESS PROGRAMMER VARIABLE, EXIT INFO COMPUTED IN *FXI*
  
 SEE2A    SA4    A0+B2       U2 = UDT(I+1)
          SA2    B7+X4       VA = LEA + WI[UI];  LE = [VA]
          SX1    B1 
          UX3    B2,X4       B = BITN[U2] 
          AX4    B2,X2
          BX2    X1*X4
          LX2    CA.PLP      PL[CI] = SHIFT(LE,-B)&1  */ PRELOAD
          BX5    X2+X5
          SA3    A2-B6       LXA = VA - VL;  LX = [LXA] 
          AX4    B2,X3
          BX2    X1*X4
          LX2    CA.LXP      LX[CI] = SHIFT(LX,-B)&1  */ LIVE EXIT
          BX5    X2+X5
          SA3    A2+B6       VA = VA + VL;  MD = [VA]  */ MOVABLE DEFS
          AX4    B2,X3
          BX1    X1*X4
          LX1    CA.PSPP     PSP[CI] = SHIFT(MD,-B)&1  */ POST ST POSSIB
          BX5    X1+X5
  
          LX6    CA.DUP+59-CA.DEFP
          PL     X6,SEE3     IF ^DEF[CI]
          NZ     X1,SEE3     IF PSP[CI]    */ POST STORE POSSIBLE 
          BX4    X6 
          LX4    CA.DEFP-CA.TUP 
          MI     X4,SEE3     IT TU[CI]     */ KEEP CV FIRST IN MTA SORT 
          SX7    X7-2        DUB = DUB - 2
          NZ     X7,SEE3     IF DUB " 0    */ USED ALSO IN REGION 
  
*         DEF ONLY AND NOT MOVABLE, CLEAR VC BIT
  
          SX1    B1 
          LX1    CA.VCP 
          BX6    -X1*X5      VC[CI] = 0 
          SA6    A5 
          EQ     SEE2 
  
*         SET PROFIT = 1 IF USE ! DEF , ELSE 3
  
 SEE3     SB2    X7+B1
          NE     B2,B3,SEE4  IF DUB " 2    */ NOT DEF ONLY
          SX7    B1          DUB = 1
  
 SEE4     LX7    CA.PRFTP 
          BX7    X5+X7       PRFT[CI] = DUB 
          SA7    A5+
          PL     X6,SEE2     IF ^DEF[CI]    */ USED ONLY
          LX6    CA.DEFP-CA.^RDP
          NZ     X2,SEE2     IF LX[CI]
  
*         DEAD ON EXIT FROM THE LOOP, KILL DEFINITIONS OF CANIDATE
*         IF IT HAS NO REAL USES IN THE LOOP
  
          PL     X6,SEE4A    IF RD[CI]
  
          LX6    CA.^RDP-CA.USEP
          MI     X6,SEE2     IF USE[CI] 
  
          MX6    0           DIFF = 0 
          EQ     SEE5 
  
 SEE4A    SA4    A4-B1       UI = UDT(I)
          LX5    -CA.SUSEP
          LX4    -UD.STCP 
          MX1    -UD.STCL 
          BX4    -X1*X4 
          BX1    -X1*X5 
          IX6    X1-X4       DIFF = SUSE[CI] - STC[UI]
          LX5    CA.SUSEP+59-CA.TUP 
          PL     X5,SEE5     IF ^TU[CI]    */ NOT THE LOOP *CV* 
  
          SA6    TUD         TUD = DIFF    */ SAVE *DIFF* FOR LATER USE 
          EQ     SEE2 
  
 SEE5     NZ     X6,SEE2     IF DIFF " 0   */ VAR HAS REAL USES 
  
          SA4    SEEA 
          BX7    X4+X7       (RA,KD)[CI] = 1
          SA7    A7 
          EQ     SEE2 
 SEE      SPACE  2,14 
*         CHECK FOR FINAL ASSIGNMENTS OF CANIDATES IN AN OUTER LOOP 
*         AND IF SO, ADJUST *INV* BIT OF *RAT* ENTRIES. 
  
 SEE6     SA1    NXC
          SA2    FBA
          SX6    B4+B1       NVC = NV + 1  */ N. VALUE CANIDATES
          SB6    A5 
          SA6    NVC
          IX7    X1+X2
          ZR     X7,SEE11    IF FBA + NXC = 0  */ NO FINAL ASSIGNMENTS
          MX0    1
          SX2    27B         I = 27B
          SB7    RAT
          NZ     X1,SEE7     IF NXC " 0 
          SX2    7           I = 7
  
 SEE7     SA5    B7+X2
          ZR     X5,SEE8     IF RAT(I) = 0
          SA4    B6+X5       J = R1[RAT(I)];  CAW = RCT(J)
          LX4    59-CA.DEFP 
          BX3    -X4*X0 
          LX3    1+RA.INVP
          BX6    X3+X5       INV[RAT(I)] = ^DEF[RCT(J)] 
          SA6    A5 
          LX4    CA.DEFP-CA.RAP 
 .FTN     IFEQ   HC.ID,2                                     ?FTN 
          PL     X4,SEE7A    IF ^RA[CAW]
  
*         CHECK FOR CANDIDATE OF FORM  LD  A0+K AND CHANGE TO F.P. ADDR 
  
          AX5    RA.R1L 
          NZ     X5,SEE8     IF (R2,R3)[CAW] " 0
          LX4    1+CA.RAP 
          SX6    X4-2 
          NZ     X6,SEE8     IF UDI[CAW] " 1
          SA3    A4+B1       C2W = RCT(J+1) 
          LX3    -IH.RFP
          SB2    X3 
          LX3    IH.RFP-IH.CAP
          NE     B2,B1,SEE8  IF RF[C2W] " 1 
                                                                         A
          SA1    =XO$FPI
          SB2    X3 
          SA1    X1+B2
          LX1    -FP.PNTP    IH = PNT[FPI(CA)]
          SX6    X1 
          SA6    A3          RCT(J+1) = IHW(0,0,IH) 
          SX3    B1 
          LX3    CA.ACP 
          BX6    X4+X3       AC[CAW] = 1
          LX3    CA.VCP-CA.ACP
          BX6    -X3*X6      VC[CAW] = 0
          SA6    A4 
          SA4    A4+2 
          SX5    2S6
          BX6    X4+X5       MIT[RCT(J+2)] = 2
          SA6    A4 
          EQ     SEE8 
 .FTN     ENDIF                                              'FTN 
  
*         INV ADDRESS CANIDATE AND *RF* NOT MARKED
  
 SEE7A    LX4    1+CA.RAP-CA.SUSEP
          MX7    -CA.SUSEL
          BX3    -X7*X4 
          NZ     X3,SEE8     IF SUSE[RCT(J)] " 0  */ OTHER USES 
  
          LX4    CA.SUSEP+59-CA.RAP 
          BX6    X0+X4       RA[RCT(J)] = 1 
          LX6    1+CA.RAP 
          SX7    B1 
          LX7    CA.RFP 
          BX6    -X7*X6      RF[RCT(J)] = 0  */ FOR *MTA* 
          SA6    A4 
  
 SEE8     SX2    X2-1        I = I - 1
          NZ     X2,SEE7     IF I " 0 
 SEE      SPACE  1,10 
*         SCAN *IA* LIST TO SET USEAGE MODE FOR ENTRIES ON IT 
  
 SEE11    SA1    IAI
          ZR     X1,SEE      IF IAI = 0    */ NO *IA* INCRS 
  
          SB2    SCR         K = 0
          SB3    X1+B2
          SX0    B1 
          LX0    CA.RFP 
          SX1    B1 
          LX1    CA.EUP 
          SB5    59-CA.KDP
          SX4    B1 
          LX4    CA.LXP 
  
 SEE12    SA2    B2          (J,I) = SCR(K) 
          SB2    B2+B1       K = K + 1
          SA5    B6+X2       CAW = RCT(I)  */ *RD* VAR
          LX6    B5,X5
          MI     X6,SEE14    IF KD[CAW]    */ INC IS USELESS
  
          BX7    X0*X5       BIT = RF[CAW]
          AX2    18 
          NZ     X7,SEE13    IF BIT " 0    */ SHORT USEAGE IN THE LOOP
  
          BX6    X1+X5       EU[CAW] = 1   */ MARK AS LONG USEAGE 
          SA6    A5 
          BX7    X1          BIT = EU 
  
 SEE13    SA3    B6+X2
          BX6    X7+X3       BIT[RCT(J)] = 1
          SA6    A3 
          LX3    59-CA.CONP 
          MI     X3,SEE14    IF CON[RCT(J)] 
          BX6    X4+X6       LX[RCT(J)] = 1  */ INHIBIT BIASING IN *MFA*
          SA6    A3 
  
 SEE14    LT     B2,B3,SEE12 IF K < IAI 
          EQ     SEE
  
 SEEA     BFMW   CA,(RA,VC,KD)
 ERC      TITLE  ERC - ENTER REGISTER CANIDATES INTO *RCT*
**        ERC - ENTER REGISTER CANIDATES INTO *RCT* 
*         FOWARD SCAN OF THE BLOCKS IN THE LOOP TO ENTER CANIDATES
*         BY CALLING *SCT*. LINK WORDS OF CANIDATES POINT TO THEIR *RCT*
*         ENTRIES, ALL OTHERS ARE CLEARED.
*         SET BITS IN *LUV* ( LOOP USEAGE VECTOR ) FOR NON CANIDATE 
*         MEMORY REFERENCES.
*         MARK FINAL B AND X ASSIGNMENTS FROM INNER LOOPS ( *RS* )
  
          QUAL   ERC
  
          PROCESS EOQ 
          SX6    B6-B5       L.RCT = CL - CO
          SA6    L.RCT
          TRACE  ERC,RLIST,SEQ
  
 ERC      ROUTINE 
          LX3    B1,X4
          IX1    X3+X4
          ALLOC  RCT,X1      ALLOC( RCT , 3*NC )
          SB5    X2          CO = O.RCT 
          SA5    O.SEQ
          SB6    X2+B6       CL = CO + OLD(L.RCT) 
          SA4    LUV
          SA3    O.UDT
          SB3    3
          SB4    X4          (B4) = [LUV] 
          S"TB"  X5+B3       TB = O.SEQ + 3 
          SA5    X5          R1 = O.SEQ 
          SA0    X3          (A0) = [O.UDT] 
  
          PROCESS (BOS,EOS) 
          SX7    X5 
          ZR     X7,ERC1     IF IH[R1] = 0 */ NO BLOCK NUMBER 
          LX5    -R1.H2P
          MX4    -CA.APLNL
          BX6    -X4*X5 
          LX6    CA.APLNP    APF = APLN[R1] 
          SA6    APF
  
*         CLEAR LINK WORD ( NON CANIDATE )
  
          PROCESS CLR 
 ERC1     MX7    0
          SA7    A5+B3       LI = R1 + 3;  [LI] = 0  */ CLEAR LINK WORD 
  
*         ADVANCE TO NEXT INSTRUCTION 
  
 ERC2     SA5    A5+4        R1 = R1 + 4
          UX6    B2,X5
          JP     ERC.JT+B2   JUMP( ERC.JT( OC[R1] ) ) 
 SCON     SPACE  3,14 
*         CONSTANT CANIDATE PROCESSING
  
          PROCESS S 
          LX5    -R1.INP
          SX6    X5 
          AX6    59 
          SX7    X5 
          BX6    X6-X7
          LX6    IH.CAP      C2W = IHW(0,0,ABS(IN[R1]),0) 
  
 SET1     SA3    A5+2        DI = R1 + 2
          LX3    59-D.PRSP
          PL     X3,SET2     IF ^PRS[DI]
          SA2    A5+4        R1RS = R1 + 4
          LX2    59-R1.SOP-SO.INVP
          PL     X2,ERC1     IF ^INV[R1RS]  */ CHANGED IN INNER LOOP
          SX7    X5 
          PL     X7,SET2     IF IN[R1]  \ 0  */ *S* WITH NEGATIVE CON 
          MX7    -IH.CAL
          BX6    -X7*X5 
          LX6    IH.CAP      C2W = IHW(0,0,IN[R1],0)
  
 SET2     MX4    0           R = 0
          SX1    B1 
          MX7    0           CCW = 0
          LX1    CA.CONP     CPW = CAW(0,CON,0) 
          MX2    1
          LX2    1+IH.MSKP         */ FORCE *S* TO BE A B-CANIDATE
          BX2    -X6*X2 
          LX2    CA.RFP-IH.MSKP 
          BX1    X2+X1       RF[CPW] = ^MSK[C2W]
          RJ     SCT         ENTER CONSTANT 
          EQ     ERC2 
 FMA      SPACE  2
          PROCESS FMA 
          LX5    -R1.INP
          MX7    1
          LX7    1+IH.MSKP
          SX4    X5 
          LX4    IH.CAP 
          BX6    X4+X7       C2W = IHW(1,0,IN[R1],0)
          EQ     SET1 
 SXT      SPACE  3
*         SXT - ENTER *CA* OF FOLLOWING CON SHIFT 
  
          PROCESS SXT 
          SA4    A5+5        R2S = R1 + 5 
          LX4    -IH.CAP
          SX6    X4 
          LX6    IH.CAP      C2W = IHW(0,0,CA[R2S],0) 
          MX4    0           R = 0
          SX1    B1 
          MX7    0           CCW = 0
          LX1    CA.CONP     CPW = CAW(0,CON,0) 
          RJ     SCT         ENTER CON
  
*         CHECK PRED OF *SXT* AND BUMP USES OF CON, IF PRED IS MULTI USE
  
          SA5    A5 
          SB2    "TB"-B1
          MX3    -D.USESL+1 
          LX5    -R1.RJP
          BX7    "RN"X5      R = RJ[R1] 
          SA4    B2+X7       DIP = TB-1 + R 
          LX4    -D.USESP-1 
          BX7    -X3*X4 
          ZR     X7,ERC2     IF USES[DIP] = 1 
          SX3    B1 
          LX3    CA.NOCCP 
          IX6    X3+X6       NOCC[CAW] = NOCC[CAW] + 1
          SA6    A6 
          EQ     ERC2 
 STT      SPACE  3,14 
*         STT - ENTER CONSTANT OR ADDRESS CANIDATE
  
          PROCESS STT 
          SA1    A5+2        DI = R1 + 2
          SA3    A5+B1       R2 = R1 + 1
          LX1    59-D.INCP
          LX3    -IH.RFP
          BX4    "RN"X3      R = RF[R2] 
          PL     X1,STT2     IF ^INC[DI]   */ NOT AN INCREMENT
  
          LX1    D.INCP-D.PSP 
          PL     X1,ERC1     IF ^PS[DI]    */ THIS IS THE TEST INCR 
  
          LX3    IH.RFP-IH.CAP
          SX6    X3 
          PL     X6,STT1
          BX6    -X6
 STT1     LX6    IH.CAP      C2W = IHW(0,0,ABS(CA[R2]),0) 
          EQ     SET2 
  
*         PROCESS ADDRESS CANIDATE
  
 STT2     BX6    X0*X3       C2W = IHW(0,0,CAIH[R2])
          LX5    -R1.INP
          SX1    B1 
          LX6    IH.RFP 
          MX7    -R1.H2L
          LX1    CA.ACP 
          SX2    X5 
          LX5    R1.INP-R1.H2P
          BX1    X1+X2       CPW = CAW(0,AC,0,IN[R1]) 
          BX7    -X7*X5 
          LX7    CC.H2P      CCW = H2[R1] 
          EQ     ST2A 
 TST      SPACE  3,14 
*         TST/TLD - ENTER VALUE CANIDATES 
  
          PROCESS TST 
          SA3    A5+B3       LI = R1 + 3
          ZR     X3,ERC2     IF [LI] = 0   */ USED IN INNER LOOP
          SA1    TSTA 
          EQ     TLD1 
  
          PROCESS TLD 
          SA1    TLDA 
  
 TLD1     SA3    A5+B1       R2 = R1 + 1
          MX7    0           CCW = 0
          SX4    B0          R = 0
          BX6    X3          C2W = [R2] 
  
 TLD2     SX3    B2-OC.LDC
          MI     X3,TLD3     IF OC[R1] < OC.LDC  */ ^(LDC ! LDV)
          SX3    X3+B1
          LX3    IH.SLVP     SLV[C2W] = 1 + OC[R1]-OC.LDC 
          BX6    X3+X6
  
 TLD3     RJ     SCT         ENTER CANIDATE 
          EQ     ERC2 
  
 TLDA     BFMW   CA,(PL,USE)
 TSTA     BFMW   CA,(PL,DEF)
 LDST     SPACE  2,14 
*         LD/ST - ENTER VALUE OR ADDRESS CANIDATE 
  
          PROCESS ST
          SX1    B1 
          LX1    CA.DEFP     BIT = DEF
          EQ     ST1
  
          PROCESS (LD,ILD,LDC,LDV)
          SA4    A5+2        DI = R1 + 2
          SX1    B1 
          LX1    D.RFP
          BX2    X1*X4       RFB = RF[DI]  */ FORCE *RF* IF *DO* LIMITS 
          LX1    CA.USEP-D.RFP
          LX2    CA.RFP-D.RFP 
          BX1    X1+X2       BIT = (USE,RFB)
  
 ST1      SA3    A5+B3       LI = R1 + 3
          LX5    -R1.INP
          SX6    X5 
          BX1    X1+X6       CPW = CAW(0,BIT,IN[R1])
          SA2    A5+B1       R2 = R1 + 1
          LX3    59-CA.VCP
          MX7    0           CCW = 0
          SX4    B0          R = 0
          BX6    X2          C2W = [R2] 
          MI     X3,TLD2     IF VC[LI]
          LX3    CA.VCP-CA.ACP
          PL     X3,ST4      IF ^AC[LI] 
  
*         ADJUST RF FOR *SCT* IF IT IS AN *INC* 
  
          LX2    -IH.RFP
          BX4    "RN"X2      R = RF[R2] 
  
 ST2A     SB2    "TB"-B1
          MX5    -IH.CAIHL
          BX6    -X5*X6      C2W = IHW(0,0,CAIH[R2])
  
 ST2B     SA2    B2+X4       DIP = TB-1 + R 
          LX2    59-D.INCP
          PL     X2,ST3      IF ^INC[DIP] 
  
          LX2    1+D.INCP+58-D.TYP
          SA4    A2-B1       R2P = DIP - 1
          PL     X2,ST2      IF TYPE[DIP] = I 
          LX4    -IH.RFP
          BX4    "RN"X4      R = RF[R2P]   */ POINT TO INC VARIABLE 
          EQ     ST2B 
  
 ST2      SA2    A2+B1       LIP = DIP + 1 */ CONTAINS CANIDATE ORDINAL 
          ZR     X2,ST3      IF [LI] = 0   */ THIS INC IS NOT A CANIDATE
          SX2    X2 
          MX4    0           R = 0
          LX2    IH.RFP 
          BX6    X2+X6       RF[C2W] = CO[LIP]
  
 ST3      RJ     SCT         ENTER CANIDATE 
          SA4    A5+3 
          NZ     X4,ERC2     IF [R1+3] " 0 */ CANIDATE ENTERED
  
          SA1    A5+
          LX1    -R1.INP
 ST       SPACE  1,12 
*         SET BIT IN *LUV* TO INDICATE USEAGE OF VAR IN AN INNER LOOP 
  
 ST4      SB2    X1+B1
          SA2    A0+B2       U2 = UDT(IN[R1]+1) 
          SX1    B1 
          SA3    B4+X2       LUA = LUV + WI[U2] 
          UX7    B2,X2
          LX1    B2,X1
          BX6    X1+X3       [LUA] = [LUA] ! SHIFT(1,BITN[U2])
          SA6    A3 
          EQ     ERC1 
 RS       SPACE  3,20 
**        RS - IF A FULL LOCK *RS* AND ONLY 1 INNER LOOP IN THE NEST, 
*         THEN ATTEMPT TO MOVE IT OUT.
  
          PROCESS RS
          SA1    N.HB 
          LX5    -R1.SOP-SO.LKP 
          MX6    -SO.LKL
          SB2    X1 
          NE     B2,B1,RS9   IF N.HB " 1   */ ^ OUTER WITH 1 INNER LOOP 
          BX7    -X6*X5 
          SB2    X7+B1
          NE     B2,B3,RS9   IF SOLK[R1] " 2 */ NOT FULL LOCK RS
          MX6    -SO.REGL 
          SA2    XRF
          NZ     X2,RS9      IF XRF " 0    */ EXT REFS IN LOOP
          LX5    SO.LKP 
          BX7    -X6*X5      REGN = SOREG[R1] 
  
*         BYPASS MOVING ASSIGNMENT OUT OF THEIR IS A TEMP/RJRS USE
  
          SA2    TRA
          SB2    X7-59
          LX6    -B2,X2 
          MI     X6,RS9      IF SHIFT(TRA,59-REGN) < 0  */ TEMP/RJRS USE
  
          RJ     FCP         I = FCP(R1)   */ RCT ORD OF PRED 
          ZR     X4,ERC1     IF I = 0      */ PRED NOT A CANIDATE 
  
          SA3    B5+X4       CAW = RCT(I) 
          LX3    59-CA.RAP
          MI     X3,RS9      IF RA[CAW]    */ CANIDATE ASSIGNED 
 RS       SPACE  2,14 
*         MOVE THE *RS* AND ITS PRED IF THE *CAIH* IN THE *RS* MATCHS 
*         THE *CAIH* IN THE *LD* OR *RS* IS INVARIANT IN BOTH LOOPS.
  
          SA3    A5+B1       R2 = R1 + 1;  R2W = [R2] 
          LX5    -SO.INVP 
          ZR     X3,RS2      IF R2W = 0    */ NO *CAIH* IN *RS* 
          SA2    A4-2        R2P = LI - 2 
          BX6    X2-X3
          SA2    B5+X4       CI = RCT([LI]) 
          ZR     X6,RS1      IF [R2P] = R2W  */ SAME IH"S 
  
*         DO NOT MOVE *RS* PREDECESSOR IS  LD FP AND *AC* 
  
          LX2    59-CA.FPP
          PL     X2,RS2      IF ^FP[CI] 
          LX2    CA.FPP-CA.ACP
          PL     X2,RS2      IF ^AC[CI] 
          EQ     ERC1 
  
 RS1      LX2    59-CA.VCP
          MI     X2,RS3      IF VC[CI]     */ NO INTERFERENCE IN LOOPS
          EQ     ERC1 
  
 RS2      MX6    -2 
          BX2    X6+X5
          NZ     X2,RS9      IF ^( INV[R1] & INVC[R1] ) 
  
          SA1    A5-4        R1P = R1 - 4 
          SA2    A1+B1       R2P = R1P + 1
          UX6    B2,X1
          SX3    B2-OC.STT
          NZ     X3,RS3      IF OC[R1P] " OC.STT
          SX6    X2                                                     002180
          LX2    -IH.RFP
          BX1    "RN"X2      R = RF[R2P]
          ZR     X1,RS3      IF R = 0      */ NO PREDECESSOR
  
          SA2    "TB"+X1     LIP = TB + R;  K = CO[LI]
          SA3    A5-B1       LI = R1 - 1;  J = CO[LI] 
          SA1    B5+X2       CK = RCT(K)                                002200
          ZR     X6,RS2A     IF IH[R2P] = 0  */ NO IH                   002210
          BX6    X1                                                     002220
          LX6    59-CA.VCP                                              002230
          PL     X6,ERC1     IF ^VC[CK]    */ FP AND INTERFERENCE       002240
                                                                        002250
 RS2A     LX3    RA.R3P                                                 002260
          BX6    X2+X3       (R1,R3)RAT(REGN) = (K,J) 
          SA6    RAT+X7 
          SX3    B1 
          LX3    CA.SUSEP 
          IX6    X1-X3       SUSE[CK] = SUSE[CK] - 1
          SA6    A1 
 .FTN     IFEQ   HC.ID,2                                     ?FTN 
          SB2    X1-2 
          NZ     B2,RS3      IF UDI[CK] " 1 
          LX1    59-CA.VCP
          PL     X1,RS3      IF ^VC[CK] 
          SA1    A1+B1       C2K = RCT(K+1) 
          LX1    -IH.RFP
          SB2    X1 
          NE     B2,B1,RS3   IF RF[C2K] " 1  */ ^ A0
  
*         STT  RI,,FPIH  EXPANDED BY *ESR*, CHANGE IT BACK TO NON 
*         EXPANDED FORM IN *RCT* SO WE MAY USE IT AS A BASE ADDRESS 
*         FOR OTHER CANDIDATES. 
  
          SA3    A5-B1       J = CO[LI] 
          LX1    IH.RFP-IH.CAP
          SB2    X1 
          SA2    =XO$FPI
          SA1    X2+B2
          LX1    -FP.PNTP    IH = PNT[FPI(CA[C2K])] 
          SX1    X1 
          SB2    X3+B1
          SA3    B5+B2       C2J = RCT(J+1) 
          BX6    X1+X3
          MX1    -IH.RFP
          BX6    -X1*X6      RCT(J+1) = IHW(0,CA[C2J],IH) 
          SA6    A3 
          MX6    0
          SA6    RAT+X7      RAT(REGN) = 0
 .FTN     ENDIF                                              'FTN 
 RS       SPACE  1,10 
*         SETUP *RCT* AND *RAT* TO MARK THE CANIDATE AS ASSIGNED
*         TO A REGISTER IN THIS LOOP. 
  
 RS3      SA2    B5+X4       J = CO[LI];  CI = RCT(J) 
          SA3    A2+2 
          MX1    2
          LX1    2+CA.RAFP   (RA,IRA)RCT(J) = 1 
          BX6    X1+X2
          SA6    A2 
          SB2    X7-8 
          LX7    CC.REG1P 
          BX6    X3+X7       REG1[RCT(J+2)] = REGN
          LX2    -CA.ACP
          SX1    B1 
          BX1    X1*X2
          LX1    CC.MITP+1
          BX6    X1+X6       MIT[RCT(J+2)] = 2*AC[CI] 
          SA6    A3 
          LX7    -CC.REG1P
          SX6    X4 
          SA6    A5+3        [R1+3] = J 
          SA1    RAT+X7 
          NZ     X1,RS4      IF RAT(REGN) " 0  */ STT CASE
          SA6    A1+         RAT(REGN) = J
  
 RS4      PL     B2,RS5      IF REGN > 7
  
          SA7    FBA         FBA = REGN    */ INIDCATE FINAL B-ASSIGNMEN
          EQ     ERC2 
  
 RS5      SA1    NXC
          SA6    XCT+X1      XCT(NXC) = J 
          SX7    X1+B1
          SA7    A1          NXC = NXC + 1
          EQ     ERC2 
  
 RS9      EQU    ERC1        MARKED AS *EU* IN DUM
 FCP      SPACE  3,14 
**        FCP - FIND CANIDATE PREDECESSOR 
* 
*         ENTRY  (A5) = R1 , OF AN *RS* INSTRUCTION 
* 
*         EXIT   (X4) = I , RCT ORDINAL OF CANIDATE 
  
 FCP      ROUTINE 
          SA4    A5-B1       LI = R1 - 1;  I = [I]
          SA3    A4-B1       DI = LI - 1
          NZ     X4,FCP      IF I " 0      */ IMMEDIATE PRED A CANIDATE 
          LX3    58-D.TYP 
          MX6    D.TYL
          BX3    X6*X3
          NZ     X3,FCP      IF TYPE[DI] " I  */ NOT POSSIBLE SA/XMT
  
          SA3    A3-2        R1P = DI - 2 
          UX6    B2,X3
          LX3    -R1.RJP
          BX6    "RN"X3      R = RJ[R1P]
          SA4    "TB"+X6     LI = TB + R;  I = [LI] 
          ZR     X4,FCP      IF I " 0      */ PRED NOT A CANIDATE 
          SX6    B2-OC.SA 
          ZR     X6,FCP      IF OC[R1P] = OC.SA 
          SX6    B2-OC.XMT
          ZR     X6,FCP      IF OC[R1P] = OC.XMT
  
          MX4    0           I = 0         */ INDICATE PRED NOT A CANIDA
          EQ     FCP
 SCT      TITLE  SCT - SEARCH CANIDATE TABLE, ENTER UPDATE ENTRY
**        SCT - SEARCH CANIDATE TABLE FOR MATCH OF KEY AND MAKE NEW 
*         ENTRY OR UPDATE OLD ONE.
* 
*         ENTRY  (X1) = CPW , CANIDATE PROPERTY WORD
*                (X4) = R , RF OF INDEXED REFERENCE 
*                (X6) = C2W , CANIDATE KEY
*                (X7) = CCW , THIRD WORD OF ENTRY 
*                (A5) = R1 , INSTRUCTION ADDRESS
*                (B3) = 3 
*                (B5) = CO , O.RCT
*                (B6) = CL , LWA+1 OF TABLE 
* 
*         EXIT   (A6,X6) = UPDATED *CA* WORD OF ENTRY 
*                CANIDATE ENTERED, USES, NOCC BUMPED, ETC 
* 
*         USES   B - 2, A - 1, 2, 3, 4  X - 1, 2, 3, 4, 5, 6, 7 
  
 SCT0     SX7    0
          SA7    A5+3        [R1+3] = 0 
  
 SCT      ROUTINE 
          SB2    B5+B3       SA = CO + 3   */ SEARCH ADDRESS
          ZR     X4,SCT1     IF R = 0 
          SA4    "TB"+X4     LI = TB + R;  R = [LI]  */ SUBST RCT INDX
          ZR     X4,SCT0A    IF R = 0      */ OPERAND NOT IN *RCT*
          SA3    B5+X4
          LX3    59-CA.VCP
          MI     X3,SCT0B    IF VC[RCT(R)]
          MX4    0           R = 0
 SCT0A    SX3    X6+
          ZR     X3,SCT0     IF IH[C2W] = 0  */ *AC* AND NO *IH*
  
          SX3    4S6
          BX7    X3+X7       MIT[CCW] = 4  */ RF NOT IN RCT CASE
  
 SCT0B    SB2    B2+X4       SA = SA + R
          LX4    IH.RFP 
          BX6    X4+X6       RF[R2] = R 
  
*         SET SEARCH TERMINATOR, SEARCH FOR PREVIOUS OCCURANCES 
  
 SCT1     SA6    B6+B1       [CL+1] = C2W 
          SA7    A6+B1       [CL+2] = CCW 
          SA3    A5+B3       LI = R1 + 3
          SA4    B2+B1       CI = SA + 1;  KEY = [CI]  */ C2 WORD 
          SA2    SCTA 
          BX5    X7 
          BX1    X3+X1       CPW = CPW ! [LI]  */ SET CT, USAGE 
          LX7    X1 
          SA7    B6+         [CL] = CPW    */ SKEL CA WORD
          BX7    X5 
  
 SCT2     BX5    X4-X6       DIFF = C2W - KEY 
          SA4    A4+B3       CI = CI + 3;  KEY = [CI] 
          NZ     X5,SCT2     IF DIFF " 0
  
          SA3    A4-2        CJ = CI - 2
          BX5    X3-X7
          BX5    X2*X5
          NZ     X5,SCT2     IF (H2,MIT)[CJ] " (H2,MIT)[CCW]
          SA3    A3-2        CJ = CJ - 2   */ CA WORD 
          BX5    X3-X1
          MX3    -CA.CTL
          LX5    -CA.CTP
          BX3    -X3*X5 
          NZ     X3,SCT2     IF CT[CJ] " CT[CPW]  */ NOT SAME TYPE
  
*         CHECK RESULTS OF SEARCH 
  
          SB2    A4-4        EA = CI - 4   */ ENTRY ADDRESS 
          LT     B2,B6,SCT3  IF EA < CL    */ ENTRY IN TABLE
  
          SA4    A5+2        DI = R1 + 2
          SX2    B1 
          SB6    B6+B3       CL = CL + 3
          LX2    CA.FPP 
          LX4    CA.FPP-D.FPP 
          BX3    X2*X4
          BX2    X3+X1       CAW = CPW ! FP[DI] 
          EQ     SCT4 
 SCT      SPACE  1,10 
 SCT3     SA3    B2 
          MX5    -CA.UDIL 
          BX1    X5*X1       UDI[CPW] = 0 
          BX2    X1+X3       CAW = CPW ! [EA] 
 SCT      SPACE  2,10 
*         UPDATE FIELDS IN ENTRY, LINK INSTRUCTION TO *RCT* 
  
 SCT4     SA1    APF
          SA4    A5+2        DI = R1 + 2
          SX5    B1 
          MX3    -D.USESL 
          BX2    X1+X2       APLN[CAW] = APF ! APLN[CAW]
          LX4    -D.USESP 
          LX5    CA.NOCCP    NOCC[CAW] = NOCC[CAW] + 1
          BX1    -X3*X4 
          LX1    CA.SUSEP 
          BX5    X1+X5       SUSE[CAW] = SUSE[CAW] + USES[DI] 
          IX6    X2+X5
          LX4    D.USESP+59-D.INCP
          SA6    B2          [EA] = CAW 
          SX7    B2-B5
          SA7    A5+B3       [LI] = EA - CO  */ SET INDEX TO *RCT*
          PL     X4,SCT      IF ^INC[DI]
          LX4    D.INCP-D.STP 
          PL     X4,SCT      IF ^ST[DI] 
  
*         INCREMENT *ST*, ADD USES OF INC TO CANIDATE ENTRY 
  
          LX4    1+D.STP-D.XUP
          SX2    B1 
          BX3    X2*X4
          LX3    CA.EUP      EU[CAW] = XU[DI]  */ FORCE *EU* IF *XU*
          BX6    X3+X6
          SA5    A5 
          SB2    "TB"-B1
          BX7    "RN"X5 
          SA4    B2+X7       DIP = TB-1 + RI[R1]
          BX3    -X3*X4 
          SX2    X3-1 
          LX2    CA.SUSEP 
          IX6    X2+X6       SUSE[CAW] = SUSE[CAW] + USES[DIP]-1
          SA6    A6 
  
*         COLLECT INFORMATION ABOUT THE INCREMENT VALUE OF THE *RD* 
  
          SA3    A6+2        CCW = EA + 2 
          LX3    59-CC.I1P
          SA2    A4+B1       LIP = DIP + 1;  I = CO[LIP]
          PL     X3,SCT5     IF ^I1[CCW]   */ THIS IS THE FIRST INC ST
  
          SX4    B1 
          LX4    CC.I2P 
          LX3    1+CC.I1P 
          BX7    X4+X3       I2[CCW] = 1   */ INDICATE MORE THAN 1 INC
          SA7    A3 
          BX3    X7 
          ZR     X2,SCT6     IF I = 0      */ INCOP IS IA/IS
          EQ     SCT
  
 SCT5     LX3    1+CC.I1P 
          ZR     X2,SCT6     IF I = 0      */ INCOP IS IA OR IS 
 SCT      SPACE  1,10 
*         INCOP IS AN *STT*, SET INC SIGN 
  
          SA1    A4-B1       R2P = DIP - 1
          LX1    42-IH.CAP         SIGN = IF( CA[R2P] < 377777B ) 
          EQ     SCT10                     THEN 0; ELSE 1 
  
*         INCOP IS *IA* OR *IS* 
  
 SCT6     SA1    A4-2        R1P = DIP - 2
          UX5    B2,X1
          LX5    -R1.RJP
          BX7    "RN"X5      R = RJ[R1] 
          SA2    "TB"+X7     LIP = TB + R;  I = CO[LIP] 
          SA4    B5+X2       CJP = RCT([LIP]) 
          LX4    59-CA.DEFP 
          PL     X4,SCT7     IF ^DEF[CJP]  */ THIS IS THE INC 
          LX5    R1.RJP-R1.RKP
          BX7    "RN"X5 
          SA2    "TB"+X7     LIP = TB + RK[R1];  I = CO[LIP]
          SX1    B2-OC.IA 
          LX1    59          SIGN = IF( OC[R1P] = OC.IA ) THEN 0 ELSE 1 
  
*         ADD ENTRY TO *IA* LIST FOR CANIDATE AND INC VALUE 
  
 SCT7     SA4    IAI
          SX7    A6-B5       J = EA - C0   */ SET CANIDATE ORDINAL
          SA7    A1+B3       [R1+3] = J    */ IN LINK WORD OF IA/IS 
          ZR     X2,SCT12    IF I = 0      */ INC VALUE NOT A CANIDATE
          SX5    X4-77B 
          MI     X5,SCT8     IF IAI < 77B  */ NO OVERFLOW 
  
          SA4    B5+X2
          SX7    B1 
          LX7    CA.EUP 
          BX7    X7+X4       EU[RCT(I)] = 1 
          SA7    A4 
          EQ     SCT9 
  
 SCT8     LX2    18 
          BX7    X2+X7
          SA7    SCR+X4      SCR(IAI) = SHIFT(I,18) ! J 
          LX2    -18
          SX7    X4+B1       IAI = IAI + 1
          SA7    A4 
  
 SCT9     BX4    X3 
          LX4    59-CC.I2P
          MI     X4,SCT      IF I2[CCW] 
  
*         SAVE *INC* INFORMATION IN *CCW* OF CANIDATE ENTRY 
  
 SCT10    MX4    1
          BX1    X4*X1       IM[CCW] = SIGN 
          LX1    1+CC.IMP 
          LX4    1+CC.I1P    I1[CCW] = 1
          BX4    X1+X4
          SA1    APF
          LX2    CC.INCP
          IX3    X2+X3       INC[CCW] = I 
          BX7    X4+X3
          NZ     X1,SCT11    IF APF " 0    */ INCR UNCONDITINALLY EXEC
          SX4    B1 
          LX4    CC.I2P 
          BX7    X4+X7       I2[CCW] = 1   */ INHIBIT PREFETCHING 
 SCT11    SA7    A3 
          EQ     SCT
  
*         INC VALUE NOT A CANDIDATE ( LVL2 / LU ) , SET *EU* FOR INCR 
  
 SCT12    SX7    B1 
          LX7    CA.EUP 
          BX6    X6+X7       EU[RCT(J)] = 1 
          SA6    A6 
          EQ     SCT
  
 SCTA     BFMW   CC,(H2,MIT)
  
          QUAL   *
 ERC      EQU    /ERC/ERC 
 DUM      TITLE  DUM - DETERMINE USEAGE MODE OF INSTRUCTIONS
**        DUM - DETERMINE USEAGE MODE AND CANIDATE TYPE OF INSTRUCTIONS.
* 
*         A BACKWARD SCAN OVER THE BLOCKS TO SET THE USEAGE MODE BITS 
*         ( EU, RF, TU, LU ) AND THE CANIDATE TYPES OF THE MEMORY REFS. 
* 
*         NOTE THAT THE *IST* BIT IN *UDT* IS ON IF A VARIABLE WAS
*         REFERENCED IN A INNERMOST LOOP OR THEIR WAS AN INTERFERING
*         STORE INTO THE CLASS BASE IN THIS LOOP. 
* 
*         EXIT   (A0) = NC , MAX NUMBER OF REGISTER CANIDATES 
  
 DUMA     BFMW   CA,(EU,RF) 
 DUMB     BFMW   CA,(EU,^RD)
 DUMC     BFMW   CA,(EU,TU) 
  
          QUAL   DUM
  
          PROCESS BOS 
          SX6    A0+         BSW = NC 
          SA6    =XBSW
 DUM      ROUTINE 
          RJ     FBM         FIND BOUNDARY MARKERS                      000310
          SA2    O.UDT
          SA4    UVA
          SB4    59-UD.ISTP 
          S"TB"  X5+3        TB = O.SEQ + 3 
          SB5    X4 
          SB6    X2 
          SA3    X5+B1       R2 = O.SEQ + 1 */ R2 OF *BOS*
          LX3    -R2.TXTLP
          IX6    X5+X3
          MX7    D.TYL
          SA0    -B1         NC = -1       */ N. CANIDATES
          LX7    D.TYL+D.TYP
          SA5    X6-4        R1 = O.SEQ + TXTL[R2] - 4
  
*         SHORT CONSTANTS, BUMP NUMBER OF CANIDATES 
  
          PROCESS (S,FMA,CLR) 
          SA0    A0+1        NC = NC + 1
  
*         ADVANCE TO NEXT INSTRUCTION, JUMP TO OPCODE PROCESSOR 
  
 DUM1     SA4    A5-2        DI = R1 - 2
          SA5    A4-2        R1 = DI - 2
          BX3    X7*X4
          UX6    B2,X5
          SA1    DUM.JT+B2
          NZ     X3,DUM2     IF TYPE[DI] " I
          LX6    -R1.RJP
          BX3    "RN"X6 
          LX6    R1.RJP-R1.RKP
          SA2    "TB"+X3     LJ = TB + RJ[R1] 
          BX6    "RN"X6 
          SA3    "TB"+X6     LK = TB + RK[R1] 
  
 DUM2     SB2    X1 
          JP     B2          JUMP( [MTT.JT( OC[R1] )] ) 
 TYI      SPACE  3,14 
*         TYI - GENERAL TYPE I INSTRUCTION
  
 TYI      SX1    B1 
          LX1    CA.EUP 
          BX6    X1+X2       EU[LJ] = 1 
          SA6    A2 
          BX6    X1+X3       EU[LK] = 1 
          SA6    A3 
          EQ     DUM1 
 XMT      SPACE  3,8
*         XMT - TRANSMIT USAGE MODE BACK TO OPERAND 
  
          PROCESS  XMT
          SA1    A4+B1       LI = DI + 1
          BX6    X1+X2       [LJ] = [LI] ! [LJ] 
          SA6    A2+
          EQ     DUM1 
 SA       SPACE  2
*         SA,SS - INDICATE SHORT USEAGE 
  
          PROCESS (SA,SS) 
          SA1    DUMA        BITS = (EU,RF)                             000330
          SA4    LBM                                                    000340
          IX6    X4-X4                                                  000350
          PL     X6,SA1      IF RK \ LBM                                000360
          SX1    B1                                                     000370
          LX1    CA.EUP      BITS = EU                                  000380
 SA1      BX6    X1+X3       BITS[LK] = 1                               000390
          SA6    A3                                                     000400
          SA1    DUMA        BITS = (EU,RF)                             000410
          SX5    A2-"TB"                                                000420
          IX6    X5-X4                                                  000430
          PL     X6,SA2      IF RJ \ LBM                                000440
          SX1    B1                                                     000450
          LX1    CA.EUP      BITS = EU                                  000460
 SA2      BX6    X1+X2       BITS[LJ] = 1                               000470
          SA6    A2                                                     000480
          EQ     DUM1 
  
*         TYPE I, B AND X OPERANDS
  
          PROCESS (ILS,IRS,PK)
          SA1    DUMA        BITS = (EU,RF)                             000500
          SA4    LBM                                                    000510
          SX5    A2-"TB"                                                000520
          IX6    X5-X4                                                  000530
          PL     X6,ILS1     IF RJ \ LBM                                000540
          SX1    B1                                                     000550
          LX1    CA.EUP      BITS = EU                                  000560
 ILS1     BX6    X1+X2                                                  000570
          SA6    A2          BITS[LJ] = 1                               000580
  
*         TYPE I - 1 OPERAND
  
          PROCESS (NR,RNZ,UP) 
          SX1    B1 
          LX1    CA.EUP 
          BX6    X1+X3       EU[LK] = 1 
          SA6    A3 
          EQ     DUM1 
  
*         DIRECT READ/WRITE INSTRUCTIONS
  
          PROCESS DWL 
          BX6    "RN"X5 
          SA3    "TB"+X6     LI = TB + RI[R1] 
          SA1    DUMB 
          BX6    X1+X3       (EU,^RD)[LI] = 1 
          SA6    A3 
  
          PROCESS  (XMTC,DRL) 
          SX1    B1 
          LX1    CA.EUP 
          BX6    X1+X2       EU[LJ] = 1 
          SA6    A2 
          EQ     DUM1 
 IA       SPACE  3,14 
*         IA,IS - PROPAGATE EU,TU AND INC[DI]*RF BITS DOWN, IF ^INC 
*         THEN SET *EU*, ELSE SET *IA* BIT, SO CAN SET *EU* LATER IF NEC
  
          PROCESS (IA,IS) 
          SA1    A4+B1       LI = DI + 1
          SX5    B1 
          LX4    -D.INCP
          BX6    X5*X4       I = INC[DI]
          LX5    CA.EUP      BIT = EU 
          ZR     X6,IA1      IF I = 0 
          LX5    CA.IAP-CA.EUP     BIT = IA 
  
 IA1      SA4    DUMC 
          LX6    CA.RFP 
          BX4    X6+X4
          BX1    X4*X1       UMB = (EU,TU,I*RF)[LI] 
          BX5    X5+X1
          BX6    X5+X2       BIT[LJ] = 1;  [LJ] = [LJ] ! UMB
          SA6    A2 
          BX6    X5+X3       BIT[LK] = 1;  [LK] = [LK] ! UMB
          SA6    A3 
          EQ     DUM1 
 JPX      SPACE  3,14 
*         X - JUMPS - PROPAGATE *TU* BIT DOWN IT LOOP TEST JUMP 
  
          PROCESS (JPX,RJXJ)
          SA2    LTT
          BX6    "RN"X5 
          SX1    B1 
          SA3    "TB"+X6     LI = TB + RI[R1] 
          LX1    CA.EUP      BIT = EU 
          ZR     X2,JPX1     IF LTT = 0    */ NO TEST REPLACEMENT 
  
          LX4    59-D.INCP
          PL     X4,JPX1     IF ^INC[DI]   */ THIS IS NOT THE TEST JP 
          LX1    CA.TUP-CA.EUP     BIT = TU 
  
 JPX1     BX6    X1+X3       BIT[LI] = 1
          SA6    A3 
          SA2    LBM                                                    000600
          ZR     X2,DUM1     IF LBM = 0    */ NOT DOING RF CHECKING     000610
          SA3    A4+B1                                                  000620
          SX6    X3          LBM = [DI+1]  */ SET LOW BND FOR SAFE RF   000630
          SA6    A2                                                     000640
          EQ     DUM1 
 STT      SPACE  3,14 
*         STT - SET RF USEAGE AND PROPAGATE *TU* BIT DOWN 
*         PROPAGATE *EU* BIT TO PRED, IF AN *INC* STT 
  
          PROCESS STT 
          SA3    A5+B1       R2 = R1 + 1
          SA0    A0+B1       NC = NC + 1
          LX3    -IH.RFP
          BX5    "RN"X3      R = RF[R2] 
          ZR     X5,DUM1     IF R = 0      */ NO OPERANDS 
  
          SA1    A4+B1       LI = DI + 1
          LX4    CA.EUP-D.INCP
          SA2    "TB"+X5     LJ = TB + R
          SX6    B1 
          LX6    CA.EUP 
          BX4    X6*X4
          LX6    CA.TUP-CA.EUP
          BX5    X6*X1       TU[LJ] = TU[LI]                            000860
          BX4    X4*X1       EU[LJ] = EU[LI] & INC[DI]
          LX6    CA.RFP-CA.TUP
          BX4    X4+X5                                                  000880
          BX2    X4+X2                                                  000890
          LX3    IH.RFP-IH.IHP                                          000900
.FTN      IFEQ   HC.ID,2                                                000910
          SA1    =XS=TRACE                                              000920
          SX3    X3                                                     000930
          IX1    X1-X3                                                  000940
          ZR     X1,STT1     IF IH[R2] = TRACE.                         000950
          BX2    X6+X2       RF[LJ] = 1                                 000960
                                                                        000970
 STT1     BSS    0                                                      000980
.FTN      ELSE                                                          000990
          BX2    X6+X2                                                  001000
 .FTN     ENDIF                                                         001010
          BX6    X2                                                     001020
          SA6    A2 
          EQ     DUM1 
 RS       SPACE  2,10 
*         DEF, RS - REMOVE SPECIFIED REGISTER FROM AVAILABLE SET
  
          PROCESS RS
          BX6    "RN"X5 
          SA2    "TB"+X6     LIP = TB + RI[R1]
          SX1    B1 
          LX1    CA.EUP 
          BX6    X1+X2       EU[LIP] = 1   */ INHIBIT BIASING 
          SA6    A2 
  
          PROCESS DEF 
          SA2    MRA
          LX5    -R1.SOP
          MX3    -SO.REGL 
          SX1    B1 
          BX6    -X3*X5 
          SB2    X6          REGN = SOREG[R1] 
          LX1    B2,X1
          BX6    -X1*X2      MRA = MRA & ^SHIFT(1,REGN) 
          LX5    59-SO.LKP
          SA6    A2+
          PL     X5,DUM1     IF SOLK[R1] " 1 ! 3  */ ^ TEMP/RJRS LOCK 
  
          SA2    TRA
          BX6    X1+X2       TRA = TRA ! SHIFT(1,REGN)
          SA6    A2 
          EQ     DUM1 
 KLS      SPACE  2
*         KLS/KRS - SET *RF* USEAGE FOR *SXT* SO *CON* GOES TO A B-REG
  
          PROCESS (KLS,KRS) 
          SX6    B1 
          SA0    A0+B1       NC = NC + 1
          LX6    CA.RFP 
          SA6    A5-B1       LIP = R1 - 1;  RF[LIP] = 1 
          EQ     DUM1 
 LDST     SPACE  2,18 
**        MEMORY REFERENCE PROCESSING - DETERMINE CANIDATE TYPE 
  
          PROCESS TST 
          SA1    A5+B1       R2 = R1 + 1
          SA2    ITL
          LX1    -IH.CAP
          SB2    X1          C = CA[R2] 
          SX6    B1 
          SB3    X2 
          LX6    CA.EUP 
          SA2    O.TET
          SA3    "TB"+X5     LIP = TB + RI[R1]
          SA2    X2+B2       TW = TET(C)
          GE     B2,B3,TST1  IF C > ITL    */ CREATED IN THIS LOOP
          BX6    X6+X3       EU[LIP] = 1
          SA6    A3 
          EQ     DUM1 
  
 TST1     LX4    59-D.INCP
          MI     X4,TST2     IF (NOT INC[DW]) 
          BX6    X6+X3                                                  001150
          SA6    A3                                                     001160
          EQ     DUM1 
  
TST2      SB2    A5-B1                                                  001170
          SB2    A3-B2
          ZR     B2,.TLD     IF R1-1 = LIP */ INCR NEXT TO STORE
  
          SA3    A4+B1       LI = DI + 1
          SX1    B1 
          LX1    CA.EUP 
          BX6    X1+X3       EU[LI] = 1    */ INHIBIT ADDRESS DIFFERENCING
          SA6    A3 
  
          PROCESS TLD 
          SA3    A4+B1       LI = DI + 1
          SX1    B1 
          SA0    A0+B1       NC = NC + 1
          LX1    CA.VCP 
          BX6    X1+X3       VC[LI] = 1 
          SA6    A3 
          EQ     DUM1 
 ST       SPACE  2
          PROCESS ST
          BX2    X4 
          SX1    B1 
          LX2    59-D.INCP
          SA3    "TB"+X5     LIP = TB + RI[R1]
          LX1    CA.EUP 
          PL     X2,ST1      IF ^INC[DI]
  
          SB2    A5-B1
          SB2    A3-B2
          ZR     B2,.LD      IF LIP = R1-1 */ INC NEXT TO STORE 
  
          BX6    X1+X3       EU[LIP] = 1
          SA6    A3 
          EQ     .LD
  
 ST1      BX6    X1+X3       EU[LIP] = 1
          SA6    A3 
          LX1    CA.^RDP-CA.EUP 
          SA2    A4+B1       LI = DI + 1
          BX6    X1+X2       ^RD[LI] = 1   */ INDICATE NON RECURSIVE DEF
          SA6    A2 
  
          PROCESS (LD,ILD,LDC,LDV)
          SA3    A5+B1       R2 = R1 + 1
          LX5    -R1.INP
          SX1    B1 
          LX3    -IH.RFP
          LX1    CA.VCP      CT = VC       */ SET FOR VALUE CANIDATE
          BX6    "RN"X3 
          ZR     X6,LD1      IF RF[R2] = 0
  
          SA2    LBM                                                    000660
          IX3    X6-X2                                                  000670
          MI     X3,LD0      IF RF < LBM   */ CONDITIONAL REF           000680
          SA2    "TB"+X6     LJ = TB + RF[R2] 
          LX1    CA.RFP-CA.VCP
          BX6    X1+X2       RF[LJ] = 1 
          SA6    A2 
 LD0      SX1    B1                                                     000700
          LX1    CA.ACP      CT = AC                                    000710
          EQ     LD3
  
*         CHECK SCALAR LD/ST FOR INTERFERENCE, EXPLICIT USE IN INNER LP 
  
 LD1      SA2    B6+X5       UI = UDT( IN[R1] ) 
          LX6    B4,X2
          MI     X6,LD2      IF IST[UI]    */ INTERFERENCE
          LX6    UD.ISTP-UD.CMP 
          PL     X6,LD3      IF ^CM[UI]    */ NOT MEMBER OF A CLASS 
  
*         CHECK TO SEE IF BASE MEMBER WAS USED ( INDEXED *LD* ) 
  
          LX6    1+UD.CMP-UD.BMIP 
          SA2    B6+X6       UB = UDT( BMI[UI] )
          LX2    59-UD.DEFRP
          MI     X2,LD2      IF DEFR[UB]   */ BASE DEFINED IN INNER LP
          SA3    A2+B1       U2 = UB + 1
          UX5    B2,X3
          SB2    B2-59
          SA2    B5+X3       UVW = UVA( WI[U2] )
          LX5    -B2,X2 
          PL     X5,LD3      IF SHIFT( UVW , 59-BITN[U2] ) > 0
  
          LX6    UD.BMIP+59-UD.DEFRP
          PL     X6,LD3      IF ^DEFR[UI]  */ NO DEFS IN LOOP 
  
*         ^ VC , CLEAR *INC* BIT OF ST PRED SO AS TO FORCE *EU* 
*         FOR CON PRED OF *IA* INSTRUCTION. 
  
 LD2      LX4    59-D.INCP
          PL     X4,LD2A     IF ^INC[DI]   */ ^ INC STORE 
          SX3    B1 
          SA2    A5-2        DIP = R1 - 2 
          LX3    D.INCP 
          BX6    -X3*X2      INC[DIP] = 0 
          SA6    A2 
  
*         CHECK FOR POSSIBLE ADDRESS CANIDATE 
  
 LD2A     LX4    D.INCP-D.FPP 
          PL     X4,DUM1     IF ^FP[DI] 
          LX1    CA.ACP-CA.VCP     CT = AC
  
 LD3      SA3    A4+B1       LI = DI + 1
          SA0    A0+B1       NC = NC + 1
          BX6    X1+X3       CT[LI] = 1 
          SA6    A3 
          EQ     DUM1 
 PST      SPACE  3
          PROCESS PST 
          BX3    "RN"X5 
          SX3    X3-1 
          SA2    "TB"+X3     DI OF PRED 
          SX1    B1 
          LX1    D.INCP 
          BX6    -X1*X2      INC[DIP] = 0 
          SA6    A2 
          EQ     DUM1 
 FBM      SPACE  4,18                                                   000730
**        FBM - FIND BOUNDARY MARKERS                                   000740
*         FOWARD SCAN TO FIND BOUNDARY MARKERS IN AN EBB.               000750
*         USED BY PROCESSORS SO AS TO NOT SET THE *RF* BIT WHEN THE     000760
*         INSTRUCTION REFERENCING THE RF IS CONDITIONALLY EXECUTED.     000770
*         AN ASSIGNMENT OF THE RF TO A B-REGISTER MAY CAUSE AN OVERFLOW 000780
*         AT EXECUTION TIME.                                            000790
                                                                        000800
 LBM      BSS    1           LAST BOUNDARY MARKER                       000810
                                                                        000820
 FBM0     SA7    LBM         LBM = LB                                   000830
 FBM      ROUTINE                                                       000840
          SX7    B0          LB = 0                                     000850
          SA1    =XHO$UO                                                000860
          NZ     X1,FBM0     IF UO " 0                                  000870
          SA1    HO$OPT 
          PL     X1,FBM1     IF OPT NE 2
          SA2    X5          R1 = [TXT]                                 000900
          MX3    -2                                                     000910
          LX2    -R1.H2P                                                000920
          BX4    -X3*X2                                                 000930
          NZ     X4,FBM1     IF AP ! LN    */ BLOCK EXECUTED UNCONDITION000940
          SX7    377777B     LB = INFINITY                              000950
          EQ     FBM0                                                   000960
                                                                        000970
 FBM1     SB6    X5+2        D0 = TXT + 2                               000980
          SB2    B1+B1                                                  000990
          SA4    B6          DI = D0                                    001000
                                                                        001010
 FBM2     SA3    A4+B2       R1 = DI + 2                                001020
          SA4    A3+B2       DI = R1 + 2                                001030
          UX6    B3,X3                                                  001040
          LX4    59-D.JPP                                               001050
          ZR     B3,FBM0     IF OC[R1] = 0 */ END OF SEQUENCE           001060
          PL     X4,FBM2     IF ^JP[DI]                                 001070
                                                                        001080
          SA7    A4+B1       [DI+1] = LB   */ SAVE INDEX OF LAST BM     001090
          SX7    A4-B6       LB = DI - D0                               001100
          EQ     FBM2                                                   001110
  
          QUAL   *
 DUM      EQU    /DUM/DUM 
 DUM.JT   EJECT 
**        DEFINE *OPR* MACRO TO CREATE COMBINED JUMP TABLE FOR *ERC/DUM*
*         AND A LIST OF OPCODES WHICH MAY PRECEED A *RS* TO A B-REG.
  
          ECHO   2,X=(S,SA,SS,STT)
          NOREF  BRS.X
 BRS.X    EQU    1
  
          MACRO  OPR,NAM,SS 
          NOREF  /DUM/.NAM,/ERC/.NAM
* 
          IF     DEF,/ERC/.NAM,2
          EQ     /ERC/.NAM             NAM
          ELSE   1
          EQ     /ERC/ERC1   NAM
* 
          NOREF  BRS.NAM
          IF     DEF,BRS.NAM,2
-         VFD    12/1S11
          ELSE   1
-         VFD    12/0 
* 
 O        IF     DEF,/DUM/.NAM
          VFD 18//DUM/.NAM             NAM
 O        ELSE
 TYP      MICRO  4,1,$SS$ 
          IFC    EQ,/"TYP"/ /,2 
          VFD 18//DUM/TYI    NAM
          SKIP   1
          VFD 18//DUM/DUM1
 O        ENDIF 
* 
          ENDM
  
 DUM.JT   BSS    0
 ERC.JT   BSS    0
*CALL     OPRDEFS 
 GRA      TTL    GRA - GLOBAL REGISTER ASSIGNMENT / CANIDATE SELECTION
 MTA      TITLE  MTA - MAKE TENATIVE B-ASSIGNMENTS
**        MTA - MAKE TENATIVE B-ASSIGNMENTS, MAKE TENATIVE COUNTING 
*         METHOD DECISION ( *TRD* ).
  
 MTAA     BFMW   CA,(VC,RF) 
 MTAB     BFMW   CA,(IRA,EU,LX)    NO BIAS BITS ( BY AN *CAIH* )
  
 MTA      ROUTINE 
          SA2    MRA
          SX3    376B 
          BX4    X3*X2       BR = MRA & 376B  */ B-REGS 
          SX5    X4+B1
          PX6    X5          ABR = PACK( 0 , BR+1 ) 
          CX7    X4          NAB = COUNT( BR )
          SA6    ABR
          SA7    NAB
          SA7    NTA         NTA = NAB
          ZR     X7,MTA      IF NAB = 0    */ NO B-S AVAIL
  
*         SELECT VALUE CANIDATES THAT ARE *RF* FROM *RCT* AND FORM A
*         SORT TABLE.  FORMAT - 42/SORT[CAW],18/RCT INDEX  ( *CO* ) 
  
          SA1    NVC
          ALLOC  RND,X1      ALLOC( RND , NVC )  */ SORT TABLE
          SA4    O.RCT
          SA5    L.RCT
          MX7    0
          SA7    X2          SI = [O.RND];  [SI] = 0
          MX0    -CA.SORTL
          SB7    X2+B1       S0 = SI + 1
          LX0    CA.SORTP 
          SB6    X4          CO = [O.RCT] 
          SB3    3
          SA5    B6+X5       CI = CO + L.RCT
          SA1    MTAA 
  
 MTA1     SA5    A5-B3       CI = CI - 3
          ZR     X5,MTA2     IF [CI] = 0   */ END OF TABLE
          BX6    -X1+X5 
          NZ     X6,MTA1     IF ^( VC[CI] & RF[CI] )
  
          BX3    -X0*X5 
          LX5    59-CA.^RDP 
          MI     X5,MTA1     IF ^RD[CI]    */ NON RECURSIVE DEF 
  
          SX4    A5-B6       I = CI - CO
          IX7    X3+X4
          SA7    A7+B1       SI = SI + 1;  [SI] = SORT[CI] ! I
          EQ     MTA1 
  
 MTA2     SB3    A7+B1       SI = SI + 1
          SX1    B3-B7       LEN = SI - SO
          ZR     X1,MTA12    IF LEN = 0    */ NO CANIDATES
  
          CALL   SHL#        SORT( RND )
          TRACE  MTA,RND
  
*         ON EXIT FROM *SHL* (B6) = CO IS INTACT AND (B3) = SI, LWA+1 
 MTA      SPACE  2,14 
*         NOTE THAT THE LOOP INDEX AND LIMIT ( IF A VARIABLE ) WILL BE
*         THE LAST 2 ENTRIES IN THE TABLE.  USING THESE FACTS AND OTHER 
*         INFO MAKE A PRELIMINARY COUNTING METHOD/TEST REPLACEMENT
*         DECISION.  SET *TRD* TO ONE OF THE FOLLOWING. 
*         0      NO TEST REPLACEMENT
*         1      I-N IN A B-REG 
*         2      I AND N IN B-REGS
*         3      I, N ALLOCATED, COUNT BY A+I AND LIMIT = A+N 
*         4      I ASSIGNED, COUNT BY F(I), F(N) WHERE *F* IS A 
*                LINEAR FUNCTION OF I ( I.E. A INTEGER POLYNOMIAL ).
  
          SA1    LTT
          SB7    B3-B1       SI = SI - 1   */ LWA OF SORT TABLE 
          SA0    B0          TRM = 0       */ TEST REPLACEMENT MODE 
          ZR     X1,MTA11    IF LTT = 0    */ LOOP TEST NOT STANDARD FOR
  
*         GET A B-REG FOR THE *CV*
  
          SA5    B7 
          SB4    X5          I = CO[SI]    */ CANIDATE ORDINAL
          SA4    B6+X5       CI = RCT(I)
          LX4    59-CA.TUP
          PL     X4,MTA11    IF ^TU[CI]    */ CHECK FOR *CV*
          LX4    CA.TUP-CA.DEFP 
          PL     X4,MTA11    IF ^DEF[CI]
          MX1    0           INVF = 0 
          RJ     AIR         ASSIGN *CV* TO AN INDEX REGISTER 
          SX6    -B2
          SA6    LCV+1       LCV(2) = REGNO 
          SB7    B7-B1       SI = SI - 1   */ REMOVE FROM SORT TABLE
          AX6    3
          NZ     X6,MTA11    IF REGNO > 10B  */ *CV* IN AN X-REG
*                            IN FUTURE - DELETE X-ASSIGNMENT AND LOOP 
  
*         FIND THE UPPER LIMIT. IT IS NOT IN *RCT* IF IN A INNER LP 
*         AND IT IS A CONSTANT. 
  
 MTA2A    SA5    B7 
          SA1    LUL
          SB4    X5          I = CO[SI]    */ POSSIBLE *UL* 
          LX5    59-CA.TUP
          PL     X5,MTA3     IF ^TU[SI]    */ NOT TEST USE
  
*         ENTRY IS *TU*, ENSURE THAT IT IS NOT A VARIABLE INCREMENT 
  
          SA4    B6+B4       CAW = RCT(I) 
          UX6    B2,X1
          AX6    PS.UDIP
          BX7    X6-X4
          SB3    X7 
          ZR     B3,MTA5     IF UDI[CAW] = UDI[LUL] 
  
          MX2    1
          BX6    -X2*X5      TU[SI] = 0 
          MX7    0
          LX6    1+CA.TUP 
          SA7    STP         STP = 0       */ INHIBIT BIASING IN *MFA*
          SA6    A5 
          LX2    1+CA.EUP 
          BX7    X2+X4       EU[CAW] = 1   */ INHIBTI BIASING IN *MFA*
          SA7    A4 
          ZR     B2,MTA3     IF TYP[LUL] = 0  */ *UL* IS A CON
  
*         VARIABLE INC BEFORE VARIABLE *UL*, SWAP ENTRIES 
  
          SA3    B7-B1
          ZR     X3,MTA11    IF [SI-1] = 0 */ UL NOT IN SORT TABLE
          SA6    A3          SWAP( [SI] , [SI-1] )
          BX7    X3 
          SA7    A5 
          EQ     MTA2A
  
*         SEARCH *RCT* FOR CON *UL* IF FINAL B-ASSIGNMENTS WERE MADE
  
 MTA3     UX6    B2,X1
          NZ     B2,MTA11    IF TYP[LUL] " 0   */ *UL* IS A VAR 
          LX6    IH.CAP 
          SA3    FBA
          SB4    0           I = 0
          ZR     X3,MTA5     IF FBA = 0    */ NO FINAL B-ASSIGNMENTS
  
          SA2    L.RCT
          SB2    B6+B1
          SA6    B6+B1       KEY = [CO+1] = IHW(0,0,CA[LUL],0)
          SA5    B2+X2       CI = CO+1 + L.RCT
  
 MTA4     SA5    A5-3        CI = CI - 3
          BX7    X6-X5
          NZ     X7,MTA4     IF [CA] " KEY
  
          SB4    A5-B2       I = CI - (CO+1)
          SA7    B6+B1       [CO+1] = 0 
 MTA      SPACE  2,10 
*         NOW LOOK AT TEST REPLACEMENT POSSABILITIES
  
 MTA5     SA2    B6+B4       ULW = RCT(I)  */ *UL* WORD 
          SA0    B1+B1       TRM = 2       */ I,N IN B-REGS 
          LX2    59-CA.RAP
          PL     X2,MTA6     IF ^RA[ULW]
  
*         *UL* IN A REGISTER, SET *EU* BIT FOR *CV* SO IT ISNT BIASED.
  
          SA1    A2+2        CC = RCT(I+2)
          LX1    -CC.REG1P
          MX7    -CC.REG1L
          BX6    -X7*X1 
          SB2    X6-10B 
          SA6    LUL+1       LUL(2) = REG1[CC]
          SA2    B7+B1       CVO = CO[SI+1] 
          SA3    B6+X2
          SX1    B1 
          LX1    CA.EUP 
          BX6    X1+X3       EU[RCT(CVO)] = 1  */ INHIBIT BIASING IN *MFA*
          SA6    A3 
          MI     B2,MTA11    IF REG1[CC] < 10B  */ *UL* IN A B-REG
          SA0    B0          TRM = 0
          EQ     MTA11
  
 MTA6     SA1    B7+B1
          SA3    MTAB 
          LX2    CA.RAP-CA.SUSEP
          SA5    B6+X1       CVW = RCT([SI+1])  */ *CV* WORD
          BX6    X3*X5
          NZ     X6,MTA10    IF (IRA,EU,LX)[CVW]
          MX7    -CA.SUSEL+1
          BX6    -X7*X2 
          NZ     X6,MFA6A    IF SUSE[ULW] > 1 
          BX6    X2 
          LX6    CA.SUSEP-CA.CONP 
          PL     X6,MTA7     IF ^CON[ULW]  */ NO OTHER USES 
  
 MFA6A    SX6    B1 
          LX2    1+CA.SUSEP 
          LX6    CA.LXP 
          BX7    X6+X2       LX[ULW] = 1   */ INHIBIT BIASING IN *MFA*
          SA7    A2 
          EQ     MTA10
  
*         *CV* IS DEAD ON EXIT AND ^EU
  
 MTA7     SA1    TUD
          SA0    A0+B1       TRM = 3       */ A+I, A+N
          AX7    B1,X1
          NZ     X7,MTA10    IF TUD > 1    */ I IS USED IN INDEXED LD"S 
  
          SA3    STP
          SA0    1           TRM = 1       */ I-N CASE
          ZR     X3,MTA8     IF STP = 0    */ NO *IP* WHICH IS F(I) 
  
          SA1    NAB
          ZR     X1,MTA12    IF NAB = 0 
          SA0    4           TRM = 4       */ F(I), F(N) CASE 
  
*         REMOVE VAR *UL* FROM CONSIDERATION
  
 MTA8     SA2    B7 
          SA3    B6+X2
          SX6    X2 
          LX2    59-CA.TUP
          PL     X2,MTA11    IF ^TU[SI]    */ NOT VAR *UL*
          SA6    RAT         RAT = CO[SI]  */ SAVE ORD OF *UL*
          SB7    B7-B1       SI = SI - 1
          MX1    1
          LX1    1+CA.RAP 
          BX7    X1+X3       RA[RCT(CO[SI])] = 1
          SA7    A3 
          EQ     MTA11
  
*         ASSIGN A REGISTER FOR THE *UL*
  
 MTA10    SA1    NAB
          ZR     X1,MTA12    IF NAB = 0 
          SX1    B1          INVF = 1 
          RJ     AIR         ASSIGN IT TO A REGISTER
          SX6    -B2
          SA6    LUL+1       LUL(2) = REGNO 
          MX7    0
          SA7    B6          [CO] = 0      */ IN CASE WE ASSIGNED 0 
          SA7    B6+B1       [CO+1] = 0 
          SA7    B6+2        [CO+2] = 0 
  
*         ASSIGN REMAINING CANIDATES TO REGISTERS 
  
 MTA11    SA5    B7 
          SA1    NAB
          SB4    X5          I = CO[SI] 
          ZR     X5,MTA14    IF I = 0      */ END OF TABLE
          ZR     X1,MTA14    IF NAB = 0    */ END OF REGS 
          SA4    B6+B4
          SX0    B1 
          LX4    -CA.DEFP 
          BX1    -X4*X0      INVF = ^DEF[RCT(I)]
          RJ     AIR         ASSIGN IT TO A REGISTER
          SX2    X7 
          SB7    B7-B1       SI = SI - 1
          NZ     X2,MTA11    IF UDT[CAW] " 0  */ PROGRAMMER VAR 
  
          SA4    A7+B1
          SA3    O.TET
          LX4    -IH.CAP     C = CA[RCT(I+1)] 
          SB3    X3 
          SA2    B3+X4
          SX5    -B2
          LX5    T.REGP 
          BX6    X5+X2       REG[TET(C)] = REGNO
          SA6    A2 
          EQ     MTA11
  
 MTA12    SA0    0           TRM = 0
  
*         SAVE FLAGS, CHECK TEST REPLACEMENT DECISION 
  
 MTA14    SA4    NTA
          SA5    NAB
          SA1    ABR
          SA2    MRA
          SX6    A0 
          MX7    0
          SA6    TRD         TRD = TRM
          SA7    L.RND       L.RND = 0
          IX6    X4-X5       NTA = NTA - NAB  */ N. TENATIVE ASSIGNMENTS
          SA6    A4 
          MX7    -8 
          BX3    X7+X1
          BX7    X3*X2       MRA = MRA & ( ABR + 77777400B )
          SA7    A2 
  
          SA1    LTT
          SX2    A0 
          SX0    B1 
  
*         TRM = 0 , SCAN *RCT* AND SET *EU* BIT FOR ALL CANIDATES THAT
*         ARE MARKED AS *TU* SO *IRA* WILL MATERIALIZE THEM IN AN 
*         X-REGISTER IN THE CASE THEY WERE ASSIGNED TO A B-REG. 
  
          SA3    L.RCT
          SB5    59-CA.TUP
          LX0    CA.EUP 
          SB7    B6+X3       CI = RCT;  LIM = RCT + L.RCT 
          SB4    B6 
          ZR     X1,MTA17    IF LTT = 0    */ NO *TU* GAMES 
          NZ     X2,MTA17    IF TRM " 0    */ *TU* BIT IS SUFFICIENT
  
 MTA15    SA5    B6 
          SB6    B6+3 
          LX4    B5,X5
          PL     X4,MTA16    IF ^TU[CI] 
          BX6    X0+X5       EU[CI] = 1 
          SA6    A5 
 MTA16    LT     B6,B7,MTA15 IF CI < LIM
  
*         SCAN *RCT* FOR CANIDATES THAT ARE *IA* AND *RA* AND BUMP
*         *NOCC* OF THEIR INCREMENTS TO FORCE THEM TO A B-REGISTER. 
  
 MTA17    SA1    MTAC 
          SA2    A1+B1
          SA5    B7          CI = LIM 
          LX0    CA.NOCCP-CA.EUP
          SB3    3
  
 MTA18    SA5    A5-B3       CI = CI - 3
          ZR     X5,MTA      IF [CI] = 0   */ END OF RCT
          BX6    -X1+X5 
          NZ     X6,MTA18    IF ^(RA,VC,IA,RF)[CI]
          BX6    X2*X5
          NZ     X6,MTA18    IF KD[CI] ! ^RD[CI]
          SA3    A5+2        CCW = CI + 2 
          LX3    -CC.INCP 
          SA4    B4+X3       CJ = RCT(INC[CCW]) 
          IX6    X0+X4
          LX4    59-CA.CONP 
          PL     X4,MTA18    IF ^CON[CJ]   */ INC IS NOT A *CON*
          SA6    A4          NOCC[CJ] = NOCC[CJ] + 1
          EQ     MTA18
  
 MTAC     BFMW   CA,(RA,VC,IA,RF) 
          BFMW   CA,(KD,^RD)
 AIR      TITLE  AIR - ASSIGN INDEX REGISTER
**        AIR - ASSIGN INDEX REGISTER 
* 
*         ENTRY  (B4) = I, RCT INDEX OF CANIDATE
*                (B6) = [O.RCT] 
*                (X1) = INVF , = 1 IS INV IN LOOP, ELSE 0 
* 
*         EXIT   (B2) = -REGNO ASSIGNED 
*                (A7,A7) = RCT(I) 
*                *RCT* ENTRY, RAT, NAB, ABR UPDATED 
  
 AIR1     SA2    A5+2        CCW = RCT(I+2) 
          LX5    1+CA.RAP 
          BX7    X5 
          MX6    -CC.REG1L
          LX2    -CC.REG1P
          BX4    -X2+X6 
          SA7    A5+
          SB2    X4          REGNO = REG1[CCW]
  
 AIR      ROUTINE 
          SA5    B6+B4       CAW = RCT(I) 
          LX5    59-CA.RAP
          MI     X5,AIR1     IF RA[CAW]    */ REG PREVIOUSLY ASSIGNED 
  
          SX2    B1 
          SA4    ABR
          SA3    NAB
          NX7    B2,X4
          IX6    X3-X2       NAB = NAB - 1
          SB2    B2-47       REGNO = 47 - NORMC( ABR )
          SA6    A3 
          LX2    -B2,X2 
          BX7    -X2*X4      ABR = ABR & ^SHIFT(1,REGNO)
          SA7    A4 
          SX6    -B2
          SX7    B4 
          LX1    RA.INVP
          BX7    X1+X7       INV[RAT(REGNO)] = INVF 
          SA7    RAT+X6      R1[RAT(REGNO)] = I  */ RAT POINTS TO RCT 
          LX6    CC.REG1P 
          MX4    1
          BX7    X4+X5       RA[CAW] = 1
          LX7    1+CA.RAP 
          SA7    A5 
          SA3    A5+2 
          BX6    X6+X3       REG1[RCT(I+2)] = REGNO 
          SA6    A3 
          EQ     AIR
 DXA      TITLE  DXA - DETERMINE X-ASSIGNMENTS
**        DXA - DETERMINE X-ASSIGNMENTS IN AN INNERMOST LOOP
*         FORM X-REGISTER CANIDATE TABLE AND SORT.
*         SELECT A MAX OF 4 CANIDATES AND SEE IF THE LOOP CAN BE CODED
*         WITH THEM LOCKED IN REGISTERS.  COUNT NUMBER OF REMAINING 
*         MEMORY REFS IN THE LOOP AND MAKE THE X-ASSIGNMENTS. 
* 
*         ENTRY  (XRF) = 0 , NO EXTERNAL REFS 
*                MAXW < 8 + NTA , X-REG ASSIGNMENT MAY BE POSSIBLE
* 
*         EXIT   (MLW) = MAX REG WIDTH IN LOOP BODY AFTER X-ASSIGNMENT
*                (NXC) = NUMBER OF X-CANIDATES ASSIGNED 
  
 DXAA     BFMW   CA,(VC,CON)
          BFMW   CA,(RA,RF) 
  
 DXA      ROUTINE 
          SA5    NXC
          NZ     X5,DXA4A    IF NXC " 0    */ X-REGS ASSIGNED IN *ERC*
          SA4    N.HB 
          NZ     X4,DXA      IF N.HB " 0   */ NOT AN INNERMOST LOOP 
  
          SA1    NVC
          ALLOC  RND,X1      ALLOC( RND , NVC ) 
          SA4    O.RCT
          SA5    L.RCT
          MX7    0
          SA7    X2          SI = [O.RCT]; [SI] = 0 
          MX0    -CA.SORTL
          SB7    X2+B1       SO = SI + 1
          LX0    CA.SORTP 
          SB6    X4          CO = [O.RCT] 
          SA1    DXAA 
          SA2    A1+B1
          SA5    B6+X5       CI = CO + L.RCT
          SB3    3
  
*         FORM X-CANIDATE TABLE AND SORT
  
 DXA1     SA5    A5-B3       CI = CI - 3
          ZR     X5,DXA2     IF [CI] = 0   */ END OF TABLE
          BX6    X1*X5
          ZR     X6,DXA1     IF ^( VC[CI] ! CON[CI] ) 
          BX3    X2*X5
          NZ     X3,DXA1     IF RA[CI] ! RF[CI] 
  
          BX3    -X0*X5 
          SX4    A5-B6       I = CI - CO
          IX7    X3+X4
          SA7    A7+B1       SI = SI + 1;  [SI] = SORT[CI] ! I
          EQ     DXA1 
  
 DXA2     SB3    A7+B1       SI = SI + 1   */ LWA + 1 
          MX7    0
          SX1    B3-B7       LEN = SI - SO
          SA7    L.RND       L.RND = 0
          SX6    DXA
          SA6    CRWA        [CRWA] = DXA  */ FAIL EXIT ADDR
          ZR     X1,DXA5     IF LEN = 0    */ GO COMPUTE MLW, N.LD, N.ST
  
          CALL   SHL#        SORT( RND )
  
*         MOVE CANIDATES WITH HIGHEST PRIORITY TO *XCT* 
*         AND SET *RA* BIT FOR WINNERS IN *RCT*.
  
          SB4    XCT         I = 0
          SB5    B4+4        LIM = 4
          MX0    1
          LX0    1+CA.RAP 
          SB2    B4+
  
 DXA3     SA1    B3-B1       SW = [SI-1]
          SA2    B6+X1
          SX6    X1          J = XCT(I) = CO[SW]
          BX7    X0+X2       RA[RCT(J)] = 1 
          SA6    B4 
          SB4    B4+B1       I = I + 1
          SA7    A2 
          SB3    B3-B1       SI = SI - 1
          EQ     B4,B5,DXA4  IF I = LIM    */ LIM CANIDATES COLLECTED 
          GT     B3,B7,DXA3  IF SI > SO    */ NOT END OF SORT TABLE 
  
*         COMPUTE REG WIDTH OF LOOP, IF FAILURE, REDUCE NUMBER OF 
*         X-CANIDATES, ELSE MAKE FINAL ASSIGNMENTS
  
 DXA4     SX6    B4-B2
          SA6    NXC         NXC = I       */ N. X-CANIDATES
  
 DXA4A    SX6    DXA6 
          SA6    CRWA        [CRWA] = DXA6 */ FAIL EXIT ADDRESS 
  
 DXA5     SX7    0
          SA7    MLW         MLW = 0       */ MAX REG WITH OF LOOP
  
          CLCM   CRW         COMPUTE REG WIDTH
          SA1    N.HB 
          ZR     X1,DXA7     IF N.HB = 0   */ INNERMOST LOOP
  
          EQ     DXA
  
*         CRW FAIL EXIT, REDUCE X-REG CANIDATE COUNT
  
 DXA6     SA1    NXC
          RJ     RXA         REMOVE LAST X-ASSIGNMENT 
          NZ     X6,DXA5     IF NXC " 0    */ MORE CANIDATES LEFT 
  
          EQ     DXA
 DXA      SPACE  3,14 
*         SUCCESS, ASSIGN CANIDATES TO REGISTERS
*         CHECK NUMBER OF REMAINING STORES AND REMOVE X6,X7 FROM
*         CONSIDERATION IF THEIR ARE TOO MANY LEFT. 
  
 DXA7     CLCM   CMR         COUNT NUMBER OF MEMORY REFS LEFT IN LOOP 
  
          SA5    NXC
          ZR     X5,DXA      IF NXC = 0    */ NO X-CANIDATES
  
          SA1    MRA
          SA2    N.ST 
          LX1    -16         AXR = SHIFT(MRA,-16) 
          MX0    0           STL = 0
          ZR     X2,DXA8     IF N.ST = 0   */ NO STORES LEFT IN THE LOOP
          SX0    1S6         STL = 1S6     */ LOCKOUT X6
          AX3    B1,X2
          ZR     X3,DXA8     IF N.ST = 1   */ ONLY 1 ST PER BLOCK 
          SX0    3S6         STL = 3S6     */ LOCKOUT THE STORE REGS
  
*         PICK THE SET OF REGISTERS USED FOR THE *LD* ONLY CANIDATES
*         SO THAT SUFFICIENT LD REGS WILL BE AVAIL FOR THE OTHER LD"S.
  
 DXA8     SA5    N.LD 
          SA0    321670B     LRS = 076123  */ LD ONLY REG SET 
          SB2    X5-3 
          GT     B2,DXA9     IF N.LD > 3
          SA0    367021B     LRS = 120763 
          ZR     B2,DXA9     IF N.LD = 3
          SA0    670321B     LRS = 123076 
  
 DXA9     SA2    NXC
          SA3    O.RCT
          BX1    -X0*X1      AXR = AXR & ^STL 
          SB4    XCT         I = 0
          SB5    B4+X2       L = NXC
          MX2    -3 
          SB6    X3 
          SX0    1
  
*         PICK X-REGISTERS FOR THE CANIDATES AS A FUNCTION OF THEIR 
*         TYPE AND USEAGE.
  
 DXA10    SA4    B4          J = XCT(I) 
          SA5    B6+X4       CAW = RCT(J) 
          SX7    321670B     XRS = 076123  */ X-REG SET IN SEARCH ORDER 
          SB2    X5 
          LX5    59-CA.CONP 
          MI     X5,DXA11    IF CON[CAW]
          ZR     B2,DXA11    IF UDI[CAW] = 0  */ COMPILER TEMP
  
          LX5    CA.CONP-CA.DEFP
          SX7    A0          XRS = LRS
          PL     X5,DXA11    IF ^DEF[CAW]  */ LOAD ONLY 
          SX7    321067B     XRS = 760123 
  
 DXA11    BX6    -X2*X7      REGN = XRS & 7 
          AX7    3           XRS = SHIFT(XRS,-3)
          SB2    X6 
          LX3    B2,X0       RBIT = SHIFT(1,REGN) 
          BX5    X3*X1
          ZR     X5,DXA11    IF AXR & RBIT = 0 */ REG NOT AVAILABLE 
  
          SA5    A5 
          BX1    -X3*X1      AXR = AXR & ^RBIT  */ REMOVE FROM AVAIL SET
          SX6    X6+20B      REGN = REGN + 20B  */ X-REG NUMBER 
          SX4    X4          R1[RAT(REGNO)] = J 
          LX5    -CA.DEFP 
          BX3    -X5*X0      INV[RAT(REGNO)] = ^DEF[RCT(J)] 
          SA5    A5+2 
          LX3    RA.INVP
          BX7    X3+X4
          SA7    RAT+X6 
          LX6    CC.REG1P 
          BX6    X6+X5       REG1[RCT(J+2)] = REGN
          SB4    B4+1        I = I + 1
          SA6    A5 
          LT     B4,B5,DXA10 IF I < NXC 
  
          LX1    16 
          BX6    X1 
          SA6    MRA         MRA = SHIFT(AXR,16)
          EQ     DXA
 CRW      TITLE  CRW - COMPUTE REGISTER WIDTH 
**        CRW - COMPUTE REGISTER WIDTH OF A SEQUENCE
* 
*         LINK WORDS CONTAIN *RCT* ORDINALS OF CANIDATES AND *RA* BIT 
*         IS SET IF IT IS ASSIGNED TO A REGISTER. 
*         CANIDATES PLACED IN LOCKED REGISTERS ARE ASSUMED TO BE *LIVE* 
*         THORUGHOUT THE LOOP.
* 
*         ENTRY  (X0) = R-NUMBER MASK 
*                (X5) = O.SEQ 
*                (NXC) = NUMBER OF LOCKED X-REGISTERS 
* 
*         EXIT   (B6) = [O.RCT] 
*                (MLW) = MAX REG WIDTH OF LOOP
  
          DESCRIBE I.,60     LINK WORD
          DEFINE 24 
 USES     DEFINE 18          REMAINING USES OF NON CANIDATES
 CO       DEFINE 18          CANIDATE ORDINAL ( *RCT* ) 
  
 CRWA     CON    377777B     FAIL EXIT ADDRESS PROCESSOR
 ASPA     BFMW   D,(BM,ST)
  
 CRW      ROUTINE 
          SA1    L.SEQ
          SB2    X1-8 
          LE     B2,CRW      IF L.SEQ @ 8  */ EMPTY BLOCK 
  
          RJ     SLW         SAVE LINK WORDS
          SA3    O.RCT
          S"TB"  X5+3        TB = O.SEQ + 3 
          SB6    X3 
  
*         FIRST ADJUST THE PRED OF STORES THAT ARE LOCKED IN REGISTERS
  
          SA1    ASPA 
          SA4    "TB"-B1     DI = TB - 1
          SB4    CA.RAP-CA.LXP
          EQ     ASP2 
  
 ASP1     UX6    B2,X5
          ZR     B2,CRW0     IF OC[R1] = OC.EOQ 
  
 ASP2     SA4    A4+4        DI = DI + 4
          BX6    X1*X4
          LX4    59-D.BMP 
          ZR     X6,ASP2     IF ^( BM[DI] ! ST[DI] )
  
          SA5    A4-2        R1 = DI - 2
          MI     X4,ASP1     IF BM[DI]
  
          SA2    A4+B1       LI = DI + 1;  I = CO[LI] 
          SA3    B6+X2       CI = RCT(I)
          LX3    59-CA.RAP
          PL     X3,ASP2     IF ^RA[CI] 
  
          LX6    B4,X3
          LX3    CA.RAP-CA.PSPP 
          PL     X6,ASP3     IF ^LX[CI]    */ DEAD ON EXIT
          PL     X3,ASP2     IF ^PSP[CI]   */ STORE CANT MOVE 
  
 ASP3     BX5    "RN"X5      R = RI[R1] 
          SX7    X2+
          SA7    "TB"+X5     LI = TB + R;  [LI] = I 
          EQ     ASP2 
  
*         INITIALIZE FOR THE REG WIDTH CALCULATION
  
 CRW0     SA2    NXC
          SB4    X2          RW = NXC      */ REG WIDTH 
          SA0    X2 
          SB5    X2          MW = NXC      */ MAX WIDTH 
          MX2    -D.USESL 
          SX1    B1 
          LX2    I.USESP
          SA4    "TB"-1      DI = TB - 1
          SB3    OC.RS
  
*         ADVANCE TO NEXT INSTRUCTION, JUMP ON TYPE 
  
 CRW1     SA5    A4+2        R1 = DI + 2
          SA4    A5+2        DI = R1 + 2
          UX5    B2,X5
          LX4    58-D.TYP 
          IX7    X4+X4
          MI     X4,CRW3     IF TYPE[DI] = III ! IV 
          MI     X7,CRW2     IF TYPE[DI] = II 
  
*         TYPE I
  
          LX4    1+D.TYP-D.^DP     RNUMS = RJRKRI[R1] 
          MI     X4,CRW7     IF ^D[DI]
          AX5    R1.RIL      RNUMS = RJRK[R1] 
          EQ     CRW7 
  
*         TYPE II 
  
 CRW2     LX4    1+D.TYP-D.^DP
          NE     B2,B3,CRW9  IF OC[R1] " OC.RS
          EQ     CRW1 
  
*         TYPE IV 
  
 CRW3     PL     X7,CRW4     IF TYPE[DI] = III
          SB4    A0+         RW = NXC 
          NZ     B2,CRW1     IF OC[R1] " OC.EOQ 
  
          RJ     RLW         RESTORE LINK WORDS 
          SA1    MLW
          SX6    B5 
          SB3    X1 
          GE     B3,B5,CRW   MLW = MAX( MLW , MW )
          SA6    A1+
          EQ     CRW
  
*         TYPE III
  
 CRW4     LX4    1+D.TYP-D.^DP     RNUMS = RI[R1] 
          MI     X4,CRW5     IF ^D[DI]
          MX5    0           RNUMS = 0
 CRW5     SA3    A5+B1       R2 = R1 + 1
          BX5    "RN"X5 
          LX3    -IH.RFP
          BX6    "RN"X3      R = RF[R2] 
          ZR     X6,CRW7     IF R = 0 
          LX5    R1.RIL 
          BX5    X6+X5       RNUMS = SHIFT(RNUMS,R1.RIL) ! R
  
*         DECREMENT USES OF OPERANDS ( RNUMS )
  
 CRW7     BX7    "RN"X5      R = RI[RNUMS]
          AX5    R1.RIL      RNUMS = SHIFT(RNUMS,-R1.RIL) 
          ZR     X7,CRW8     IF R = 0 
  
          SA3    "TB"+X7     LI = TB + R
          LX3    -I.USESP 
          SB2    X3+         U = USES[LI] 
          ZR     B2,CRW8     IF U = 0      */ LOCKED IN A REGISTER
          IX6    X3-X1       USES[LI] = USES[LI] - 1
          LX6    I.USESP
          SA6    A3 
          GT     B2,B1,CRW8  IF U > 1      */ NOT LAST USE
          SB4    B4-B1       RW = RW - 1
 CRW8     NZ     X5,CRW7     IF RNUMS " 0 
  
*         ADVANCE *RW* TO ACCOUNT FOR THE NEW RESULT
  
 CRW9     SA3    A4+B1       LI = DI + 1
          MI     X4,CRW1     IF ^D[DI]     */ ^DEF A NEW RESULT 
          SA5    B6+X3
          LX5    59-CA.RAP
          MI     X5,CRW1     IF RA[RCT(CO[LI])]  */ IN A LOCKED REG 
  
          LX4    D.^DP-D.PRSP 
          PL     X4,CRW10    IF ^PRS[CI]
  
          SA5    A3+B1       R1RS = LI + 1  */ R1 OF FOLLOWING RS 
          LX5    58-R1.SOP-SO.RTP 
          PL     X5,CRW1     IF SORT[R1RS] " 2  */ NOT TO AN X-REGISTER 
  
 CRW10    LX4    1+D.PRSP-D.USESP+I.USESP 
          BX5    -X2*X4 
          SB4    B4+B1       RW = RW + 1
          BX6    X5+X3       USES[LI] = USES[DI]
          SA6    A3 
          LE     B4,B5,CRW1  IF RW @ MW 
  
          SB5    B4          MW = RW       */ SET NEW MAX 
          SB2    9
          LT     B5,B2,CRW1  IF MW < 9     */ HAVENT JAMMED THE REGS
  
          RJ     RLW         RESTORE LINK WORDS 
          SA1    CRWA 
          SX6    B2 
          SB3    X1 
          SA6    MLW         MLW = 9
          JP     B3          JUMP( [CRWA] )  */ EXIT TO FAIL ADDRESS
 SLW      SPACE  3,14        SLW
**        SLW - SAVE LINK WORDS 
* 
*         ENTRY  (X1) = L.SEQ 
* 
*         EXIT   (X5) = [O.SEQ] 
  
 SLW      ROUTINE 
          AX1    2
          SB2    X1-2 
          ZR     B2,SLW      IF L.SEQ = 8  */ EMPTY BLOCK 
          ALLOC  RND,X1      ALLOC( RND , L.SEQ/4 ) 
          SA5    O.SEQ
          SB2    X1-2        I = L.SEQ/4 - 2
          SA4    X5+7        SI = O.SEQ + 7 
          BX6    X4 
          SA6    X2          RI = [O.RND];  [RI] = [SI] 
  
 SLW1     SA4    A4+4        SI = SI + 4
          SB2    B2-B1       I = I - 1
          BX6    X4 
          SA6    A6+B1       RI = RI + 1;  [RI] = [SI]
          NZ     B2,SLW1     IF I " 0 
  
          EQ     SLW
 RLW      SPACE  2           RLW
**        RLW - RESTORE LINK WORDS
* 
*         PRESERVES  B - 2, 3, 5, 6, 7
  
 RLW      ROUTINE 
          SA1    O.RND
          SA2    L.SEQ
          SB4    4
          SA3    X1          RI = [O.RND] 
          AX2    2
          SX7    X2-2        I = L.SEQ/4 - 2
          ZR     X7,RLW      IF I = 0 
          SA5    O.SEQ
          BX6    X3 
          SA6    X5+7        SI = O.SEQ + 7;  [SI] = [RI] 
          SX2    B1 
  
 RLW1     SA3    A3+B1       RI = RI + 1
          IX7    X7-X2       I = I - 1
          BX6    X3 
          SA6    A6+B4       SI = SI + 4;  [SI] = [RI]
          NZ     X7,RLW1     IF I " 0 
  
          SA7    L.RND       L.RND = 0
          EQ     RLW
 CMR      TITLE  CMR - COUNT MEMORY REFERENCES
**        CMR - COUNT REMAINING MEMORY REFERENCES IN A BLOCK
*         THE PURPOSE OF THIS ROUTINE IS TO SEE HOW MANY LOADS AND
*         STORES ARE LEFT IN THE LOOP SO WE CAN MAKE AN INTELLIGENT 
*         DECISION ABOUT ASSIGNING STORE REGISTERS IN *DXA* AND LOAD
*         REGISTERS IN *DAA* WHEN TRYING TO SETUP PREFETCH CODE.
*         IN THE CASE THAT A STORE CANNOT MOVE OUT OF A LOOP THIS 
*         SCHEME BACKFIRES AND THE CANIDATE WILL PROBABELY GET ASSIGNED 
*         TO A LOAD REGISTER, FORCEING TRANSMITS IN AND OUT OF THE LOOP.
* 
*         ENTRY  (X5) = O.SEQ 
* 
*         EXIT   N.MR, N.ST UPDATED 
  
 CMRA     BFMW   D,(BM,LD,ST) 
  
 CMR0     SX6    B4          N.LD = SLD 
          SX7    B7 
          SA6    A1 
          SA7    A1+B1
  
 CMR      ROUTINE 
          SA1    N.LD 
          SA2    N.ST 
          SA3    O.RCT
          SA4    X5+2        DI = O.SEQ + 2 
          SB3    B0          NMR = 0       */ MEM REFS IN BLOCK 
          SA5    CMRA 
          SB4    X1          SLD = N.LD    */ SUM OF *LD*"S 
          BX0    X5 
          SB5    B0          NST = 0       */ *ST*"S IN BLOCK 
          SB6    X3 
          SB7    X2          MST = N.ST    */ MAX *ST*"S SO FAR 
          EQ     CMR4 
  
*         PROCESS BOUNDARY MARKER 
  
 CMR1     SB3    B3-B5       NMR = NMR - NST
          LE     B5,B7,CMR2  N.ST = MAX( NST , N.ST ) 
          SB7    B5 
 CMR2     SA5    A4-2        R1 = DI - 2
          UX6    B2,X5
          SB4    B4+B3       SLD = SLD + NMR
          ZR     B2,CMR0     IF OC[R1] = OC.EOQ 
  
          SB3    B0          NMR = 0
          SB5    B0          NST = 0
  
*         ADVANCE TO NEXT INSTRUCTION, CHECK FOR MEMORY REFERENCE 
  
 CMR4     SA4    A4+4        DI = DI + 4
          BX7    X0*X4
          LX4    59-D.BMP 
          ZR     X7,CMR4     IF ^(BM,LD,ST)[DI] 
  
          MI     X4,CMR1     IF BM[DI]
          LX4    D.BMP-D.L2P
          MI     X4,CMR4     IF L2[DI]     */ LEVEL 2 LD/ST 
  
*         MEMORY REF, COUNT IT IF NOT ASSIGNED TO A REGISTER
  
          SA3    A4+B1       LI = DI + 1;  I = CO[LI] 
          LX7    59-D.LDP 
          SA2    B6+X3       CI = RCT(I)
          LX2    59-CA.RAP
          PL     X2,CMR6     IF ^RA[CI]    */ NOT IN A REG
  
*         COUNT STORE IF WE CANT MOVE IT OUT
  
          MI     X7,CMR4     IF LD[DI]
          LX2    CA.RAP-CA.LXP
          PL     X2,CMR4     IF ^LX[CI]    */ DEAD ON EXIT
          LX2    CA.LXP-CA.PSPP 
          MI     X2,CMR4     IF PSP[DI]    */ POST STORE POSSIBLE 
  
 CMR6     SB3    B3+B1       NMR = NMR + 1
          MI     X7,CMR4     IF LD[DI]
          SB5    B5+B1       NST = NST + 1
          EQ     CMR4 
 DAA      TITLE  DAA - DETERMINE A-ASSIGNMENTS ( PREFETCHS )
**        DAA - DETERMINE A-ASSIGNMENTS ( PREFETCHS ) 
* 
*         THE CRITERIA FOR PREFETCHING FALL INTO TWO CATEGORIES - 
*         1) THAT THE LOOP BE SUFFICIENTLY SMALL SO WE CAN DO IT. 
*         2) THE RESTRICTIONS THAT THE PREFETCH CANIDATES MUST MEET.
*         SOME OF THE RESTRICTIONS ARE NATURAL, WHILE OTHERS ARE
*         ARTIFICAL AND COULD BE RELAXED IF WE HAD MORE INFORMATION.
* 
*         EXIT   (NAA) = N. A-ASSIGNMENTS 
*                ACT(I) = 24/RCT-INC INFO,18/,18/X-REGNO OF PREFETCH
  
 DAAA     BFMW   D,(LD,BM)
          BFMW   CA,(RA,CON)
 DAAB     BFMW   CA,(RA,VC) 
  
 DAA      ROUTINE 
          SA1    MLW
          SA2    N.EBB
          SX6    X1-8 
          MI     X6,DAA0     IF MLW < 8 
          NZ     X6,DAA      IF MLW > 8 
          SB2    X2 
          GT     B2,B1,DAA   IF N.EBB > 1 
          SA3    L.SEQ
          SX6    X3-240B
          PL     X6,DAA      IF L.SEQ > 240B  */ MAGIC NUMBER 
 DAA0     SX7    X2-3 
          PL     X7,DAA      IF N.EBB > 2  */ > 1 EBB + 1 LATCH NODE
  
          SA3    N.LD 
          SA4    N.ST 
          SA5    N.LJ 
          SX6    X3-8 
          SX7    X4-3 
          PL     X6,DAA      IF N.LD > 7
          PL     X7,DAA      IF N.ST > 2
          SX6    B1 
          IX5    X5-X6
          NZ     X5,DAA      IF N.LJ " 1   */ ONLY *LBJ* IS A *JPX* 
          SX7    X1-2 
          PL     X7,DAA0A    IF MLW \ 2 
          IX6    X3-X4
          ZR     X6,DAA      IF N.LD = N.ST  */ A MOVE LOOP 
  
*         DETERMINE MAA, THE MAX NUMBER OF PREFETCHS WE WILL ASSIGN.
  
 DAA0A    SA1    MRA
          SX2    76B
          LX1    -16
          BX6    X2*X1       ALR = SHIFT(MRA,-16) & 76B  */ AVAIL LDREGS
          CX5    X6          NLR = COUNT( ALR ) 
          IX6    X5-X3
          LX5    1
          IX7    X5-X3       MAA = 2*NLR - N.LD  */ MAX A-ASSGNMNTS 
  
          SA1    MARA 
          IX2    X1-X7
          AX2    59 
          BX1    X2*X1
          BX2    -X2*X7 
          IX7    X1+X2       MAA = MIN( MARA , MAA )
          SB2    X7 
          LE     B2,DAA      IF MAA @ 0 
          PL     X6,DAA1     IF NLR \ N.LD
          BX6    X7 
          AX6    2
          ZR     X6,DAA1     MAA = MIN( 3 , MAA ) 
          SX7    3
 DAA1     SA7    MAA
          SX6    2
          SA6    BSI         BSI = 2
          CALL   RTB#        GET POINTERS TO HEADER NODE
  
          CALL   AAV         ASSIGN ARRAY VARIABLES TO A/X REGISTERS
          SA5    MAA                                                    002320
          SB5    X5                                                     002330
          LE     B5,DAA      IF MAA LE 0,  RETURN                       002340
 DAA      SPACE  2,10 
*         SELECT CANIDATES FROM THE INDEXED LD"S IN THE HEADER NODE.
*         FORM *ACT* - 24/RCT-INC INFO,18/INC FIRST BIAS,18/RCT-INDEX 
  
          SA2    O.UDT
          SA3    O.RCT
          SA5    O.SEQ
          SA1    DAAA 
          SA4    A1+B1
          SB5    B0          J = 0         */ ACT STORE INDEX 
          SB6    X3 
          BX0    X4 
          SB7    X2 
          SA4    X5+6        DI = O.SEQ + 4 + 2  */ SKIP PAST *LAB* 
          SB4    X5+2                      (B4) = TXT+2 
  
 DAA2     SA4    A4+4        DI = DI + 4
          BX6    X1*X4
          LX4    59-D.BMP 
          ZR     X6,DAA2     IF ^( LD[DI] ! BM[DI] )
  
          MI     X4,DAA4     IF BM[DI]
          LX4    D.BMP-D.L2P
          MI     X4,DAA2     IF L2[DI]     */ LEVEL 2 LD
  
          SA5    A4+B1       LI = DI + 1;  I = CO[LI] 
          SA3    B6+X5       CI = RCT(I)
          SA2    B7+X3       UI = UDT( UDI[CI] )
          LX2    59-UD.DEFRP
          MI     X2,DAA2     IF DEFR[UI]   */ STORE INTO SAME CLASS 
          LX3    59-CA.ACP
          PL     X3,DAA2     IF ^AC[CI]    */ NOT AN ADDRESS CANIDATE 
          LX3    CA.ACP-CA.NOCCP
          MX6    -CA.NOCCL+1
          BX3    -X6*X3 
          NZ     X3,DAA2     IF NOCC[CI] > 1  */ POSSIBLE A(I);I=I+1;A(I
  
          SA2    A3+B1       C2W = RCT(I+1) 
          LX2    -IH.RFP     R = RF[C2W]
  
*         LOOK AT INDEX OF *LD* FOR INFO ABOUT THE INCREMENT VALUE. 
  
          SB2    X2+2 
          SA3    B6+B2       CCW = RCT(R+2) 
          LX3    59-CC.I1P
          PL     X3,DAA2     IF ^I1[CCW]   */ NOT *RD*
          LX3    CC.I1P-CC.I2P
          MI     X3,DAA2     IF I2[CCW]    */ MORE THAN 1 INC OF INDEX
          LX3    1+CC.I2P-CC.INCP  IP = INC[CCW] */ RCT INDEX OF INC VAL
          SA2    B6+X3       CJ = RCT(IP) 
          BX6    X0*X2
          ZR     X6,DAA2     IF ^( RA[CJ] ! CON[CJ] ) 
  
          LX3    CC.INCP
          MX7    -CC.INCP 
          BX7    X7*X3
          BX6    X7+X5
          SA5    A4-B1       R2 = DI - 1
          LX5    -IH.RFP
          SA5    B4+X5       DIP = TXT(RF[R2]+2)
          LX5    59-D.LDP 
          MI     X5,DAA3     IF LD[DIP]    */ ^ INC FIRST 
          LX2    59-CA.CONP 
          PL     X2,DAA2     IF ^CON[CJ]   */ INC VALUE ^ A CON 
  
*         INC-FIRST-BIAS = CA[C2J] * IM[CCW]
  
          SA5    A2+B1       C2J = RCT(IP+1)
          LX3    59-CC.IMP
          MX7    -IH.CAL
          AX3    59 
          LX7    IH.CAP 
          BX3    X3-X5
          BX5    -X7*X3 
          BX6    X5+X6       BIAS = CA[C2J] * IM[CCW] 
  
 DAA3     SA6    ACT+B5      ACT(J) = ACW(INCI[CCW],BIAS,I) 
          SB5    B5+B1       J = J + 1
          SX7    B5-7 
          MI     X7,DAA2     IF J < 7 
 DAA      SPACE  2,10 
*         AT THIS POINT WE SHOULD RUN A CRITICAL PATH CALCULATION AND 
*         SORT THE CANIDATE TABLE. FOR THE PRESENT WE OMIT IT.
  
 DAA4     ZR     B5,DAA      IF J = 0      */ NO CANIDATES
          SA5    =XO.SYM
          SA4    MAA
          SA0    X5+1 
          SB4    B0          FI = 0 
          MX7    0
          SA7    ACT+B5      ACT(J) = 0 
          SB7    X4 
          SX0    B1 
          SB5    B0          SI = 0 
          LX0    CA.NOCCP 
  
*         PRUNE THE CANIDATE TABLE TO REMOVE THOSE WITH VARIABLE
*         OR LARGE CONSTANT INCREMENTS ( AVOID MODE 1 AT EXECUTION )
  
 DAA5     SA1    =XHO$UO
          SA5    ACT+B4 
          ZR     X5,DAA9
          SB2    X5+B1       I = CO[ACT(FI)]
          LX5    -CC.INCP    IP = INC[ACT(FI)]
          NZ     X1,DAA7     IF HO$UO  " 0 */ TAKE ALL IF *UO* SELECTED 
  
          SA4    B6+X5       CI = RCT(IP) 
          LX4    59-CA.CONP 
          PL     X4,DAA8     IF ^CON[CI]   */ REJECT IF VARIABLE INC
          SA4    A4+B1       C2W = RCT(IP+1)
          LX4    -IH.CAP     C = CA[C2W]   */ CONSTANT INC VALUE
          SX7    X4-3 
          MI     X7,DAA7     IF C @ 2 
          SX6    X4-MAX.INC 
          PL     X6,DAA8     IF C > MAX.INC  */ CON INC TOO BIG 
  
*         CHECK LOCATION OF SYMBOL, IF IN LABELED COMMON OR LOCAL,
*         ASSUME THAT THEIR WILL BE AT LEAST MAX.INC STORAGE ABOVE IT.
  
          SA4    B6+B2       C2W = RCT(I+1) 
          SB2    X4          H = IH[C2W]
          LX4    1
          SB2    B2+X4
          SA3    A0+B2       WORDB = SYM(3*IH+1)
          LX3    59-WB.FPP
          MI     X3,DAA8     IF FP[WORDB]  */ LOCATION UNKNOWN
          LX3    WB.FPP-WB.COMP 
          PL     X3,DAA7     IF ^COM[WORDB]  */ NOT IN COMMON 
          SA3    A3+B1       WORDC = WORDB + 1
          MX7    -WC.RBL
          LX3    -WC.RBP
          BX6    -X7*X3      RBN = RB[WORDC]
 .FTN     IFEQ   HC.ID,2,2                                              001210
          SA1    =XBLNKCOM                                              001220
          BX6    X6-X1                                                  001230
          ZR     X6,DAA8     IF RBN = 0    */ IN // COMMON
  
*         ADD NAME TO FINAL CANIDATE LIST 
  
 DAA7     SA4    B6+X5       CIP = RCT(IP)
          LX5    CC.INCP
          IX7    X0+X4       NOCC[CIP] = NOCC[CIP] + 1
          BX6    X5 
          SA6    ACT+B5      ACT(SI) = ACT(FI)
          SA7    A4 
          SB5    B5+B1       SI = SI + 1
          EQ     B5,B7,DAA9  IF SI = MAA
  
 DAA8     SB4    B4+B1       FI = FI + 1
          EQ     DAA5 
  
 DAA9     ZR     B5,DAA      IF SI = 0
  
          SA1    MRA
          SB3    20B         REGN = 20B    */ X0, X1,...
          SB4    B0          J = 0
          SX0    B1 
  
*         NOW MARK THE PREFETCH ASSIGNMENTS IN *RCT* AND *RAT*
  
 DAA10    SA2    ACT+B4      I = CO[ACT(J)] 
          SA4    DAAB 
          SA3    X2+B6       CI = RCT(I)
          BX6    X4+X3       (RA,VC)[CI] = 1
          SA6    A3 
          SA4    A3+B1       C2W = RCT(I+1) 
          LX2    -IH.CAP
          SB2    X2 
          LX4    -IH.CAP
          SX5    B2+X4
          MX7    -IH.CAL
          BX5    -X7*X5      CA[C2W] = CA[C2W] + CA[ACT(J)] 
          LX2    IH.CAP 
          BX7    X7*X4
          BX6    X7+X5
          LX6    IH.CAP 
          SA6    A4 
          LX4    IH.CAP-IH.RFP     R = RF[C2W]
          SA5    B6+X4       CJ = RCT(R)
          MX7    -CA.SUSEL
          LX5    -CA.SUSEP
          IX6    X5-X0       SUSE[CJ] = SUSE[CJ] - 1
          BX7    -X7*X6 
          LX6    CA.SUSEP 
          SA6    A5 
          SX7    X7-1 
          NZ     X7,DAA11    IF SUSE[CJ] " 1
  
*         USES OF INCREMENT VARIABLE = 1 , DEALLOCATE THE B-REGISTER
*         AND MARK THE VAR AS DEAD. 
  
          SX7    X6 
          LX6    59-CA.LXP
          MI     X6,DAA11    IF LX[CJ]     */ LIVE ON EXIT FROM THE LOOP
          NZ     X7,DAA10A   IF UDI[CJ] " 0  */ PROGRAMMER VARIABLE 
          LX6    CA.LXP-CA.CONP 
          MI     X6,DAA10A   IF CON[CJ] 
  
          SA4    A5+B1
          MX7    -T.REGL
          LX4    -IH.CAP
          SB2    X4          C = CA[RCT(R+1)] 
          SA4    O.TET
          LX7    T.REGP 
          SA4    X4+B2
          BX6    X7*X4       REG[TET(C)] = 0
          SA6    A4 
  
 DAA10A   SA4    A5+2        CCW = RCT(R+2) 
          MX7    -CC.REG1L
          SX6    B0 
          LX4    -CC.REG1P
          BX4    -X7*X4      REG = REG1[CCW]
          SB2    X4 
          SA6    RAT+X4      RAT(REG) = 0 
          LX7    B2,X0
          BX1    X7+X1       MRA = MRA ! SHIFT(1,REG) 
          SA4    NAB
          SX7    X4+B1       NAB = NAB + 1
          SA7    A4 
          SA4    SEEA 
          LX5    CA.SUSEP 
          BX6    X4+X5       KD[CJ] = 1    */ SET TO KILL THIS DEF
          SA6    A5 
  
*         SELECT A LD-REG AND MARK THE ASSIGNMENT IN *RCT* AND *RAT*
  
 DAA11    SB3    B3+1        REGN = REGN + 1
          LX7    B3,X0       BIT = SHIFT(1,REGN)
          BX6    X7*X1
          ZR     X6,DAA11    IF MRA & BIT = 0  */ LD-REG NOT AVAIL
  
          SA4    A3+2        CCW = RCT(I+2) 
          BX1    -X7*X1      MRA = MRA & ^BIT 
          SX6    X2 
          SA6    RAT+B3      RAT(REGNO) = I 
          SX3    B3 
          BX2    X2-X6
          BX7    X2+X3       CO[ACT(J)] = REGNO  */ SAVE X-REGNO IN ACT 
          SA7    A2 
          LX3    CC.REG1P 
          BX7    X3+X4       REG1[CCW] = REGN 
          SA7    A4 
          SB4    B4+B1       J = J + 1
          LT     B4,B5,DAA10 IF J < SI
  
          SX6    B5 
          BX7    X1 
          SA6    NAA         NAA = SI 
          SA7    MRA
          EQ     DAA
 AAV      TITLE  AAV - ASSIGN ARRAY VARIABLES TO REGISTERS
**        AAV - ASSIGN ARRAY VARIABLES TO X-REGISTERS 
* 
*         CHECK LOOP FOR STATEMENTS OF THE FORM A(I) = A(I) OP EXPR 
*         WHERE I IS INVARIANT AND NO OTHER REFS TO A.  IF SO, THEN 
*         ASSIGN A(I) TO AN X-REGISTER WITH THE ADDRESS IN THE
*         CORRESPONDING A-REGISTER. 
  
 CA.NO=2P EQU    CA.NOCCP+1 
 CA.NO=2L EQU    1
 AAVA     BFMW   CA,(AC,NO=2,DEF,USE) 
  
 AXCT     BSSZ   4           A/X CANIDATE TABLE   24/0,18/RCT-ORD,18/REG
  
 AAV      ROUTINE 
          SA1    HO$OPT 
          PL     X1,AAV      IF OPT NE 2
          SA1    N.ENL
          SB5    B0          J = 0
          AX1    1
          NZ     X1,AAV5     IF N.ENL > 1  */ MORE THAN 1 EXIT NODE 
  
*         SCAN *RCT* FOR CANIDATES
  
          SA4    O.RCT
          SA5    LCT
          SA1    AAVA 
          SB6    X4 
          SB4    X5+B1
          BX0    X1 
          SA5    B6+X5       CI = RCT + LCT 
  
 AAV2     SA5    A5-3        CI = CI - 3
          ZR     X5,AAV5     IF [CI] = 0   */ END OF TABLE
          BX6    -X0+X5 
          NZ     X6,AAV2     IF ^( NOCC = 2 & AC & DEF & USE )
          LX5    59-CA.RAP
          MI     X5,AAV2     IF RA[CI]     */ PREVIOUSLY ASSIGNED 
          SA4    A5+B1       C2W = CI + 1 
          LX4    -IH.RFP
          SX3    X4 
          ZR     X3,AAV2     IF RF[C2W] = 0 
          SA3    B6+X3       CIF = RCT(RF)
          LX3    59-CA.DEFP 
          MI     X3,AAV2     IF DEF[CIF]   */ SUBSCRIPT NOT INVARIANT 
          LX5    1+CA.RAP-CA.APLNP
          MX7    -CA.APLNL
          BX7    -X7*X5 
          NZ     X7,AAV2A    IF REFED ON AP/LN NODES
          SA2    HO$UO
          ZR     X2,AAV2     IF NOT UNSAFE OPT ALLOWED
 AAV2A    BSS    0
  
*         CHECK FOR INTERFERING REFS
  
          LX4    IH.RFP 
          SB3    A4 
          SA2    B6+B4       C2K = RCT(LCT+1) 
          MX7    -IH.IHL
 AAV3     SA2    A2-3        C2K = C2K - 3
          ZR     X2,AAV4     IF [C2K] = 0  */ END OF TABLE
          BX6    X2-X4
          BX3    -X7*X6 
          NZ     X3,AAV3     IF IH[C2I] " IH[C2K] 
          SB2    A2-B3
          ZR     B2,AAV3     IF C2K = C2I  */ SAME ENTRY
          EQ     AAV2        INTERFERENCE 
  
 AAV4     SX6    A5-B6       I = CI - RCT 
          SA6    AXCT+B5     AXCT(J) = I   */ SAVE ORDINAL
          SB5    B5+B1       J = J + 1
          SX7    B5-3 
          MI     X7,AAV2     IF J < 3 
  
 AAV5     SA1    MAA
          MX6    0
          SX7    B5 
          SA6    AXCT+B5     AXCT(J) = 0
          SA2    MRA
          AX2    21B
          MX3    -5 
          BX4    -X3*X2 
          CX3    X4          N.LDREG = COUNT(MRA_LOAD_REGISTERS)
          IX5    X3-X7
          IX2    X1-X5                                                  002380
          AX2    59                                                     002390
          BX1    X2*X1                                                  002400
          BX5    -X2*X5                                                 002410
          BX6    X1+X5       MAA = MIN( MAA , N.LDREG-NXA ) 
          SA2    N.LD 
          SB3    X2 
          SB3    B3-B5
          SB4    X6 
          LE     B3,B4,AAV5A IF N.LD - #X/A LE MAA
          SX6    X6-1        MAA = MAA - 1
  
 AAV5A    SA6    A1 
          ZR     B5,AAV      IF J = 0      */ NO A/X ASSIGNMENTS
  
*         MARK THE ASSIGNMENTS IN *RCT* AND *RAT* 
  
          SA1    MRA
          SB3    20B         REGN = 20B 
          SB4    B0          K = 0
  
 AAV6     SA5    DAAB 
          SA2    AXCT+B4     I = AXCT(K)
          SA3    B6+X2       CI = RCT(I)
          BX6    X5+X3       (RA,VC)[CI] = 1
          SA6    A3 
          MX0    -CA.NOCCL
          LX3    -CA.NOCCP
          BX7    -X0*X3 
          SA4    A3+B1       C2I = CI + 1 
          LX4    -IH.RFP     R = RF[C2I]
          SA5    B6+X4       CF = RCT(R)
          LX7    CA.SUSEP 
          IX6    X5-X7       SUSE[CF] = SUSE[CF] - NOCC[CI] 
          SA6    A5 
          LX6    -CA.SUSEP
          BX7    -X0*X6 
          SX0    B1 
          NZ     X7,AAV9     IF SUSE[CF] " 0
  
*         VAR HAS NO USES, DEALLOCATE THE REGISTER ASSIGNED TO IT 
  
          LX6    CA.SUSEP 
          MX4    1
          LX4    1+CA.RAP 
          BX7    X4*X6
          ZR     X7,AAV9     IF NOT RF[CF]   */ NOT IN A REG
          BX6    -X4*X6      RA[CF] = 0 
          SA6    A6 
          SX7    X6 
          NZ     X7,AAV8     IF UDI[CF] " 0  */ PROGRAMMER VARIABLE 
          LX6    59-CA.CONP 
          MI     X6,AAV8     IF CON[CF] 
  
          SA4    A5+B1
          MX7    -T.REGL
          LX4    -IH.CAP
          SB2    X4          C = CA[RCT(R+1)] 
          SA4    O.TET
          LX7    T.REGP 
          SA4    X4+B2
          BX6    X7*X4       REG[TET(C)] = 0
          SA6    A4 
  
 AAV8     SA4    A5+2        CCW = RCT(R+2) 
          MX7    -CC.REG1L
          SX6    B0 
          LX4    -CC.REG1P
          BX4    -X7*X4      REG = REG[CCW] 
          SB2    X4 
          SA6    RAT+X4      RAT(REG) = 0 
          LX7    B2,X0
          BX1    X1+X7       MRA = MRA ! SHIFT(1,REG) 
          SA4    NAB
          SX7    X4+B1       NAB = NAB + 1
          SA7    A4 
  
 AAV9     SB3    B3+1        REGN = REGN + 1
          LX7    B3,X0       BIT = SHIFT(1,REGN)
          BX6    X7*X1
          ZR     X6,AAV9     IF MRA & BIT = 0  */ REG NOT AVAIL 
  
          SA4    A3+2        CCW = RCT(I+2) 
          BX1    -X7*X1      MRA = MRA & ^BIT 
          SX7    X2 
          SA7    RAT+B3      RAT(REGN) = I
          SX5    B3 
          LX2    18 
          BX6    X2+X5
          SA6    A2          AXCT(K) = 24/0,18/I,18/REGN
          LX5    CC.REG1P 
          BX6    X4+X5       REG1[CCW] = REGN 
          SA6    A4 
          SB4    B4+B1       K = K + 1
          LT     B4,B5,AAV6  IF K < NAXA
  
          BX6    X1 
          SA6    A1          UPDATE MRA 
          EQ     AAV
 MFA      TTL    GRA - GLOBAL REGISTER ASSIGNMENT / FINAL B-ASSIGNMENT
 MFA      TITLE  MFA - MAKE FINAL B-ASSIGNMENTS 
**        MFA - MAKE FINAL B-ASSIGNMENTS
* 
*         ADJUST ADDRESS REFERENCES TO MINIMIZE SIZE OF CODE IN LOOP. 
*         ASSIGN CONSTANTS TO B-REGS, SETUP LOOP COUNTING CODE INFO.
  
*         BC. - B-REG CANIDATE SORT TABLE 
  
          DESCRIBE BC.,60    BCT(RF,IH,NOCC,CO) 
 RF       DEFINE 15          RCT RF 
 IH       DEFINE 18          IH OF SYMBOL 
 NOCC     DEFINE 9
 CO       DEFINE 18          RCT INDEX OF CANIDATE
  
*         AI. - RF CLASS INDEX TABLE
  
          DESCRIBE AI.,60    AIT(BASE,NIH,LEN,INDX) 
          DEFINE 2
 BASE     DEFINE 1           =1 IF PROG VAR OR BASE MEMBER OF *IP* CLASS
 NIH      DEFINE 18          377777B - N.IH"S IN RF CLASS 
 LEN      DEFINE 18          NUMBER OF ENTRIES IN CLASS 
          DEFINE 2
 FP       DEFINE 1
 INDX     DEFINE 18          INDEX TO LWA OF CLASS
  
 MFA      ROUTINE 
          SA1    MRA
          SA5    L.RCT
          SX2    376B 
          BX3    X2*X1
          SX4    X3+B1
          PX6    X4          ABR = PACK( 0 , MRA&376B + 1 ) 
          SA6    ABR
          ALLOC  RND,X5      ALLOC( RND , L.RCT ) 
          SA4    O.RCT
          MX7    0
          SB7    X2+B1       BO = O.RND + 1 
          SA7    X2          BI = BO - 1;  [BI] = 0 
          SB6    X4          CO = [O.RCT] 
          SA5    B6+X5       CI = CO + L.RCT
          MX0    -CA.NOCCL
          SB4    B0          NC = 0        */ N. CONS 
          LX0    CA.NOCCP 
          SB5    B0          LC = 0        */ LINK TO LAST CON
          MX6    60 
          SA6    B6          [CO] = -0     */ INDICATE RF=0 IS IN A REG 
          EQ     MFA2 
  
*         ADD ENTRY TO *CON* LIST 
  
 MFA1     SA3    A5+B1
          SA4    A3+B1
          LX3    59-IH.MSKP 
          MI     X3,MFA2     IF MSK[CI+1] 
          SX7    B5 
          SB4    B4+B1       NC = NC + 1
          LX7    CC.INCP     INC[CI+2] = LC 
          BX6    X4+X7
          SB5    A5-B6       LC = CI - CO  */ POINT TO LAST 
          SA6    A4 
  
*         SCAN *RCT* AND BUILD *CON* LIST AND RF,IH SORT TABLE
*         OF ADDRESS CANIDATES
  
 MFA2     SA5    A5-3        CI = CI - 3
          ZR     X5,MFA3     IF [CI] = 0   */ END OF TABLE
          BX6    X5 
          LX6    59-CA.CONP 
          MI     X6,MFA1     IF CON[CI] 
          LX6    CA.CONP-CA.RAP 
          MI     X6,MFA2     IF RA[CI]
          LX6    CA.RAP-CA.ACP
          PL     X6,MFA2     IF ^AC[CI] 
  
          SA4    A5+2        CCW = [RCT+2]
          LX4    -CC.H2P
          SX3    X4 
          NZ     X3,MFA2     IF H2[CCW] " 0  */ OMIT SYM DIFFERENCES
          SA4    A5+B1       C2W = [CI+1] 
          BX5    -X0*X5 
          SX3    X4 
          LX4    -IH.RFP
          SX4    X4          R = RF[CI] 
          LX5    BC.NOCCP-CA.NOCCP
          ZR     X4,MFA2B    IF R = 0 
  
          SA1    DAAB 
          SA2    B6+X4       CJ = RCT(R)
          BX6    -X1+X2 
          NZ     X6,MFA2B    IF ^( VC[CJ] & RA[CJ] )
          SA2    A2+2        CCW = RCT(R+2) 
          LX2    59-CC.REG1P-4
          PL     X2,MFA2C    IF REG1[CCW] < 20B  */ IN A B-REGISTER 
  
 MFA2B    ZR     X3,MFA2     IF IH[C2W] = 0 
          MX4    0           R = 0
          SA2    A5 
          SA1    MFAD 
          BX6    X1*X2
          NZ     X6,MFA2C    IF FP[CI] ! NOCC[CI] \ 2 
          LX2    59-CA.RAP
          PL     X2,MFA2     IF ^RA[CI] 
  
 MFA2C    LX3    BC.IHP 
          SX6    A5-B6
          LX4    BC.RFP 
          BX3    X3+X4
          IX5    X5+X6
          BX7    X3+X5
          SA7    A7+B1       BI = BI + 1;  [BI] = BCT(R,IH,NOCC,CI-CO)
          EQ     MFA2 
  
 MFA3     SX6    B5 
          SA6    CL          CL = LC       */ CON LIST POINTER
          MX6    0
          SA6    B6          [CO] = 0 
          SB3    A7+B1       BI = BI + 1
          SX1    B3-B7       LEN = BI - BO
          BX6    X1 
          SA6    NAC         NAC = LEN     */ NUMBER OF ADDRESS CANIDATE
          ZR     X1,MFA48    IF LEN = 0 
  
          CALL   SHL#        SORT( BCT )
  
*         NOW FORM THE RF CLASS INDEX TABLE AND SORT IT 
  
          SA2    O.TET
          MX7    60 
          SA7    B3          AI = BI;  [AI] = -0  */ SEARCH TERMINATOR
          MX0    -BC.RFP
          SB3    B3+B1       AF = AI + 1   */ BASE
          SA0    X2 
          SB4    377776B     NIH = -1 
          MX1    -BC.IHL
          SB5    B7          BF = BO       */ ADDRESS OF FIRST IN CLASS 
          LX1    BC.IHP 
          SA5    B7          BI = BO
          EQ     MFA6 
  
*         END OF RF CLASS, SETUP INDEX WORD IN *AIT*
  
 MFA4     AX2    BC.RFP 
          SA4    B6+X2       CI = RCT(RF[BL]) 
          SB2    X2                                                     000250
          MX7    0           BASE = 0                                   000260
          ZR     B2,MFA5     IF RF[BL] = 0                              000270
          SX7    B1          BASE = 1 
          SB2    X4 
          NZ     B2,MFA5     IF UDI[CI] " 0  */ PROGRAMMER VAR
  
          SA4    A4+B1
          LX4    -IH.CAP
          SB2    X4 
          SA3    A0+B2       TI = TET(CA[CI+1]) 
          LX3    -T.BIPP
          BX7    X7*X3       BASE = BIP[TI] 
  
 MFA5     SX2    A5-B7       INDX = BI - BO 
          LX2    AI.INDXP 
          SX3    A5-B5       LEN = BI - BF
          SB5    A5          BF = BI
          LX3    AI.LENP
          SX4    B4 
          LX7    AI.BASEP 
          BX6    X7+X2
          LX4    AI.NIHP
          IX3    X3+X4
          BX7    X3+X6
          SA7    A7+1        AI = AI + 1;  [AI] = AIT(BASE,NIH,LEN,INDX)
          SB4    377776B     NIH = -1 
          ZR     X5,MFA7     IF [BI] = 0   */ END OF TABLE
  
 MFA6     BX2    X5          BL = [BI]
          SA5    A5+B1       BI = BI + 1
          BX6    X5-X2
          BX7    X0*X6
          NZ     X7,MFA4     IF RF[BI] " RF[BL] 
  
          BX6    -X1*X6 
          ZR     X6,MFA6     IF IH[BI] = IH[BL] 
          SB4    B4-1        NIH = NIH - 1
          NZ     X5,MFA6     IF [BI] " 0
  
          EQ     MFA5 
  
*         SORT THE CLASS INDEX TABLE
  
 MFA7     SB2    A7+B1
          SB7    B7-B1
          SX6    B2-B7       ATI = AI+1 - (BO-1)
          MX7    0
          SA7    A5          [BI] = 0 
          SA6    ATI
          SA6    L.RND
          SX1    B2-B3       LEN = AI+1 - AF
          SB7    B3 
          CALL   SHL#        SORT( AIT )
  
          PRINT  MFA,(* NAC,ATI =*2Z5),(NAC,ATI)
          TRACE  MFA,RND
  
*         GET SPACE FOR NEW ENTRIES ( CON"S, DIFFERENCES )
  
          SA5    NAC
          LX4    B1,X5
          IX1    X4+X5
          ALLOC  RCT,X1      ALLOC( RCT , 3*NAC ) 
          SA4    O.RND
          SX6    B6 
          SB7    X4 
          SA6    L.RCT       L.RCT = OLD(L.RCT) 
          SB6    X2 
 MFA      SPACE  2,10 
**        MAIN LOOP FOR ADDRESS CANIDATE MODIFICATION 
*         (A0) = REGNO,  (B6) = [O.RCT],  (B7) = [O.RND]
  
 MFA10    SA1    ATI
          SX7    X1-1        ATI = ATI - 1
          SA2    B7+X7       AI = RND(ATI)
          SA7    A1 
          ZR     X2,MFA48    IF AI = 0     */ END OF TABLE
  
          LX2    -AI.INDXP
          SA5    B7+X2       BI = RND(INDX[AI]) 
          LX2    AI.INDXP-AI.LENP 
          SB5    X2          L = LEN[AI]   */ NUMBER OF ENTRIES 
          LX2    AI.LENP-AI.NIHP
          SB2    X2+400000B 
          LX2    AI.NIHP+59-AI.BASEP
          BX6    X5 
          SB4    -B2         N = -NIH[AI]  */ NUMBER OF IH"S
          AX6    BC.RFP 
          SB2    X6+2        R = RF[BI] 
          MX0    -CC.REG1L
          SA3    B6+B2       CCW = RCT(R+2) 
          LX3    -CC.REG1P
          BX7    -X0*X3 
          SA0    X7          REGNO = REG1[CCW]
          ZR     X7,MFA40    IF REGNO = 0 
  
          SA4    A3-2        CAW = RCT(R) 
          SA1    MTAB 
          BX6    X1*X4
          LX4    59-CA.TUP
          NZ     X6,MFA40    IF (IRA,EU,LX)[CAW]  */ CANT BIAS
          PL     X4,MFA10A   IF ^TU[CAW]   */ NOT LOOP *CV* OR LIMIT
          SA1    TRD
          SX4    X1-2 
          ZR     X4,MFA40    IF TRD = 2    */ I,N IN REGS 
  
 MFA10A   GT     B5,B1,MFA20 IF L > 1      */ MORE THAN 1 MEMBER IN CLASS 
  
*         1 ENTRY IN RF,IH CLASS, SETUP ADDRESS IN B-REG WITH RF
  
          PL     X2,MFA12    IF ^BASE[AI] 
  
*         ASSIGN BASE MEMBER ADDRESS TO B-REG 
  
 MFA11    RJ     AFA         ASSIGN FULL ADDRESS
          EQ     MFA10
  
*         ^BASE *IP*, FIND BASE TP IN REGS AND DO DIFFERENCING
  
 MFA12    SA4    A4+B1
          SA3    O.TET
          LX4    -IH.CAP
          SB2    X4          C = CA[RCT(R+1)]  */ CA OF *IP*
          SA2    X3+B2
          SA1    O.IIT
          LX2    59-T.INVP
          MI     X2,MFA11    IF INV[TET(C)] 
          LX2    1+T.INVP-T.ITIP
          SB2    X2 
          ZR     B2,MFA11    IF ITI = 0    */ INVARAINT TEMP
          SA4    X1+B2       ITW = IIT(ITI) 
          LX4    -PI.CAP
          SB2    X4          BC = CA[ITW]  */ CA OF BASE
          SA2    X3+B2
          LX2    -T.REGP
          SB5    X2          BREGN = REG[TET(BC)]  */ REG THAT BASE IS I
          ZR     B5,MFA11    IF BREGNO = 0 */ BASE NOT IN A REG 
          SA1    RAT+B5      J1 = R1[RAT(BREGN)]
          SA2    B6+X1
          LX2    59-CA.EUP
          MI     X2,MFA11    IF EU[RCT(J1)]  */ BASE IP IS *XU* 
  
*         NOW PLAY AROUND TO SETUP *REGNO* AS DELTA(IHCA,RF"S)
  
          SA1    B6+X5       J = CO[BI] 
          MX0    1
          SA2    A1+2        CCW = RCT(J+2) 
          LX0    1+CA.RAP 
          SX3    B5+2S6+V.SRF  REG1[CCW] = BREGN
          LX3    CC.REG1P    MIT[CCW] = 42B    */ SET *SRF* BIT 
          SX4    A0          REG2[CCW] = REGNO
          LX4    CC.REG2P 
          BX6    X0+X1       RA[RCT(J)] = 1 
          SA6    A1 
          BX3    X3+X4
          BX7    X3+X2
          SA7    A2 
          SA7    GRASRF      GRASRF = 1 
  
*         SETUP *RAT* TO FORM DIFFERENCE CODE IN PROLOGUE 
  
          SA1    RAT+B5 
          SX3    X1          J1 = R1[RAT(BREGN)]
          LX1    -RA.R3P
          SB3    X1          J3 = R3[RAT(BREGN)]
          SA2    RAT+A0      JO = R1[RAT(REGNO)]
          LX0    RA.INVP-CA.RAP 
          BX2    X0+X2       INV[RAT(REGNO)] = 1
          LX3    RA.R2P 
          BX7    X3+X2       R2[RAT(REGNO)] = J1
          SA7    A2 
          SA4    SEEA 
          SA3    B6+X2
          BX6    X3+X4       KD[RCT(JO)] = 1
          SA6    A3 
          NZ     B3,MFA13    IF J3 " 0     */ SYMBOL APPENDED 
  
          SX3    X5 
          LX3    RA.R3P 
          BX7    X3+X7       R3[RAT(REGNO)] = J  */ APPEND THIS IHCA
          SA7    A7 
          EQ     MFA10
  
*         BASE REG HAS A SYMBOL APPENDED, FORM ADDRESS DIFFERENCE 
  
 MFA13    SX5    X5+B1
          SA1    B6+X5
          SB3    B3+B1
          SA2    B6+B3
          MX0    -IH.RFP
          BX1    -X0*X1      CAIH1 = CAIH[RCT(J+1)] 
          BX2    -X0*X2      CAIH2 = CAIH[RCT(J3+1)]
          BX3    X1-X2
          ZR     X3,MFA10    IF CAIH1 = CAIH2 
  
          SA4    L.RCT
          SB2    X3 
          SB4    X4+B1       OL = L.RCT 
          SX6    X4+3        L.RCT = L.RCT + 3
          LX4    RA.R3P 
          SA6    A4 
          BX7    X4+X7       R3[RAT(REGNO)] = OL  */ DIFF CANIDATE
          MX0    -IH.CAL
          SA7    A7 
          SX3    X1 
          SX4    X2 
          LX1    -IH.CAP
          LX2    -IH.CAP
          SX1    X1 
          SX2    X2 
          IX1    X1-X2
          MX7    0           KEY2 = 0 
          BX6    -X0*X1 
          LX6    IH.CAP      KEY = IHW(0,0, CA1-CA2 , 0 ) 
          ZR     B2,MFA14    IF IH1 = IH2 
          SX7    X4 
          LX7    CC.H2P      KEY2 = CCW(0,IH2,0)
          BX6    X3+X6       IH[KEY] = IH1
  
 MFA14    SA4    EDCA 
          SA6    B6+B4       RCT(OL+1) = KEY
          SA7    A6+B1       RCT(OL+2) = KEY2 
          BX6    X4 
          SA6    A6-B1       RCT(OL) = CAW(0,AC,PL) 
          EQ     MFA10
 MFA      SPACE  2,10 
*         PROCESS CLASS WITH L > 1 AND NIH = 1
  
 MFA20    NE     B4,B1,MFA30 IF N > 1 
          RJ     PSC         PROCESS SIMPLE CLASS 
          EQ     MFA10
 MFA      SPACE  2,10 
*         MULTI IH CLASS
  
 MFA30    SX6    B4-5 
          PL     X6,MFA40    IF N > 4 
          SA4    NAB
          ZR     X4,MFA10    IF NAB = 0 
  
*         1 < NIH @ 4 , TRY ADDRESS DIFFERENCING
*         FIRST FORM AN *IH* CLASS SUBTABLE 
  
          SB3    B0          ML = 0        */ MAX *IH* CLASS LEN
          MX0    -BC.IHP
          SX1    B0          NC = 0 
          SX7    A5          BF = BI
  
 MFA31    BX4    X5          BL = [BI]
          SA5    A5-B1       BI = BI - 1
          BX6    X4-X5
          BX3    X0*X6
          ZR     X3,MFA31    IF RFIH[BI] = RFIH[BL] 
  
          SA2    B6+X4       CI = RCT(CO[BL]) 
          SX3    B1 
          LX3    CA.FPP 
          BX3    X3*X2
          SX2    A5 
          IX6    X7-X2       LEN = BF - BI
          LX3    AI.FPP-CA.FPP     FP = FP[CI]
          SB2    X6 
          BX7    X3+X7
          LX6    AI.LENP
          BX7    X6+X7
          SA7    CIT+X1      CIT(NC) = AIT(0,0,LEN,FP,BF) 
          SX1    X1+B1       NC = NC + 1
          LE     B2,B3,MFA32 ML = MAX( ML , LEN ) 
          SB3    B2 
 MFA32    SX7    A5 
          SB2    X1 
          LT     B2,B4,MFA31 IF NC < N
  
          SA2    NAB
          SA3    CIT
          SB2    X2+B3
          SA5    X3          BI = INDX[CIT] 
          GT     B5,B2,MFA40 IF L > NAB + ML  */ NOT ENOUGH REGISTERS 
 MFA      SPACE  2,10 
*         BASE *IH* CLASS IS THAT WITH *ML* AND F.P. ( IF ANY ) 
  
          MX7    0
          SA7    A7+B1       CIT(NC) = 0   */ TABLE TERMINATOR
          SB5    B1          I = 1
          SB2    B0          IM = 0;  MVAL = CIT(0) 
  
 MFA33    SA4    CIT+B5 
          IX6    X3-X4
          SB5    B5+B1       I = I + 1
          PL     X6,MFA34    IF CIT(I-1) @ MVAL 
          SB2    B5-B1       IM = I - 1 
          BX3    X4          MVAL = CIT(IM) 
 MFA34    LT     B5,B4,MFA33 IF I < N 
  
          GT     B3,B1,MFA34A      IF ML > 1
          LX3    59-AI.FPP
          PL     X3,MFA40    IF ^FP[MVAL]  */ NO F.P. S IN THE CLASS
  
 MFA34A   SA2    CIT+B2 
          SA3    A3 
          BX6    X3 
          LX7    X2 
          SA6    A2          SWAP( CIT(0) , CIT(IM) ) 
          SA7    A3 
  
          SA5    X2          BI = INDX[CIT] 
          LX2    -AI.LENP 
          SB5    X2          L = LEN[CIT] 
          RJ     PSC         PROCESS BASE CLASS 
  
          SX6    B1+B1
          SA6    CIT         I = 2;  AI = CIT(1)
  
 MFA35    SA1    CIT+1
          SA2    MFAC 
          SA3    X1          BI = INDX[AI]
          IX6    X1-X2       (LEN,INDX)[AI] = (LEN,INDX)[AI] - 1
          SA6    A1 
          SB5    X3          J = CO[BI] 
          RJ     AAD         ASSIGN ADDRESS DIFFERENCE( J, REGNO , CAIH 
          SA1    CIT+1
          LX1    -AI.LENP 
          SB2    X1 
          NZ     B2,MFA35    IF LEN[AI] " 0 
  
          SA2    A1-B1
          SA3    CIT+X2      AI = CIT(I)
          SX7    X2+B1       I = I + 1
          SA7    A2 
          BX6    X3 
          SA6    A1 
          NZ     X3,MFA35    IF AI " 0
  
          EQ     MFA10
  
 MFAC     BSS    0
          POS    AI.LENP+1
          VFD    1/1,*P/1 
 CA.NOC2P EQU    CA.NOCCP+1 
 CA.NOC2L EQU    CA.NOCCL-1 
 MFAD     BFMW   CA,(FP,NOC2) 
 MFA      SPACE  2,14 
*         PARTIAL ASSIGNMENT, SET IH+CA IN A REGISTER 
  
 MFA40    SX6    0
          SA6    CAIH        CAIH = 0 
  
 MFA41    SX7    A5-B1
          SB2    X5+B1
          SA7    CIT
          SB3    X5          J = CO[BI] 
          SA4    B6+B2       C2W = RCT(J+1) 
          MX0    -IH.RFP
          BX1    -X0*X4      CAIH1 = CAIH[C2W]
          MX2    0
          RJ     SDC         SEARCH FOR CAIH
          NZ     B2,MFA45    IF REGN " 0   */ IN A REG
  
          SA1    MFAD 
          SA2    B6+B3       CAW = RCT(J) 
          SA4    NAB
          BX3    X1*X2
          ZR     X3,MFA47    IF ^( FP[CAW] ! NOCC[CAW] > 1 )
          ZR     X4,MFA47    IF NAB = 0 
  
          SA4    =XO.SYM
          SA5    A2+B1
          SX4    X4+B1
          LX5    -IH.IHP
          SX5    X5 
          IX4    X4+X5
          LX5    1
          IX4    X4+X5
          SA4    X4          WORDB=SYM(3*IH+1)
          LX4    59-WB.LCMP 
          MI     X4,MFA47    IF LCM 
  
          RJ     EDC         ENTER CANIDATE 
  
*         SETUP *J* AS A *SLD*
  
 MFA45    SA1    B6+B3
          MX0    1
          SA2    A1+2        CCW = RCT(J+2) 
          LX0    1+CA.RAP 
          BX6    X0+X1       RA[RCT(J)] = 1 
          SA6    A1 
          SX7    4S6         MIT[CCW] = 4  */ SPECIAL CASE SLD/SST/SA 
          SX5    A0 
          SX4    B2 
          ZR     X5,MFA46    IF REGNO = 0  */ NO BASE REG 
  
          BX7    X5+X7       REG1[CCW] = REGNO
          LX7    CC.REG1P 
          LX4    CC.REG2P    REG2[CCW] = REGN 
          BX2    X4+X2
          BX7    X2+X7
          SA7    A2 
          EQ     MFA47
  
 MFA46    LX4    CC.REG1P 
          BX5    X4+X7       REG1[CCW] = REGN 
          BX7    X5+X2
          SA7    A2 
  
 MFA47    SA4    CIT
          SB5    B5-B1       L = L - 1
          SA5    X4          BI = BI - 1
          NZ     B5,MFA41    IF L " 0 
  
          EQ     MFA10
 MFA      SPACE  2,14 
 MFA48    SA1    NAB
          SA2    N.HB 
          NZ     X1,MFA48A   IF NAB " 0    */ B-REGS AVAIL
          SX7    X2-1 
          NZ     X7,MFA60    IF N.HB " 1   */ NOT OUTER LP WITH 1 INNER 
  
*         FORM SORT TABLE OF CONSTANTS WITH MORE THAN 1 OCCURANCE OR
*         PREVIOUSLY ASSIGNED TO A REGISTER IN AN INNER LOOP. 
  
 MFA48A   SA2    CL 
          MX0    -CA.NOCCL
          SX7    B0 
          LX0    CA.NOCCP 
          SB7    SCR+1
          SA7    B7-B1       SI = SCR;  [SI] = 0
          SX1    B0          L = 0
          SX2    X2          J = CL 
          SB5    -36B 
          SA0    0           NPA = 0       */ N. PREVIOUS ASSIGNMENTS 
          MX3    1
          LX3    1+CA.RAP 
  
 MFA49    SA5    B6+X2       CAW = RCT(J) 
          BX6    -X0*X5      N = NOCC[CAW]
          IX7    X6+X2
          BX4    X3*X5
          LX4    58-CA.RAP
          BX7    X4+X7       STW = CST(RA[CAW],N,J) 
          ZR     X4,MFA50    IF ^RA[CAW]
          SA0    A0+B1       NPA = NPA + 1
          EQ     MFA51
  
 MFA50    LX6    -CA.NOCCP
          SB2    X6 
          LE     B2,B1,MFA52 IF N @ 1 
  
 MFA51    SX1    X1+1        L = L + 1
          SA7    A7+B1       SI = SI + 1;  [SI] = CST(N,J)
          SB2    X1+B5
          PL     B2,MFA53    IF L = 36B 
  
 MFA52    SA5    A5+2 
          LX5    -CC.INCP 
          SX2    X5          J = INC[RCT(J+2)]
          NZ     X2,MFA49    IF J " 0      */ NOT END OF CON LIST 
  
 MFA53    ZR     X1,MFA60    IF L = 0      */ NO CANIDATES
          MX7    0
          SA7    A7+B1       SI = SI + 1;  [SI] = 0 
  
          CALL   SHL#        SORT( SCR )
          SA1    O.RND
          SA5    NAB
          SB2    A0+B1
          SB3    B3-B2       SI = SI - (NPA+1)  */ LWA OF ^ASGNED CONS
          SB7    X1+
          NZ     X5,MFA54    IF NAB " 0 
          EQ     B2,B1,MFA60 IF NPA = 0 
          EQ     MFA55
  
*         ASSIGN CONSTANTS TO THE B-REGS
  
 MFA54    SA5    B3          J = CO[SI] 
          ZR     X5,MFA55    IF J = 0      */ END OF SORT TABLE 
          SB3    B3-B1       SI = SI - 1
          SX1    B1          INVF = 1 
          SB4    X5 
          RJ     AIR         ASSIGN AN INDEX REGISTER 
          SA1    NAB
          NZ     X1,MFA54    IF NAB " 0    */ MORE B-REGS LEFT
  
*         PROPAGATE CONSTANT ASSIGNMENTS TO PARTIALLY MODIFIED INSTS
  
 MFA55    SA2    PMF
          ZR     X2,MFA60    IF PMF = 0    */ NO PARTIAL MODS 
          MX0    -IH.CAL
          SA3    B3+B1       SI = SI + 1   */ IN *A3* 
          LX0    IH.CAP 
          SB4    X3+B1       J = CO[SI] 
  
 MFA56    SA1    B6+B4       C2W = RCT(J+1) 
          SA2    A1+B1
          MX7    -CC.REG1L
          LX2    -CC.REG1P
          BX2    -X7*X2      REGN = REG1[RCT(J+2)]
          SA5    B7+B1       BI = O.RND + 1 
          LX2    CC.REG2P 
  
 MFA57    PL     X5,MFA59    IF [BI] > 0   */ NOT A PARTIAL MOD 
          BX5    -X5
          SB2    X5+B1       I = -CO[BI]
          SA4    B6+B2
          SX7    1S6         IT = 2 
          BX5    -X0*X4      C = CA[RCT(I+1)] 
          IX6    X5-X1
          ZR     X6,MFA58    IF C = C2W 
          IX4    X5+X1
          BX6    X0+X4
          NZ     X6,MFA59    IF -C " C2W
          LX7    1           IT = 3        */ 2S6 
  
*         CHANGE INSTRUCTION
  
 MFA58    SA4    A4+B1       CCW = RCT(I+2) 
          BX6    X2+X7       REG2[CCW] = REGN 
          IX7    X6+X4       MIT[CCW] = IT
          SA6    A4 
          SA7    A4 
  
 MFA59    SA5    A5+B1       BI = BI + 1
          NZ     X5,MFA57    IF [BI] " 0   */ NOT END OF ADDRESS TABLE
  
          SA3    A3+B1       SI = SI + 1
          SB4    X3+B1       J = CO[SI] 
          NZ     X3,MFA56    IF J " 0 
 MFA      SPACE  2,14 
*         SETUP LOOP TEST REPLACEMENT CODE INFO 
  
 MFA60    SA1    TRD
          SX6    0           L.RND = 0
          SA6    L.RND
          ZR     X1,MFA      IF TRD = 0    */ NO TEST REPLACEMENT 
  
          SA5    LUL
          UX6    B2,X5
          NZ     B2,MFA61    IF TYPE[LUL] " 0  */ NOT A CON *UL*
  
*         ENTER CONSTANT UPPER LIMIT IN *RCT* 
  
          ALLOC  RCT,3       ALLOC( RCT , 3 ) 
          MX0    -IH.CAL
          SX6    B1 
          BX7    -X0*X5 
          LX6    CA.CONP
          SA6    X2+B6       RCT(OL) = CAW(0,CON,0) 
          LX7    IH.CAP 
          SA7    A6+B1       RCT(OL+1) = IHW(0,0,CA[LUL],0) 
          MX6    0
          SA6    A7+B1       RCT(OL+2) = 0
          SA1    TRD
          SA4    X2+B1
          SX6    X1-2 
          NZ     X6,MFA60B   IF TRD " 2 
  
*         I, N IN REGS, CHECK FOR PREVIOUS ASSIGNMENT OF *UL* IN THIS LP
  
          SB5    X2+4 
          SB3    3
 MFA60A   BX6    X4-X7
          SA4    A4+B3
          NZ     X6,MFA60A   IF RCT(I-2) " RCT(OL+1)
          SB4    A4-B5
          EQ     B4,B6,MFA60B      IF I = OL
          SA3    A4-4        CAW = RCT(I) 
          LX3    59-CA.RAP
          PL     X3,MFA60A   IF ^RA[RCT(I)-3)]
          LX3    CA.RAP-CA.CONP 
          PL     X3,MFA60A   IF ^CON[CAW] 
          SA1    LUL+1
          SA6    RAT+X1      RAT(LUL(2)) = 0
          SA4    A3+2        CCW = RCT(I+2) 
          LX4    -CC.REG1P
          MX0    -CC.REG1L
          BX6    -X0*X4      LUL(2) = REG1[CCW] 
          SA6    A1 
          SB6    B4          OL = I 
  
 MFA60B   SA1    LUL+1
          SX7    B6 
          MX0    1
          LX0    1+RA.INVP
          BX7    X0+X7       RAT(LUL(2)) = RATW(1,0,0,OL) 
          SA7    RAT+X1 
  
 MFA61    SA5    TRD
          SB2    X5-2 
          ZR     B2,MFA      IF TRD = 2    */ I,N CASE
          PL     B2,MFA63    IF TRD " 1 
  
*         I-N CASE, SETUP TO BIAS REG THAT *CV* IS IN 
  
 MFA62    SA1    LUL+1
          SA2    RAT+X1 
          SA3    LCV+1
          SA4    RAT+X3 
          SX2    X2 
          LX2    RA.R2P      R2[RAT(LCV(2))] = R1[RAT(LUL(2))]
          BX6    X2+X4
          SA6    A4 
          MX7    0
          SA7    A2          RAT(LUL(2)) = 0
          SA7    A1          LUL(2) = 0 
          EQ     MFA
  
*         PROCESS A+I , A+N CASE , CV REG IS ALREADY BIASED 
  
 MFA63    NE     B2,B1,MFA64 IF TRD " 3 
          SA1    LUL+1
          SA2    RAT+X1 
          SA3    LCV+1
          SA4    RAT+X3 
          MX0    -RA.R3L
          SX7    B1 
          LX0    RA.R3P 
          BX5    -X0*X4      J = R3[RAT(LCV(2))]
          LX7    RA.INVP
          BX2    X7+X2       INV[RAT(LUL(2))] = 1 
          BX6    X5+X2       R3[RAT(LUL(2))] = J
          SA6    A2 
          EQ     MFA
  
*         TRD = 4, I,F(I) IN REGS, SEARCH FOR F(I)
  
 MFA64    SA1    O.RCT
          SA2    O.TET
          SA3    O.IIT
          SA4    =XIT.
          SA5    LCV
          SB7    7           I = 7         */ REGNO 
          SB6    X1+B1
          SB5    X2 
          SB4    X3+B1
          BX4    -X4
          SB3    X4 
          UX5    X5 
          AX5    PS.UDIP
          BX5    -X5
          SB2    X5          U = UDI[LCV] 
  
 MFA65    SA5    RAT+B7      R = R1[RAT(I)] 
          ZR     X5,MFA66    IF R = 0 
          SA4    B6+X5       C2W = RCT(R+1) 
          SX6    X4+B3
          NZ     X6,MFA66    IF IH[C2W] " IT. 
          SA3    A4-B1
          LX4    -IH.CAP     C = CA[C2W]
          LX3    59-CA.KDP
          SA2    B5+X4
          LX2    -T.ITIP     ITI = ITI[TET(C)]
          MI     X3,MFA66    IF KD[RCT(R)]
          SX2    X2 
          ZR     X2,MFA66    IF ITI = 0 
          SA1    B4+X2       IAW = IIT(ITI+1) 
          LX1    -IA.UDIP 
          SX6    X1+B2
          ZR     X6,MFA67    IF UDI[IAW] = U
  
 MFA66    SB7    B7-B1       I = I - 1
          NZ     B7,MFA65    IF I " 0 
  
*         F(I) NOT FOUND, CHANGE TO TRD = 1 
  
          SX6    B1 
          SA6    TRD         TRD = 1
          EQ     MFA62
  
*         POSSIBLE F(I) FOUND, CHECK INCREMENT VALUE. DISALLOW VARIABLE 
*         INCREMENTS SINCE THEY MAY BE NEGATIVE.
  
 MFA67    SA3    A4+B1       CCW=RCT(R+2)                               001250
          LX3    -CC.INCP                                               001260
          SX6    X3-1        IP=INC[CCW]                                001270
          SA1    B6+X6       CAWI=RCT(IP)                               001280
          LX1    59-CA.CONP                                             001290
          PL     X1,MFA66    IF CON[CAWI]=0 */VAR INCR.                 001300
                                                                        001310
*   IF F(I) INDEXES BLANK COMMON, A FORMAL PARAMETER OR LCM AND ITS     001320
*   INCREMENT IS SUFFICIENTLY LARGE USING IT AS AN ALTERNATE LOOP COUNT 001330
*   COULD RESULT IN A B REGISTER OVERFLOW.  FIRST CHECK IF SIZE OF      001340
*   INCREMENT IS SUFFICIENTLY LARGE (>100B).                            001350
                                                                        001360
          SA1    A1+B1       IHWI=CAWI+1                                001370
          LX1    -IH.CAP-6                                              001380
          SX1    X1                                                     001390
          ZR     X1,MFA68    IF CA[IHWI]<100B                           001400
                                                                        001410
*   NOW CHECK IF F(I) INDEXES BLANK COMMON,A FORMAL PARAMETER OR LCM.   001420
                                                                        001430
          SX5    X5          LOOK THRU IH WORDS OF RCT                  001440
          MX6    -IH.RFL     BACKWARDS LOOKING FOR THE                  001450
          SX0    B2          F(I) RCT INDEX IN THE                      001460
          LX5    IH.RFP      RF FIELD.                                  001470
          SA1    L.RCT                                                  001480
          SA4    =XO.SYM                                                001490
          LX6    IH.RFP                                                 001500
          SA1    B6+X1                                                  001510
          SA0    X4+B1                                                  001520
                                                                        001530
 MFA67A   SA1    A1-3                                                   001540
          ZR     X1,MFA68    IF END OF RCT                              001550
          BX4    -X6*X1                                                 001560
          BX4    X4-X5                                                  001570
          NZ     X4,MFA67A   IF F(I) NE RF                              001580
          LX1    -IH.IHP     IH=IH[RCT(I+1)]                            001590
          SB2    X1                                                     001600
          ZR     B2,MFA67B   IF IH = 0 THEN UNSAFE                              CCGA036 24
          LX1    1                                                      001610
          SB2    B2+X1                                                  001620
          SA4    A0+B2       WORDB=SYM(3*IH+1)                          001630
          LX4    59-WB.LCMP                                             001640
          MI     X4,MFA67B   IF LCM                                     001650
          LX4    WB.LCMP-WB.FPP                                         001660
          MI     X4,MFA67B   IF A FORMAL PARAMETER                      001670
          LX4    WB.FPP-WB.COMP                                         001680
          PL     X4,MFA67A   IF NOT COMMON                              001690
          SA4    A4+B1       WORDC=WORDB+1                              001700
          MX7    -WC.RBL                                                001710
          LX4    -WC.RBP                                                001720
          BX7    -X7*X4      RBN=RB[WORDC]                              001730
 .FTN     IFEQ   HC.ID,2,2                                              001740
          SA4    =XBLNKCOM                                              001750
          BX7    X4-X7                                                  001760
          NZ     X7,MFA67A   IF RBN=0 */INDEXES BLANK COMMON            001770
                                                                        001780
*   F(I) IS NOT SAFE LOOK FOR ANOTHER F(I).                             001790
                                                                        001800
 MFA67B   SB2    X0          RESTORE B2                                 001810
          EQ     MFA66                                                  001820
  
*         ADJUST TRD IF NEGATIVE F(I), SAVE *IIT* INDEX 
  
 MFA68    LX3    59-CC.IMP+CC.INCP                                      001840
          MX7    1
          SX6    4
          BX7    X7*X3                                                  001860
          BX6    X6+X7       TRD = SHIFT(IM[CCW],59) ! 4
          SA6    TRD
          SA1    RAT         ULO = R1[RAT(0)]  */ UL ORD
          SA3    LCV+1
          SA4    RAT+X3      CVO = R1[RAT(LCV(2))]
          BX6    X3 
          SX7    B7 
          SA6    LUL+1       J = LUL(2) = LCV(2)  */ UL IN CV REG 
          SA7    A3          LCV(2) = I    */ CV IN F(I) REG
          SX2    X2+B1
          LX2    RA.R2P      R2[RAT(J)] = ITI + 1  */ FORMULA INDEX 
          BX7    X1+X2       R1[RAT(J)] = ULO 
          SA7    RAT+X3 
          MX6    0
          SA6    A1          RAT(0) = 0 
          SB6    B6-B1
          MX7    1
          SA2    SEEA 
          SA3    B6+X4
          BX6    X2+X3       KD[RCT(CVO)] = 1 
          SA6    A3 
          EQ     MFA
 PSC      TITLE  PSC - PROCESS SIMPLE CLASS ( 1 IH )
**        PSC - PROCESS SIMPLE CLASS ( 1 IH ) 
*         FIND A BASE MEMBER ( *CA* IS IN CENTER OF CLASS ).
*         REDUCE THE BASE MEMBER TO A SHORT INSTRUCTION AND CHANGE
*         THE OTHER MEMBERS OF THE CLASS TO THE FORM *REG+CON*. 
* 
*         ENTRY  (B5) = L , CLASS LENGTH
*                (A5) = BI , LWA OF CLASS 
*                (A0) = REGNO , REGISTER NUMBER OF *RF* 
* 
*         EXIT   (CAIH) = CAIH OF BASE MEMBER 
  
 PSC      ROUTINE 
          SB4    B5-B1
          SB6    B6+B1
          LE     B4,B1,PSC5  IF L @ 2      */ ONLY 2 MEMBERS
  
*         L > 2 ,  FIND A BASE MEMBER WHICH IS THE CENTER OF THE
*         *CA*"S IN THE CLASS.
  
          SA4    A5          I = BI 
          MX6    0           AVE = 0
          SB4    B0          J = 0
  
 PSC2     SA3    B6+X4       C2W = RCT(CO[I]+1) 
          SB4    B4+B1       J = J + 1
          LX3    -IH.CAP
          SA4    A4-B1       I = I - 1
          SX7    X3 
          IX6    X6+X7       AVE = AVE + CA[C2W]
          LT     B4,B5,PSC2  IF J < L 
          SX7    B5 
          IX7    X6/X7,B4    AVE = AVE / L
  
*         SEARCH CLASS TO FIND BASE MEMBER, AND MOVE IT TO LWA OF CLASS 
  
          SB4    B0          J = 0
          SA4    A5          I = BI 
          SB3    377777B     MIND = 377777B  */ MIN DIFFERENCE
          SX0    A5          IM = BI
  
 PSC3     SA3    B6+X4       C2W = RCT(CO[I]+1) 
          LX3    -IH.CAP
          SX2    X3          C = CA[C2W]
          IX6    X2-X7
          BX2    X6 
          AX6    59 
          BX2    X6-X2       DIFF = ABS( AVE - C )
          SB2    X2 
          GE     B2,B3,PSC4  IF DIFF \ MIND 
          SX0    A4          IM = I 
          SB3    B2          MIND = DIFF
 PSC4     SB4    B4+B1       J = J + 1
          SA4    A4-B1       I = I - 1
          LT     B4,B5,PSC3  IF J < L 
  
          SA4    X0 
          LX6    X5 
          LX7    X4          SWAP( [IM] , [BI] )
          SA6    A4 
          SA7    A5 
  
*         CHANGE CLASS BASE TO A SHORT REF
  
 PSC5     SA5    A5 
          SB6    B6-B1
          RJ     AFA         ASSIGN FULL ADDRESS TO BASE
  
*         CHANGE REST OF CLASS TO LONG REFS OF FORM REG+CON 
  
          SA1    A6-B1       C2W = CCW - 1
          MX0    -IH.RFP
          BX7    -X0*X1 
          LX1    -IH.CAP
          SB4    X1          BCA = CA[C2W] */ CA THAT IS IN BASE REG
          SA7    CAIH        CAIH = CAIH[C2W] 
          SB4    -B4
          EQ     B5,B1,PSC   IF L = 1 
  
 PSC6     SA5    A5-B1       BI = BI - 1
          MX0    -IH.CAL
          SB2    X5+B1       J = CO[BI] 
          SA4    B6+B2       C2W = RCT(J+1) 
          BX6    -X5         [BI] = -[BI]  */ SET FLAG FOR LATER
          SA6    A5 
          LX4    -IH.CAP
          SX3    X4+B4       C = CA[C2W] - BCA  */ CHANGE CA
          BX4    X0*X4
          SA2    A4-B1       CAW = RCT(J) 
          BX1    -X0*X3 
          BX6    X4+X1       CA[C2W] = C
          LX6    IH.CAP 
          MX1    1
          SA6    A4 
          LX1    1+CA.RAP 
          BX7    X1+X2       RA[RCT(J)] = 1 
          SA7    A2 
          SA1    A4+B1       CCW = RCT(J+2) 
          SX7    A0+1S6 
          LX7    CC.REG1P    REG1[CCW] = REGNO
          BX6    X7+X1       MIT[CCW] = 1  */ PLD, PST
          SA6    A1 
          RJ     ECC         ENTER CON CANIDATE 
          SB5    B5-B1       L = L - 1
          GT     B5,B1,PSC6  IF L > 1 
  
          SX6    B1 
          SA6    PMF         PMF = 1       */ INDICATE PLD"S EXIST
          EQ     PSC
 AAD      TITLE  AAD - ASSIGN ADDRESS DIFFERENCE TO A REGISTER
**        AAD - ASSIGN ADDRESS DIFFERENCE TO A REGISTER 
* 
*         ENTRY  (A0) = REGNO OF BASE REGISTER
*                (B5) = J , ORDINAL OF CANIDATE TO BE DIFFERENCED 
*                (CAIH) = CA,IH IN BASE REGISTER
  
 AAD      ROUTINE 
          SA1    CAIH        CAIH1 = CAIH 
          SB2    B5+B1
          SA2    B6+B2       CAIH2 = RCT(J+1) 
          RJ     SDC         SEARCH FOR CAIH - RCT(J+1) 
          SB3    3S6         IT = 3        */ SDL, SDS
          NZ     B2,AAD1     IF REGN " 0   */ DIFF IN A REGISTER
          SA2    CAIH 
          SB2    B5+B1
          SA1    B6+B2
          RJ     SDC         SEARCH FOR RCT(J+1) - CAIH 
          SB3    2S6         IT = 2        */ SLD, SST
          NZ     B2,AAD1     IF REGN " 0
  
          RJ     EDC         ENTER DIFFERENCE CANIDATE
  
*         SETUP *J* AS A SLD OR SDL 
  
 AAD1     SA1    B6+B5
          MX0    1
          SA2    A1+2        CCW = RCT(J+2) 
          LX0    1+CA.RAP 
          SX3    A0+B3       REG1[CCW] = REGNO;  MIT[CCW] = IT
          LX3    CC.REG1P 
          SX4    B2          REG2[CCW] = REGN 
          LX4    CC.REG2P 
          BX6    X0+X1       RA[RCT(J)] = 1 
          IX5    X3+X4
          SA6    A1 
          BX7    X5+X2
          SA7    A2 
          EQ     AAD
 ECD      SPACE  3,14        ECD
**        EDC - ENTER DIFFERENCE CANIDATE IN *RCT* AND ASSIGN A REG 
  
 EDC      ROUTINE 
          SA1    L.RCT
          SA4    EDCA 
          SB2    X1+B1       OL = L.RCT 
          SA6    B6+B2       RCT(OL+1) = KEY
          SA7    A6+B1       RCT(OL+2) = KEY2 
          BX6    X4 
          SA6    A6-B1       RCT(OL) = CAW(0,AC,PL,0) 
          SX7    X1+3        L.RCT = L.RCT + 3
          SA7    A1 
          SB4    X1 
          SX1    B1          INVF = 1 
          RJ     AIR         ASSIGN A B-REG 
          SB2    -B2
          EQ     EDC
  
 EDCA     BFMW   CA,(AC,PL) 
 SDC      SPACE  3,20        SDC
**        SDC - SEARCH FOR DIFFERENCE CANIDATE
* 
*         ENTRY  (X1) = CAIH1 
*                (X2) = CAIH2 
* 
*         EXIT   (X6) = KEY = IHW(0,0, CA1-CA2 , IH1 )
*                (X7) = KEY2 = CCW(0,IH2,0,0,0) 
*                (B2) = REGN , REGNO THAT KEY,KEY2 IS IN
  
 SDC      ROUTINE 
          SX7    X2 
          LX7    CC.H2P      KEY2 = CCW(0,IH2,0)
          SX6    X1 
          LX6    IH.IHP 
          LX1    -IH.CAP
          LX2    -IH.CAP
          SX1    X1 
          SX2    X2 
          IX5    X1-X2
          MX0    -IH.CAL
          BX4    -X0*X5 
          LX4    IH.CAP 
          MX0    -CC.H2L
          BX6    X4+X6       KEY = IHW(0,0, CA1-CA2 , IH1 ) 
          LX0    CC.H2P 
          SB2    7           REGN = 7 
          SA5    RAT+7       RI = RAT(REGN) 
  
*         SEARCH B-REGISTERS FOR PREVIOUS OCCURANCE OF DIFF CANIDATE
  
 SDC1     SA2    B6+X5
          SA4    A2+B1
          LX2    59-CA.ACP
          BX3    X4-X6
          PL     X2,SDC2     IF ^AC[RCT(RI)]
          NZ     X3,SDC2     IF RCT(RI+1) " KEY 
          SA4    A4+1 
          BX3    X7-X4
          BX2    -X0*X3 
          ZR     X2,SDC      IF H2[RCT(RI+2)] = KEY2
 SDC2     SB2    B2-B1       REGN = REGN - 1
          SA5    A5-B1       RI = RAT(REGN) 
          NZ     B2,SDC1     IF REGN " 0
  
          EQ     SDC
 AFA      TITLE  AFA - ASSIGN FULL ADDRESS TO A B-REG 
**        AFA - ASSIGN FULL ADDRESS TO A B-REG
* 
*         ENTRY  (A0) = REGNO OF REGISTER WITH *RF* 
*                (X5) = [BI] , B-CANIDATE TABLE WORD OF ENTRY 
*                (B6) = [O.RCT] 
* 
*         EXIT   (A6) = CCW , ADDRESS OF CC WORD
*                RAT, RCT UPDATED 
  
 AFA      ROUTINE 
          SA4    RAT+A0 
          SA1    B6+X5
          SX3    X5          J = CO[BI] 
          LX3    RA.R3P 
          BX6    X3+X4       R3[RAT(REGNO)] = J  */ SET TO APPEND IH,CA 
          SA6    A4 
          MX0    1
          SA2    A1+2        CCW = RCT(J+2) 
          LX0    1+CA.RAP 
          BX7    X0+X1       RA[RCT(J)] = 1  */ INDICATE MODIFICATION 
          SA7    A1 
          SX3    A0+2S6 
          LX3    CC.REG1P    REG1[CCW] = REGNO
          BX6    X2+X3       MIT[CCW] = 2  */ SLD, SST
          SA6    A2 
          EQ     AFA
 ECC      TITLE  ECC - ENTER CONSTANT CANIDATE
**        ECC - ENTER CONSTANT CANIDATE 
* 
*         ENTRY  (X3) = CON 
*                (X2) = CAW OF REF THAT IT IS PART OF 
*                (B6) = [O.RCT] 
  
*         BUMP OCCURANCES OF CANIDATE IN TABLE
  
 ECC0     SA2    A4-B1       CAW = RCT(I) 
          IX6    X2+X0       NOCC[CAW] = NOCC[CAW] + N
          SA6    A2 
  
 ECC      ROUTINE 
          SA1    CL 
          MX0    -CA.NOCCL
          LX3    IH.CAP 
          LX0    CA.NOCCP 
          SB2    X1+1        I = CL 
          BX0    -X0*X2      N = NOCC[CAW]
          PL     X3,ECC1     KEY = IHW(0,0,ABS(CON),0)
          BX3    -X3
  
 ECC1     SA4    B6+B2       C2W = RCT(I+1) 
          BX6    X3-X4
          ZR     X6,ECC0     IF [C2W] = KEY 
          SA1    A4+B1       CCW = RCT(I+2) 
          LX1    -CC.INCP 
          SB2    X1+1        I = INC[CCW] 
          NE     B2,B1,ECC1  IF I " 0 
  
*         CON NOT ON CHAIN, ADD TO THE END OF RCT AND END OF CHAIN. 
  
          SA2    L.RCT       OL = L.RCT 
          SX7    X2+3        L.RCT = L.RCT + 3
          BX6    X2+X1       INC[CCW] = OL
          SA7    A2 
          LX6    CC.INCP
          SA6    A1 
          SX4    B1 
          LX4    CA.CONP
          BX6    X0+X4       RCT(OL) = CAW(CON,0,N,0) 
          SA6    B6+X2
          BX7    X3 
          SA7    A6+B1       RCT(OL+1) = KEY
          MX6    0
          SA6    A7+B1       RCT(OL+2) = 0
          EQ     ECC
 GRA      TTL    GRA - GLOBAL REGISTER ASSIGNMENT / ENTRY CODE
 SUP      TITLE  SUP - SETUP PRELOADS OF LOCKED REGISTERS 
**        TYPEI - DEFINE MACRO TO FORM A TYPE I INSTRUCTION 
*                J,K OPERANDS MUST BE IN X-REGISTERS. 
*                R2 WORD IS ASSUMED TO BE IN X7 . 
  
 TYPEI    MACRO  OPC,I,J,K
          R=     X6,I 
          IFC    NE,/J//,2
          L_J    R1.RJP 
          BX6    X6+J 
          IFC    NE,/K//,2
          L_K    R1.RKP 
          BX6    X6+K 
          IF     REG,OPC,2
          R=     B2,OPC 
          ELSE   1
          R=     B2,OC.OPC
          RJ     =XSRI# 
          ENDM
 ORS      SPACE  2,14        ORS
**        ORS - OUTPUT *RS* 
* 
*         ENTRY  (B5) = I , REGNO OF REGISTER 
  
 ORS0     SB2    OC.RS
          RJ     SRI         SRI(  RS  MI-4,FL+I )
  
 ORS      ROUTINE 
          SA2    RAT+B5      RW = RAT(I)
          SX4    B5+SO.LOCK 
          SX6    B6-4 
          LX4    R1.SOP 
          BX6    X4+X6
          MX4    1
          BX7    X4*X2
          LX7    1+R1.SOP+SO.INVP 
          BX6    X7+X6       INV[R1W] = INV[RAT(I)] 
          MX3    -2*RA.R1L
          SX7    B0          R2W = 0
          LX3    RA.R2P 
          BX4    -X3*X2 
          NZ     X4,ORS0     IF ( R2[RW] ! R3[RW] ) " 0 
  
          SA2    B4+X2       CAW = RCT(R1[RW])
          SA3    A2+B1       C2W = RCT(R1[RW]+1)
          SB2    X2 
          ZR     B2,ORS0     IF UDI[CAW] = 0  */ CON OR COMPILER TEMP 
          LX2    59-CA.ACP
          MI     X2,ORS0     IF AC[CAW]    */ PREFETCH
          MX4    -IH.CAIHL
          BX7    -X4*X3      R2W = IHW(0,0,CAIH[C2W]) 
          EQ     ORS0 
  
 SUPA     BFMW   CA,(AC,CON,PL) 
 SUP      SPACE  3,24        SUP
**        SUP - SETUP PRELOADS OF LOCKED REGISTERS IN THE HOLDING BLOCK 
* 
*         GENERAL REGISTER SETUP FOR *SUP* AND ITS SUBROUTINES
*         (A0) = [O.SYM]-1 , (B4) = [O.RCT] , (B6,B7) = MI, MB
*         AND X0 IS PRESERVED BY ALL THE SUBROUTINES
  
 SUP      ROUTINE 
          SX6    0           BSI = 0
          SA6    BSI
          CALL   RTB#        GET THE HOLDING BLOCK
  
*         INSERT THE *UXR* AND *MRA* FIELDS IN THE *R2* OF THE *BOS*
  
          SA3    XRF
          SA2    MRU
          SA1    O.SEQ
          SA5    MRA
          MX4    1
          SA1    X1+B1       R2 = [O.SEQ+1] 
          BX6    X4*X3
          LX6    1+R2.UXRP   UXR[R2] = XRF & 1S59 
          BX2    -X2*X5 
          LX2    R2.MRAP     MRA[R2] = ^MRU & MRA  */ MACHINE REGS AVAIL
          BX7    X6+X2
          BX6    X7+X1
          SA6    A1 
  
          ALLOC  MOD,16*17   ALLOC( MOD , 4*4*(7+7+3) ) 
          SA3    O.SYM
          SA4    O.RCT
          SB7    X2          MB = [O.MOD] 
          SA0    X3+1 
          SB4    X4          (B4) = [O.RCT] 
          SA5    TRD
          SB6    4           MI = 4        */ STORE INDEX 
          SX6    X5-4 
          NZ     X6,SUP4     IF TRD " 4    */ NOT F(I), F(N) IN REGS
  
*         SETUP CODE TO INITIALIZE THE LOOP UPPER LIMIT REGISTER
  
          SA1    LUL+1
          SA2    O.IIT
          SA5    RAT+X1      RW = RAT(LUL(2)) 
          MX6    60 
          SA6    A5          RAT(LUL(2)) = -0 
          LX5    -RA.R2P     PFI = R2[RW] 
          SB2    X2 
          SA3    B2+X5       IAW = IIT(PFI) 
          UX6    B3,X3
          SX7    B3 
          IX0    X5+X7       PFI = PFI + NWD[IAW] 
          SA4    B2+X0       IAW = IIT(PFI) 
          SA5    A4+B1       IBW = IAW(PFI+1) 
          UX6    B3,X4
          SX1    B3-2        N = NWD[IAW] - 2  */ WORDS IN *IP* FORMULA 
          BX7    X1 
          SA7    N
          ALLOC  MOD,X1      ALLOC( MOD , N)
          SA3    O.SYM
          SA4    O.RCT
          SB7    X2          MB = [O.MOD] 
          SA0    X3+1 
          SB4    X4 
          SB6    4           MI = 4 
          SA2    O.IIT
          SB2    X0+2        PFI = PFI + 2
          SB5    B7 
          MOVE   X1,X2+B2,B7+B6    MOVE( N , O.IIT+PFI , MB+MI )
          SB7    B5 
          LX5    -IB.ILDP 
          SB6    X5          MI = ILD[IBW]
          LX0    RA.R2P 
          SX5    X0          J = R1[RW] 
          RJ     LIV         INSERT LOAD OF *UL* IN FORMULA 
          SA1    N
          SA2    LCV+1
          SB6    X1+4        MI = N + 4 
          SA3    RAT+X2 
          LX3    -RA.R3P
          SX5    X3          J = R3[RAT(LUL(2))]
          NZ     X5,SUP1     IF J " 0      */ ADDRESS APPENDED
  
          TYPEI  SA,B6,X1    SRI(  SA  MI,MI-4 )
          EQ     SUP2 
  
 SUP1     SX4    X3+B1
          SB3    X1 
          RJ     SIV         SIV( J , RF = N )
  
 SUP2     SA1    LUL+1
          SB5    X1+
          RJ     ORS         ORS(  RS  MI-4,INVF )
 SUP      SPACE  1,10 
*         SCAN *RAT* AND SETUP INITIALIZATION CODE FOR THE B-REGISTERS
  
 SUP4     SB5    7           I = 7         */ REGNO 
  
 SUP5     SA1    RAT+B5 
          ZR     X1,SUP10    IF RAT(I) = 0 */ REGISTER NOT ASSIGNED 
  
*         EVALUATE THE INITIALIZATION FORMULA 
  
          BX0    X1          RW = RAT(I)
          SX5    X1          J = R1[RW] 
          SA2    SUPA 
          MX6    -2*RA.R1L
          SA3    B4+X1       CAW = RCT(J) 
          LX0    -RA.R2P
          BX7    -X6*X0 
          NZ     X7,SUP5A    IF (R2,R3)[RW] " 0 
          BX4    X2*X3
          ZR     X4,SUP10    IF ^(CON,AC,PL)[CAW]  */ PRELOAD NOT NEC 
  
 SUP5A    RJ     LIV         LIV(J) 
          SX6    B6-4 
          SA6    RR          RR = MI-4
          SX5    X0          J = R2[RW] 
          ZR     X5,SUP6     IF J = 0 
          RJ     LIV         LIV( J ) 
          SA1    RR          ORN = RR 
          SX2    B6-4 
          SX6    B6          RR = MI       */ OF *IS* 
          SA6    A1 
          TYPEI  IS,X6,X1,X2 SRI(  IS  MI,MI-4,ORN )
  
 SUP6     LX0    RA.R2P-RA.R3P
          SX5    X0          J = R3[RW] 
          ZR     X5,SUP7     IF J = 0 
          SA1    RR 
          SX4    X0+B1
          SB3    X1 
          RJ     SIV         SIV( J , RF = RR ) 
          EQ     SUP9 
  
*         TRANSFER THE RESULT TO A B-REGISTER , IF NECESSARY
  
 SUP7     SX1    B6-4 
          SA5    B7+X1       R1 = MB + MI-4 
          UX6    B2,X5
          SA4    A5+2        DI = R1 + 2
          LX4    59-D.LDP 
          MI     X4,SUP8     IF LD[DI]
          SX6    B2-OC.IS 
          NZ     X6,SUP9     IF OC " OC.IS
  
 SUP8     MX7    0
          TYPEI  SA,B6,X1    SRI(  SA  MI,MI-4 )
  
 SUP9     RJ     ORS         ORS(  RS  MI-4,FL+I,INV )
  
 SUP10    SB5    B5-B1       I = I - 1
          NZ     B5,SUP5     IF I " 0 
 SUP      SPACE  1,14 
*         NOW SETUP PRELOADS FOR THE X-REGISTERS
  
          MX0    5
          SB5    20B         I = 20B
          LX0    -1          LDREG = 37BS54  */ LD-REG FLAG 
  
 SUP12    SA5    RAT+B5      J = RAT(I)    */ *R1* ONLY 
          ZR     X5,SUP14    IF RAT(I) = 0
  
          SA1    B4+X5       CAW = RCT(J) 
          SA2    SUPA 
          BX7    X2*X1
          ZR     X7,SUP14    IF ^(CON,PL,AC)[CAW]  */ PRELD NOT NECESS
  
          RJ     LIV         LIV( J ) 
          MI     X0,SUP13    IF LDREG < 0  */ RS IS TO A *LD* REG 
          SX1    B6-4 
          TYPEI  XMT,B6,X1         SRI(  XMT  MI,MI-4 ) 
  
 SUP13    RJ     ORS         ORS(  RS  MI-4,FL+I,INV )
  
 SUP14    SB5    B5+B1       I = I + 1
          LX0    1           LDREG = SHIFT(LDREG,1) 
          SX6    B5-30B 
          MI     X6,SUP12    IF I @ 27B 
 SUP      SPACE  2,14 
*         SETUP *MOD* CONTROL WORD AND MERGE THIS WITH *HB* 
  
          SA1    L.SEQ
          SX0    X1-8        II = L.SEQ-8 
          SX6    B6 
          LX0    ML.IIP 
          SA6    L.MOD       L.MOD = MI 
          SX2    4
          IX6    X6-X2
          LX6    ML.NIP-2    NI = (MI-4) / 4
          LX2    ML.MTIP
          BX3    X0+X2
          IX1    X3+X6
          SA5    O.SEQ       HBA = O.SEQ
          ZR     X6,SUP15    IF NI = 0     */ NO MODS 
  
          ADDWRD MLT,X1      ADDWRD( MLT , MCW(0,II,NI,4) ) 
          MX6    1
          CALL   MPB#        MERGE MODS WITH *HB*, SQUEEZE AND REWRITE
  
          SA5    O.TXT       HBA = O.TXT
  
*         SCAN TET AND CLEAR *HBN* FIELD OF IT."S CREATED IN THIS LOOP
  
 SUP15    SA1    O.TET
          SA2    ITL
          SA3    L.TET
          SB2    X2          I = ITL
          SB6    X3          L = L.TET
          MX0    -T.HBNL
          SB5    X1                        (B5) = TET 
          LX0    T.HBNP 
          SB7    X2                        (B7) = ITL 
          EQ     B2,B6,SUP17 IF ITL = L.TET  */ NO IT. S CREATED
  
 SUP16    SA2    B5+B2
          BX6    X0*X2       HBN[TET(I)] = 0
          SB2    B2+B1       I = I + 1
          SA6    A2 
          LT     B2,B6,SUP16 IF I < L 
  
*         SCAN *HB* AND SET *HBN* FIELD OF IT. S DEFINED IN THIS LOOP 
  
 SUP17    SA1    =XHBI
          SB4    4
          SA5    X5+B4       R1 = HBA + 4 
          SB3    OC.TST 
          LX1    T.HBNP 
  
 SUP18    UX6    B2,X5       OC = OC[R1]
          SA5    A5+B4       R1 = R1 + 4
          ZR     B2,SUP19    IF OC = OC.EOQ  */ END OF BLOCK
          NE     B2,B3,SUP18 IF OC " OC.TST 
  
          SA4    A5-3        R2 = R1 - 3
          LX4    -IH.CAP     C = CA[R2] 
          SA3    B5+X4
          BX2    X0*X3
          IX6    X1+X2       HBN[TET(C)] = HBI
          SA6    A3 
          EQ     SUP18
  
*         SCAN *TET* BACKWARDS AND REMOVE TRAILING ENTRIES THAT WERE NOT
*         MATERIALIZED ( ASSIGNED TO A REGISTER, KD, ETC ). 
  
 SUP19    SB6    B6-B1       L = L - 1
          SA4    B5+B6
          LT     B6,B7,SUP20 IF L < ITL 
          BX6    -X0*X4 
          ZR     X6,SUP19    IF HBN[TET(L)] = 0  */ NOT MATERIALIZED
  
 SUP20    SA1    =XN.GT 
          SX6    B6+B1       L.TET = L + 1
          IX2    X1-X6
          SA6    L.TET
          MI     X2,SUP      N.GT = MIN( N.GT , L.TET ) 
          SA6    A1 
          EQ     SUP
 LIV      SPACE  3,24        LIV
**        LIV - LOAD INITIAL VALUE
* 
*         ENTRY  (X5) = J , *RCT* ORDINAL OF CANIDATE 
  
 LIV      ROUTINE 
          SA1    B4+X5       CAW = RCT(J) 
          SA2    A1+B1       C2W = RCT(J+1) 
          MX7    -IH.CAL
          LX1    59-CA.CONP 
          PL     X1,LIV2     IF ^CON[CAW] 
  
          SB2    OC.S 
          LX7    IH.CAP 
          BX6    -X7*X2 
          MX7    0
          LX6    R1.INP-IH.CAP
          LX2    59-IH.MSKP 
          PL     X2,LIV1     IF ^MSK[C2W] 
          SB2    OC.FMA 
          NZ     X6,LIV1     IF IN[R1] " 0
          SB2    OC.CLR 
  
 LIV1     SX4    B6 
          BX6    X4+X6
          RJ     SRI         SRI(  S/FMA/CLR  CA[C2W],MI )
          EQ     LIV
  
 LIV2     LX1    CA.CONP-CA.VCP 
          MI     X1,LIV3     IF VC[CAW] 
  
          SB3    B0          RF = 0 
          SX4    X5+B1
          RJ     SIV         SIV( J ) 
          EQ     LIV
  
*         *VC* - OUPUT *LD* OF INITIAL VALUE
  
 LIV3     LX2    -IH.RFP
          SB3    X2          R = RF[C2W]
          LE     B3,B1,LIV4  IF R @ 1 
          SX4    B3 
          SB3    B0 
          RJ     OIL         OIL( J = RF[C2W] , RF = 0 )
          SB3    B6-4        RF = MI - 4
  
 LIV4     SX4    X5 
          RJ     OIL         OIL( J , R ) 
          EQ     LIV
 OIL      SPACE  3,18        OIL
**        OIL - OUTPUT INITIAL *LD* 
* 
*         ENTRY  (X4) = J , *RCT* ORDINAL OF CANIDATE 
*                (B3) = RF , OPERAND R-NUMBER 
* 
*         PRESERVES X0, X5
  
 OIL      ROUTINE 
          SA1    B4+X4       CAW = RCT(J) 
          SA2    A1+B1       C2W = RCT(J+1) 
          SX7    B3 
          MX3    -IH.CAIHL
          LX7    IH.RFP 
          BX3    -X3*X2      CAIH = CAIH[C2W] 
          IX7    X7+X3       R2W = IHW(0,RF,CAIH) 
          SX6    X1          U = UDI[CAW] 
          AX2    IH.SLVP
          SA3    OILA+X2
          SB2    X3          OC = OILA(SLV[C2W])
          EQ     B3,B1,OIL5  IF RF = 1
          LX1    59-CA.RAP
          PL     X1,OIL2     IF ^RA[CAW]   */ NOT ASSIGNED TO A REG 
          NZ     X2,OIL2     IF LSV[C2W] " 0  */ LDC OR LDV 
          NZ     B3,OIL2     IF RF " 0
  
*         CHECK VARIABLE AND SETUP AN *ILD* IF DEAD ON EXIT FROM LOOP 
  
          SB2    OC.ILD 
          ZR     X6,OIL1     IF U = 0      */ COMPILER TEMPORARY
          SA3    O.UDT
          SB3    X6 
          SA4    X3+B3       UI = UDT(U)
          LX4    59-UD.CMP
          PL     X4,OIL0     IF ^CM[UI] 
  
*         *CR*, DO NOT OUTPUT A *ILD* IF THE BASE IS USED IN THE LOOP.
  
          LX4    1+UD.CMP-UD.BMIP 
          SB3    X3+B1
          SA4    B3+X4       UB = UDT(BMI[UI]+1)
          SA3    UVA
          SB3    X4 
          SA3    X3+B3       UVW = UVA(WI[UB])
          UX4    B3,X4
          SB3    B3-59
          LX3    -B3
          MI     X3,OIL1A    IF SHIFT(UVW,59-BN) < 0  */ BASE USED
  
 OIL0     BX3    X1 
          LX3    CA.RAP-CA.LXP
          PL     X3,OIL2     IF ^LX[CAW]   */ DEAD ON EXIT
          LX3    CA.LXP-CA.PSPP 
          MI     X3,OIL2     IF PSP[CAW]   */ POST STORE POSSIBLE 
 OIL1A    SB2    OC.LD       OC = OC.LD 
          EQ     OIL2 
  
 OIL1     LX2    -IH.CAP
          SA3    ITL
          SX2    X2 
          IX4    X2-X3
          PL     X4,OIL2     IF CA[C2W] \ ITL  */ CREATED IN THIS LOOP
          SB2    OC.TLD      OC = OC.TLD
  
 OIL2     SX2    B6 
          LX6    R1.INP 
          BX6    X2+X6
          LX1    CA.RAP-CA.ACP
          PL     X1,OIL3     IF ^AC[CAW]   */ NOT A PREFETCH
  
          MX1    1
          LX1    1+IH.LDP 
          BX7    X1+X7       LD[R2W] = 1   */ INHIBIT SQUEEZING 
  
 OIL3     SB3    X7-1S12
          SX1    0           DB = 0 
          PL     B3,OIL4     IF IH[R2W] > 1S12  */ LVL2 OR SUCH 
          SB3    X7 
          SX2    B3+B3
          SB3    A0+B3
          SA2    B3+X2       WORDB = SYM(3*IH[R2W]+1) 
          LX2    -WB.FPP
          SX3    B1 
          BX1    X3*X2
          LX1    D.FPP       FP[DB] = FP[WORDB] 
  
 OIL4     SA4    F.RDT+B2 
          PX6    B2,X6
          SA6    B7+B6       MOD(MI) = TYII(OC,U,0,MI)
          SA7    A6+B1       MOD(MI+1) = R2W
          BX6    X4-X1       MOD(MI+2) = XOR(RDT(OC),DB)
          SA6    A7+B1
          MX7    0
          SA7    A6+B1       MOD(MI+3) = 0
          SB6    B6+4        MI = MI + 4
          EQ     OIL
  
*         SPECIAL CASE, RF = 1 AND IH = 0 
  
 OIL5     SX4    B6 
          LX6    R1.INP 
          MX1    0           DB = 0 
          BX6    X4+X6
          NZ     X2,OIL4     IF CAIH " 0   */ CA .NE. 0, SINCE IH = 0 
          MX1    2
          LX1    2+D.SZP     SZ[DB] = 3    */ SET TO TOGGLE *SZ* FIELD
          EQ     OIL4 
  
 OILA     CON    OC.LD,OC.LDC,OC.LDV
 SIV      TITLE  SIV - SET INITIAL VALUE
**        SIV - SET INITIAL VALUE, GENERATE A *STT* OF A VALUE
*         NOTE THAT THE *RF* IN THE *RCT* ENTRY IS IGNORED. 
* 
*         ENTRY  (X4) = J+1, J = *RCT* ORDINAL OF ENTRY 
*                (B3) = RF , OPERAND R-NUMBER 
  
*         OUTPUT STT WITH AN *H2* FIELD 
  
 SIV0     SX6    X2 
          SX7    B3 
          RJ     OSI         OSI(  STT  R,RF,CAIH,H2 )
  
 SIV      ROUTINE 
          SA1    B4+X4       C2W = RCT(J+1) 
          SA2    A1+B1       CCW = RCT(J+2) 
          MX7    -IH.CAIHL
          LX2    -CC.H2P
          BX1    -X7*X1      CAIH = CAIH[C2W] 
          SB2    X2          H2 = H2[CCW] 
          ZR     B2,SIV0     IF H2 = 0
  
*         CHECK ADDRESS DIFFERENCE TO SEE IF SYMS ARE F.P. OR COMMON
  
          SB2    B2+B2
          LX6    B1,X1
          SB2    X2+B2
          SA3    A0+B2       WORDB2 = SYM(3*H2+1) 
          SB2    X6 
          ZR     B2,SIV1     IF IH[C2W]  = 0  */ NEG RELOC NOT ALLOWED
          SB2    B2+X1
          SA4    A0+B2       WORDB = SYM(3*IH[C2W]+1) 
          BX6    X3+X4
          LX6    59-WB.LABP 
          MI     X6,SIV0     IF LAB[WORDB] ! LAB[WORDB2]  */ LAB DIFF 
          LX6    WB.LABP-WB.FPP 
          MI     X6,SIV1     IF FP[WORDB] ! FP[WORDB2]
          LX6    1+WB.FPP-WB.CXP
          MX7    -WB.CXL
          BX6    -X7*X6 
          ZR     X6,SIV0     IF ^( CX[WORDB] ! CX[WORDB2] ) 
          SA3    A3+B1       WORDC2 = WORDB2 + 1
          SA4    A4+B1       WORDC = WORDB + 1
          BX7    X3-X4
          SA4    SIVA 
          BX6    X4*X7
          ZR     X6,SIV0     IF (RL,RB)[WORDC] = (RL,RB)[WORDC2]
  
          MX3    0           C = 0
          EQ     SIV2 
  
 SIV1     BX3    X1          C = CA[C2W]
          SX1    X1          CAIH = IH[C2W] 
          BX3    X3-X1
  
 SIV2     MX7    0           F = 0
          SX6    B0          H2 = 0 
          RJ     OSI         OSI(  STT  R,,CAIH ) 
          SX1    X2          CAIH = H2[CCW] 
          SX6    B0          H2 = 0 
          MX7    0           F = 0
          BX2    X5          FLB = FPL2    */ SAVE
          RJ     OSI         OSI(  STT  R,,H2[CCW] )
          BX6    X2-X5
          SX1    B6-8        RJ = MI - 8   */ OPERANDS OF *IS*
          SX2    B6-4        RK = MI - 4
 .FTN     IFEQ   HC.ID,2     IF FTN 
          SA4    =XHO$ARGC
          PL     X4,SIV2AC   IF NOT HO$ARGC 
          SB2    X1+B7
          SA4    B2+2 
          LX4    59-D.FPP 
          PL     X4,SIV2AA   IF NOT FP[DJ]
          SX4    X1          J = RJ 
          SX1    B6          RJ = MI
          TYPEI  SA,B6,X4    SRI(  SA  MI,J ) 
  
 SIV2AA   SB2    X2+B7
          SA4    B2+2 
          LX4    59-D.FPP 
          PL     X4,SIV2C    IF NOT FP[DK]
          SX4    X2          J = RK 
          SX2    B6          RK = MI
          TYPEI  SA,X2,X4    SRI(  SA  MI,J ) 
          EQ     SIV2C
  
 SIV2AC   BSS    0
 .FTN     ENDIF 
 #DAL     IFNE   .DAL,0 
          ZR     X6,SIV2C    IF FLB = FPL2 */ NEITHER/BOTH FP&L2
  
*         ONE OF THE SYMBOLS IS A LEVEL2 F.P., OUTPUT A *SA* PRIOR TO 
*         THE *IS* TO REMOVE BIT 59 IN THE APLIST WORD. 
  
          SB2    OC.SA
          NZ     X5,SIV2A    IF FPL2 " 0   */ RJ IS FP&L2 
          SX4    X1          J = RJ 
          SX1    B6          RJ = MI
          EQ     SIV2B
 SIV2A    SX4    X2          J = RK        */ RK IS FP&L2 
          SX2    B6          RK = MI
 SIV2B    TYPEI  B2,B6,X4    SRI(  SA  MI,J ) 
 #DAL     ENDIF 
  
 SIV2C    TYPEI  IS,B6,X1,X2 SRI(  IS  MI,RJ,RK ) 
          ZR     X3,SIV3     IF C = 0 
  
          BX1    X3 
          SX7    B6-4        F = MI - 4 
          MX6    0           H2 = 0 
          RJ     OSI         OIS(  STT  R,F,C ) 
          ZR     B3,SIV      IF RF = 0
  
 SIV3     ZR     B3,SIV4     IF RF = 0
          SX2    B6-4 
          SX3    B3 
          TYPEI  IA,B6,X2,X3 SRI(  IA  MI,MI-4,RF ) 
  
 SIV4     SX2    B6-4 
          TYPEI  SA,B6,X2    SRI(  SA  MI,MI-4 )
          EQ     SIV
  
 SIVA     BFMW   WC,(RL,RB) 
 OSI      SPACE  3,14        OSI
**        OSI - OUTPUT *STT* INSTRUCTION
* 
*         ENTRY  (X1) = CAIH FIELDS 
*                (X6,X7) = H2, RF FIELDS RIGHT JUSTIFIED
* 
*         EXIT   (X5) = FPL2 = FP[WORDB] & LCM[WORDB] 
* 
*         USES   X - 1, 4, 5, 6, 7
  
 OSI      ROUTINE 
          LX7    IH.RFP 
          BX7    X1+X7
          LX6    R1.H2P 
          SX4    B6 
          BX6    X4+X6
          LX4    B1,X7
          SB2    X4 
          SB2    B2+X7
          SA4    A0+B2       WORDB = SYM(3*IH+1)
          BX5    X4 
          LX5    59-WB.LABP 
          AX5    59 
          BX4    -X5*X4      IF( LAB[WORDB] ) THEN WORDB = 0
          SX5    B1 
          LX4    -WB.FPP
          BX1    X5*X4
          LX4    WB.FPP-WB.LCMP 
          BX5    X1*X4       FPL2 = FP[WORDB] & LCM[WORDB]
          SA4    F.RDT+OC.STT 
          LX1    D.FPP       FP[DB] = FP[WORDB] 
          SB2    OC.STT 
          PX6    B2,X6
          SA6    B7+B6       MOD(MI) = TYII(OC.STT,0,H2,MI) 
          LX5    IH.SIAP
          BX7    X5+X7
          SA7    A6+B1       MOD(MI+1) = IHW(SIA,RF,CAIH) 
          BX6    X1+X4
          SA6    A7+B1       MOD(MI+2) = RDT(OC.STT) ! DB 
          MX7    0
          SA7    A6+B1       MOD(MI+3) = 0
          SB6    B6+4        MI = MI + 4
          EQ     OSI
 SXC      TITLE  SXC - SET EXIT CONDITIONS ( POST STORE INFO )
**        SXC - SET EXIT CONDITIONS ( POST STORE INFO ) 
*         SETUP POST STORE INFORMATION IN *PSI* FOR LATER USE BY
*         *IPS* IN *GPO*. 
* 
*         ENTRY  (NPS) = N. POST STORES IN SEQUENCE ( SET BY *CLB* )
  
 SXC      ROUTINE 
          SA1    NPS
          SA2    N.ENL
          ZR     X1,SXC7     IF NPS = 0 
          SA4    EPSI 
          IX3    X2-X4
          ZR     X3,SXC7     IF N.ENL = EPSI  */ NO EXIT NODE POST ST"S 
  
          SX0    X1+B1
          IX1    X0*X2
          ALLOC  PSI,X1+20   ALLOC( PSI , N.ENL*(NPS+1) + 20 )
          SA3    O.UDT
          SA4    O.RCT
          SA5    O.RXI
          SB6    X2+B6       PO = O.PSI + OLD(L.PSI)
          SB7    X2 
          SB3    X3+B1       (B3) = [O.UDT]+1 
          SB4    X4          (B4) = [O.RCT] 
          MX0    -IH.CAIHL
          SA5    X5+B1       RI = [O.RXI] + 1 
  
*         SCAN POST STORE LIST AND FORM LIST OF VARIABLES IN *PSI*
*         THAT ARE TO BE STORED ON ENTRY TO THE LOOP EXIT BLOCKS. 
  
 SXC2     SA4    NPS
          SB5    A5+B1       RB = RI + 1   */ LIVE ENTRY VECTOR ADDRESS 
          SA7    B6          PI = PO
          LX5    59-E.ALLPP 
          PL     X5,SXC5     IF ^ALLP[RI]  */ CANT POST STORE IN THIS BL
  
          SA0    X4          I = NPS
  
 SXC3     SA4    PST-1+A0    J = CO[PST(I)] 
          SA3    B4+X4       CAW = RCT(J) 
          LX4    -18         REGNO = REG[PST(I)]
          SX7    X3          K = UDI[CAW] 
          SA1    B3+X3       U2 = UDT(K+1)
          SA2    B5+X1       LEW = [RB+WI[U2]]
          UX6    B2,X1       BIT = BITN[U2] 
          SB2    B2-59
          LX6    -B2,X2 
          PL     X6,SXC4     IF SHIFT(59-BIT,LEW) > 0  */ DEAD ON ENTRY 
  
*         SETUP *PSI* WORD FOR THIS *RCT* ENTRY 
  
          SA1    A3+B1
          LX7    PS.UDIP
          SX4    X4 
          LX4    PS.REGP
          BX2    -X0*X1      CAIH = CAIH[RCT(J+1)]
          IX6    X4+X7
          BX7    X6+X2
          SA7    A7+B1       PI = PI + 1;  [PI] = PSI(REGNO,K,CAIH) 
  
 SXC4     SB2    A0-B1
          SA0    A0-B1       I = I - 1
          NZ     B2,SXC3     IF I > 0 
  
*         SETUP HEADER WORD, AND POINT *BIT* ENTRY TO *PSI* LIST. 
  
 SXC5     SX6    A7-B6       N = PI - PO
          ZR     X6,SXC6     IF N = 0      */ NO STORES TO THIS BLOCK 
  
          MX7    -E.BIL 
          SA1    O.BIT
          LX5    1+E.ALLPP-E.BIP
          BX4    -X7*X5      BN = BI[RI]
          SB2    X1 
          SA2    B2+X4       BIW = BIT(BN)
          MX3    -BI.PIIL 
          LX2    -BI.PIIP 
          BX7    -X3*X2      OPI = PII[BIW] 
          ZR     X7,SXC5B    IF OPI = 0    */ NO POST ST"S FROM INNERLP 
  
*         ADD POST STORES FROM INNER LOOP TO CURRENT LIST FOR THIS BLOCK
  
          SB2    B7-B1
          SA1    B2+X7       PJ = PSI + OPI-1 
          SB2    X1          J = [PJ]      */ N.POST ST"S FROM INNER
          SX6    X6+B2       N = N + J
  
 SXC5A    SA1    A1+B1       PJ = PJ + 1
          SB2    B2-B1       J = J - 1
          BX7    X1 
          SA7    A7+B1       PI = PI + 1;  [PI] = [PJ]
          NZ     B2,SXC5A    IF J " 0 
  
 SXC5B    SA6    B6          [PO] = N      */ SET HEADER WORD 
          BX2    X3*X2
          SB6    B6+B1       PO = PO + 1
          SX4    B6-B7
          BX7    X2+X4       PII[BIT(BN)] = PO - PSI
          LX7    BI.PIIP
          SA7    A2+
  
 SXC6     SA1    BVL
          SB6    B6+X6       PO = PO + N
          SB2    X1+B1
          SA5    B5+B2       RI = RB + BVL+1
          NZ     X5,SXC2     IF [RI] " 0   */ NOT END OF LIST 
  
          SX6    B6-B7       L.PSI = PO - O.PSI 
          SA6    L.PSI
  
          TRACE  SXC,PSI
 SXC      SPACE  2,10 
*         ADJUST *LUV* AND *LEA* BIT VECTORS. SET BITS FOR VARIABLES
*         EXPLICITLY REFERENCED IN THE LOOP ( *LUV* ). ADJUST THE *HB*
*         LIVE EXIT VECTOR ( *LEA* ) TO INDICATE THAT *VC*"S THAT ARE 
*         *KD* ARE DEAD ON EXIT FROM IT.
  
 SXC7     SA1    =XHO$OPT 
          PL     X1,SXC      IF HO$OPT " 2
  
          SA5    O.RCT
          SA1    LCT
          SA2    O.UDT
          SA3    LUV
          SA4    LEA
          SB4    X2+B1       (B4) = [O.UDT] + 1 
          SB2    X1 
          SB5    X3          (B5) = [LUV] 
          SB6    X4          (B6) = [LEA] 
          SA5    X5+B2       CI = O.RCT + LCT 
          SX0    B1 
          NZ     B2,SXC9     IF LCT " 0    */ NO USER EXT REFS
          EQ     SXC
  
 SXC8     SA2    B5+X4
          LX1    B2,X0
          BX6    X1+X2       LUV(W) = LUV(W) ! SHIFT(1,B) 
          SA6    A2 
  
 SXC9     SA5    A5-3        CI = CI - 3
          ZR     X5,SXC11    IF [CI] = 0   */ END OF TABLE
          SB2    X5          K = UDI[CI]
          ZR     B2,SXC9     IF K = 0      */ CON OR COMPILER TEMP
  
          SA4    B4+B2       U2 = UDT(K+1);  W = WI[U2] 
          LX5    59-CA.KDP
          UX7    B2,X4       B = BITN[U2] 
          MI     X5,SXC10    IF KD[CI]     */ USELESS INCREMENT 
  
          LX5    CA.KDP-CA.ACP
          MI     X5,SXC8     IF AC[CI]
          LX5    CA.ACP-CA.RAP
          PL     X5,SXC8     IF ^RA[CI] 
  
*         *VC* AND *RA*, SET BIT IN *LUV* IF STORED IN LOOP.
  
          LX5    CA.RAP-CA.DEFP 
          PL     X5,SXC9     IF ^DEF[CI]
          LX5    CA.DEFP-CA.PSPP
          PL     X5,SXC8     IF ^PSP[CI]   */ STORED IN THE LOOP
          EQ     SXC9 
  
*         CLEAR BIT IN *LEA* TO INDICATE CORE VALUE DEAD ON ENTRY TO
*         LOOP AFTER COMBINING THE *HB* AND ITS PREDECESSOR.
  
 SXC10    SA2    B6+X4
          LX1    B2,X0
          BX6    -X1*X2      LEA(W) = LEA(W) & ^SHIFT(1,B)
          SA6    A2 
          EQ     SXC9 
 SXC      SPACE  2,14 
*         ADJUST LOOP LIVE ENTRY BV TO CLEAR BITS FOR VARIABLES THAT
*         ARE NOT USED AND DEAD ON EXIT FROM THE LOOP.
  
 SXC11    SA1    LXA
          SA2    BVL
          SA5    SVA
          SB3    X2+B1       VL = BVL + 1 
          SB2    B0          I = 0
          SA1    X1 
          SB7    X5                        (B7) = SVA 
  
 SXC12    SA2    B5+B2
          BX6    X1+X2       SV(I) = LX(I) ! LU(I)
          SA6    B7+B2
          SB2    B2+B1       I = I + 1
          SA1    A1+B1
          LT     B2,B3,SXC12 IF I < VL
  
*         CHECK FOR CHANGED BITS, AND CLEAR THOSE IN THE *LE* VECTOR
*         IF THE REF IS ^CM OR THE BASE MEMBER ( *CR* ) IS NOT REFED. 
  
          SA0    B6 
          SB2    B0          I = 0
          SX0    3           BO = 4 - 1    */ UDT OFFSET
  
 SXC13    SA2    A0+B2                     (X2) = LE(I) 
          SA1    B7+B2
          BX3    X2*X1
          BX7    X3-X2       VD = XOR( LE(I) , SV(I) & LE(I) )
          CX6    X7 
          ZR     X6,SXC17    IF COUNT(VD) = 0 
  
 SXC14    RJ     FLB         J = FLB(VD)
          SX1    B1 
          LX1    B5,X1
          BX7    -X1*X7      VD = VD & ^SHIFT(1,J)  */ CLEAR BIT
          SB6    B5+B5
          SX6    X0+B6       K = 2*J + BO 
          SA3    B4+X6       UK = UDT(K)
          LX3    59-UD.CMP
          PL     X3,SXC15    IF ^CM[UK]    */ ^ A CLASS MEMBER
  
          LX3    1+UD.CMP-UD.BMIP 
          SA4    B4+X3       U2 = UDT(BMI[UK]+1)
          SA5    B7+X4       SVW = SV(WI[U2]) 
          UX6    B6,X4       B = BITN[U2] 
          SB6    B6-59
          LX6    -B6,X5 
          MI     X6,SXC16    IF SHIFT(SVW,59-B) < 0  */ BASE MEM REFED
  
 SXC15    BX2    -X1*X2      LE(I) = LE(I) & ^SHIFT(1,J)
  
 SXC16    NZ     X7,SXC14    IF VD " 0
          BX6    X2 
          SA6    A2 
  
 SXC17    SX0    X0+120      BO = BO + 120
          SB2    B2+1        I = I + 1
          LT     B2,B3,SXC13 IF I < VL
  
          EQ     SXC
 FLB      SPACE  3,14 
**        FLB - FIND LEADING BIT SET IN A WORD
* 
*         ENTRY  (X7) = WORD
* 
*         EXIT   (B5) = BIT NUMBER ( 0 - 59 ) 
* 
*         USES   B - 5, 6  X - 5, 6 
  
 FLB      ROUTINE 
          MX5    12 
          BX6    X5*X7       T12 = MASK(12) & WORD
          ZR     X6,FLB1     IF T12 = 0 
          LX6    -12
          SB5    59 
          PX6    X6 
          NX5    B6,X6
          SB5    B5-B6       SC = 59-NORMC(PACK(0,SHIFT(T12,-12)))
          EQ     FLB
  
 FLB1     PX6    X7 
          SB5    47 
          NX5    B6,X6
          SB5    B5-B6       SC = 47-NORMC(PACK(0,WORD))
          EQ     FLB
 GRA      TTL    GRA - GLOBAL REGISTER ASSIGNMENT / CODE LOOP BODY
 CLB      TITLE  CLB - CODE LOOP BODY 
**        CLB - CODE LOOP BODY ( CONTROL )
  
          DESCRIBE BS.,60    BSW(CL,PC,LEN) 
          DEFINE 7
 CL       DEFINE 15          CODE LENGTH
 PC       DEFINE 2           PARCEL COUNT 
          DEFINE 18 
 LEN      DEFINE 18          LENGTH OF SAVED CODE IN *PIT*
  
 CLPC     DEQU   PC,17       COMBINATION FIELD
  
 CLBA     BFMW   CA,(VC,PSP,LX,DEF) 
 CLBB     BFMW   CA,(VC,IA,RF)
  
 CLB      ROUTINE 
          SA1    NAA
          SA2    NXC
          IX4    X1+X2
          LX3    B1,X4
          SX6    X3+7+51B    NXS = 4*( 2*(NAA+NXC) + 48 ) */ EXTRA SPACE
          LX6    2
          SA6    NXS
  
*         SCAN *RCT* AND SET *EU* BIT FOR *IA* CANIDATES WHOSE INCREMENTS 
*         VALUE IS NOT IN A B-REGISTER AND VISA-VERSA.
  
          MX0    -CC.REG1L
          SA5    LCT
          SA4    O.RCT
          SA1    CLBB 
          ZR     X5,CLB1     IF LCT = 0    */ NO CANIDATES
          SB6    X4 
          SA5    B6+X5       CI = RCT + LCT 
          SX7    B1 
          LX7    CA.EUP 
  
 AUM1     SA5    A5-3        CI = CI - 3
          ZR     X5,CLB1     IF [CI] = 0   */ END OF *RCT*
          BX6    -X1+X5 
          NZ     X6,AUM1     IF ^(VC,IA,RF)[CI] 
          SA4    A5+2        CCW = CI + 2 
          LX4    -CC.REG1P
          BX6    -X0*X4 
          LX4    CC.REG1P-CC.INCP 
          AX6    3
          SA3    B6+X4       CJ = RCT(INC[CCW]) 
          LX3    59-CA.RAP
          ZR     X3,AUM1     IF [CJ] = 0   */ INC[CCW] = 0
          LX5    59-CA.RAP
          PL     X5,AUM3     IF ^RA[CI]    */ INC VAR NOT IN A B-REG
          LX5    1+CA.RAP 
          NZ     X6,AUM3     IF REG1[CCW] \ 20B  */ INC VAR IN AN X-REG 
          LX4    CC.INCP+59-CC.I2P
          MI     X4,AUM2     IF I2[CCW] 
          PL     X3,AUM2     IF ^RA[CJ] 
          SA3    A3+2        CCWJ = CJ + 2
          LX3    -CC.REG1P
          BX6    -X0*X3 
          AX6    3
          ZR     X6,AUM1     IF REG1[CCWJ] < 7  */ INC IN A B-REG 
  
 AUM2     BX6    X7+X5       EU[CI] = 1 
          SA6    A5 
          EQ     AUM1 
  
 AUM3     LX3    1+CA.RAP 
          BX6    X7+X3       EU[CJ] = 1    */ FORCE INC VAL TO BE *EU*
          SA6    A3 
          EQ     AUM1 
 CLB      SPACE  2,10 
*         INITIALIZE FLAGS
  
 CLB1     SX6    B1+B1
          MX7    0
          SA6    BSI         BSI = 2
          SA7    MRU         MRU = 0       */ MACHINE REGS USED 
          SA7    L.PIT       L.PIT = 0
          SA7    PL          PL = 0 
  
*         SCAN *RAT* AND FORM POST STORE LIST 
  
          SX2    27B         I = 27B
          SA5    O.RCT
          SA3    NXC
          SA1    CLBA 
          SB7    B0          NPS = 0
          SB6    X5 
          NZ     X3,CLB2     IF NXC " 0 
          SX2    7           I = 7
  
 CLB2     SA5    RAT+X2      J = R1[RAT(I)] 
          ZR     X5,CLB3     IF RAT(I) = 0
          SA4    B6+X5       CAW = RCT(J) 
          BX6    -X1+X4 
          NZ     X6,CLB3     IF ^(VC[CAW]&PSP[CAW]&LX[CAW]&DEF[CAW])
  
          SX3    X5 
          LX2    18 
          BX7    X2+X3
          LX2    -18
          SA7    PST+B7      PST(NPS) = SHIFT(I,18) ! J 
          SB7    B7+1        NPS = NPS + 1
  
 CLB3     SX2    X2-1        I = I - 1
          NZ     X2,CLB2     IF I " 0 
  
          SX7    B7+
          SA7    NPS
  
*         PROCESS ALL NON-EMPTY BLOCKS IN THE LOOP BODY 
  
 CLB4     SX6    4           L.TXT = 4
          SA6    L.TXT
          CALL   RTB#        READ BLOCK IN
          SA1    L.SEQ
          RJ     SLW         SAVE LINK WORDS
  
          CALL   IRA         INSERT REGISTER ASSIGNMENTS
  
          SA1    L.TXT
          SA2    DTL
          IX3    X1-X2
          NZ     X3,CLB4A    IF L.TXT " DTL */CODE IT 
  
*         NOTHING TO CODE - MAKE BST(BSI+1) = 0 
*         SO NOTHING WILL BE WRITTEN TO BLK.
  
          SA1    O.BST
          SA2    BSI
          MX6    0
          IX3    X1+X2
          SA6    X3+B1       BST(BSI+1) = 0 
          EQ     CLB10
  
 CLB4A    BSS    0
  
          TRACE  CLB,RLIST,SEQ
          TRACE  CLB,RLIST
  
          RJ     RLW         RESTORE LINK WORDS 
  
          CALL   CUC         COLLECT USES COUNTS
  
 #IWT     IFEQ   .CPU,74
 #IWT     IFNE   .IWT,0                                          ?IWT 
  
*         IF A 6600 AND IWTIME " 0, THEN CHECK LOOP LENGTH AND SET STACK
*         FLAG IF IT FITS.  NOTE THAT BECAUSE OF PARCEL FAULTS THE
*         LOOP COULD BE CODED BY *MCG* AND NOT FIT *INSTACK*. 
  
          SA1    N.EBB
          SX6    X1-1 
          NZ     X6,CLS3     IF N.EBB " 1 
          SA5    O.TXT
          MX1    -D.SZL 
          SA4    L.TXT
          LX1    D.SZP
          SX2    B1+B1
          SX7    29 
          LX2    D.SZP       LEN = 2
          IX6    X4+X5
          LX7    D.SZP
          SA4    X6-2        DI = O.TXT + L.TXT - 2 
          SB4    4
  
 CLS1     SA4    A4-B4       DI = DI - 4
          LX4    59-D.JPP 
          PL     X4,CLS1     IF ^JP[DI]    */ NOT TERMINAL JUMP 
  
 CLS2     SA4    A4-B4       DI = DI - 4
          SA5    A4-2        R1 = DI - 2
          BX6    -X1*X4 
          IX2    X2+X6       LEN = LEN + SZ[DI] 
          UX3    B2,X5
          IX6    X2-X7
          PL     X6,CLS3     IF LEN > 28   */ LOOP NOT INSTACK
          NE     B2,B1,CLS2  IF OC[R1] " OC.BOS 
  
          MX7    1
          LX7    1+IH.STKP
          SA7    A5+5        STK[R1+5] = 1  */ INDICATE STACK TIMING
  
 CLS3     BSS    0
 #IWT     ENDIF                                                  'IWT 
  
          SA3    NXC
          RJ     CIS         SET THE PARCEL COUNT AND CODE THE SEQUENCE 
          NZ     X6,CLB14    IF MCGFAIL " 0  */ TOO MANY LOCKED REGS
  
*         COLLECT THE LIST OF REGISTERS USED BY *MCG* FOR OUTER LOOPS 
  
          SA5    MRA
          ZR     X5,CLB9     IF MRA = 0    */ NO REGS AVAIL 
  
          SA1    MRU
          SA2    O.TXT
          SA3    L.TXT
          SA5    X2+7        LI = O.TXT + 7 
          SB4    4
          SB3    X3-8        I = L.TXT - 8
          SX0    B1 
          BX6    X1 
  
 CLB8     SB5    X5          REGN = REG[LI] 
          LX2    B5,X0
          SB3    B3-B4       I = I - 4
          BX6    X2+X6       MRU = MRU ! SHIFT(1,REGN)
          SA5    A5+B4       LI = LI + 4
          NZ     B3,CLB8     IF I " 0 
          SA6    A1 
  
*         SAVE CODE LENGTH INFO IN *BST*
  
 CLB9     SA1    PL 
          SA2    L.PIT
          SA4    =XPC 
          SX3    0           CODEL = 0
          SA5    O.BST
          IX0    X2-X1       LEN = L.PIT - PL 
          LX0    BS.LENP
          BX6    X2          PL = L.PIT 
          SA6    A1 
          LX3    BS.CLP 
          LX4    BS.PCP 
          BX3    X3+X4
          SA4    BSI
          IX6    X3+X0
          SB5    X5+B1
          SA6    B5+X4       BST(BSI+1) = BSW(CL,PC,LEN)
          MX7    0
          SA1    NXC
          NZ     X1,CLB10    IF NXC " 0    */ LOCKED X-MODE 
          SA1    NAA
          NZ     X1,CLB10    IF NAA " 0    */ LOCKED A-REGS 
  
          SA7    PL          PL = 0 
          BX4    X6 
          SA1    A6-B1       BAW = BST(BSI) 
          RJ     WSC         DUMP CODE
          SA7    PL          PL = 0 
          SA7    L.PIT       L.PIT = 0
  
*         ADVANCE TO NEXT SEQUENCE
  
 CLB10    SA1    BSI
          SA2    L.BST
          SX6    X1+2        BSI = BSI + 2
          SX3    X2-1 
          IX7    X6-X3
          SA6    A1 
          MI     X7,CLB4     IF BSI < L.BST - 1 
  
          SX7    4
          SA7    L.TXT       L.TXT = 4
 CLB      SPACE  1,10 
*         WRITE THE SAVED CODE BACK TO *BLK*
  
          SA1    L.PIT
          ZR     X1,CLB      IF L.PIT = 0  */ NO SAVED CODE 
          SX6    B1+B1       BSI = 2
          MX7    0
          SA7    PL          PL = 0 
  
 CLB11    SA2    O.BST
          IX7    X6+X2
          SA1    X7          BAW = BST(BSI) 
          SA4    X7+B1       BSW = BST(BSI+1) 
          ZR     X1,CLB13    IF BAW = 0    */ END OF *BST*
          ZR     X4,CLB12    IF BST(BSI+1) = 0 */NOT CODED
          SA6    BSI
          RJ     WSC         WRITE SAVED CODE TO *BLK*
          SA1    BSI
          SX6    X1+
 CLB12    SX6    X6+2        BSI = BSI + 2
          EQ     CLB11
  
 CLB13    SX6    0
          SA6    L.PIT       L.PIT = 0
          EQ     CLB
 CLB      SPACE  3,10 
*         *MCG* FAILED, REDUCE LOCKED X-REG COUNT AND TRY AGAIN.
  
 CLB14    SA1    NXC
          ZR     X1,CLB17    IF NXC = 0 
          RJ     RXA         REMOVE LAST X-ASSIGNMENT 
          PRINT  CLB,(* --- MCG FAIL ---*)
          EQ     CLB1 
 CLB      SPACE  2,10 
*         A-REGS LOCKED AND MCG FAILED, REDUCE *MARA* AND RESTART 
  
 CLB17    CLCM   CLW         CLEAR LINK WORDS 
          SA1    NAA
          SX6    X1-1        MARA = NAA - 1 
          SA6    MARA 
          SX7    4
          SA7    L.TXT       L.TXT = 4
          SX7    0
          SA7    L.PIT       L.PIT = 0
          SA7    L.RCT       L.RCT = 0
          SA7    LUL+1       LUL(2) = 0 
          MX6    36 
          BX6    -X6
          SA6    MRA         MRA = ^MASK(36)
          EQ     GRA0 
 CLW      SPACE  3
**        CLW - CLEAR LINK WORDS OF A BLOCK 
  
 CLW      ROUTINE 
          SA1    O.SEQ
          SA2    L.SEQ
          SB4    4
          SB2    X1+3        I = 3
          IX3    X1+X2
          MX6    0
          SB3    X3 
  
 CLW1     SA6    B2          SEQ(I) = 0 
          SB2    B2+B4       I = I + 4
          LE     B2,B3,CLW1  IF I < L.SEQ 
  
          EQ     CLW
 RXA      SPACE  3,14 
**        RXA - REMOVE AN X-ASSIGNMENT FROM *RCT* 
* 
*         ENTRY  (A1,X1) = NXC,[NXC]
* 
*         EXIT   (X6) = NXC , DECREMENTED 
  
 RXA      ROUTINE 
          SA3    O.RCT
          SA2    XCT-1+X1    J = CO[XCT(NXC)] 
          MX0    2
          LX0    2+CA.RAFP
          SB3    X3 
          SA4    B3+X2
          BX6    -X0*X4      (RA,IRA)RCT(J) = 0 
          SA6    A4 
          MX0    -CC.REG1L
          SA5    A4+2        CCW = RCT(J+2) 
          LX5    -CC.REG1P
          BX2    -X0*X5      REGN = REG1[CCW] 
          MX0    -CC.REGFL
          LX0    CC.REGFP 
          LX5    CC.REG1P 
          BX6    X0*X5       REGF[RCT(J+2)] = 0 
          SA6    A5 
          SX6    X1-1        NXC = NXC - 1
          SA6    A1 
          ZR     X2,RXA      IF REGN = 0
          MX7    0
          SA7    RAT+X2      RAT(REGN) = 0
          SA7    RVT+X2      RVT(REGN) = 0
          EQ     RXA
 CXB      TITLE  CXB - CODE EXTENDED BASIC BLOCK
**        CXB - CODE EXTENDED BASIC BLOCK ( STRAIGHT LINE CODE )
  
 CXB      ENTRY. **,# 
          SA1    L.SEQ
          SB2    X1-8 
          LE     B2,CXB      IF L.SEQ @ 8 
  
          CALL   AIS#        ASSIGN INDEX REGISTERS 
          MX6    0
          SA6    PL          PL = 0 
          MX3    0
          RJ     CIS         SET *PC* AND CODE SEQUENCE 
          SA1    O.BST
          SA2    BSI
          SA3    =XPC 
          SA4    L.PIT
          IX7    X1+X2
          SA1    X7          BAW = BST(BSI) 
          LX3    BS.PCP 
          BX4    X3+X4       BSW = BSW(0,PC,L.PIT)
          RJ     WSC         WRITE SAVED CODE TO *BLK*
          SX6    4
          SA6    L.TXT       L.TXT = 4
          SA7    L.PIT       L.PIT = 0
          EQ     CXB
 CIS      SPACE  2,14        CIS
**        CIS - CODE INSTRUCTION SEQUENCE 
*                SETS THE INITIAL VALUE OF *PARCEL* AND CALLS *MCG*.
* 
*         ENTRY  (X3) = NXC , *MCG* LOCKED REGISTER FLAG
*         EXIT   (X6) = MCGFAIL FLAG, = 0 IF SEQUENCE CODED 
  
 CIS      ROUTINE 
          SA1    O.BST
          SA2    O.BIT
          SA4    BSI         J = BSI
          SB2    X1 
          SB3    X2 
          SA4    B2+X4
          LX4    -BA.BIP     BI = BI[BST(J)]
          SA5    B3+X4       BIW = BIT(BI)
          MX7    0           PPC = 0       */ PREVIOUS SEQ *PC* 
          LX5    59-BI.ILP
          MI     X5,CIS2     IF IL[BIW]    */ BLOCK HAS A INITIAL LABEL 
          MX6    -BI.PCL
  
 CIS1     SA5    A5-2        BI = BI - 2;  BIW = BIT(BI)
          LX5    59-BI.CBP
          PL     X5,CIS1     IF ^CB[BIW]   */ PART OF AN EXTENDED BLOCK 
          LX5    1+BI.CBP-BI.PCP
          BX7    -X6*X5      PPC = PC[BIW]
  
 CIS2     SX6    X3+
          SA7    =XCC$PC     CC$PC = PPC
          CALL   MCG# ( NXC )  CODE THE SEQUENCE
          EQ     CIS
 WSC      TITLE  WSC - WRITE SAVED CODE FROM *PIT* TO *BLK* 
**        WSC - WRITE SAVED CODE IN *PIT* TO *BLK*
* 
*         ENTRY  (BSI) = *BST* INDEX
*                (PL) = INDEX TO SAVED CODE IN *PIT*
*                (X1) = BAW = BST(BSI)
*                (X4) = BSW = BST(BSI+1) = BSW(CL,PC,LEN) 
* 
*         EXIT   (M.PL) = MAX *PIT* LENGTH OF A BLOCK UPDATED 
*                (X7) = 0 
*                *CB* AND *PC* FIELDS SET IN *BIT* ENTRY. 
  
 WSC      ROUTINE 
          SA5    O.BIT
          LX1    -BA.BIP
          SB3    X1          BN = BI[BAW] 
          MX0    -BS.CLPCL
          SA2    X5+B3       BIW = BIT(BN)
          SA3    M.PL 
          LX0    BS.CLPCP 
          LX4    -BS.LENP 
          SX1    X4          LEN = LEN[BSW] 
          LX4    BS.LENP
          SA5    O.PIT
          BX4    -X0*X4 
          SX7    B1 
          BX2    X0*X2
          LX7    BI.CBP 
          LX4    BI.PCP-BS.PCP
          BX2    X4+X2       CLPC[BIW] = CLPC[BSW]
          IX0    X3-X1
          SA4    PL 
          BX7    X7+X2       CB[BIW] = 1   */ INDICATE BLOCK CODED
          SA7    A2 
          PL     X0,WSC2     M.PL = MAX( M.PL , LEN ) 
          SX6    X1 
          SA6    A3 
  
 WSC2     IX6    X4+X5       FWAB = O.PIT + PL
          IX7    X4+X1       PL = PL + LEN
          SA7    A4+
          CALL   WFB#        WFB( FWAB , LEN )  */ WRITE TO *BLK* 
          MX7    0
          EQ     WSC
 IRA      TITLE  IRA - INSERT REGISTER ASSIGNMENTS IN BLOCKS
          QUAL   IRA
  
**        IRA - INSERT REGISTER ASSIGNMENTS IN TO BLOCKS
*         MODIFY SEQUENCE TO REFLECT REGISTER ASSIGNMENTS MADE IN GRA,
*         CHANGE INCREMENTS ( IA,IS ) TO SHORT INSTRUCTIONS, ETC. 
* 
*         ENTRY  (NXS) = N. EXTRA SPACE NEEDED
*                RCT, NAA,ACT, TRD, LUL, LCV, LIH SET.
*                LINK WORD OF INSTRUCTION POINTS TO *RCT* ENTRY.
* 
*         EXIT   (LBJ) " 0 , IF SEQUENCE CONTAINS A LOOP BACK JUMP
* 
*         DURING *IRA* THE LINK WORDS HOLD THE R-NUMBERS OF THE 
*         INSTRUCTIONS THAT REFLECT THE VALUES THAT ARE AVAILABLE IN
*         THE DIFFERENT REGISTER CLASS"S. 
  
          DESCRIBE I.,60     RNI(INB,ST,BR,XR)
 INB      DEFINE 1           =1 IF BR R-NUMBER IS AVAIL 
 MIB      DEFINE 1           MINUS VALUE IN B-REG 
          DEFINE 4
 ST       DEFINE 18          ST REG R-NUMBER
 BR       DEFINE 18          B-REG R-NUMBER 
 XR       DEFINE 18          X-REG R-NUMBER 
  
*         REGISTER ASSIGNMENTS ( MAIN LOOP ) -
*         (X0) = R-NUMBER MASK, (A5) = R1 , (A1,X1) = RCT(J)
*         (B2) = OC[R1] , B4 = [O.RCT] , B6 = TI , (B7) = [O.TXT] 
 SB       MICRO  1,,/B5/     O.SEQ + 3
 IRA      SPACE  2
 IRA      ROUTINE 
          SA1    L.SEQ
          SA2    NXS
          IX1    X1+X2
          ALLOC  TXT,X1      ALLOC( TXT , L.SEQ+NXS ) 
          SA4    O.SEQ       TI = OLD(L.TXT)
          SA3    O.RCT
          SB7    X2          TB = O.TXT 
          MX7    0
          S"SB"  X4+3        SB = O.SEQ + 3 
          SA5    X4          R1 = O.SEQ 
          SA1    X4+4 
          SB4    X3          (B4) = [O.RCT] 
          BX6    X5 
          SA6    B7          [TB] = [R1]   */ SET LINE NUM OF SEQ 
          SA7    RVT         RVT(0) = 0 
          SA7    LBJF        LBJF = 0 
          SA6    LBN         LBN = [R1] 
          SA7    "SB"        [SB] = 0 
          UX6    B2,X1
          SX7    B2-OC.LAB
          SA0    4           LF = 4        */ INIT LAB NOT PRESENT
          NZ     X7,IRA1     IF OC[R1+4] " OC.LAB 
  
          SA0    B0          LF = 0        */ INIT LAB PRESENT
          SA5    A1          R1 = R1 + 4
          RJ     SRI         SRI(  LAB  [R1],0 )
          SA1    F.RDT+OC.EOS 
          BX6    X1          FT[DI] = 0 
          SA6    A6 
 IRA      SPACE  2,14 
*         SCAN *RAT* AND SETUP INITIAL *DEF*"S AND *DAR*"S
*         CA OF R2 WORD HOLDS THE *CA* IN THE B-REG FOR PLD/PST"S.
  
 IRA1     SX5    27B         I = 27B       */ REGNO 
          SB3    OC.DEF 
          MX0    IH.CAL 
          SA1    =XF.RDT+OC.DEF 
          LX0    IH.CAL+IH.CAP
  
 IRA3     SA4    RAT+X5 
          ZR     X4,IRA5     IF RAT(I) = 0
          SA3    B4+X4       J = R1[RAT(I)];  CAW = RCT(J)
          SX6    B6 
          SA6    RVT+X5      RVT(I) = TI   */ R-NUMBER IN REG 
          SX2    X5+SO.LOCK 
          LX2    R1.SOP 
          BX6    X2+X6
          LX4    -RA.R3P
          PX6    B3,X6
          SA6    B7+B6       TXT(TI) = TYII(OC.DEF,0,FL+I,TI) 
  
          SB2    X4+B1       J3 = R3[RAT(I)]
          SA2    B4+B2
          BX7    -X2*X0      CA[R2W] = -CA[RCT(J3+1)] 
          SA7    A6+B1       TXT(TI+1) = R2W
          BX7    X1 
          SA7    A7+B1       TXT(TI+2) = RDT(OC.DEF)
          MX7    0
          SA7    A7+B1       TXT(TI+3) = 0
          LX3    59-CA.VCP
          SB6    B6+4        TI = TI + 4
  
          PL     X3,IRA5     IF ^VC[CAW]
          LX3    CA.VCP-CA.ACP
          PL     X3,IRA5     IF ^AC[CAW]   */ NOT A PREFETCH
  
*         OUTPUT *DAR* TO DEFINE THE R-NUM IN THE A-REG 
  
          SX7    B1 
          LX7    R1.SOP+SO.LKP
          BX6    X7+X6       SOLK[TXT(TI-4)] = 3  */ INDICATE *A-LOCK*
          SA6    A6 
          SX6    B6 
          SA6    RVT+X5-8    RVT(I-8) = TI
          SX4    B6-4 
          TYPEI  DAR,X6,X4   SRI(  DAR  TI,TI-4 ) 
  
 IRA5     SX5    X5-1        I = I - 1
          NZ     X5,IRA3     IF I " 0 
  
          SX6    B6+A0       DTL = TI + LF
          SA6    DTL
          SX0    RN.MASK
          EQ     IRA10
 EOQ      SPACE  3,20 
          PROCESS EOQ 
          SA3    NPS
          SA2    EPSI 
          ZR     X3,EOQ5     IF NPS = 0 
          ZR     X2,EOQ5     IF EPSI = 0
  
*         SEARCH *RXI* FOR THIS *BN* AND SEE IF AN *EPS* NODE 
  
          SA5    BVL
          SA4    O.UDT
          SB2    X5+2        V = BVL + 2   */ RXI INCREMENT 
          SA1    O.RXI
          SB3    X4+B1       (B3) = UDT + 1 
          SA0    X3          I = NPS
          SA5    X1+B1       TI = RXI + 1 
          MX1    -E.PREDL 
          SA2    LBN         BN = IH[LBN]  */ LAST BOS/EOS
  
 EOQ1A    LX5    -E.PREDP 
          BX6    X2-X5
          LX5    59-E.SCRP+E.PREDP
          BX7    -X1*X6 
          NZ     X7,EOQ1B    IF PRED[RI] " BN 
          PL     X5,EOQ1B    IF ^SCR[RI]
          LX5    E.SCRP-E.JPP 
          PL     X5,EOQ1C    IF ^JP[RI]    */ A FALL THROUGH EDGE 
  
 EOQ1B    SA5    A5+B2       RI = RI + V
          NZ     X5,EOQ1A    IF [RI] " 0   */ NOT END OF TABLE
          EQ     EOQ5 
  
 EOQ1C    SB5    A5+1        RB = RI + 1   */ LIVE ENTRY BIT VECTOR 
  
*         OUTPUT EPILOGUE POST STORES FOR VARIABLES LIVE ON EXIT
*         FROM THIS BLOCK.
  
 EOQ1     SA1    PST-1+A0    J = CO[PST(I)] 
          SA2    B4+X1       CAW = RCT(J);  K = UDI[RCT(J)] 
          LX1    -18         REGN = REG[PST(I)] 
          SA3    B3+X2       U2 = UDT(K+1)
          SA4    B5+X3       LEW = [RB+WI[U2]]
          SX6    B1 
          UX3    B2,X3       B = BITN[U2] 
          LX6    B2,X6
          BX7    X6*X4
          ZR     X7,EOQ4     IF ^B[LEW]    */ DEAD ON ENTRY 
  
*         SET BIT IN *LUV*, OUTPUT *ST* TO UPDATE VALUE IN MEMORY.
  
          SA4    LUV
          SB2    X3 
          SA4    X4+B2
          BX6    X6+X4       B[LUV(WI[U2])] = 1  */ SET BIT IN *LUV*
          SA6    A4 
  
          SA4    RVT+X1      RN = RVT(REGN) 
          SX7    X1-26B 
          PL     X7,EOQ3     IF REGN \ 26B */ RESULT IN A *ST-REG*
  
          SX7    X1-20B 
          SB2    OC.XMT      OC = OC.XMT
          PL     X7,EOQ2     IF REGN \ 20B */ IN A X-REG
          SB2    OC.SA       OC = OC.SA 
 EOQ2     MX7    0
          TYPEI  B2,B6,X4    SRI(  XMT/SA  TI,RN )
          SX4    B6-4        RN = TI - 4
  
 EOQ3     SA2    A2+B1
          SB2    OC.ST
          MX1    -IH.CAIHL
          SX6    X4          R1W = TYII(OC,0,0,RN)
          BX7    -X1*X2      R2W = IHW(0,0,CAIH[RCT(J+1)])
          RJ     SRI         SRI(  ST  RN,CAIH )
  
 EOQ4     SB2    A0-B1
          SA0    A0-B1       I = I - 1
          GT     B2,EOQ1     IF I > 0 
  
*         CHECK FOR AND OUTPUT STORES FOR THE A/X CANIDATES 
  
 EOQ5     SA1    LBJF 
          ZR     X1,EOQ7     IF NOT EXIT BLOCK
  
          SA1    AXCT        I = 1
  
 EOQ6     ZR     X1,EOQ7     IF AXCT(I) = 0 
          SA2    RVT+X1 
          MX7    0
          TYPEI  XMT,B6,X2   SRI( XMT  RI,RVT(REGN) ) 
          SA3    RVT+X1-10B                */ R-NUMBER IN A-REG 
          AX1    18 
          SX1    X1+B1
          SA2    B4+X1       C2W = RCT(CO+1)
          MX7    -IH.CAIHL
          BX7    -X7*X2 
          SX6    B6-4 
          TYPEI  SST,X6,X3   SRI( SST RI-4,ARN,,CAIH )
          SA1    A1+B1       I = I + 1
          EQ     EOQ6 
  
 EOQ7     SB2    OC.EOQ 
          MX6    0
          SX7    B0 
          CALL   SRI         SRI(  EOQ  0,0 ) 
          SX6    B6+
          SA6    L.TXT       L.TXT = TI 
          EQ     IRA
 TYI      EJECT 
          PROCESS (UP,NR,RNZ) 
          ZR     X7,TYI      IF RJ[R1] = 0
          SX2    B6+4        LJW = TI + 4  */ FAKE A B-OPERAND
  
*         TYPE I INSTRUCTION, 2 X OPERANDS AND ARBITRARY X-RESULT 
  
 TYI      SX2    X2          J = SETX(LJW)  */ X-REG OP 
          SX5    B6 
          LX2    R1.RJP 
          SX3    X3          K = SETX(LKW)
          BX2    X2+X5
          SX6    B6 
          LX5    I.STP
          BX6    X5+X6
          SA6    A5+3        [R1+3] = RNI(0,TI,0,TI)
          LX3    R1.RKP 
          BX5    X2+X3
  
 TYIA     MX7    0           R2W = 0
          SA4    F.RDT+B2    D = RDT(OC[R1])
          PX6    B2,X5       R1W = TYI(OC[R1],J,K,TI) 
  
*         TRANSFER INSTRUCTION TO *TXT*,  (X4,X6,X7) = D,R1W,R2W
  
 TYIT     SA6    B7+B6       TXT(TI) = R1W
          SA7    A6+B1       TXT(TI+1) = R2W
          BX6    X4 
          SA6    A7+B1       TXT(TI+2) = D
          MX7    0
          SA7    A6+B1       TXT(TI+3) = 0
          SB6    B6+4        TI = TI + 4
  
*         ADVANCE TO NEXT INSTRUCTION, JUMP TO OPCODE PROCESSOR 
  
          PROCESS (BOS,NOP) 
 IRA10    SA5    A5+4        R1 = R1 + 4
          SA4    A5+2        DI = R1 + 2
          MX7    D.TYL
          SA1    A4+B1       LI = DI + 1
          LX4    58-D.TYP 
          BX3    X7*X4
          UX6    B2,X5
          NZ     X3,IRA11    IF TYPE[DI] " I
  
          LX6    -R1.RJP
          BX7    "RN"X6 
          LX6    R1.RJP-R1.RKP
          SA2    "SB"+X7     LJW = [SB+RJ[R1]]
          BX6    "RN"X6 
          SA3    "SB"+X6     LKW = [SB+RK[R1]]
  
 IRA11    SA1    B4+X1       J = CO[LI];  CAW = RCT(J)
          LX4    2+D.TYP
          JP     IRA.JT+B2   JUMP( IRA.JT( OC[R1] ) ) 
 TYIV     SPACE  3,14 
*         TYPE IV INSTRUCTIONS
  
          PROCESS EOS 
          SX6    X5 
          ZR     X6,.LAB     IF IH[R1] = 0 */ ^ OPT=2 *EOS* 
  
          SA6    LBN         LBN = IH[R1]  */ SAVE FOR *EOQ*
          EQ     IRA10
  
          PROCESS (LAB,ENT,UJP,RJ3,RJ6) 
          SA3    A5+B1
          LX6    X5 
          BX7    X3          R2W = [R1+1] 
          EQ     TYIT 
 TYIM     SPACE  3,14 
*         MISCELLANEOUS TYPE I INSTRUCTIONS 
  
          PROCESS (ILS,IRS,PK)
          LX2    -I.BRP      LJW = SHIFT(LJW,-I.BRP)
          EQ     TYI
 DRL      SPACE  2,14 
          PROCESS DRL 
          SX6    B6          R = TI 
          BX7    X4 
          SA6    A4+B1       [DI+1] = RNI(0,0,0,TI) 
          LX7    59-D.L2P 
          PL     X7,DWL1     IF ^L2[DI]    */ LEVEL 0 
          SX7    B6          R = TI 
          LX7    I.STP
          BX7    X6+X7
          SA7    A4+B1       [DI+1] = RNI(0,TI,0,TI)
          EQ     DWL1 
  
          PROCESS DWL 
          BX7    "RN"X5 
          SA3    "SB"+X7
          BX7    X4                                                             CCGA039 11
          LX7    59-D.L2P                                                       CCGA039 12
          MI     X7,DWL0     IF L2[DI]                                          CCGA039 13
          LX3    -I.STP      R = ST[SB+RI[R1]]                                  CCGA039 14
*                                                                               CCGA039 15
 DWL0     SX6    X3          ELSE R= XR[SB+RI[R1]]                              CCGA039 16
  
 DWL1     SX2    X2          J = XR[LJW]
          SA1    A5+B1       R2 = R1 + 1
          LX2    R1.RJP 
          BX6    X2+X6
          LX1    -IH.RFP
          PX6    B2,X6
          BX3    "RN"X1      LF = RF[R2]
          BX1    X0*X1
          ZR     X3,DWL2     IF LF = 0     */ NO RF 
          SA3    "SB"+X3     LF = [SB+R]
          NZ     X3,DWL2     IF LF " 0     */ RF MATERIALIZED 
          LX2    -R1.RJP
          SX3    X2          LF = J        */ USE RJ AS RF
 DWL2     PL     X3,DWL3     IF ^INB[LF]
          LX3    -I.BRP      LF = SHIFT(LF,-I.BRP)
 DWL3     SX3    X3 
          BX7    X3+X1       RF[R2] = SETX(LF)
          SA3    F.RDT+B2 
          SX2    B1 
          LX2    D.L2P                     */ L2[D] = 0 IF *SUB0* 
          BX4    -X4*X2 
          BX4    X3-X4       D = RDT(OC[R1]) & ^L2[DI]
          LX7    IH.RFP 
          EQ     TYIT 
 SS       SPACE  2,6
          PROCESS SS
          LX2    -I.BRP 
          LX3    -I.BRP 
          EQ     TYI
 SA       SPACE  2,14 
          PROCESS SA
          LX1    59-CA.RAP
          MI     X1,PVC      IF RA[CAW] 
          PL     X2,SA1      IF ^INB[LJW] 
          LX2    -I.BRP      LJW = SHIFT(LJW,-I.BRP)
          NZ     X3,SA1      IF LKW " 0 
  
          LX4    59-D.PRSP
          MX7    -SO.REGL 
          PL     X4,SA2      IF ^PRS[DI]
          SA1    A5+4        R1RS = R1 + 4
          LX1    -R1.SOP
          BX6    -X7*X1      REGNO = SOREG[R1RS]
          LX1    59-SO.LKP
          SX7    X6-8 
          PL     X7,SA1      IF REGNO > 7 
          PL     X1,SA1      IF SOLK[R1RS] " 1  */ NOT TEMP LOCK
  
          SA5    A1          R = R1RS      */ OMIT *RS* 
          LX2    I.BRP
          BX7    X2 
          SA7    A1-B1       [R1+3] = LJW 
          EQ     IRA10
  
 SA1      PL     X3,TYI      IF ^INB[LKW] 
          LX3    -I.BRP      LKW = SHIFT(LKW,-I.BRP)
          EQ     TYI
  
*         SA  RI,RJ ,AND OPERAND IN A B-REG 
  
 SA2      SX6    B6 
          SX2    X2 
          MX7    1
          LX2    I.BRP
          BX7    X7+X6
          LX6    I.STP
          BX6    X2+X6
          BX7    X7+X6
          SA7    A4+B1       [DI+1] = RNI(1,TI,SETX(LJW),TI)
          SX5    B6 
          LX2    R1.RJP-I.BRP 
          BX5    X2+X5
          EQ     TYIA 
 IA       SPACE  2,14 
          PROCESS IA
          BX6    X2+X3
          PL     X6,TYI      IF ^( INB[LJW] ! INB[LKW] )
          SA4    =XHO$LCM 
          PL     X4,IAA            */ IF NOT LCM=G
          SA4    A2-3        R1W = [SB+RJ[R1]] - 3
          UX4    B2 
          PL     X2,IA4      IF ^INB[LJW] 
          SX7    -OC.DEF
          SX7    X7+B2
          NZ     X7,IA4      IF ^(OC = OC.DEF)
          SX3    B6 
          EQ     IA6
  
 IA4      SA4    A3-3        R1W = [SB+RK[R1]] - 3
          UX4    B2 
          MI     X3,IA5      IF INB[LKW]
  
 IA       SB2    OC.IA                               */   RESTORE B2
  
 IAA      LX1    59-CA.RFP
          PL     X1,TYI      IF ^RF[CI]    */ ^ *INC* AND SHORT USE 
  
          SB2    OC.SA       OC = OC.SA 
          BX6    X2*X3
          MI     X6,IA2      IF INB[LJW] AND INB[LKW] 
          BX6    X2 
          PL     X2,IA1      IF ^INB[LJW]  */ X+B IS OK 
          BX2    X3 
          LX3    X6          SWAP( LJW , LKW )
 IA1      LX3    -I.BRP      LKW = SHIFT(LKW,-I.BRP)
          EQ     TYI
 IA2      BX6    X2+X3
          LX6    59-I.MIBP
          PL     X6,IS1      IF NOT ( MIB[LJW] OR MIB]LKW] )
          SB2    OC.SS       OC = OC.SS 
          BX6    X3 
          LX6    59-I.MIBP
          MI     X6,IS1      IF MIB[LKW]
          BX3    X2          SWAP( LJW , LKW )
          LX6    1+I.MIBP 
          BX2    X6 
          EQ     IS1
  
 IA5      SX7    -OC.DEF
          SX7    X7+B2
          NZ     X7,IA       IF ^(OC = OC.DEF)
          SX3    B6 
  
 IA6      LX4    -R1.SOP
          MX7    -SO.REGL 
          BX5    -X7*X4 
          SB2    -4 
  
 IA7      SX7    -OC.DEF
  
 IA8      SB2    B2+4 
          GT     B2,B6,IA                      */ IF END OF TABLE 
          SA4    B7+B2
          UX4    B3 
          SX6    X7+B3
          NZ     X6,IA8                            */ IF NOT OC.DEF 
          MX7    -SO.REGL 
          LX4    -R1.SOP
          BX7    -X7*X4                            */ REG TYPE AND NUM
          IX7    X7-X5
          NZ     X7,IA7               */ IF NOT B REG WE ARE LOOKING FOR
          SX4    B2                            */ B REG RI
          SX6    B6                            */ NEXT AVAILABLE R NUM
          TYPEI  SA,X6,X4    SRI(SA, RI, J) 
          EQ     IA 
 IS       SPACE  2,8
          PROCESS IS
          BX6    X2*X3
          PL     X6,TYI      IF ^( INB[LJW] & INB[LKW] )
          LX1    59-CA.RFP
          PL     X1,TYI      IF ^RF[CI]    */ ^ *INC* AND SHORT USE 
  
          SB2    OC.SS       OC = OC.SS 
          BX6    X3 
          LX6    59-I.MIBP
          PL     X6,IS1      IF NOT MIB[LKW]
          SB2    OC.SA       OC = OC.SA 
 IS1      LX2    -I.BRP      LJW = SHIFT(LJW,-I.BRP)
          LX3    -I.BRP      LKW = SHIFT(LKW,-I.BRP)
          EQ     TYI
 SXT      SPACE  2,14 
          PROCESS SXT 
          LX1    59-CA.RAP
          PL     X1,TYI      IF ^RA[CAW]
  
          SA1    A1+2        CCW = RCT(J+2) 
          SA5    A5+4        R1 = R1 + 4
          MX7    -CC.REG1L
          SX3    X2          LKW = XR[LJW]
          LX1    -CC.REG1P
          BX7    -X7*X1 
          SA2    RVT+X7      LJW = RVT(REG1[CCW]) 
          UX6    B2,X5
          SB2    B2-OC.KLS+OC.ILS  OC = OC[R1]-OC.KLS+OC.ILS
          EQ     TYI
 XMTC     SPACE  2
          PROCESS XMTC
          PL     X2,TYI      IF ^INB[LJW] 
          SB2    OC.SS       OC = OC.SS 
          LX2    -I.BRP 
          SX3    X2          LKW = BR[LJW]
          SX2    0           LJW = 0
          EQ     TYI
 XMT      SPACE  3,14 
          PROCESS XMT 
          LX1    59-CA.RAP
          MI     X1,PVC      IF RA[CAW] 
          LX4    59-D.PSP 
          BX7    X2 
          PL     X4,XMT1     IF ^PS[DI] 
          LX7    -I.STP 
          SX6    X7 
          ZR     X6,XMT1     IF ST[LJW] = 0  */ OPERAND NOT IN *ST* REG 
  
*         OPERAND FREE TO GO TO A *ST* REG, SKIP THE *XMT*
  
          LX7    I.STP
          SA7    A4+B1       [DI+1] = LJW 
          EQ     IRA10
  
 XMT1     SX3    B6 
          SX6    X2          J = XR[LJW]
          LX3    I.STP
          SX5    B6 
          BX7    X3+X6       LW = RNI(0,TI,0,J) 
          NZ     X6,XMT2     IF J " 0 
          LX2    -I.BRP 
          SX6    X2          J = BR[LJW]
          SB2    OC.SA
          BX7    X3+X5       LW = RNI(0,TI,0,TI)
 XMT2     LX6    R1.RJP 
          LX4    D.PSP-D.PRSP 
          PL     X4,XMT3     IF NOT PRS[DI] 
          SX7    X7          LW = RNI(0,0,0,X)  */ CLEAR ST FIELD 
  
 XMT3     SA7    A4+B1       [DI+1] = LW
          BX5    X6+X5       R1W = TYI(0,J,0,TI)
          EQ     TYIA 
 PST      SPACE  2,8
          PROCESS (PST,SST,SDS) 
          BX7    "RN"X5 
          SA1    "SB"+X7
          LX1    -I.STP 
          SX6    X1          R = ST[SB+RI[R1]]
          EQ     PLD1 
 PLD      SPACE  2,14 
          PROCESS (PLD,SLD,SDL) 
          SX6    B6+         R = TI 
          SA6    A5+3        [R1+3] = RNI(0,0,0,TI) 
  
 PLD1     PL     X2,PLD2     IF ^INB[LJW] 
          LX2    -I.BRP      LJW = SHIFT(LJW,-I.BRP)
 PLD2     PL     X3,PLD3     IF ^INB[LKW] 
          LX3    -I.BRP      LKW = SHIFT(LKW,-I.BRP)
  
 PLD3     SX2    X2 
          PX6    B2,X6
          LX2    R1.RJP 
          SX3    X3 
          BX6    X2+X6
          SA2    A5+B1       R2 = R1 + 1
          LX3    R1.RKP 
          BX6    X3+X6       R1W = TYI(OC[R1],SETX(LJW),SETX(LKW),R)
          SA1    DMASK
          LX2    -IH.RFP
          BX5    "RN"X2 
          SA3    "SB"+X5     LFW = [SB+RF[R2]]
          PL     X3,PLD4     IF ^INB[LFW] 
          LX3    -I.BRP 
 PLD4     BX2    X0*X2
          SX3    X3          RF[R2W] = SETX(LFW)
          BX7    X2+X3
          BX4    -X1*X4      D = [DI] & ^DMASK
          LX7    IH.RFP 
          EQ     TYIT 
 RS       SPACE  2,14 
          PROCESS RS
          MX7    -SO.REGL 
          LX6    -R1.SOP
          BX2    -X7*X6      REGNO = SOREG[R1]
          LX6    R1.SOP+59-R1.INP 
          PL     X6,RS1      IF IN[R1] = 0 */ ^ A RJRS
          SX6    B6          R = TI 
          EQ     RS2
  
 RS1      LX1    59-CA.IRAP 
          MI     X1,IRA10    IF IRA[CAW]   */ PRED AND RS TO BE MOVED 
          SX6    B6-4        R = TI - 4 
          SX3    X2-8 
          MI     X3,RS2      IF REGNO < 8  */ IN A B-REGISTER 
          SX3    X2-26B 
          PL     X3,RS3      IF REGNO \ 26B  */ IN A ST-REGISTER
  
          SA2    A5-B1       LIP = R1 - 1  */ LINK WORD OF RS PRED
          SX7    X2 
          LX2    -I.STP 
          SX3    X2 
          BX7    X7-X3
          NZ     X7,RS3      IF ST[LIP] " XR[LIP] 
          BX7    X0*X2
          LX7    I.STP       ST[LIP] = 0
          SA7    A2 
          EQ     RS3
  
 RS2      MX7    1
          LX7    1+I.INBP 
          LX6    I.BRP
          BX7    X6+X7
          LX6    -I.BRP 
          BX3    "RN"X5 
          SA7    "SB"+X3     [SB+RI[R1]] = RNI(B,0,R,0) 
  
 RS3      BX5    X0*X5
          MX2    -D.USESL 
          BX6    X5+X6       RI[R1W] = R
          MX7    0           R2W = 0
          BX4    X2*X4       USES[DI] = 0;  D = [DI]
          EQ     TYIT 
 TYII     SPACE  3,14 
          PROCESS (FMA,CLR,S) 
          LX1    59-CA.RAP
          MI     X1,PVC      IF RA[CAW] 
  
 FMA1     SX7    B6 
          SX6    B6 
          LX7    I.STP
          BX6    X7+X6       RNW = RNI(0,TI,0,TI) 
  
 FMA2     SA6    A4+B1       [DI+1] = RNW 
          BX5    X0*X5
          SX7    B6 
          BX5    X7+X5       RI[R1W] = TI 
          EQ     TYIA 
 DEF      SPACE  2
          PROCESS DEF 
          MX3    -SO.REGL 
          LX5    -R1.SOP
          BX7    -X3*X5      REGN = SOREG[R1] 
          LX5    R1.SOP 
          SA3    RVT+X7 
          SX2    X7-26B 
          NZ     X3,DEF1     IF RVT(REGN) " 0  */ DEF IS A CANIDATE 
          PL     X2,FMA1     IF REGN \ 26B  */ IN A STORE REG 
          AX7    4
          SX6    B6          RNW = RNI(0,0,0,TI)
          NZ     X7,FMA2     IF REGN \ 20B   */ X-REG 
          MX7    1
          LX6    I.BRP
          BX6    X7+X6       RNW = RNI(1,0,TI,0)
          EQ     FMA2 
  
*         REGISTER ASSIGNMENT EXTENDED FROM INNER LOOP, SETUP LINK WORD 
*         AND SKIP THIS *DEF*.
  
 DEF1     SX6    X3          R = RVT(REGN)
          LX6    I.STP
          BX6    X3+X6       RNW = RNI(0,R,0,R) 
          AX7    4
          PL     X2,DEF2     IF REGN \ 26B */ STORE REG 
          MX2    1
          SX6    X3          RNW = RNI(0,0,0,R) 
          NZ     X7,DEF2     IF REGN \ 20B */ X-REG 
          LX3    I.BRP
          BX6    X2+X3       RNW = RNI(1,0,R,0) 
 DEF2     SA6    A4+B1       [DI+1] = RNW 
          EQ     IRA10
 TYIII    SPACE  2,14 
          PROCESS (KLS,KRS) 
          SX7    B6 
          PX6    B2,X7       R1W = TYII(OC[R1],0,0,TI)
          SA7    A4+B1       [DI+1] = RNI(0,0,0,TI) 
          SB3    B0          SC = 0 
  
*         TYIII - ADJUST *RF*, SC, R1W SET
  
 TYIII    SA3    A5+B1       R2 = R1 + 1;  R2W = [R2] 
          SA4    F.RDT+B2    D = RDT(OC[R1])
          LX3    -IH.RFP
          BX5    "RN"X3      R = RF[R2] 
          SA2    "SB"+X5     LJW = [SB+R] 
          BX3    X0*X3
          AX2    B3,X2       LJW = SHIFT(LJW,-SC) 
          SX1    X2 
          BX7    X1+X3       RF[R2W] = SETX(LJW)
          LX7    IH.RFP 
          EQ     TYIT 
 JIN      SPACE  2,12 
          PROCESS (JIN,JPBB)
          SB3    I.BRP
          SA3    A5+1        R2 = R1 + 1
          PL     X3,JIN3     IF [R2] < 0   */ NOT SPECIAL *JIN* 
          SA2    =XL.HB 
          SX6    X2-12
          PL     X6,JIN2     IF L.HB > 8   */ *HB* IS NON EMPTY 
          SA2    RAT+1
          MX6    27          I = 27 
 JIN1     NZ     X2,JIN2     IF RAT(I) " 0
          SA2    A2+B1
          LX6    1           I = I - 1
          MI     X6,JIN1     IF I " 0 
          EQ     JIN3                      */ NO REGISTERS ASSIGNED 
  
*         HOLDING BLOCK IS OR WILL BE NON-EMPTY, SETUP CODE TO CHECK
*         FOR JUMP TO TOP OF LOOP LABEL BEFORE *JP* INSTRUCTION.
  
 JIN2     SA2    LGL
          SX7    X2 
          TYPEI  STT,B6      SRI( STT  TI,,,SETX(LGL) ) 
          SX6    B6-4 
          SX2    SO.TLOCK+3 
          LX2    R1.SOP 
          BX6    X2+X6
          TYPEI  RS,X6       SRI( RS  TI-4,TLOCK+3 )
          BX7    "RN"X5 
          SA3    "SB"+X7
          SA2    LIH
          LX3    -I.BRP      I = BR[SB+RI[R1]]
          SX7    B6-8        J = TI - 8 
          LX7    IH.RFP 
          BX7    X2+X7
          TYPEI  JPBB,X3     SRI( JPBB  I,J,0,LIH ) 
          SB2    OC.JIN 
  
 JIN3     BX7    "RN"X5      R = RI[R1] 
          SA3    "SB"+X7     LJW = [SB+R] 
          BX5    X0*X5
          AX3    B3,X3
          SX2    X3          R = SETX( SHIFT(LJW,-SC) ) 
          BX6    X2+X5       RI[R1W] = R
          EQ     TYIII
 RJXJ     SPACE  3
          PROCESS RJXJ
          SA3    A5+B1       R2 = R1 + 1
          SB3    B0          SC = 0 
          EQ     JIN3 
 JPX      EJECT 
          PROCESS JPX 
          SA1    LIH
          SA2    A5+B1       R2 = R1 + 1
          SB3    B0          SC = 0 
          BX6    X1-X2
          SX7    X6 
          NZ     X7,JPX9     IF LIH " IH[R2]  */ NOT THE LOOP BACK JUMP 
          SX7    1
          SA7    LBJF        LBJF = 1 
          SA1    TRD
          ZR     X1,JPX0     IF TRD = 0    */ NO TEST REPLACEMENT 
          SA4    A5-4 
          BX6    X4-X5
          BX7    "RN"X6 
          NZ     X7,JPX0     IF RI[R1] " RI[R1-4] 
          SB6    B6-4        TI = TI - 4   */ DELETE LAST INSTRUCTION 
  
*         INSERT PREFETCHS FOR NEXT ITERATION OF LOOP 
*         NOTE - NO *IH* IN THE LD SINCE NO STORES INTO CLASS IN LOOP.
  
 JPX0     SA3    NAA
          ZR     X3,JPX7     IF NAA = 0    */ NO A-ASSIGNMENTS
          SA0    X3-1        I = NAA
  
 JPX1     SA1    ACT+A0      AI = ACT(I)
          SA2    RVT+X1 
          SB3    X1          XREG = SETX( AI ) */ X-REGNO OF *LD* 
          LX1    -CC.INCP    IP = INC[AI] 
          SA2    RVT-8+B3    J = RVT(XREG-8)  */ R-NUM OF A-REG 
          SA3    B4+X1       CAW = RCT(IP)
          LX1    CC.INCP+59-CC.IMP
          LX3    59-CA.RAP
          PL     X3,JPX3     IF ^RA[CAW]   */ INC NOT IN A REGISTER 
  
          SB2    OC.SLD      OC = OC.SLD
          PL     X1,JPX2     IF ^IM[AI] 
          SB2    OC.SDL      OC = OC.SDL
 JPX2     SA3    A3+2        CCW = RCT(IP+2)
          MX7    -CC.REG1L
          LX3    -CC.REG1P
          BX7    -X7*X3      REGNO = REG1[CCW]
          LX2    R1.RJP 
          SA4    RVT+X7      K = RVT(REGNO) 
          MX7    0           R2W = 0
          LX4    R1.RKP 
          BX6    X2+X4       R1W = TYI(0,J,K,0) 
          EQ     JPX5 
  
*         INC NOT IN A REGISTER, MUST BE A CON ( *DAA* RESTRICTION ). 
  
 JPX3     SA3    A3+B1       C2W = RCT(IP+1)
          LX2    IH.RFP 
          PL     X1,JPX4     IF ^IM[AI] 
          LX3    -IH.CAP-IH.CAL 
          MX4    IH.CAL 
          BX3    -X3*X4      CA[C2W] = -CA[C2W] 
          LX3    IH.CAL+IH.CAP
  
 JPX4     SB2    OC.LD       OC = OC.LD 
          MX6    0           R1W = 0
          BX7    X2+X3       R2W = IHW(0,J,CA[C2W],0) 
  
 JPX5     SX5    B6          R = TI 
          BX6    X6+X5
          RJ     SRI         SRI(  OC  R,... )
  
          SA2    RVT+B3      J = RVT(XREG)
          SX4    SO.LOCK+B3 
          SB2    OC.RS
          LX4    R1.SOP 
          BX6    X4+X5
          LX2    IH.RFP 
          BX7    X2          R2W = IHW(0,J,0,0) 
          RJ     SRI         SRI(  RS  R,FL+XREG,R2W )
          SB2    A0 
          SA0    A0-B1       I = I - 1
          GT     B2,JPX1     IF I > 0 
  
 JPX7     SA4    TRD
          SA5    A5 
          SB3    B0          SC = 0 
          UX6    B2,X5
          ZR     X4,JPX9     IF TRD = 0    */ NO TEST REPLACEMENT 
  
*         OUTPUT SPECIAL TEST JUMP,  GE  LUL,LCV,LIH
  
          SA1    LUL+1
          SA2    LCV+1
          SB2    OC.JPBB
          SA1    RVT+X1      I = RVT(LUL(2))
          SA3    LIH
          SA2    RVT+X2      J = RVT(LCV(2))
          PL     X4,JPX8     IF TRD > 0    */ F(I) NOT NEGATIVE 
          SB3    X1+
          BX1    X2          SWAP( I , J )
          SX2    B3 
  
 JPX8     SA4    F.RDT+B2    D = RDT(OC.JPBB) 
          LX2    IH.RFP 
          SX7    B1+B1
          PX6    B2,X1       R1W = TYII(OC.JPBB,0,0,I)
          BX2    X2+X3
          LX7    IH.CAP 
          BX7    X7+X2       R2W = IHW(0,J,2,LIH) 
          EQ     TYIT 
*         CONVERT ZR,NZ JUMPS TO TEST THE B-VALUES IF AVAILABLE 
  
 JPX9     SA4    A5+B1       R2 = R1 + 1
          MX6    -3 
          LX4    -IH.CAP
          BX6    -X6*X4 
          SX7    X6-2 
          PL     X7,JIN3     IF JC[R2] " ZR,NZ
          BX7    "RN"X5 
          SA2    "SB"+X7     LJW = [SB+RI[R1]]
          LX2    -I.BRP 
          SX2    X2 
          ZR     X2,JIN3     IF BR[LJW] = 0  */ NO B-REGISTER VALUE 
  
          BX6    X2 
          SB3    8
          SA6    RVT
 JPX10    SA3    RVT-1+B3    SEARCH RVT FOR MATCH OF R-NUM
          BX6    X2-X3
          SB3    B3-B1
          NZ     X6,JPX10 
          SA6    RVT
          ZR     B3,JIN3     IF R-NUM NO LONGER AVAIL 
*                            B3 = 0 WHEN GOING TO JIN3
  
          SB2    OC.JPBB
          LX4    IH.CAP 
          PX6    B2,X2
          BX7    X4 
          SA4    F.RDT+B2 
          EQ     TYIT 
 LD       SPACE  3,14 
          PROCESS (LD,ILD,TLD,LDC,LDV)
          LX1    59-CA.RAP
          SX6    B6          TR = TI
          PL     X1,LD1      IF ^RA[CAW]
          LX1    CA.RAP-CA.VCP
          MI     X1,PVC      IF VC[CAW] 
  
          SB2    OC.LD       OC[R1] = OC.LD 
  
          SA3    A5+B1       R2 = R1 + 1
          SX6    X3 
          NZ     X6,PAC      IF IH[R2] " 0 */ NOT A F.P. ADDR LOAD
          LX3    -IH.RFP
          SX6    X3-1 
          NZ     X6,PAC      IF RF[R2] " 1
          SB2    OC.STT      OC = OC.STT   */ FORCE A *SA* INST IN *PAC*
          SA3    A1+2        CCW = CAW + 2
          MX6    -CC.REG1L
          LX3    -CC.REG1P
          BX6    -X6*X3 
          BX3    X6 
          AX6    3
          ZR     X6,PAC      IF REG1[CCW] < 8  */ IN A B-REGISTER 
  
*         LCM=I ADDRESS IS IN AN X-REGISTER, USE THAT VALUE 
  
          SA3    RVT+X3      R = RVT(REG1[CCW]) 
          BX6    X3 
          LX3    I.STP
          BX7    X3+X6
          SA7    A5+3        [R1+3] = RNI(0,R,0,R)
          EQ     IRA10
  
 LD1      SA6    A5+3        [R1+3] = RNI(0,0,0,TR) 
          BX7    X4 
          LX7    59-D.FPP 
          PL     X7,LD2      IF ^FP[DI] 
          SA2    =XHO$OPT 
          PL     X2,LD2      IF HO$OPT " 2
          SX7    B1          FLAG = 1 
          CALL   MPR#        CALL MPR( R1 , FLAG )
          SA4    A5+2        RESTORE X4, X6 
          SA3    A4+B1
          BX6    X3 
  
*         ADJUST *RF* OF LD,ST,STT INSTRUCTIONS 
  
 LD2      SA3    A5+B1       R2 = R1 + 1
          LX3    -IH.RFP
          BX1    "RN"X3      R = RF[R2] 
          SA2    "SB"+X1     LJW = [SB+R] 
          BX7    X0*X3
          PL     X2,LD3      IF ^INB[LJW] 
          LX2    -I.BRP      LJW = SHIFT(LJW,-I.BRP)
 LD3      SX2    X2          J = SETX(LJW)
          SA1    DMASK
          BX7    X2+X7
          BX5    X0*X5
          LX7    IH.RFP      RF[R2W] = J
          BX6    X5+X6       RI[R1W] = TR 
          BX4    -X1*X4      D = [DI] & ^DMASK
          EQ     TYIT 
 STT      SPACE  2
*         STT - *IRA* *AC* OR *CON* CANIDATE
  
 STT0     SX7    B6 
          SX6    B6 
          LX7    I.STP
          BX7    X6+X7
          SA7    A5+3        [R1+3] = RNI(0,TI,0,TI)
          EQ     LD2
  
          PROCESS STT 
          LX1    59-CA.RAP
          PL     X1,STT0     IF ^RA[CAW]
  
          LX1    CA.RAP-CA.IRAP 
          PL     X1,STT1     IF ^IRA[CAW]  */ NOT ASSIGNED IN *ERC* 
          BX6    X4 
          LX6    59-D.PRSP
          PL     X6,STT1     IF ^PRS[DI]   */ NOT THE ONE ERC MARKED
          SA2    A5+7        LIS = R1 + 7  */ LINK WORD OF *RS* 
          ZR     X2,STT1     IF [LIS] = 0  */ NOT MOVED BY ERC/RS 
  
          MX7    0
          SA7    A4+B1       [DI+1] = 0 
          EQ     IRA10
  
 STT1     LX1    CA.IRAP-CA.CONP
          PL     X1,PAC      IF ^CON[CAW] 
  
*         CHANGE *INC* STT TO A *SA* OR *SS*
  
          SA1    A1+B1       C2W = RCT(J+1) 
          SA3    A5+B1       R2 = R1 + 1
          BX1    X3-X1
          LX3    -IH.RFP
          SA2    "SB"+X3     LJW = [SB+RF[R2]]
          LX3    IH.RFP+42-IH.CAP 
          MI     X2,STT2     IF INB[LJW]
  
          MI     X3,STT0     IF CA[R2] < 0 */   SRI  X-B DOESNT EXIST 
  
 STT2     LX1    59-IH.CAP
          SB2    OC.SA       OC = SA
          MX7    -CC.REG1L
          PL     X1,STT3     IF CA[R2] = CA[C2W]
          SB2    OC.SS       OC = OC.SS 
  
 STT3     SA1    A1+B1       CCW = RCT(J+2) 
          LX1    -CC.REG1P
          BX7    -X7*X1 
          SA3    RVT+X7      LKW = RVT(REG1(CCW]) 
          PL     X2,TYI      IF ^INB[LJW] 
          LX2    -I.BRP      LJW = SHIFT(LJW,-I.BRP)
          EQ     TYI
 ST       EJECT 
*         ST - ADDRESS CANIDATE OR REDEFINTION OF A REGISTER
  
          PROCESS (ST,TST)
          BX7    "RN"X5      R = RI[R1] 
          SA2    "SB"+X7     LJ = SB + R;  LJW = [LJ] 
          LX1    59-CA.RAP
          MI     X1,ST0      IF RA[CAW] 
  
          LX2    -I.STP 
          SX6    X2          TR = ST[LJW] 
          EQ     LD1
  
 ST0      LX1    CA.RAP-CA.KDP
          PL     X1,ST1      IF ^KD[CAW]
          LX4    59-D.INCP
          PL     X4,IRA10    IF ^INC[DI]
  
*         CLEAR LINK WORD OF INCREMENT SO WE DONT GET GARBAGE IN THE
*         *RF* FIELD OF MEM REFS IN THE INCREMENT FIRST CASE. 
  
          SB6    B6-4        TI = TI - 4   */ BACK OVER INC INSTRUCTION 
          MX6    0
          SA6    A2          [LJ] = 0      */ CLEAR LINK WORD OF *INC*
          EQ     IRA10
  
 ST1      LX1    CA.KDP-CA.VCP
          PL     X1,PAC0     IF ^VC[CAW]
  
*         PROCESS REDEFINITION OF A REGISTER
  
          SA0    A2 
          SA1    A1+2        CCW = RCT(J+2) 
          MX7    -CC.REG1L
          LX1    -CC.REG1P
          BX5    -X7*X1      REGNO = REG1[CCW]
          SA3    N.HB 
          ZR     X3,ST1A     IF N.HB = 0   */ INNER LOOP
  
*         OUTER LOOP, CHECK FOR POST STORE OF A REGISTER ASSIGNMENT MADE
*         IN AN INNER LOOP AND EXTENDED TO THIS LOOP. 
  
          SA3    B7+X2       R1P = TXT(XR[LJW]) 
          SB3    OC.XMT 
          UX7    B2,X3
          EQ     B2,B3,ST0A  IF OC[R1P] = OC.XMT
          SB3    OC.SA
          NE     B2,B3,ST0B  IF OC[R1P] " OC.SA 
          LX3    -R1.RKP
          BX6    "RN"X3 
          NZ     X6,ST1A     IF RK[R1P] " 0  */ NOT  * SA  RI,RJ *
 ST0A     LX7    -R1.RJP
          BX6    "RN"X7 
          SA3    B7+X6       R1P = TXT(RJ[R1P]) 
          UX7    B2,X3
 ST0B     SB3    OC.DEF 
          NE     B2,B3,ST1A  IF OC[R1P] " OC.DEF
          LX7    -R1.SOP
          MX6    -SO.REGL 
          BX7    X5-X7
          BX6    -X6*X7 
          NZ     X6,ST0C     IF SOREG[R1P] .NE. REGNO */ DIF. CANDIDATES
          SA3    A3+2        DIP = R1P + 2
          LX3    59-D.XUP 
          MI     X3,ST1C     IF XU[DIP]   */ VAR WAS REDEF IN THIS SEQ. 
          EQ     ST4A 
  
 ST0C     BX6    X3-X2
          BX7       "RN"X6
          ZR        X7,ST1C  IF RI[R1P] = XR[LJW] */ REGNO-S " & DEF,ST 
  
*         SEE IF *OP* CAN PRS TO A B-REG ( S,SA,SS,STT )
  
 ST1A     SB2    X2+4 
          NE     B2,B6,ST1C  IF XR[LJW] " TI-4  */ RS WONT FOLLOW REDEF 
          SA3    B7+X2       R1P = TXT(XR[LJW]) 
          SX7    X5-8 
          UX6    B2,X3
          PL     X7,ST3      IF REGNO > 7  */ ^ IN A B-REG
          SB3    OC.CLR 
          NE     B2,B3,ST1B  IF OC[R1P] " OC.CLR
  
*         CLR PRS TO A B-REG, CHANGE TO A *  S  RI,0 *
  
          SA4    F.RDT+OC.S  DJ = RDT(OC.S) 
          SB2    OC.S 
          PX7    B2,X3       OC[R1P] = OC.S 
          SX6    B1 
          SA7    A3 
          LX6    D.SZP
          IX7    X4-X6       SZ[DJ] = 1 
          SA7    A3+2        [R1P+2] = DJ 
          EQ     ST3
  
 ST1B     SA4    DUM.JT+B2
          SB3    OC.SA
          LX4    59-29
          PL     X4,ST1C     IF ^BRS(OC[R1P])  */ CANT PRS TO A B-REG 
  
*         OUTPUT *SA* IF PRED IS A *EU* SA PUT OUT BY *PVC* SO AS TO
*         PRESERVE THE X-REG R-NUMBER 
  
          NE     B2,B3,ST3   IF OC[R1P] " OC.SA 
          LX3    -R1.RKP
          BX7    "RN"X3 
          NZ     X7,ST3      IF RK[R1P] " 0  */ NOT  SA RI,RJ 
  
*         OUTPUT *SA/XMT* SO THAT *RS* WILL FOLLOW DEFINITION OF RESULT 
  
 ST1C     SB2    OC.XMT 
          SX7    X5-8 
          BX6    X2+X7
          PL     X6,ST2      IF REGNO > 7 & ^INB[LJW] 
          SB2    OC.SA
          PL     X2,ST2      IF ^INB[LJW] 
          LX6    X2 
          LX2    -I.BRP      LJW = SHIFT(LJW,-I.BRP)
          LX6    59-I.MIBP
          PL     X6,ST2      IF ^MIB(LJW) 
          SB2    OC.SS
          SX2    X2          RJ = SETX(LJW) 
          LX2    R1.RKP 
          EQ     ST2A                  */ TO SRI WITH RJ SWITCHED TO RK 
  
 ST2      SX2    X2          RJ = SETX(LJW) 
          LX2    R1.RJP 
  
 ST2A     SX6    B6 
          BX6    X2+X6
          MX7    0
          RJ     SRI         SRI(  XMT/SA  TI,RJ )
  
*         OUTPUT *RS* TO FORCE THE RESULT BACK TO THE REGISTER
  
 ST3      SA4    A5+2        DI = R1 + 2
          LX4    59-D.XUP 
          PL     X4,ST3A     IF ^XU[DI]    */ IF NO EXTENDED USES 
  
          RJ     APD         ADJUST PREVIOUS DEF TO SAVE OLD VALUE
  
 ST3A     SA3    RVT+X5      F = RVT(REGNO)  */ OLD R-NUM IN REGISTER 
          SX4    X5+SO.LOCK 
          SB2    OC.RS
          SX6    B6-4        R = TI - 4 
          LX4    R1.SOP 
          SA6    A3          RVT(REGNO) = R  */ UPDATE R-NUM IN REG 
          SB3    X3+2 
          BX6    X4+X6
          SA4    B7+B3       DIP = TXT(F+2)  */ CHECK PRED FOR A *CA* 
          SX7    A4-B1       R2P = DIP - 1
          LX4    59-D.PIP 
          MI     X4,ST4      IF PI[DIP] 
          SX7    X7+4        R2P = R2P + 4
 ST4      SA4    X7 
          MX7    -IH.CAIHL
          LX3    IH.RFP 
          BX4    -X7*X4 
          BX7    X3+X4       R2W = IHW(0,F,CAIH[R2P]) 
          RJ     SRI         SRI(  RS  R,FL+REGNO,R2W ) 
  
*         UPDATE R-NUMBER IN THE LINK WORD OF THE PRED
  
 ST4A     SA1    A1-2 
          SA3    RVT+X5      RN = RVT(REGNO)
          SA2    A0+         LJW = [LJ] 
          SX7    X5-8 
          PL     X7,ST7      IF REGNO > 7  */ X-REG 
  
*         VALUE IS IN A B-REGISTER
  
          MI     X2,ST5      IF INB[LJW]
          MX7    1
          LX3    I.BRP
          LX7    1+I.INBP 
          BX7    X3+X7
          SA7    A0          [LJ] = RNI(1,0,RN,0) 
          LX3    -I.BRP 
          BX2    X7          LJW = [LJ] 
  
 ST5      LX1    59-CA.EUP
          MI     X1,ST6      IF EU[CAW] 
          LX1    CA.EUP-CA.PSPP 
          MI     X1,IRA10    IF PSP[CAW]   */ ST CAN MOVE 
  
*         MOVE RESULT TO AN X-REG 
  
 ST6      SB3    X2 
          NZ     B3,ST10     IF XR[LJW] " 0*/ PRED IS IN A X-REG
          SX6    B6 
          BX7    X6+X7
          LX6    I.STP
          BX7    X6+X7
          SA7    A0          [LJ] = RNI(1,TI,RN,TI) 
          SB2    OC.SA
          EQ     ST9
  
*         VALUE IS IN A X-REGISTER
  
 ST7      SX7    X5-26B 
          PL     X7,ST10     IF REGNO > 25B  */ RESULT IN A *ST* REG
  
          SA4    A0-B1       DJP = LJ - 1 
          MX7    -D.USESL+1 
          SA6    A0          [LJ] = RNI(0,0,0,RN) 
          LX0    I.STP
          BX6    X0*X2
          SA6    A0          ST[LJ] = 0 
          LX0    -I.STP 
          LX4    -D.USESP-1 
          BX7    -X7*X4 
          NZ     X7,ST8      IF USES[DJP] > 1 
          LX1    59-CA.PSPP 
          MI     X1,IRA10    IF PSP[CAW]
  
 ST8      SX4    B6 
          LX4    I.STP
          BX7    X4+X6
          SA7    A0          ST[LJ] = TI
          SB2    OC.XMT 
          SX3    X7+
  
 ST9      SX6    B6 
          LX3    R1.RJP 
          MX7    0
          BX6    X3+X6
          RJ     SRI         SRI(  SA/XMT  TI,RN )
  
*         OUTPUT STORE IF NOT MOVABLE 
  
 ST10     SA1    A1 
          LX1    59-CA.PSPP 
          MI     X1,IRA10    IF PSP[CAW]
          LX1    CA.PSPP-CA.ACP 
          MI     X1,IRA10    IF AC[CAW]    */ A/X CANIDATE
  
          SA5    A5 
          SA2    A0 
          SA4    A5+2 
          LX2    -I.STP 
          SX6    X2          TR = ST[LJW] 
          UX7    B2,X5
          EQ     LD1
 APD      EJECT 
**        APD - ADJUST PREVIOUS DEFINITION OF A CANIDATE TO PRESERVE
*         PREVIOUS VALUE, BECAUSE USES OF IT EXTEND PAST THE CURRENT
*         DEFINITION ( *XU* ).
* 
*         ENTRY  (A0,X5) = LJ, REGNO AS SETUP BY IRA/ST 
  
*         FIND PREVIOUS DEFINITION OF THIS CANIDATE IN *SEQ*
  
 APD      ROUTINE 
          SA3    A5+B1       R2 = R1 + 1;  R2P = R2 
          SB3    4
          BX7    X3          R2W = [R2] 
 APD1     SA3    A3-B3       R2P = R2P - 4
          BX6    X7-X3
          NZ     X6,APD1     IF [R2P] " R2W 
  
          SA4    A3+B1       DIP = R2P + 1
          SA2    A4+B1       LIP = DIP + 1
          LX4    59-D.LDP 
          MI     X4,APD2     IF LD[DIP]    */ PREVIOUS DEF IS A *LD*
          SA3    A3-B1       R1P = R2P - 1
          BX6    "RN"X3 
          SA2    "SB"+X6     LIP = SB + RI[R1P] 
  
*         CHECK LINK WORD TO SEE IF WE MADE A COPY OF THE VALUE 
  
 APD2     SX6    X5-8 
          PL     X6,APD3     IF REGNO > 8  */ CANIDATE IN AN X-REGISTER 
  
*         CANIDATE IN B-REG, SEE IF X-REG VALUE IS AVAILABLE
  
          SA3    A1-2 
          SB2    OC.SA       OC = OC.SA 
          LX2    -I.BRP 
          SX7    X2          ORV = BR[LIP]
          LX3    59-CA.EUP
          LX2    I.BRP
          PL     X3,APD4     IF ^EU[RCT(J)]  */ NO COPY MADE
  
          SX7    X7+2 
          SA3    B7+X7       DI = TXT(ORV+2) */ OF DEF
          SX7    B1 
          LX7    D.XUP
          BX7    X3+X7       XU[DI] = 1    */ INDICATE EXT USE TO IRA/ST
          SA7    A3 
          MX7    1
          BX6    -X7*X2      INB[LIP] = 0  */ MAKE OLD B-VAL UNAVAILABLE
          SA6    A2 
          EQ     APD
  
 APD3     SB2    OC.XMT      OC = OC.XMT
          SX7    X2          ORV = XR[LIP] */ OLD R-NUM VALUE 
  
*         NO COPY OF CANIDATE AVAILABLE, INSERT *XMT/SA* TO SAVE OLD
*         VALUE OF PREVIOUS DEF BEFORE LAST INSTRUCTION IN *TXT*. 
  
 APD4     SX6    B6-B3       R = TI - 4 
          BX4    X6 
          LX6    I.STP
          BX6    X4+X6       [LIP] = RNI(0,R,0,R) 
          SA6    A2 
          SA3    B7+X4       R1W = TXT(R) 
          SX2    B3 
          IX6    X3+X2       RI[R1W] = RI[R1W] + 4
          LX7    R1.RJP 
          SA6    B7+B6       TXT(TI) = R1W  */ MOVE LAST INST UP
          PX7    B2,X7
          BX7    X4+X7
          SA7    A3          TXT(R) = TYI(OC,ORV,0,R)*/ INSERT XMT/SA 
          SA3    A3+B1
          BX6    X3          TXT(TI+1) = TXT(R+1) 
          SA6    A6+B1
          MX7    0
          SA7    A3          TXT(R+1) = 0 
          SA3    A3+B1
          BX6    X3          TXT(TI+2) = TXT(R+2) 
          SA6    A6+B1
          SA7    A6+B1       TXT(TI+3) = 0
          SA2    F.RDT+B2 
          BX7    X2          TXT(R+2) = RDT(OC) 
          SA7    A3 
  
*         ADJUST THE LINK WORD OF THE STORE PREDECESSOR 
  
          SA2    A0          LJW = [LJ] 
          BX4    X2          OLW = LJW     */ SAVE ORIGINAL LW
          SB2    36          SC = 36
          SX7    B3 
          SB6    B6-B3       TI = TI - 4
 APD5     AX3    B2,X2
          SB3    X3 
          NE     B3,B6,APD6  IF RN[SHIFT(LJW,-SC)] " TI 
          LX6    B2,X7
          IX2    X6+X2       LJW = LJW + SHIFT(4,SC)
 APD6     SB2    B2-18       SC = SC - 18 
          PL     B2,APD5     IF SC \ 0
  
          BX6    X2 
          SA6    A2          [LJ] = LJW 
          SB6    B6+8        TI = TI + 8
  
          SA3    A0-3        R1P = LJ - 3  */ CHECK ST PRED 
          SB3    OC.XMT 
          UX7    B2,X3
          NE     B2,B3,APD   IF OC[R1P] " OC.XMT
          LX3    -R1.RJP
          BX7    "RN"X3      R = RJ[R1P]
          SA3    "SB"+X7     LJP = SB + R  */ PRED OF *XMT* 
          BX7    X4-X3
          NZ     X7,APD      IF [LJP] " OLW  */ NOT OMITTED *XMT* 
          SA6    A3+         [LJP] = LJW   */ UPDATE LINK WORD OF PRED
          EQ     APD
 PVC      EJECT 
**        PVC - PROCESS VALUE CANIDATE DEFINITION ( LD OR CON ) 
  
 PVC      SA1    A1 
          LX1    59-CA.KDP
          PL     X1,PVC1     IF ^KD[CAW]
  
          MX6    0
          SA6    A4+B1       [DI+1] = 0 
          EQ     IRA10
  
 PVC1     SA2    A1+2        CCW = RCT(J+2) 
          MX7    -CC.REG1L
          LX2    -CC.REG1P
          BX4    -X7*X2      REGNO = REG1[CCW]
          SA3    RVT+X4      R = RVT(REGNO) 
          SX6    X4-8 
          PL     X6,PVC5     IF REGNO > 7 
  
*         CANIDATE IN A B-REGISTER
  
          LX1    1+CA.KDP 
          SX7    B6 
          LX3    I.BRP
          BX6    X3+X7
          LX7    I.STP
          BX6    X6+X7
          MX7    1
          LX7    1+I.INBP 
          BX6    X7+X6
          SA6    A5+3        [R1+3] = RNI(1,TI,R,TI)
          LX1    59-CA.CONP 
          MX7    0
          LX3    R1.RJP-I.BRP 
          SB2    OC.SA       OC = OC.SA 
          PL     X1,PVC2     IF ^CON[CAW] 
  
          SA1    A1+B1       C2W = RCT(J+1) 
          LX5    IH.CAP-R1.INP
          BX1    X5-X1
          LX1    59-IH.CAP
          PL     X1,PVC2     IF CA[C2W] = IN[R1]
          SX1    B1 
          LX1    I.MIBP 
          BX6    X6+X1
          SA6    A6          [R1+3] = RNI(3,TI,R,TI)
          SB2    OC.SS
          LX3    R1.RKP-R1.RJP
  
 PVC2     SX6    B6 
          BX6    X6+X3
          RJ     SRI         SRI(  SA  TI,R  /  SS  TI,,R ) 
          EQ     IRA10
  
*         CANIDATE IN A X-REGISTER
  
 PVC5     SA2    A4 
          SX6    X4-26B 
          BX5    X3          RST = R       */ R-NUM IN A ST REG 
          LX2    59-D.PSP                                               002270
          PL     X6,PVC6     IF REGNO > 25B  */ X6,X7 
          SX5    B0          RST = 0
          PL     X2,PVC6     IF ^PS[DI] 
  
          LX3    R1.RJP 
          SX5    B6          RST = TI 
          MX7    0
          BX6    X3+X5
          LX3    -R1.RJP
          TYPEI  XMT,X6      SRI(  XMT  TI,R )
  
 PVC6     LX5    I.STP
          BX6    X5+X3
          SA6    A5+3        [R1+3] = RNI(0,RST,0,R)
          LX2    D.PSP-D.PRSP 
          PL     X2,IRA10    IF ^PRS[DI]
  
          SA4    A5+7        LIRS = R1 + 7;  I = CO[LIRS]  */ RS LINK WD
          SA1    B4+X4       CAW = RCT(I) 
          LX1    59-CA.IRAP 
          MI     X1,IRA10    IF IRA[CAW]   */ RS IS TO BE MOVED OUT 
  
          MX7    0
          TYPEI  XMT,B6,X3   SRI(  XMT  TI,R )  */ OUTPUT XMT FOR *RS*
          EQ     IRA10
 PAC      SPACE  3,24 
**        PAC - PROCESS ADDRESS CANIDATE, MIT = 1 - 4 
* 
*         ENTRY  (B2) = OC.LD, OC.ST, OC.STT
  
 PAC0     SB2    OC.ST
  
 PAC      SA1    A1+2        CCW = RCT(J+2) 
          SB2    B2-OC.LD    MODE = OC[R1] - OC.LD
          MX7    -CC.REG1L
          LX1    -CC.REG1P
          BX2    -X7*X1      REGN1 = REG1[CCW]
          LX1    CC.REG1P-CC.MITP 
          BX3    -X7*X1      IT = MIT[CCW]
          SA0    X3 
          LX1    CC.MITP-CC.REG2P 
          BX7    -X7*X1      REGN2 = REG2[CCW]
          SA4    PACA+B2     OCW = PACA(MODE) 
          LX3    3
          MX6    -8 
          BX3    -X6*X3      IT = IT & 37B
          SB3    X3 
          LX1    B3,X4
          BX6    -X6*X1      NOC = SHIFT(OCW,8*IT) & 377B 
          SB3    X6 
          SX6    B6+         R = TI 
          SA6    A5+3        [R1+3] = R 
  
          ZR     B2,PAC1     IF MODE = 0   */ LD
          NE     B2,B1,PAC3  IF MODE " 1   */ NOT ST
          BX5    "RN"X5 
          SA3    "SB"+X5     LIW = [SB+RI[R1]]
          LX3    -I.STP 
          SX6    X3          R = ST[LIW]
  
*         REFORM REFERENCE AS A TYPE I INSTRUCTION
  
 PAC1     SX4    A0-4 
          ZR     X4,PAC4     IF IT = 4
  
*         IT = 1 - 3 , RJ,RK ARE FROM *RVT* 
  
          SA3    RVT+X7      K = RVT(REGN2) 
          SA2    RVT+X2      J = RVT(REGN1) 
          SA4    A5+B1       R2 = R1 + 1
          LX3    R1.RKP 
          BX6    X3+X6
          LX2    R1.RJP 
          BX6    X2+X6
          LX4    -IH.RFP
          SX1    B1          ZB = 1        */ ZP BIT
          BX7    "RN"X4      F = RF[R2] 
          SA3    "SB"+X7     LFW = [SB+F] 
          ZR     X7,PAC2     IF F = 0      */ NO RF OR A0 
  
          SX1    B0          ZB = 0 
          PL     X3,PAC2     IF ^INB[LFW] 
          LX2    -R1.RJP
          SX3    X2          LFW = RVT(REGN1)  */ USE *RF* FROM RVT 
  
 PAC2     BX4    X0*X4
          SX3    X3 
          LX1    D.ZPP
          BX7    X3+X4       RF[R2W] = SETX(LFW)
          SA2    F.RDT+B3    D = RDT(NOC) 
          LX7    IH.RFP 
          SX3    A0 
          BX4    X2+X1       ZP[D] = ZB 
          AX3    5
          PX6    B3,X6       R1W = TYI(NOC,J,K,R) 
          LX3    IH.SRFP
          BX7    X3+X7       SRF[R2W] = IT & 40B
          EQ     TYIT 
  
*         STT - SETUP LINK WORD AND CHECK FOR SPECIAL CASE
  
 PAC3     LX6    I.STP
          SX4    B6 
          BX6    X4+X6
          SA6    A6          [R1+3] = RNI(0,TI,0,TI)
          SX1    A0-B1
          SX6    B6          R = TI 
          NZ     X1,PAC1     IF IT " 1     */ NOT SPECIAL CASE
  
*         IT = 1, PARTIALLY MODIFIED *STT* FROM *PSC*, *CA* IS FROM 
*         *RCT* AND *RF* IS RVT(REGN1)
  
          SA1    A1-B1       C2W = RCT(J+1) 
          SA2    RVT+X2 
          MX3    -IH.CAL
          PX6    B3,X6       R1W = TYII(OC.STT,0,0,TI)
          LX3    IH.CAP 
          SA4    F.RDT+B3    D = RDT(NOC) 
          BX3    -X3*X1 
          LX2    IH.RFP 
          BX7    X2+X3       R2W = IHW(0,RVT(REGN1),CA[C2W],0)
          EQ     TYIT 
  
*         IT = 4 , GET RJ FROM LINK WORK OF RF IN *SEQ*.
  
 PAC4     SA4    A5+B1       R2 = R1 + 1
          LX4    -IH.RFP
          BX5    "RN"X4      F = RF[R2] 
          BX4    X0*X4
          NZ     X5,PAC5     IF F " 0 
  
          SA2    RVT+X2      J = RVT(REGN1) 
          MX3    0           K = 0
          SX1    B1          ZB = 1 
          EQ     PAC8 
  
 PAC5     SA3    "SB"+X5     LFW = [SB+F] 
          PL     X3,PAC6     IF ^INB[LFW] 
          LX3    -I.BRP      LFW = SHIFT(LFW,-I.BRP)
 PAC6     SX5    X3          F = SETX(LFW)
          SA3    RVT+X7      K = RVT(REGN2) 
          SX1    B0          ZB = 0 
          NZ     X7,PAC7     IF REGN2 " 0  */ RF IS IN *RCT*
          SA3    RVT+X2      K = RVT(REGN1) 
 PAC7     SX2    X5+         J = F
  
 PAC8     BX7    X4+X5       RF[R2W] = F
          SA4    F.RDT+B3    D = RDT(NOC) 
          LX7    IH.RFP 
          LX2    R1.RJP 
          LX3    R1.RKP 
          BX2    X2+X3
          BX5    X2+X6
          PX6    B3,X5       R1W = TYI(NOC,J,K,R) 
          LX1    D.ZPP
          BX4    X1+X4       ZP[D] = ZB 
          EQ     TYIT 
  
 OPT      MACRO  A,B,C
          VFD    8/OC.A,8/OC.B,8/OC.C,8/OC.B,28/0 
          ENDM
  
 PACA     BSS    0
          OPT    PLD,SLD,SDL
          OPT    PST,SST,SDS
          OPT    STT,SA,SS
 CUC      TITLE  CUC - COLLECT USES COUNTS, SET PRECEDENCE BITS 
**        CUC - COLLECT USES COUNTS, SET PRECEDENCE BITS AND REMOVE 
*         DEAD ( USELESS ) DEFINITIONS FROM A SEQUENCE IN *TXT*.
* 
*         ENTRY  *TXT* - RLIST INSTRUCTION SEQUENCE WITH R-NUMBERS IN 
*                CANONICAL FORM.
* 
*         EXIT   USES, PS,PRS, RJRS FIELDS ADJUSTED AND USELESS 
*                DEFINITIONS REMOVED FROM THE SEQUENCE. 
* 
*         *CUC* MAY BE CALLED AFTER A SEQUENCE HAS BEEN MODIFIED BY 
*         DELETION OR SUBSTITUTION IN SUCH A WAY AS NOT TO INTRODUCE
*         REDUNDANT INSTRUCTIONS. 
*         NOTE THAT THE ZP, FP, L2 AND SZ BITS ARE NOT ADJUSTED HERE, 
*         AND MUST BE PRESERVED BY PREVIOUS PROCESSORS. 
* 
*         *CUC* CONSISTS OF A BACKWARDS SCAN TO COLLECT USES AND
*         SET PRECEDENCE BITS, OPTIONALLY FOLLOWED BY A FOWARD SCAN TO
*         COMPRESS THE SEQUENCE IF DEAD DEFINITIONS WERE ENCOUNTERED. 
  
          QUAL   CUC
  
 CUCA     BFMW   D,(^D,RJRS,PI,USES)
  
 CUC      ROUTINE 
          SA2    O.TXT
          SA3    L.TXT
          SA1    CUCA 
          SB2    B1+B1
          S"TB"  X2+B2       TB = O.TXT + 2 
          SB6    D.PSP
          SX0    RN.MASK
          SA0    B0          DD = 0        */ ADDRESS OF FIRST DEAD DEF 
          IX6    X2+X3
          SA5    X6-4        R1 = O.TXT + L.TXT - 4 
          MX7    0           [DI+1] = 0 
          SA7    "TB"+B1     [TB+1] = 0    */ CLEAR LINK WD OF *BOS*
          EQ     CUC1 
 TYI      SPACE  3,14 
          PROCESS (PST,SST,SDS) 
          BX4    "RN"X5 
          SA3    "TB"+X4     DIP = TB + RI[R1]
          LX6    B6,X7
          IX2    X7+X3       USES[DIP] = USES[DIP] + 1
          BX6    X2+X6       PS[DIP] = 1
          SA6    A3+
  
*         TYPE I INSTRUCTION PROCESSING 
  
 TYI      LX5    -R1.RJP
          BX6    "RN"X5 
          SA3    "TB"+X6     DJ = TB + RJ[R1] 
          LX5    R1.RJP-R1.RKP
          IX6    X3+X7       USES[DJ] = USES[DJ] + 1
          SA6    A3+
          BX5    "RN"X5 
          SA2    "TB"+X5     DK = TB + R5[R1] 
          IX6    X2+X7       USES[DK] = USES[DK] + 1
          SA6    A2+
  
*         ADVANCE TO NEXT INSTRUCTION, CHECK FOR USELESS DEFINITIONS
  
          PROCESS (LAB,ENT,UJP,RJ3,RJ6,S,FMA,CLR) 
  
 CUC1     SA4    A5-B2       DI = R1 - 2
          SA5    A4-B2       R1 = DI - 2
          BX6    X1*X4
          UX2    B3,X5
          SA3    CUC.JT+B3
          ZR     X6,CUC2     IF ^(^D,PI,RJRS)[DI] & USES[DI] = 0
  
          SB4    X3 
          SX7    B1 
          JP     B4          JUMP( ([UC.JT( OC[R1] )] ) 
  
          PROCESS DAR 
          MX3    -D.USESL 
          BX6    -X3*X4 
          NZ     X6,TYI      IF USES[DI] " 0
  
*         USELESS DEF, MARK AS DEAD 
  
 CUC2     SA6    A4          [DI] = 0 
          SA0    A5          DD = R1
          EQ     CUC1 
  
          PROCESS EOS 
          SX7    X5 
          ZR     X7,CUC1     IF IH[R1] = 0 */ NOT AN OPT=2 *EOS*
  
          PROCESS NOP 
          MX6    0
          EQ     CUC2 
  
          PROCESS DWL 
          MX6    0           PS = 0                                             CCGA039 18
          LX4    59-D.L2P                                                       CCGA039 19
          MI     X4,CUC10    IF L2[DI]                                          CCGA039 20
          LX6    B6,X7       PS = 1                                             CCGA039 21
*                                                                               CCGA039 22
 CUC10    BX4    "RN"X5                                                         CCGA039 23
          SA3    "TB"+X4     DIP = TB + RI[R1]                                  CCGA039 24
          BX3    X3+X6       DIP = DIP + PS                                     CCGA039 25
          IX6    X3+X7       USES[DIP] = USES[DIP] + 1
          SA6    A3 
          EQ     TYI
  
          PROCESS (UP,NR,RNZ) 
          LX5    -R1.RKP
          BX4    "RN"X5 
          SA3    "TB"+X4     DK = TB + RK[R1] 
          IX6    X3+X7       USES[DK] = USES[DK] + 1
          SA6    A3 
          EQ     CUC1 
 RS       SPACE  3,14 
          PROCESS RS
          LX5    -R1.SOP-SO.LKP 
          MX3    -SO.LKL
          SA2    A5-B2       DIP = R1 - 2 
          BX6    -X3*X5 
          MX3    -D.USESL 
          SB3    X6          LKT = SOLK[R1] 
          GT     B3,B2,RS2   IF LKT = 3    */ RJ RS 
  
          LX7    D.PRSP 
          BX6    X7+X2       PRS[DIP] = 1 
          LX7    D.PSP-D.PRSP 
          BX6    -X7*X6      PS[DIP] = 0
          EQ     B3,B1,RS1   IF LKT = 1    */ TEMP LOCK 
  
          SX7    B1 
          IX6    X6+X7       USES[DIP] = USES[DIP] + 1
          SA6    A2 
          EQ     CUC1 
  
 RS1      BX7    -X3*X2 
          SA6    A2 
          NZ     X7,CUC1     IF USES[DIP] " 0 
  
          SA7    A4          [DI] = 0 
          SA7    A2          [DIP] = 0
          SA5    A2-B2       R1 = DIP - 2 
          SA0    A2-B2       DD = R1
          EQ     CUC1 
  
 RS2      BX6    -X3*X4 
          LX7    D.RJRSP
          ZR     X6,RS3      IF USES[DI] = 0
          BX6    X7+X2       RJRS[DIP] = 1
          SA6    A2 
          EQ     CUC1 
  
 RS3      SA6    A4          [DI] = 0 
          SA0    A5          DD = R1
          SA3    A2-B2
          BX7    -X7*X2      RJRS[DIP] = 0
          LX0    R1.RJP 
          SA7    A2 
          BX6    X0*X3       RJ[R1-4] = 0 
          LX0    -R1.RJP
          SA6    A3 
          EQ     CUC1 
 DEF      SPACE  2
          PROCESS DEF 
          LX7    D.PSP
          BX6    -X7*X4      PS[DI] = 0 
          SA6    A4 
          EQ     CUC1 
 BOS      SPACE  3,20 
          PROCESS BOS 
          MX1    -D.USESL 
          BX6    X1*X4       USES[DI] = 0 
          SA6    A4 
          SB6    A0          DI = DD
          ZR     B6,CUC      IF SI = 0     */ NO USELESS DEFS 
  
*         COMPRESS SEQUENCE TO REMOVE USELESS INSTRUCTIONS
  
          SA4    A0+B2       DI = DD + 2
          SB4    B2+B2
  
 BOS1     SA4    A4+B4       DI = DI + 4
          ZR     X4,BOS1     IF [DI] = 0
  
          SA5    A4-B2       R1 = DI - 2
          SA3    A4-B1       R2 = DI - 1
          BX6    X4 
          UX2    B3,X5
          SA6    B6+B2       [SI+2] = [DI]
          BX7    X5 
          SA7    B6          [SI] = [R1]
          BX6    X3 
          SA6    B6+B1       [SI+1] = [R2]
          SB6    B6+B4       SI = SI + 4
          NZ     B3,BOS1     IF OC[R1] " 0
  
          SB5    "TB"-B2
          SX7    B6-B5       L.TXT = SI - O.TXT 
          SA7    L.TXT
          SX1    A5-B5       OTL = R1 - O.TXT  */ OLD LENGTH
          ALLOC  RND,X1      ALLOC( RND , OTL ) 
          SA4    O.TXT
          SB7    X2 
          MX2    0
          SA0    X4 
          CALL   RNI#        RENUMBER THE INSTRUCTIONS
          SX6    0
          SA6    L.RND       L.RND = 0
          EQ     CUC
 TYIII    SPACE  3,14 
          PROCESS (ST,TST)
          BX5    "RN"X5 
          SA3    "TB"+X5     DIP = TB + RI[R1]
          LX6    B6,X7
          IX2    X3+X7       USES[DIP] = USES[DIP] + 1
          BX6    X6+X2       PS[DIP] = 1
          SA6    A3 
  
          PROCESS (LD,ILD,TLD,LDC,LDV,STT,KLS,KRS)
          SA3    A5+B1       R2 = R1 + 1
          LX3    -IH.RFP
          BX6    "RN"X3 
          SA2    "TB"+X6     DJ = TB + RF[R2] 
          IX6    X2+X7       USES[DJ] = USES[DJ] + 1
          SA6    A2 
          EQ     CUC1 
 JPX      SPACE  2,14 
          PROCESS (JPBB,RJXJ) 
          SA3    A5+B1       R2 = R1 + 1
          LX3    -IH.RFP
          BX6    "RN"X3 
          SA2    "TB"+X6     DJ = TB + RF[R2] 
          IX6    X2+X7       USES[DJ] = USES[DJ] + 1
          SA6    A2 
  
          PROCESS (JIN,JPX) 
          BX5    "RN"X5 
          SA3    "TB"+X5     DIP = TB + RI[R1]
          IX6    X3+X7       USES[DIP] = USES[DIP] + 1
          SA6    A3 
          EQ     CUC1 
  
          QUAL
 IRA      EQU    /IRA/IRA 
 CUC      EQU    /CUC/CUC 
 CUC#     EQENT  CUC
 OPR      SPACE  2,14 
**        OPR - DEFINE MACRO TO CREATE COMBINED JUMP TABLE FOR *IRA/CUC*
  
          MACRO  OPR,NAM,SS 
          NOREF  /IRA/.NAM,/CUC/.NAM
 TYP      MICRO  4,1,$SS$ 
 O        IF     DEF,/IRA/.NAM
          EQ     /IRA/.NAM           NAM
 O        ELSE
          IFC    EQ,/"TYP"/ /,2 
          EQ     /IRA/TYI    NAM
          SKIP   1
          EQ     ERROR
 O        ENDIF 
* 
 O        IF     DEF,/CUC/.NAM
-         JP     /CUC/.NAM           NAM
 O        ELSE
          IFC    EQ,/"TYP"/ /,2 
-         JP     /CUC/TYI    NAM
          SKIP   1
-         JP     377777B
 O        ENDIF 
          ENDM
  
 IRA.JT   BSS    0
 CUC.JT   BSS    0
*CALL     OPRDEFS 
  
          END 
