*DECK             CODGK1
USETEXT   TSOURCE 
USETEXT   TTARGET 
USETEXT   TCEXECQ 
USETEXT   TSYMCNS 
USETEXT   TREGNOS 
USETEXT   TCOM39Q 
USETEXT   TCOM78Q 
USETEXT   TCEXEC
USETEXT   TCOM88
USETEXT   TCOM88K 
PROC     CODGK1   ; 
         BEGIN    #   REGISTER SELECTION AND SCHEDULING                #
  
  
  
  
*CALL COMEX 
  
  
  
  
#     DEFS                                                             #
  
          DEF J858 #858#;          # SYMABT DIAGNOSTIC 858             # CODGK1 
          DEF J859 #859#;          # SYMABT DIAGNOSTIC 859             # CODGK1 
  
  
  
  
#     XREFS                                                            #
  
      XREF
          BEGIN 
          PROC CAS00;        #SELECT BEST STORE REGISTER# 
          LABEL CFC00;       #CODE FILE WRITER CONTROL# 
          LABEL CGIE;        #CALCULATE ISSUE, EXECUTION TIMES AND     #
                             #STATUS BEFORE GENERATING INSTR           #
          LABEL CG00;        #SELECT INSTR FOR GENERATION              #
          PROC CRU00;        #TEST FOR RECOMPUTABILITY# 
          PROC CSU00;        #CHECK OPERAND FOR SINGLE USE# 
          PROC DB;           #DEBUG TRACE ROUTINE#
          PROC FIND;
          FUNC FNDBREG;      #FIND B-REG CORRESPONDING TO I#
          PROC GBR00;        #SELECT BEST DEAD TRANSIENT B-REG# 
          FUNC GETEMP;
          PROC GIU00;        #SELECT BEST INCREMENT UNIT# 
          PROC GLR00;        #SELECT BEST LOAD REGISTER#
          PROC GMU00;        #SELECT BEST MULTIPLY UNIT#
          PROC GWR00;        #SELECT BEST DEAD X-REG# 
          PROC IINSK;        #INSERT INSTRUCTION INTO ICFT# 
          PROC INN00;        #CALCULATE INSOPA-INSOPE AND NINSA-NINSE#
          PROC IRM00;        #INITIALIZE REG MEMORIES BEFORE SCHEDULING#
          PROC IRS00;        #INITIALIZE READY SET BEFORE SCHEDULING #
          PROC ISL00;        #INSERT LOAD INTO ICFT#
          PROC LINKOB;       #LINK ENTRY OUT OF BASE ONLY CHAIN#
          PROC LINKOBS;      #LINK ENTRY OUT OF BASE+SUBS CHAIN#
          PROC MPRED; 
          PROC NCA00;        #ENCODE ADDRESS# 
          LABEL NX00;        #NO EXECUTABLE OPS IN READY SET- PICK BEST#
                             #SCHED OR ISSUABLE OP AND GENERATE IT     #
          PROC SAC00;        #SEARCH A-REGS FOR ADDRESS#
          PROC SBC00;        #SEARCH B-REGS FOR ADDRESS#
          PROC SBK00;        #SEARCH B-REGS FOR CONSTANT# 
          PROC SXAC;         #SEARCH X-REGS FOR ADDRESS#
          PROC SXK00;        #SEARCH X-REGS FOR CONSTANT# 
          PROC CG2ABT;       #ISSUE ABORT FROM CG2                     #
          PROC TRO00;        #COMPUTE AVAILABILITY OF REG#
          END 
  
  
  
  
#     XDEFS                                                            #
  
      XDEF
          BEGIN 
          LABEL CG2XIT;      #RETURN TO K1 AND THENCE TO J1#
          LABEL CSCAN;       #CONTINUE SCANNING READY SET FROM FOL[INX]#
          LABEL ISCAN;       #CONTINUE SCANNING READY SET FROM XPRS#
          LABEL RESCAN;      #CONTINUE SCANNING READY SET FROM INX# 
          LABEL XX00;        #END OF INSTRUCTION TYPE SWITCH #
          END 
  
  
  
  
#     SWITCHES                                                         #
  
#        SWITCH ON INSTRUCTION TYPE                                    #
  SWITCH ITYSW
         TU00,    #     TYPE 0  TREAT AS NULL STATEMENT                #
         TA00,    #  NORMAL BINARY OPERATOR  - 2 X-REG OPS  1 X RESULT #
         TB00,    #  COMP, SUMI -   1 X-REG OP    1 X-REG RESULT       #
         TC00,    #  MASK           NO OPS                             #
         TD00,    #  LSHC, RSHC     1 X-R OP , 1 X-RESULT              #
         TE00,    #  LSHV, RSHV, PAKB                                  #
         TF00,    #  NORM, NRMR, UNPK -  NO  B RESULT  (USE B0 )       #
         TG00,    #  NRMB, NRRB, UNPB -  X AND B  RESULT               #
         TH00,    #  SELB                                              #
#        INDUCTION VARIABLE  OPERATORS                                 #
         IVI00,   #  INVI                                              #
         IVS00,   #  INVS                                              #
         IVT00,   #  INVT                                              #
         IVB00,   #  INVB                                              #
         TJ00,    #  JP UNCONDITIONAL JUMP                             #
         TK00,    #  IR, OR, DF, ID, ZR, NZ, PL, NG - COND JUMPS       #
         TL00,    #  IJP00   INDEXED JUMP                              #
         TM00,    #  TMSR, TMWR, TMBR  - REG TO REG                    #
         TN00,    #  MSKC, MSKL     CONSTANT GENERATORS                #
         TP00,    #  LDSC     LOAD SHORT CONSTANT                      #
         TQ00,    #  ADSC     ADD SHORT CONSTANT                       #
         TR00,    #  BXND     EXTEND THE SIGN                          #
         TS00,    #  SAVE                                              #
         TT00,    #  SUBS, OFFS                                        #
         TU00,    #  NULL                                              #
         TV00,    #  LABL     LABEL                                    #
         TPI00,   #   LUAU    LOAD USING A1                            #
         TPJ00,   #   DRV     DEFINE REGISTER VALUE                    #
         TPK00,   #   SRV     SET REGISTER VALUE                       #
#                                                                      #
#        LOAD, LODP, REPL, LOCF, BRAI                                  #
         LD00,    #      LOAD                                          #
         LDP00,   #      LOAD PRIME                                    #
         RP00,    #      REPLACE                                       #
         LC00,    #      LOCF                                          #
         BR00,    #      BRAI                                          #
         TISCO ,  #   LOAD IMMEDIATE SHORT CONSTANT                    #
         TBSLD ,  #      B-REG SUBSCRIPT LOAD                          #
         TBSLC ,  #      LOC                                           #
         TBSRP ,  #      REPL                                          #
         TIAOR ,  #      IAOR    BECOMES TYPE A                        #
         TISMP ,  #      ISMP    BECOMES TYPE A                        #
         TLIN ,   #      LINE  NUMBER                                  #
         TMUL ,   #      MULTIPLY   TO SELECT A UNIT                   #
         TRL00 ,  #      RLAY                                          #
         TBPSB ,  #      BPSB   BASE + SUBS                            #
         XX00 ;        # END OF SWITCH  # 
  
  
  
  
#     LOCAL DATA                                                       #
  
      ITEM
         ACTYP    I ,               # ACCESS TYPE                      #
         AXBSET   I ,               # FOR LOAD,STORE, LOC, BRAI        #
         KISR     B ,               #  CISR  [INX]                     #
         SAILC    I ,               #  LOAD TO  LOC, BRAI ADJUSTMENT   #
         STOP2    I ,               #   OPN2 [INX]  INVI               #
         TUSC     I ,               #   TEMPORARY USE COUNT            #
         TUSC1    I ,               #   TEMPORARY USE COUNT            #
         XOP1     I ,               #   REGISTER FOR INDUCTION VAR     #
         XWTRA    I ,    #                                             #
          XWTOA;
#        -1 OR THE COMP BEING STORED  FOR REPL                         #
         ITEM     STREE I ; 
         ITEM     LREGJ I ; 
         ITEM     RTOP2 I ; 
         ITEM     TNMC  I  ;        #   MASK COUNT                     #
      ITEM AJOFS; 
      ITEM AKOFS; 
      ITEM AREGJ; 
      ITEM AREGK; 
      ITEM BJOFS; 
      ITEM BKOFS; 
      ITEM BREGJ; 
      ITEM BREGK; 
      ITEM BREGS; 
      ITEM BREGV; 
      ITEM XJOFS; 
      ITEM XKOFS; 
      ITEM XREGA; 
      ITEM XREGJ; 
      ITEM XREGK; 
      ITEM XREGS; 
      ITEM SUSP;
      ITEM NEWR;
CONTROL EJECT;
         CALL  IRM00  ;             #  INITIALIZE REGISTER MEMORIES    #
         CALL  IRS00  ;             #  INITIALIZE READY SET            #
  
#        INITIALIZE AND START SCANNING THE READY OPS                   #
  
ISCAN:  
         INXA =   XPRS ;            #  PSEUDO READY  OP                #
         INX   =  FOL [INXA] ;
         $BEGIN 
         NSCN  =  0  ;              #   NUMBER SCANNED                 #
         $END 
  
#        AT  EACH  ISCAN                                               #
#        INITIALIZE MINIMUM ISSUE TIME OPS  TO  EMPTY                  #
  
         MINSZ [0]  =  0 ;
         MINSZ [1]  =  0 ;
         MINSZ [2] = 0  ; 
         NUNOP  = 0  ;              #   NUMBER OF UNSCHEDULABLE OPS    #
         NSKED =  0 ;               #   NUMBER SCHEDULABLE OPS         #
         GOTO CSCAN1  ; 
  
  
  
  
#        CONTINUE THE SCAN OF READY OPS                                #
  
XX00:              # NULL ENTRY AT END OF SWITCH   #                     LARRY-R
CSCAN:  
         INXA  =  INX  ;
         INX  =   FOL [INXA]  ; 
CSCAN1: 
#        CHECK FOR END OF READY SET OF OPS                             #
         IF  INX  EQ  PSOS  THEN  GOTO  NX00  ;   # NONE EXECUTABLE    #
         IF OPCD [INX] EQ  QICFOP"EOS" THEN  GOTO  CFC00 ;
         IF NSKED GT 3 THEN GOTO NX00  ;
RESCAN: 
        $BEGIN
         NSCN  =  NSCN + 1 ;        #   NUMBER SCANNED                 #
         $END 
MC055:  
      REGI = 0;              #I FIELD OF INSTRUCTION                   #
      REGJ = 0;              #J FIELD                                  #
      REGK = 0;              #K FIELD                                  #
      CDROP = FALSE;         #ASSUME INSTR WON"T DESTROY ONE OF ITS OPS#
         REGFTI [SUDOR] = 0 ; 
      INSTAT = 0;            #STATUS = NOT SCHEDULABLE                 #
      FORCE = FALSE;         #DON"T AUTOMATICALLY ISSUE INSTRUCTION IF #
                             #IT IS ONLY SCHEDULABLE                   #
         LSTYP =  QLT"NIL"    ; 
      CDBLU = FALSE;         #TRUE IFF BOTH OPERANDS ARE THE SAME      #
      NOCOD = FALSE;         #TRUE IFF INSTRUCTION PRODUCES NO CODE.   #
      KISR = CISR[INX] OR MCISR[INX]; #IF TRUE- TRY TO ASSIGN STORE   # 
                                       #REGISTER TO RESULT             #
      TOP1 = BI - OPN1[INX]; #(POSITIVE) ICFT INDEX OF OPN1            #
      TOP2 = BI - OPN2[INX]; #(POSITIVE) ICFT INDEX OF OPN2            #
         IF OPN2 [INX] GE 0 THEN RTOP2 = OPN2 [INX]  ;
                  ELSE  RTOP2 = -1 ;
      INSIZ = 1;             #ASSUME 1 PARCEL INSTR- CHANGE TO 2 IF NEC#
      KACON = 0;             #CONSTANT ADDRESS PORTION OF 2 PARCEL INST#
      SPRISL = FALSE;        #SET TRUE IF NON-STANDARD RETURN FROM     #
                             #ISL00 IS WANTED                          #
         PRIOP =  PFF  [INX]  ;     #  PRIORITY                        #
      SCOMP = -1;            #ICFT INDEX OF SUBSCRIPT COMP IF APLICABLE#
      STREE = -1;            #ICFT INDEX OF COMP BEING STORED, IF REPL #
         OPCODE = OPCD [INX] ;
         ITYPE =  BITYP [ OPCODE ]  ; # BASIC INSTRUCTION  TYPE        #
         FUNU  =  FUNCU [OPCOD]  ;  #   FUNCTIONAL UNIT OF OP          #
$BEGIN
DB("(/2X5HMC00 O4,1H=,A4)",INX,BCDOP[OPCODE],".");
FOR I=0 STEP 1 UNTIL SUDOR+1 DO 
IF RGMEM[I] NQ -1 THEN BEGIN DB("(2X,O2,2X,O20)",I,RGMEM[I],".");END
$END
         GOTO  ITYSW  [ ITYPE ]  ;
      CONTROL EJECT;
#**********************************************************************#
#     TYPE A INSTRUCTIONS                                              #
#        TWO X-REG OPERANDS REQUIRED# 
#     1 X-REG RESULT                                                   #
#**********************************************************************#
  
TA00: 
         REGJ  =  XREGL [ TOP1 ]  ; 
         IF REGJ  LE  0  THEN  GOTO  TA20 ;  # LOAD OPN1  # 
         REGK  =  XREGL [ TOP2 ]  ; 
         IF REGK  LE  0  THEN  GOTO  TA25 ;  # LOAD OPN2   #
  
#        TWO  X-REGISTER OPERANDS  ARE LOADED     # 
  
         GOTO STA00 ; 
  
#        OPERAND   MUST BE LOADED   # 
  
TA20: 
#        INSERT A LOAD OF THE TEMP  OR OF THE VARIABLE      # 
#        RETURN FROM ISLOO IF LOAD OP1 OK AND PROCESSED                #
  
         SPRISL = TRUE  ; 
         CALL  ISL00 ( TOP1, TOP2 ) ; 
         SPRISL = FALSE  ;
         REGK =  XREGL [TOP2] ; 
         IF  REGK  LE 0  THEN   GOTO  TA25  ; 
         GOTO  CSCAN  ; 
  
TA25: 
         CALL  ISL00 ( TOP2, TOP1 ) ; 
  
  
  
  
#**********************************************************************#
#        INTEGER ADD OR  OR                                            #
#**********************************************************************#
  
TIAOR:  
         IF  FACL [LOGU]  LE  FACL [LADU]  THEN 
                  BEGIN 
                  FUNU  = LOGU ;
                  OPCD [INX]  =  QICFOP"LOR"    ; 
                  OPCODE  =  QICFOP"LOR"  ; 
                  END 
         ELSE 
                  BEGIN 
#        MAKE IT  IADD                                                 #
                  FUNU  = LADU  ; 
                  OPCD [INX]  =  QICFOP"IADD"  ;
                  OPCODE  =  QICFOP"IADD"  ;
                  END 
         ITYPE =  1  ;
         GOTO  TA00  ;
  
  
  
  
#**********************************************************************#
#        ISUB OR  LIMP                                                 #
#**********************************************************************#
  
TISMP:  
         IF  FACL [LOGU]  LE  FACL [LADU]  THEN 
                  BEGIN 
                  FUNU  =  LOGU  ;
                  OPCD [INX]  =  QICFOP"LIMP"  ;
                  OPCODE  =  QICFOP"LIMP"  ;
#        LEAVE OPS REVERSED FOR LIMP                                   #
                  ITYPE = 1;
                  GOTO TA00;
                  END 
  
#        MAKE IT SUBTRACT                                              #
  
         FUNU = LADU; 
         OPCD[INX] = QICFOP"ISUB";
         OPCODE = QICFOP"ISUB"; 
  
#        REVERSE OPS FOR ISUB                                          #
         T1  =  OPN1 [INX]   ;
         OPN1 [INX]  =    OPN2  [INX]  ;
         OPN2 [INX]  =  T1   ;
         GOTO MC055 ; 
  
  
  
  
#**********************************************************************#
#        MULTIPLY                                                      #
#**********************************************************************#
  
TMUL: 
         CALL  GMU00 ;              #   GET MULTIPLY UNIT              #
         ITYPE  = 1 ;               #   CHANGE TO  TYPE 1              #
         GOTO  TA00 ; 
  
  
  
  
#**********************************************************************#
#        TYPE B INSTRUCTION         # 
#        COMP, SUM1 , XMIT          # 
#        ONE X-REG OPERAND REQUIRED # 
#**********************************************************************#
  
TB00: 
         REGJ  =  XREGL [ TOP1 ] ;
          IF REGJ LE 0 THEN 
            BEGIN   #PERHAPS CNO KNOWS WHERE OPERAND IS#
              REGJ = XREGL[CNO[TOP1]] ; 
              IF REGJ LE 0 THEN GOTO TB20;
                                       #UNLOADED OPERAND# 
            END 
         REGK = REGJ  ; 
         GOTO STB00 ; 
TB20: 
         CALL  ISL00 ( TOP1, RTOP2 ) ;
  
  
  
  
#**********************************************************************#
#        TYPE C INSTRUCTION         # 
#        MASK -   NO OPERANDS       # 
#**********************************************************************#
  
TC00: 
         REGJ  =  OPN1 [INX] ;      #  000...XY  (00 - 74)             #
         REGK  =  B<57,3> REGJ +XREG0 ; #    Y                         #
         REGJ  =  B<54,3> REGJ +XREG0 ; #    X                         #
          IF OPN2 [INX] GQ 0 THEN FORCE = TRUE; 
                   #FORCE ALL REINSERTED MASKS - FOR THE SAKE OF
                        MSKL AND MSLC#
         GOTO  STC00 ;
  
  
  
  
#**********************************************************************#
#        TYPE D INSTRUCTION         # 
#        CONSTANT SHIFTS            # 
#**********************************************************************#
  
TD00: 
         REGI  =  XREGL  [ TOP1 ]  ;
          IF REGI LE 0 THEN 
              BEGIN 
              # PERHAPS CNO KNOWS WHERE IT IS#
              REGI = XREGL[CNO[TOP1]] ; 
              IF REGI LE 0 THEN GOTO TD20;  #UNLOADED OPERAND#
              END 
         IF  REFCT [ TOP1 ]  GT 1  THEN GOTO TD30 ; 
#        OPERAND WITH A SINGLE USE LOADED    #
#        CONSTANT SHIFT VALUE IS IN OPN2 IN ABSOLUTE   #
         REGJ  =  OPN2 [INX] ;      #   SHIFT VALUE CONSTANT XY        #
         REGK  =  B<57,3> REGJ + XREG0 ;  #   Y                        #
         REGJ  =  B<54,3> REGJ + XREG0 ;  #   X                        #
         GOTO  STD00 ;
TD20: 
#        MUST INSERT A LOAD (PRIME) OF THE OPERAND     #
         CALL  ISL00 ( TOP1, -1 ) ; 
#                                                                      #
TD30: 
#        HERE WE MUST INSERT A  TMWR  OF THE  OPERAND       # 
         INSOPA = ICFTJ  ;
         CALL  IINSK ( QICFOP"TMWR", OPN1 [INX], -1 ) ; 
         OPN1  [INX]  =  BI - INSOPA  ; 
         CALL  MPRED  ( INSOPA , INX ) ;
         GOTO URSIA ; 
  
  
  
  
#**********************************************************************#
#        TYPE E INSTRUCTION         # 
#        VARIABLE SHIFT AND PAKB    # 
#        ONE X-REG  OP , ONE B-REG OP   # 
#**********************************************************************#
  
TE00: 
         REGK = XREGL [TOP2]  ; 
         IF REGK  LE  0  THEN  GOTO   TE20 ;   # LOAD X-REG OPERAND # 
         REGJ = BREGL [TOP1]  ; 
         IF  REGJ  LE 0  THEN  GOTO TE30 ;   #  GET OPERAND IN B-REG #
         GOTO STE00 ; 
#        MUST INSERT LOAD  OF X-REG OPERAND  #
TE20: 
         CALL  ISL00 ( TOP2, TOP1 ) ; 
#                                                                      #
#        MUST GET  OP2  INTO A B-REG         #
#        MAY  BE ONE OR TWO INSTRUCTIONS     #
TE30: 
#        HERE WE INSERT A TMBR OF OP2                                  #
         INSOPA = ICFTJ  ;
         CALL  IINSK ( QICFOP"TMBR", OPN1 [INX], TOP2 ) ; 
         CNO [INSOPA] = TOP1  ; 
         REFCT [TOP1] = REFCT [TOP1] + 1  ;   #  ADJUST AS ANOTHER USE #
         CALL  MPRED  ( INSOPA , INX )  ; 
         GOTO  URSIA  ; 
  
  
  
  
#**********************************************************************#
#        TYPE  F INSTRUCTION        # 
#        NORM, NORMROUND ,  UNPACK,  NO B-RESULT  - B0      # 
#        PACK USING B0              # 
#**********************************************************************#
  
TF00: 
         REGK =   XREGL [ TOP1 ] ;
         IF REGK LE 0  THEN  GOTO  TF20 ; 
         REGJ =  BREG0 ;
         GOTO  STF00 ;
TF20: 
         CALL  ISL00 ( TOP1, -1 ) ; 
  
  
  
  
#**********************************************************************#
#        TYPE G INSTRUCTION                                            #
#        UNPB, NRRB ,NRMB -  X AND B-REG  OUTPUT                       #
#**********************************************************************#
  
TG00: 
         REGK =   XREGL [ TOP1 ]  ; 
         IF REGK  LE  0  THEN  GOTO TG20 ;
#        OPERAND IS LOADED IN X-REGISTER                               #
         CALL  GBR00 ( REGJ, XWTRA, XWTOA ) ; 
         IF REGJ  GE BREG0 THEN GOTO STG00 ;
#        UNSCHEDULABLE              # 
         GOTO  UNB00 ;
TG20: 
         CALL  ISL00 ( TOP1, -1 ) ; 
  
  
  
  
#**********************************************************************#
#        SELB                                                          #
#**********************************************************************#
  
TH00: 
         NOCOD =  TRUE ;
         GOTO  CG00 ; 
  
  
  
  
#**********************************************************************#
#        PLAIN UNCONDITIONAL JUMP   # 
#**********************************************************************#
  
TJ00: 
         REGI =   BREG0 ; 
         REGJ =   BREG0 ; 
TJ15: 
         CALL TRO00 (REGI) ;
TJ155:  
         INSIZ =  2  ;
         FORCE =  TRUE  ; 
         REGK  =  SUDOR ; 
         GOTO  CGIE ; 
  
  
  
  
#**********************************************************************#
#        CONDITIONAL JUMPS          # 
#**********************************************************************#
  
TK00: 
         REGJ  =  XREGL [TOP2]  ; 
      IF REGJ GT 0
      THEN
          BEGIN 
#        TEST QUANTITY LOADED       # 
#        UPDATE   REGISTER MEMORY HISTORY    #
#                                                                      #
         REGI = JTYPE [OPCODE] + XREG0  ; 
         CALL TRO00 (REGJ) ;
         MOP [INX] = CJP ;
         GOTO TJ155 ; 
          END 
         T1 = JTYPE [OPCODE] ;         # 0,1,2,3 - ZR, NZ, PL, NG      #
         IF T1 GT 3 THEN GOTO TK29 ;
         REGI = BREGL [TOP2] ;
         IF REGI LE 0 THEN GOTO TK29 ;
         REGJ = BREG0 ; 
         MOP [INX] = QCFOP"EQ" + T1 ; 
         GOTO TJ15 ;
TK29: 
         CALL  ISL00 ( TOP2, -1 ) ; 
  
  
  
  
#**********************************************************************#
#        INDEXED  JUMP              # 
#**********************************************************************#
  
TL00: 
         REGI  =  BREGL [ TOP2 ]  ; 
         IF REGI  GT  0  THEN  GOTO TL15 ;
         REGI  =  XREGL [ TOP2 ]  ; 
         IF REGI LE  0 THEN GOTO TL20 ; 
#        THE OPERAND MUST BE MOVED FROM X-REG TO B-REG                 #
#        INSERT A TMBR              # 
         INSOPA  = ICFTJ  ; 
         CALL  IINSK ( QICFOP"TMBR", OPN2 [INX], -1 ) ; 
         OPN2  [INX]  =  BI - INSOPA ;
         CALL  MPRED ( INSOPA , INX ) ; 
         GOTO  URSIA  ; 
TL15: 
         REGJ =  BREG0  ; 
         GOTO  TJ15  ;
#                                                                      #
#        MUST LOAD THE OPERAND                                         #
TL20: 
         CALL  ISL00 ( TOP2, -1 ) ; 
  
  
  
  
#**********************************************************************#
#        TYPE M INSTRUCTION         # 
#        TMBR, TMSR, TMWR                                              #
#**********************************************************************#
  
TM00: 
#                                                                      #
         REGJ =   XREGL [ TOP1 ] ;
      IF REGJ GT 0
      THEN
          BEGIN 
         REGK =  REGJ ; 
         GOTO  STM00 ;
          END 
         REGJ =  BREGL [TOP1] ;     #   SEE IF IN B-REG                #
         IF  REGJ  GT 0  THEN 
          BEGIN 
                  REGK  =  BREG0 ;  #   SXI BJ + B0  FOR TMWR TMSR     #
                  GOTO  STM00 ; 
          END 
         CALL  ISL00 ( TOP1 , RTOP2 ) ; 
  
  
  
  
#**********************************************************************#
#        TYPE N INSTRUCTION         # 
#        MASK ,COMP                 # 
#        MASK ,SHIFT                # 
#**********************************************************************#
  
TN00: 
#        THIS IS A CONSTANT BUILDING  PSEUDO OP   # 
#        A MASK OP  MUST BE  INSERTED   # 
#        THEN A  COMP OR SHIFT   HAVING THE SUCCESSORS OF   # 
#        THE  OP AT INX             # 
#        THE CISR BIT MUST BE MOVED TO THE  2ND  OP  AT LEAST    #
         CALL  INN00 ;              #   INSOPA - E                     #
         TNMC =   B<6,6> KDES [INX] ; 
#        NOW TNMC IS OPN1 OF THE MASK OP                               #
         CALL  IINSK ( QICFOP"MASK" , TNMC, RTOP2 ) ; 
          T1 = CNO[INX];
          CNO[INSOPA] = T1; 
#        NOW CHECK SUB TYPE   0 = COMP                                 #
         IF  OPCOD  EQ  QICFOP"MSKC"  THEN
          BEGIN 
#        MASK-COMP                                                     #
         CALL  IINSK ( QICFOP"COMP", NINSA,  RTOP2 ) ;
          END 
      ELSE
          BEGIN 
#        MASK - SHIFT LEFT                                             #
         CALL  IINSK ( QICFOP"LSHC", NINSA, KDES [INX] ) ;
          END 
#        AN INSERTED LEFT SHIFT WILL NOT CAUSE OUT OF REGISTERS        #
#        AND OPN2 MUST BE SHIFT VALUE                                  #
#        OPN2 OF AN INSERTED COMP SHOULD BE THE BROTHER                #
         CNO [INSOPB]  =  CNO [INX]  ;
         STI [INSOPB] =  STI [INX] ;
         CALL MPRED ( INSOPA, INSOPB) ; 
         CISR [INSOPB]  = KISR  ; 
         IF  OPCOD  NE  QICFOP"MSKC"  THEN
                  CISR  [INSOPA]  = KISR ;
         GOTO  URSIA  ; 
  
  
  
  
#**********************************************************************#
#        TYPE  P  INSTRUCTION       # 
#        LOAD SHORT CONSTANT        # 
#**********************************************************************#
  
TP00: 
         IF  REFCT [INX] LE 0 THEN
                  BEGIN 
                  NOCOD = TRUE ;
                  ITYPE = 0 ;       #   NULL                           #
                  GOTO CG00 ; 
                  END 
         REGK  =  BREG0  ;
         T1   =   OPN1 [INX]  ;     #   S.T.P. TO CONSTANT             #
         REGJ =   BREG [T1]  ;
         IF  REGJ  GT  BREG0  THEN  GOTO  STP00  ;   # CONSTANT IN BREG#
         REGK  =  SUDOR  ;
         REGJ  =  BREG0  ;
         CALL  FIND  ( T1 , T2 )  ; 
         KACON =  CONS [T2]  ;      #                                  #
         GOTO  STP00  ; 
  
  
  
  
#**********************************************************************#
#        LUAU     LOAD USING A-REGISTER UNO       # 
#**********************************************************************#
  
TPI00:  
         CALL  GLR00 ( REGI ) ; 
         LSTYP =  QLT"LOAD"  ;
         IF REGI LE  0  THEN  GOTO UNL00 ;
         CALL  GIU00 ;
          IF OPN1[INX] EQ 0 THEN REGJ = AREG1;                           NEWFEAT
                            ELSE REGJ = AREG2;                           NEWFEAT
         KACON =  KDES [INX]  ; 
      IF KACON LE 0 
      THEN
          BEGIN 
#        ZERO OFFSET     #
         REGK  =  BREG0 ; 
         MOP [INX] =  SAI54 ; 
          END 
      ELSE
          BEGIN 
#        NON ZERO OFFSET            # 
         REGK  =  SUDOR ; 
         MOP [INX] =  SAI50 ; 
         INSIZ =  2  ;
          END 
         GOTO  CGIE ; 
  
  
  
  
#**********************************************************************#
#        DEFINE REGISTER VALUE                                         #
#        DRV      # 
#**********************************************************************#
  
TPJ00:  
         NOCOD  = TRUE  ; 
         GOTO  CG00 ; 
  
  
  
  
#**********************************************************************#
#        SET REGISTER VALUE         # 
#**********************************************************************#
  
TPK00:  
         REGJ  =  XREGL [ TOP1 ] ;
      IF REGJ GT 0
      THEN
          BEGIN 
         REGI  =  ( OPN2 [INX]  LAN  O"7" ) + XREG0  ;
         FORCE =  TRUE ;
         REGK  =  REGJ ;
         MOP [INX] =  BXI10 ; 
         FUNU  =  LOGU  ;           #   BOOLEAN LOGICAL UNIT           #
         GOTO  CGIE ; 
          END 
         CALL  ISL00 ( TOP1, -1 ) ; 
  
  
  
  
#**********************************************************************#
#        TYPE Q   INSTRUCTION       # 
#        ADSC                       # 
#**********************************************************************#
  
TQ00: 
#                                                                      #
         REGJ  =  XREGL [ TOP1 ]  ; 
         IF  REGJ  LE 0  THEN  GOTO TQ20 ;
TQ10: 
         T1  =  OPN2 [INX] ;        #   S.T.P. TO CONSTANT             #
         REGK  =  BREG [ T1 ] ; 
         IF  REGK GT BREG0 THEN GOTO STQ00 ; #  CONSTANT IN BREG       #
         CALL  FIND  ( T1 , T2 )  ; 
         KACON  =  CONS [ T2 ]  ; 
         GOTO  STQ00 ;
#                                                                      #
TQ20: 
         REGJ  =  BREGL [ TOP1 ] ;
         IF REGJ GT 0 THEN GOTO TQ10 ;
#                                                                      #
         CALL  ISL00 ( TOP1, -1 ) ; 
  
  
  
  
#**********************************************************************#
#        TYPE R   INSTRUCTION       # 
#        BXND     # 
#**********************************************************************#
  
TR00: 
         REGJ  =  BREGL [ TOP1 ]  ; 
         REGK  =  XREGL [ TOP1 ]  ; 
         IF REGJ  GT 0  THEN
         BEGIN
#        SET UP REGJ , REGK                                            #
         REGK  =  BREG0  ;
         GOTO  STR00 ;
         END
         ELSE 
                  IF  REGK  GT  0  THEN 
         BEGIN
                  REGJ  = REGK  ; 
                  REGK  = BREG0 ; 
         GOTO  STR00 ;
         END
                  ELSE
#        MUST INSERT  LOAD OF  OPERAND  # 
#                                                                      #
         CALL  ISL00 ( TOP1, -1 ) ; 
  
  
  
  
#**********************************************************************#
#        RLAY                                                          #
#**********************************************************************#
  
TRL00:  
         REGI  =  XREGL [TOP2]  ; 
         REGJ  =  BREGL [TOP2]  ; 
         NOCOD  =  TRUE ; 
         GOTO  CG00   ; 
  
  
  
  
#**********************************************************************#
#        SAVE                                                          #
#**********************************************************************#
  
TS00: 
         AINVS  [INX]  =  FALSE  ;  #   SET NOT LOADED                 #
         IF REFCT [TOP2] GT 1 THEN
                   BEGIN
#        THE COMP BEING SAVED HAS MANY USES                            #
                   INSOPA = ICFTJ  ;
                   CALL IINSK ( QICFOP"TMWR", OPN2 [INX], -1 ) ;
                   OPN2 [INX] = BI - INSOPA ; 
                   CALL MPRED ( INSOPA, INX ) ; 
                   GOTO URSIA ; 
                   END
         REGI  =  XREGL  [ TOP2 ] ; 
         IF REGI  LE 0  THEN GOTO TS20 ;
         IF REGI GE XREG6  THEN 
         BEGIN
         REGJ  =  REGI ;
         NOCOD =  TRUE ;
         GOTO  CG00 ; 
         END
#                                                                      #
TS10: 
         REGK  =  REGI   ;          #   FOR OUT OF REGISTER PROC       #
         CALL  CAS00  ( REGJ , XWRTR, XWRTO ) ; 
         IF REGJ  LE  0  THEN  GOTO UNS00  ; #  UNSCHEDULABLE          #
#        REGJ  IS AVAILABLE                                            #
         IF  REGI  LE  BREG7 THEN  OPCD [INX] = QICFOP"PISR" ; ELSE 
         OPCD [INX] =  QICFOP"TSSV"  ;
#        VALUE IS IN REGI , REGJ IS AVAILABLE STORE REG                #
         NOCOD =  TRUE ;
         GOTO  CG00 ; 
#        MUST INSERT A LOAD OF VALUE TO BE SAVED                       #
TS20: 
#        CHECK FOR  B-REG                                              #
         REGI  =  BREGL  [TOP2] ; 
         IF  REGI GT 0  THEN  GOTO TS10 ; 
         CALL  ISL00 ( TOP2, -1 ) ; 
  
  
  
  
#**********************************************************************#
#        SUBS  AND OFFS                                                #
#        NULL                                                          #
#**********************************************************************#
  
TT00: 
TU00: 
         NOCOD =  TRUE ;
         GOTO  CG00 ; 
  
  
  
  
#**********************************************************************#
#        LABL                                                          #
#**********************************************************************#
  
TV00: 
         NOCOD =  TRUE  ; 
#        LABELS LINKED INTO CODE CHAIN BY CFW00                        #
         IF  NOT UNRLB  [INX] THEN  #   REFERENCED LABEL               #
           BEGIN
           IF  PARCEL NE 0 THEN 
                  BEGIN 
                  PARCEL  = 0  ;
                  CLC [0]  =  CLC [0]  + 4 ;
                  CLOCK  =  CLOCK + WDP + 2 ; 
                  END 
         END
         GOTO  CG00 ; 
  
  
  
  
#**********************************************************************#
#        LINE                                                          #
#**********************************************************************#
  
TLIN: 
         IF CIDDB NQ 0 THEN                                              JUNK 
           BEGIN                                                         JUNK 
           CLOCK  = CLOCK + 2;  # ADD TIMING FOR  SB0   #                JUNK 
           END  # DEBUG OPTION #                                         JUNK 
         NOCOD =  TRUE  ; 
          LINE = OPN1 [INX] ; 
         GOTO  CG00  ;
  
  
  
  
#**********************************************************************#
#        LOAD IMMEDIATE SHORT CONSTANT INTO SPECIFIC X REG             #
#**********************************************************************#
  
TISC0:  
         REGI  =  (OPN2 [INX] LAN O"7" ) + XREG0  ; 
         REGJ  =  BREG0  ;
         KACON =  OPN1 [INX]  ; 
         REGK  =  SUDOR  ;
         MOP [INX] = SXI71   ;
         FORCE =  TRUE  ; 
         INSIZ =  2  ;
         CALL  GIU00  ; 
         GOTO  CGIE ; 
  
  
  
  
#**********************************************************************#
#        A B-REG IS DEDICATED TO A SUBSCRIPT                           #
#        BSLD     BSLC   BSRP                                          #
#        CNO  POINTS  TO ORIGINAL   LOAD                               #
#**********************************************************************#
TBSLD:  
TBSLC:  
TBSRP:  
         REGJ  =  XREGL  [TOP1]  ;
         IF  REGJ LE 0 THEN  GOTO  TBSL20  ;
         REGK  =  IDES  [INX]  ;
         IF  OPCODE EQ  QICFOP"BSRP"  THEN GOTO  TBSR00  ;
         GOTO  STBSLD  ;
TBSL20: 
         CALL  ISL00 ( TOP1, -1 ) ; 
#                                                                      #
#        BSRP                                                          #
TBSR00: 
         REGI  =  XREGL [TOP2]  ; 
         IF  REGI LE 0  THEN  GOTO  TBSR20  ; 
         IF  REGI LT XREG6  THEN  GOTO TBSR10  ;
         CALL  TRO00  ( REGI ) ;
         GOTO  STBSRP  ;
#                                                                      #
#        TMSR                                                          #
TBSR10: 
         INSOPA = ICFTJ  ;
         CALL  IINSK ( QICFOP"TMSR", OPN2 [INX] , TOP1 ) ;
         OPN2  [INX]  =  BI - INSOPA  ; 
         CALL  MPRED  ( INSOPA ,  INX )  ;
#                                                                      #
         GOTO  URSIA  ; 
TBSR20: 
         CALL  ISL00 ( TOP2, TOP1 ) ; 
  
  
  
  
#**********************************************************************#
#     BPSB                                                             #
#     THIS IS A SCHEDULER ONLY ICFT OPERATOR.  IT REPRESENTS AN        #
#     ADD OF A BASE POINTER AND A SUBS. THE OPERANDS ARE ALREADY LOADED#
#**********************************************************************#
  
TBPSB:  
      GOTO SBPSB;            #GET A RESULT REG# 
CONTROL EJECT;
#**********************************************************************#
#     TYPE A                                                           #
#        ALL NORMAL BINARY OPS - 2 X-REG OPS, 1 X-REG RESULT     #
#**********************************************************************#
  
STA00:  
                                        #SELECTS THE RESULT REGISTER   #
                                        # FOR THE TYPE A INSTRUCTIONS. #
         IF REGJ  EQ  REGK THEN CDBLU = TRUE  ; 
                  ELSE  CDBLU = FALSE  ;
         IF NOT KISR THEN GOTO STA15 ;
#        RESULT TO BE STORED - ATTEMPT TO USE X6,X7   # 
#        STORE TYPE RESULT WANTED  #
         XWTOA = 131071 ; 
         XREGA = 0 ;
         IF   REGJ GE  XREG6 THEN 
                  BEGIN 
                  CALL CSU00 ( REGJ, TUSC, XWRTR, XWRTO ) ; 
                  IF TUSC EQ 0 THEN 
                  BEGIN 
                  IF XWRTO EQ 0 THEN
                      BEGIN 
                      REGI = REGJ   ; 
                      GOTO STA16 ;
                      END 
                      ELSE
                      BEGIN 
                      XREGA  = REGJ ; 
                      XWTRA  = XWRTR ;
                      XWTOA  = XWRTO ;
                      END 
                  END 
                  END 
         IF  REGK GE XREG6 THEN 
                  BEGIN 
                  CALL CSU00 (  REGK, TUSC, XWRTR, XWRTO )  ; 
                  IF TUSC EQ 0 THEN 
                  BEGIN 
                  IF XWRTO  EQ 0 THEN 
                      BEGIN 
                     REGI = REGK   ;
                     GOTO STA16 ; 
                      END 
                     ELSE 
                      BEGIN 
                      IF XWRTO  LT XWTOA  THEN
                           BEGIN
                           XREGA = REGK  ;
                           XWTRA = XWRTR ;
                           XWTOA = XWRTO ;
                           END
                      END 
                  END 
                  END 
         XWRTO =  0 ; 
         CALL CAS00 (  REGI, XWRTR, XWRTO ) ; 
               IF  REGI GE XREG6 THEN 
                  BEGIN 
                  IF XWRTO LE XWTOA THEN GOTO STA16 ; 
                  ELSE
                    BEGIN 
STA14:  
                    REGI =  XREGA   ; 
                    XWRTR = XWTRA   ; 
                    XWRTO = XWTOA   ; 
                    GOTO STA16 ;
                    END 
                  END 
                  IF XREGA GT XREG0 THEN GOTO STA14 ; 
STA15:  
         CALL  GWR00  ( REGI ) ;
         IF REGI  LT 0  THEN GOTO STA30 ; 
#        THERE IS A FREE WORK REGISTER  # 
STA16:  
         GOTO  CGIE ; 
#        NO FREE WORK REGISTERS    #
STA30:  
         TUSC  = 1 ;
         TUSC1 = 1 ;
         IF  REGJ GE XREG0  THEN
         CALL  CSU00 ( REGJ, TUSC, XWRTR, XWRTO ) ; 
         IF REGK GE XREG0  THEN 
         CALL  CSU00 ( REGK, TUSC1, XWTRA, XWTOA ) ;
         IF TUSC EQ 0 THEN
               BEGIN
               IF TUSC1 EQ 0 THEN 
                  BEGIN 
                  IF XWRTO LE XWTOA  THEN GOTO  STA31 ; 
                  ELSE GOTO STA32 ; 
                  END 
                  ELSE GOTO STA31 ; 
               END
               IF TUSC1 EQ 0 THEN GOTO STA32 ;
               GOTO STA35 ; 
#        USE REGJ   # 
STA31:  
         REGI = REGJ  ; 
         GOTO STA16  ;
#        USE REGK   # 
STA32:  
         REGI = REGK ;
         XWRTR =  XWTRA ; 
         XWRTO =  XWTOA ; 
         GOTO STA16  ;
#              UNSCHEDULABLE #
STA35:  
         CDROP =  TRUE ;
         CALL  CRU00 ( TOP1, REGI ) ; 
         IF  REGI  GE XREG0 THEN GOTO CGIE ;
         IF ITYPE LT FTYPE THEN        #   TYPE A OR E                 #
         CALL  CRU00 ( TOP2, REGI ) ; 
         IF  REGI  GE XREG0 THEN GOTO CGIE ;
         GOTO  UNW00 ;
  
  
  
  
#**********************************************************************#
#     TYPE B                                                           #
#        COMP AND SUM1 OPS: ONE OPERAND, ONE RESULT    #
#**********************************************************************#
  
STB00:  
                                        #SELECTS THE RESULT REGISTER   #
                                        # OF TYPE B INSTRUCTIONS.      #
         TUSC  =  1 ; 
         XWRTO  = 131071 ;
         IF NOT KISR THEN  GOTO STB15 ; 
#        RESULT TO BE STORED - ATTEMPT TO USE X6/X7    #
#        STORE REGISTER WANTED     #
         IF REGK GE XREG6 THEN
               CALL CSU00 ( REGK, TUSC, XWRTR, XWRTO ) ;
         XWTOA =  131071 ;
         CALL CAS00 (REGI , XWTRA, XWTOA )  ; 
         IF  TUSC EQ 0  THEN
               BEGIN
               IF XWRTO LE  XWTOA  THEN 
                  BEGIN 
                  REGI = REGK ; 
                  GOTO  STB16 ; 
                  END 
                  ELSE
                  BEGIN 
STB13:  
                  XWRTR  = XWTRA ;
                  XWRTO  = XWTOA ;
                  GOTO  STB16 ; 
                  END 
               END
               IF REGI GE XREG6 THEN GOTO STB13 ; 
STB15:  
         CALL  GWR00 ( REGI ) ; 
         IF REGI  LT  0  THEN GOTO STB30 ;
#        A FREE WORK REGISTER EXISTS    # 
STB16:  
         GOTO  CGIE  ;
#        NO WORK REGISTER AVAILABLE     # 
STB30:  
         CALL  CSU00 ( REGK, TUSC, XWRTR, XWRTO ) ; 
         IF TUSC EQ 0 THEN
                  BEGIN 
                  REGI = REGK ; 
                  GOTO  STB16 ; 
                  END 
#        STATEMENT UNSCHEDULABLE   #
#                                                                      #
         CDROP =  TRUE  ; 
         CALL  CRU00 ( TOP1, REGI ) ; 
         IF REGI  GE XREG0 THEN GOTO STB16  ; 
         GOTO UNW00 ; 
  
  
  
  
#**********************************************************************#
                                        #SELECTS THE RESULT REGISTER   #
                                        # OF TYPE C INSTRUCTIONS.      #
#**********************************************************************#
  
STC00:  
#        MASK  OP -  NO OPERANDS -  1  RESULT     # 
         IF NOT KISR THEN GOTO STC15 ;
#        ATTEMPT TO USE X6- X7          # 
#        STORE REGISTER WANTED     #
         CALL  CAS00 ( REGI, XWRTR, XWRTO ) ; 
         IF REGI GE XREG6 THEN GOTO STC16 ; 
         IF  REFCT [INX] LT 2  THEN GOTO  STC30  ;
#        GET WORK REGISTER    # 
STC15:  
         CALL  GWR00 ( REGI ) ; 
         IF REGI LT 0 THEN GOTO STC30 ; # NO WORK REGISTER AVAILABLE #
STC16:  
         GOTO  CGIE  ;
#        NO FREE WORK REGISTER     #
STC30:  
         IF  OPN2  [INX]  GT 0  THEN REGJ =  XREGL [OPN2  [INX]] ;
         IF  KISR THEN GOTO UNS00 ; 
         GOTO UNW00 ; 
  
  
  
  
#**********************************************************************#
#        CONSTANT SHIFT  OPS  # 
#        AT THIS POINT A CONSTANT SHIFT OPERATOR WILL HAVE A     #
#        SINGLE USE OPERAND.                                     #
#        AN XMIT TO WORK REGISTER WOULD HAVE BEEN GENERATED FOR  #
#        A MULTI-USE OPERAND.                                    #
#**********************************************************************#
  
STD00:  
         CALL  TRO00 ( REGI )  ;
         GOTO  CGIE ; 
  
  
  
  
#**********************************************************************#
#        VARIABLE SHIFT AND PAKB    # 
#**********************************************************************#
  
STE00:  
         GOTO  STA00 ;
  
  
  
  
#**********************************************************************#
#        NORM,NRMR, UNPK, PACK               #
#        USE B0 - N0 B-REG RESULT OR OPERAND #
#        XK --- XI, BJ        # 
#**********************************************************************#
  
STF00:  
         GOTO  STA00 ;
  
  
  
  
#**********************************************************************#
#        UNPB, NRRB, NRMB           # 
#        B-REG -REGJ IS OUTPUT      # 
#**********************************************************************#
  
STG00:  
         GOTO  STA00 ;
  
  
  
  
#**********************************************************************#
                                        #PROCESSES THE TRANSMIT        #
                                        # INSTRUCTIONS, TMSR, TMWR, AND#
                                        # TMBR WHICH TRANSMIT A COMPU- #
                                        # TATION FROM ONE TYPE OF      #
                                        # REGISTER TO ANOTHER TYPE OF  #
                                        # REGISTER.                    #
#**********************************************************************#
  
STM00:  
         IF OPCODE  EQ QICFOP"TMBR" THEN GOTO STM20 ; 
         IF OPCODE  EQ  QICFOP"TMWR" THEN GOTO STM15 ;
#        TMSR     # 
         IF  REGJ  LT XREG6 THEN GOTO  STM14 ;
         IF  CNO [INX]  EQ  RGMEM [REGJ]  THEN
         BEGIN
#        THE COMP HAS BEEN MOVED TO STORE REGISTER                     #
#        AND IT REPRESENTS ITSELF                                      #
STM11:  
         NOCOD =  TRUE ;
         GOTO  CG00 ; 
         END
#        THE COMP HAS BEEN MOVED TO A STORE REGISTER                   #
#        BUT IT REPRESENTS A TEMPORARY RESULT FOR A REPL               #
#        TURN IT BACK INTO ITSELF AND FIX OP2 OF REPL                  #
         T1 = ISUC [ STI [INX]]  ;
         IF OPCD [T1] NE  QICFOP"REPL" THEN GOTO STM14 ;
         CNO [INX] =  TOP1  ; 
         OPN2 [T1] = OPN1 [INX] ; 
         REFCT [TOP1] =  REFCT [TOP1] + 1 ;  #    ADJUST FOR RRC00     #
         GOTO  STM11 ;
STM14:  
         CALL  CAS00 ( REGI, XWRTR, XWRTO ) ; 
         IF  REGI  GE  XREG6  THEN  GOTO  STM25 ; 
         GOTO   STM40  ;
STM15:  
         IF  REGJ  LT XREG0  THEN  GOTO  STM17  ; 
         IF  REFCT [TOP1] GT 1 THEN GOTO STM17  ; 
#        IN XREG WITH SINGLE USE                                       #
         REGI = REGJ  ; 
         GOTO STM11   ; 
STM17:  
         CALL  GWR00 ( REGI ) ; 
         IF REGI  GE  XREG0 THEN GOTO STM25 ; 
         GOTO   STM41  ;
#        TMBR                       # 
STM20:  
         REGI  =  BREGL [TOP1]  ; 
         IF REGI GT 0 THEN GOTO STM11;  # COMP ALREADY IN B-REG#
         CALL  GBR00 ( REGI, XWRTR, XWRTO ) ; 
         IF REGI  LE  BREG0  THEN  GOTO  STM42 ;
         REGK  =  BREG0 ; 
#        SBI      XJ + B0                                              #
         MOP [INX] =  SBI63 ; 
         GOTO  STM27 ;
#        INSTRUCTION IS SCHEDULABLE  #
STM25:  
#        CHECK HERE FOR COMP IN A BREG                                 #
         IF  REGJ  LE BREG7  THEN 
                  BEGIN 
                  MOP [INX]  = SXI76 ;  #  SXI BJ + B0                 #
                  GOTO  STM27 ;     #   INCREMENT UNIT                 #
                  END 
         IF  FACL [SHIFU] LT  FACL [LOGU]  THEN 
         BEGIN
         REGK = REGJ ;
         REGJ = BREG0 ; 
         MOP [INX] = QCFOP"ICRL" ;
         FUNU  =  SHIFU ; 
         GOTO  STM28  ; 
         END
         MOP [INX] =  BXI10 ;       #  XMIT XJ TO XI                   #
         FUNU  =  LOGU  ;           #   BOOLEAN LOGICAL UNIT           #
         GOTO  STM28   ;
STM27:  
#                                                                      #
         CALL  GIU00  ;             #  GET INCREMENT UNIT              #
STM28:  
         GOTO  CGIE  ;
#        INSTRUCTION NOT SCHEDULABLE  # 
STM40:  
#        UNSCHEDULABLE              # 
         CALL  STM50  ; 
         GOTO UNS00 ;               # STORE  REGISTER  #
STM41:  
         CALL  STM50  ; 
         GOTO UNW00 ;               # WORK REGISTER    #
STM42:  
#                                                                      #
         CALL  STM50 ;
         GOTO UNB00 ;               # B REGISTER       #
#                                                                      #
    PROC STM50    ; 
         BEGIN    #      STM50                                         #
         IF  RTOP2  GT 0 THEN REGK = XREGL [RTOP2] ;
         REGJ  =  XREGL [TOP1] ;
         END      #      STM50                                         #
#**********************************************************************#
#        TYPE P                     # 
#        LOAD SHORT CONSTANT        # 
#     TYPE R                                                           #
#        BXND                                                          #
#     TYPE Q                                                           #
#        ADD SHORT  CONSTANT                                           #
#**********************************************************************#
  
STP00:  
STR00:  
STQ00:  
         CALL  GIU00  ;             #   GET  INCREMENT UNIT            #
         IF  CIBR [INX]  THEN       #   COMPUTE IN B REGISTER          #
         BEGIN
         CALL  GBR00 ( REGI, XWRTR, XWRTO ) ; 
         IF  REGI GT BREG0  THEN  GOTO  STQ50  ;
         IF REFCT [CNO [INX]] LT 2 THEN GOTO STQ17 ;
         END
         IF  NOT  KISR  THEN  GOTO  STQ15  ;
         CALL  CAS00 ( REGI, XWRTR, XWRTO ) ; 
         IF  REGI GE XREG6  THEN GOTO STQ20 ; 
         IF REFCT [CNO [INX]] LT 2 OR MCISR [INX] THEN GOTO STQ17 ; 
STQ15:  
         CALL  GWR00 ( REGI ) ; 
         IF REGI GE XREG0 THEN GOTO STQ20 ; 
STQ17:  
         IF  RTOP2  GE 0  AND  OPCOD  EQ QICFOP"LDSC" THEN
                  REGK = XREGL [RTOP2]  ; 
         IF  KISR  THEN  GOTO UNS00 ; 
         IF CIBR [INX] THEN GOTO UNB00 ;
         GOTO  UNW00 ;
STQ20:  
         IF KACON EQ 0  THEN GOTO  STQ25 ;
#        SXI      XJ/BJ + KACON                                        #
         INSIZ =  2  ;
         IF  REGJ  LE  BREG7 THEN MOP [INX] = SXI71 ;  # SXI BJ + KON  #
                  ELSE  MOP [INX] = SXI72 ;            # SXI XJ + KON  #
         GOTO  CGIE  ;
#                                                                      #
STQ25:  
#        SXI      XJ/BJ + BK        BK = B0 OR B REG OF CONSTANT       #
         IF  REGJ LE BREG7 THEN  MOP [INX] = SXI76  ;  # SXI BJ + BK   #
                  ELSE  MOP [INX] = SXI73 ;  #    SXI XJ + BK          #
         GOTO  CGIE ; 
#                                                                      #
#        B REG RESULT                                                  #
STQ50:  
         IF KACON  EQ 0  THEN  GOTO STQ55 ; 
#        SBI      XJ/BJ  + KACON                                       #
         INSIZ =  2  ;
         IF REGJ LE BREG7  THEN MOP [INX] = SBI61  ; # SBI  BJ + KON   #
                  ELSE MOP [INX] = SBI62  ;  #    SBI XJ + KON         #
         GOTO  CGIE  ;
#                                                                      #
STQ55:  
#        SBI      XJ/BJ + BK        BK = B0 OR BREG OF CONSTANT        #
         IF  REGJ LE BREG7  THEN  MOP [INX] = SBI66  ; # SBI BJ + BK   #
                  ELSE  MOP [INX] = SBI63  ; #    SBI  XJ + BK         #
         GOTO  CGIE  ;
  
  
  
  
#**********************************************************************#
#        INDUCTION VARIABLE INITIALIZATION   #
#**********************************************************************#
  
IVI00:  
         BREGL [INX] = IDES [INX] ;    #  DEDICATED B-REG              #
         STOP2  = OPN2 [INX]  ;     #   S.T.P. OPN2                    #
         IF  STOP2  GT 0  THEN  GOTO SI15 ;  # CONSTANT INIT VALUE     #
#        VARIABLE INITIAL VALUE     # 
         XOP1  =  XREGL [TOP2] ;
         IF  XOP1  GT 0 THEN  GOTO  SI05 ;   #  LOADED IN X-REG  #
         XOP1  =  BREGL [TOP2] ;
         IF  XOP1  GT 0 THEN  GOTO  SI05 ;
#        INITIAL VALUE NOT LOADED   # 
         CALL  ISL00 ( TOP2, -1 ) ; 
  
  
  
  
#**********************************************************************#
#        INDUCTION VARIABLE STEP    # 
#**********************************************************************#
  
IVS00:  
         GOTO  SI30 ; 
  
  
  
  
#**********************************************************************#
#        INDUCTION VARIABLE TEST    # 
#**********************************************************************#
  
IVT00:  
         GOTO  SI40 ; 
  
  
  
  
#**********************************************************************#
#        INDUCTION VARIABLE BRANCH  # 
#**********************************************************************#
  
IVB00:  
         GOTO  SI50 ; 
  
  
  
  
#**********************************************************************#
#        INVI ,INVS, AND INVB ( INVT)             # 
#        INVI     INDUCTION VARIABLE , COMPUTATION     #
SI05: 
#                                                                      #
#        THE SINGLE OPERAND IS LOADED IN  XOP1    # 
#        XOP1 MAY BE X-REG OR B-REG     # 
         REGI  =  IDES [INX] ;
         REGJ =   XOP1 ;
         REGK =   BREG0 ; 
#        SBI      XJ + B0           # 
#  OR    SBI      BJ + B0           # 
         MOP [INX] = SBI63   ;
         IF XOP1 LE  BREG7 THEN  MOP [INX] = SBI66 ;  # SBI BJ+B0 # 
SI10: 
         FORCE =  TRUE ;
             IF OPN1[INX] GR 0 THEN 
               BEGIN
         BREG  [OPN1 [INX]] = REGI  ; 
#        MAINTAIN DEDICATED B-REG INVIS  S.T.O.S                       #
         BRDVP [BRDVN] = OPN1 [INX] ; 
         BRDVN =  BRDVN + 1 ;       #   NUMBER OF DEDICATED INV2S      #
               END
SI11: 
         CALL  TRO00 (REGI) ; 
         CALL  GIU00  ; 
         GOTO  CGIE  ;
#                                                                      #
SI15: 
#        INVI     # 
         REGI  =  IDES [ INX ] ;
#        THE SINGLE OPERAND IS A SHORT CONSTANT        #
         REGJ  =  BREG [STOP2] ;
         IF REGJ  GT 0  THEN  GOTO  SI20 ;
SI16: 
         REGJ  =  BREG0 ; 
         CALL  FIND  ( STOP2 , TT1 ) ;
         KACON =  CONS  [ TT1 ]  ;
         IF KACON  EQ 0 THEN GOTO SI20 ;
         REGK =   SUDOR ; 
#        SBI      B0 + INITIAL VALUE CONSTANT     # 
         MOP [INX] = SBI61          ; 
         INSIZ =  2 ; 
         GOTO  SI10 ; 
#        CONSTANT  IS IN B REGISTER     # 
#        REGJ IS  SET               # 
SI20: 
         REGK  =  BREG0  ;
#        SBI      BJ + B0                                              #
         MOP [INX] = SBI66  ; 
         GOTO  SI10 ; 
  
#**********************************************************************#
  
#        INVS     LOAD OF INDUCTION VAR. , VAR  (BREG)           #
#                                        , CONST  (MAYBE B-REG)  #
SI30: 
         REGI  =  BREG [ OPN1 [ TOP1 ]]  ;
         REGJ  =  REGI ;
         TX2  =   OPN2  [ INX ]  ;
         IF TX2 LT  0  THEN 
                # CHECK IF ITS A LOAD OF A SCALAR  #
         IF OPN1[TOP2] GR 0 THEN
         IF LOADOP[OPCD[TOP2]] THEN 
         TX2  =   OPN1 [ TOP2 ]  ;
         REGK = FNDBREG ( TX2); 
         IF REGK GQ 0 THEN
           GOTO SI35; 
#        STEP VALUE  IS CONSTANT VALUE                                 #
         REGK =   SUDOR  ;
         CALL  FIND  (TX2 , TT1 )   ; 
         KACON =  CONS  [ TT1 ]  ;
         INSIZ =  2 ; 
#        SBI      BI + CONSTANT                                        #
         MOP [INX]  = SBI61 ; 
         GOTO  SI11 ; 
#        STEP VALUE IN  BREG        # 
#        SBI      BI + BK           # 
SI35: 
         MOP [INX]  = SBI66 ; 
         GOTO  SI11 ; 
#**********************************************************************#
  
#        INVT     # 
#        FOR  INVT  JUST MOVE  DOWN THE  TWO  BREG FIELDS   # 
#        FROM THE SYMBOL TABLE TO  IDES AND JDES            # 
SI40: 
         IDES[INX] = FNDBREG ( OPN1[INX] ); 
         JDES[INX] = FNDBREG ( OPN2[INX] ); 
         NOCOD   =  TRUE  ;         # NO CODE GENERATION    # 
         GOTO  CG00 ; 
#        INVB                       # 
#                                                                      #
#**********************************************************************#
#                                                                      #
SI50: 
         REGI  =  IDES [ TOP2 ] ; 
         REGJ  =  JDES [ TOP2 ] ; 
         REGK  =  SUDOR  ;
         INSIZ =  2 ; 
#        BI  GE   BJ  GOTO K        # 
         MOP [INX] =  BGE  ;
         FUNU  =  BRNU  ; 
         FORCE =  TRUE  ; 
         GOTO  CGIE ; 
  
  
  
  
#**********************************************************************#
#        BSLD  BSLC                                                    #
#**********************************************************************#
  
STBSLD: 
         IF  OPCODE  EQ  QICFOP"BSLC" THEN  GOTO STA00   ;
#        LOAD                                                          #
         CALL  GLR00 ( REGI) ;
         IF  REGI LE  XREG0  THEN  GOTO STBSL2 ;
STBSL1: 
         CALL  GIU00 ;
         GOTO  CGIE  ;
#                                                                      #
STBSL2: 
         IF  REFCT [TOP1]  GT 1  THEN  GOTO  UNL00  ; 
         REGI  =  REGJ  ; 
         CALL  TRO00 (REGI) ; 
         FORCE =  TRUE   ;
#        TIMES OFF  HERE                                               #
         GOTO  STBSL1  ;
  
  
  
  
#**********************************************************************#
#        BSRP                                                          #
#**********************************************************************#
  
STBSRP: 
#        THE  INSTRUCTION  IS  SCHEDULABLE  HERE                       #
         GOTO  STBSL1 ; 
  
  
  
  
#**********************************************************************#
#     BPSB                                                             #
#     RESULT CAN BE EITHER AN X-REG OR A B-REG                         #
#**********************************************************************#
  
SBPSB:  
      REGK = KDES[INX]; 
      K = MOP[INX]; 
      IF K NQ QICFOP"IADD"
      THEN
          GIU00;             #GET INCREMENT UNIT# 
      IF SXREG[INX] 
      THEN
          BEGIN              #X REG RESULT# 
          IF K EQ SXI76 
          THEN
              REGJ = JDES[INX] + BREG0; 
          ELSE
              IF K EQ SXI74 
              THEN
                  REGJ = JDES[INX] + AREG0; 
              ELSE
                  REGJ = JDES[INX] + XREG0; 
  
#     MAKE SURE REGS ARE STILL ALIVE                                   #
  
      IF REGJ EQ -1 
          OR REGK EQ -1 
      THEN
          BEGIN 
          CG2ABT(J858,"BAD BPSB OPERAND(CODGK1) LINE XXXXX",35);
          END 
          GOTO STA00;        #RESULT IS AN X-REG# 
          END 
          IF K EQ SBI66 
          THEN
              REGJ = JDES[INX] + BREG0; 
          ELSE
              IF K EQ SBI63 
              THEN
                  REGJ = JDES[INX] + XREG0; 
              ELSE
                  REGJ = JDES[INX] + AREG0; 
  
#     MAKE SURE REGS ARE STILL ALIVE                                   #
  
      IF REGJ EQ -1 
          OR REGK EQ -1 
      THEN
          BEGIN 
          CG2ABT(J859,"ILLEGAL BPSB OPERAND(CODGK1) LINE XXXXX", 39); 
          END 
      GBR00(REGI,XWRTR,XWRTO);     #GET A B-REG FOR RESULT# 
      IF REGI LE 0
      THEN
          GOTO UNB00;        #NO AVAILABLE B-REG.  UNLOAD ONE          #
      GOTO CGIE;             #TRY TO GENERATE THIS INSTRUCTION #
CONTROL EJECT;
#**********************************************************************#
#        LOAD PRIME      #
#**********************************************************************#
  
LDP00:  
         IF  OPN2 [INX] LT 0  THEN LREGJ = 0   ;
           ELSE   LREGJ  = XREGL [ OPN2 [INX]] ;
         IF  OPN1 [INX] GE 0 THEN  GOTO LD005  ;
         T1 =  OPCD [TOP1] ;
         IF  T1 EQ  QICFOP"SUBS"  OR
             T1 EQ QICFOP"PFUN" OR
             T1 EQ  QICFOP"OFFS"  THEN  GOTO LD005 ;
         IF XREGL [TOP1] GT 0  THEN 
         BEGIN
#        THE COMP IS IN AN X-REG                                       #
#        THE COMP  ( LIKE A SELB ) GOT MOVED FROM  B TO AN X-REG       #
         NOCOD = TRUE ; 
         ITYPE =  0 ;               #   NULL                           #
         GOTO  CG00 ; 
         END
         BREGV =  BREGL [TOP1] ;
         IF BREGV GT 0 THEN  GOTO  LDP20 ;
#        COMP MUST BE IN TSYM BY ALGORITHMIC DEFINITION                #
         OPN1 [INX] = TSYM [TOP1]  ;
         #  RETAIN   AT FOR  ANALYSIS  LATER                           # LARRY-R
         GOTO  LD005  ; 
#        COMP IN BREG                                                  #
LDP20:  
         SAILC =  0 ;               #   LOAD                           #
         LSTYP =  QLT"LOAD" ; 
         CALL  NCA00 (INX) ;
LDP22:  
         IF KISR  THEN
               BEGIN
               CALL CAS00 ( REGI, XWRTR, XWRTO ) ;
               IF REGI GT 0 THEN GOTO LDP30 ; 
               IF REFCT [CNO [INX]] EQ 1 THEN GOTO LDP40 ;
               END
         CALL  GWR00 (REGI)  ;
         IF REGI LE 0 THEN GOTO  LDP40 ;     #  UNSKEDULABLE           #
#        REGI AND BREGV SET UP                                         #
LDP30:  
         GOTO  LD32 ; 
#        UNSKEDULABLE LOAD PRIME                                       #
LDP40:  
         REGJ =   LREGJ ; 
         IF KISR  THEN GOTO UNS00 ; 
         GOTO  UNW00 ;
      CONTROL EJECT;
#**********************************************************************#
#        LOAD            #
#**********************************************************************#
  
LD00: 
$BEGIN
DB("( 9X17H LD00       IJK  O2,2X,O2,2X,O2)",REGI,REGJ,REGK,"."); 
$END
#        INITIAL LOADS HAVE NO BROTHERS IN OPN2 NOW                    #
         LREGJ =  0 ; 
LD005:  
         IF  NSKED GT 2  THEN  GOTO CSCAN ; #  FORGET LOADS HERE       #
         BREGV  = 0 ; 
         CALL  NCA00  ( INX ) ; 
         IF  REFCT [INX]  LE 0 THEN     #  UNUSED LOAD                 #
                  GOTO  LD50 ;
         LSTYP =  QLT"LOAD"  ;
         AXBSET = 6 ;               #  A,X  SET                        #
         SAILC =  0 ; 
#        SKIP INITIAL LOAD OF SCALAR VARIABLE IN B-REGISTER      #
#        LOAD     # 
         BREGV =  0 ; 
         CALL  SLR00 ;              #   SET UP TSYM    BREGV           #
         IF  OPCOD  EQ  QICFOP"LOAD"  AND 
             BREGV GT 0 THEN GOTO  LD50 ; 
         IF BREGV GT 0 THEN GOTO LD30 ;   #  LOAD X FROM B             #
         IF  NOT REFSCM[AT[INX]]  THEN    # FINAL  ACCESS IS LCM   #     LARRY-R
           BEGIN                                                         LARRY-R
           IF KISR THEN                                                  LARRY-R
             CAS00(REGI,XWRTR, XWRTO );                                  LARRY-R
           ELSE                                                          LARRY-R
           GWR00(REGI) ;                                                 LARRY-R
           END                                                           LARRY-R
         ELSE                                                            LARRY-R
         CALL  GLR00 ( REGI ) ; 
         IF REGI LE 0  THEN GOTO LD40 ;      # UNSCHEDULABLE   #
#                                                                      #
         GOTO LS00 ;
#        SXI      BJ + B0                                              #
LD30: 
         GOTO  LDP22 ;
LD32: 
         REGJ  =  BREGV  ;
         REGK  =  BREG0  ;
#                                                                      #
         MOP [INX] = SXI76 ;
         AXBSET = 2 ;               #   X-SET ONLY                     #
         LSTYP =  QLT"LOCF" ;       #   NOT MEMORY LOAD                #
         GOTO  SCG00  ; 
  
#     NO LOAD REGISTER ABAILABLE - PERHAPS WE CAN USE THE REGISTER     #
#     CONTAINING THE SUBSCRIPT (IF ONE).                               #
  
LD40: 
         IF  REFSCM[AT[INX] ]                                            LARRY-R
         AND  SUBRG   GE  XREG1           # SUBSCRIPT IS  IN  #          LARRY-R
         AND  SUBRG   LS  XREG5    THEN    # SCM LOAD REG  #             LARRY-R
           IF SRUSC  LE 1           THEN                                 LARRY-R
         BEGIN
         #HOWEVER NOT IF SUBS IS IN X1 OR X2 WHILE ITS FROZEN#           NEWFEAT
          IF (FREZA1 AND SUBRG EQ XREG1 ) OR (FREZA2 AND SUBRG EQ XREG2) NEWFEAT
                          THEN GOTO LD42;                                NEWFEAT
  
#     WE CANT USE THE SUBSCRIPT REG IF THERE IS AN ISSUED BPSB ON OUR  #
#     BASE+SUBS CHAIN SINCE REFCT OF SUBS WAS ALREADY REDUCED FOR THIS #
#     INSTR.                                                           #
  
                  FOR I = BSCHN[INX] WHILE (I NQ INX) 
                      AND ((OPCD[I] NQ QICFOP"BPSB") OR NOT ISUED[I]) DO
                          I = BSCHN[I]; 
  
                  IF I NQ INX THEN GOTO LD42; 
                  REGI  =  SUBRG  ; 
         CALL  TRO00 ( REGI ) ; 
                  GOTO  LS00 ;
         END
LD42: 
#        PROTECT  A BROTHER COMPUTATION                                #
         REGJ =   LREGJ  ;
         REGK =   SUBRG  ;          #   PROTECT SUBSCRIPT X-REG        #
         GOTO  UNL00 ;
#        SKIP  INITIAL LOAD OF  VARIABLE IN B-REG                      #
LD50: 
         BREGL [INX] = BREGV ;
         NOCOD =  TRUE  ; 
         ITYPE  =  0  ;             #   NULL                           #
         GOTO  CG00  ;
CONTROL EJECT;
#**********************************************************************#
#        REPLACE , SAVE  #
#**********************************************************************#
  
RP00: 
         IF  OPN1 [INX]  EQ  0  THEN  #  UNALLOCATED TEMP              #
                  BEGIN 
                  T1  =  GETEMP (BI - INX); 
                  OPN1 [INX] = T1 ; 
                  END 
         CALL  NCA00  ( INX ) ; 
         CALL  SLR00  ;             #   SET UP TSYM                    #
         LSTYP  = QLT"STOR"  ;      #   STORE  (REPL)                  #
         AXBSET = 6  ;              #   A,X                            #
         SAILC =  0 ; 
         REGI  =  XREGL [TOP2]  ; 
         STREE  = TOP2 ;            #   STOREE                         #
         IF REGI  LE 0 THEN GOTO  RP20 ;
         IF   NOT REFSCM[AT[INX]]  THEN                                  LARRY-R
           GOTO  RP05;                    # LCM STORE --      #          LARRY-R
                                          # ANY REG WILL DO   #          LARRY-R
         IF REGI  LT XREG6  THEN  GOTO  RP10 ;
#        STOREE IS IN  STORE  REGISTER       #
RP05: 
         CALL  TRO00  ( REGI ) ;
         GOTO LS00 ;
#        MUST INSERT A TMSR   # 
RP10: 
         INSOPA = ICFTJ ; 
         IF  NOT  MCISR [ TOP2 ] THEN 
         BEGIN
         INSOPA = ICFTJ  ;
#                                                                      #
         CALL  IINSK ( QICFOP"TMSR", OPN2 [INX] , SCOMP ) ; 
         OPN2  [INX]  =  BI - INSOPA ;
         CALL  MPRED  (  INSOPA , INX )  ;
         GOTO  URSIA  ; 
         END
#        MANY STORES OF THZS  COMP                                     #
         CALL  IINSK ( QICFOP"TMSR", OPN2 [INX], SCOMP ) ;
         CNO  [INSOPA] = TOP2 ;     #   STOREE                         #
         REFCT [TOP2]   = REFCT [TOP2] + 1 ;      #  ADJUST            #
         CALL  MPRED ( INSOPA, INX ) ;
         GOTO  URSIA ;
#                                                                      #
#        MUST INSERT A LOAD   # 
RP20: 
         CALL  ISL00 ( TOP2, SCOMP ) ;
      CONTROL EJECT;
#**********************************************************************#
#        LOC FUNCTION    #
#**********************************************************************#
  
LC00: 
$BEGIN
DB("( 9X17H LC00       IJK  O2,2X,O2,2X,O2)",REGI,REGJ,REGK,"."); 
$END
#                                                                      #
#        CHANGE AN INDIRECT SCALAR LOC  INTO                           #
#        A DIRECT SCALAR LOAD                                          #
         IF  LOCACS[AT[INX]]  NQ  0    AND                               LARRY-R
             OPN1 [INX]  GT  0  THEN
                  BEGIN 
LC05: 
                  OPCD [INX]  = QICFOP"LOAD"  ; 
                  OPCODE = QICFOP"LOAD" ;                                LARRY-R
                   IF CORERD[AT[INX]] EQ S"LCM" 
                   THEN 
                     LDFRLC[INX] = TRUE;
                  AT[INX] = LOCACS[AT[INX]]  ;                           LARRY-R
                  LCMINP  = FALSE;                                       LARRY-R
                  GOTO LD00 ; 
                  END 
          T1 = OPN1 [INX] ; 
          IF LOCACS[AT[INX]]  NQ  0    AND                               LARRY-R
               T1 LE 0 AND (OPCD[TOP1] EQ QICFOP"OFFS" OR 
                            OPCD[TOP1] EQ QICFOP"PFUN") AND 
               OPN1 [TOP1] GT 0 AND OPN2 [TOP1] EQ 0 THEN 
                    BEGIN 
                    OPN1 [INX] = OPN1 [TOP1] ;
                    TOP1 = BI - OPN1 [INX] ;
                    GOTO LC05 ; 
                    END 
         CALL  NCA00  ( INX ) ; 
         LSTYP =  QLT"LOCF"  ;
         AXBSET = 2 ;               #  X  SET                          #
         SAILC =  LFADJ ;     # LOC FUNCTION ADJUSTMENT   # 
         IF  KISR   THEN            #   COMPUTE  IN STORE REGISTER     #
           BEGIN
           CALL   CAS00 ( REGI, XWRTR, XWRTO ) ;
           IF  REGI GE XREG6  THEN GOTO LS00 ;
           END
         CALL  GWR00 ( REGI ) ; 
         IF REGI LT 0 THEN GOTO LC40 ;  # UNSCHEDULABLE     # 
         GOTO LS00  ; 
#        WORK REGISTER REQUIRED                                        #
LC40: 
         IF  SUBRG  GE  XREG0  AND  SRUSC  LE 1  THEN 
                  BEGIN 
  
#     WE CANT USE THE SUBSCRIPT REG IF THERE IS AN ISSUED BPSB ON OUR  #
#     BASE+SUBS CHAIN SINCE REFCT OF SUBS WAS ALREADY REDUCED FOR THIS #
#     INSTR.                                                           #
  
                  FOR I = BSCHN[INX] WHILE (I NQ INX) 
                      AND ((OPCD[I] NQ QICFOP"BPSB") OR NOT ISUED[I]) DO
                          I = BSCHN[I]; 
                  IF I EQ INX THEN
                      BEGIN 
                  REGI  =  SUBRG ;
                  CALL  TRO00 ( REGI ) ;
                  GOTO LS00 ; 
                      END 
                  END 
         GOTO  UNW00 ;
  
  
  
  
#**********************************************************************#
#        BRAI     # 
#**********************************************************************#
  
BR00: 
$BEGIN
DB("( 9X17H BR00       IJK  O2,2X,O2,2X,O2)",REGI,REGJ,REGK,"."); 
$END
         CALL  NCA00 ( INX )  ; 
         LSTYP =  QLT"BRAI" ; 
         AXBSET = 1 ;               #  B  SET                          #
         SAILC =  BIADJ ;     # B-REG ADDRESS INIT ADJUSTMENT    #
         REGI  =  OPN2 [INX]  LAN  O"7" + BREG0  ;
         CALL  TRO00 ( REGI ) ; 
         GOTO LS00  ; 
CONTROL EJECT;
#**********************************************************************#
#  INPUT                            # 
#        REGI                       # 
#        LOCF     BOOLEAN           # 
#        LOAD     BOOLEAN           # 
#        STOR     BOOLEAN           # 
#        ABSO     ENCODED ADDRESS   # 
#        OFFST    CONSTANT          # 
#        ASUB     FOR SUBSCRIPTED ARRAY ELEMENTS       #
#        PARAMETER SCALAR ITEM      # 
#        LOAD,STORE, LOC            # 
#        A PARAMETER ARRAY WITH CONSTANT OFFSET IS     #
#        CONSIDERED A PARAMETER SCALAR  # 
#        AN X-REGISTER HAS BEEN CHOSEN  # 
#        THE ENCODED ADDRESS  (INDIRECT, BASE(STP), OFFSET, NOSUBSCR) # 
#        EXISTS IN ABSO             # 
#        THIS WILL GO INTO A-REG HISTORY     #
#        LOADS AND STORES SET BOTH A-REG AND X-REG     #
#        LOIS SET ONLY X-REG        # 
#        ********   MULTI -INSTRUCTION LOAD *****  #
#        THE DOUBLE INSTRUCTION LOAD MUST BE INSERTED  #
#        SUCH THAT THE FIRST ONE SETS ONLY X-REG (SINGLE USE     #
#        OPERAND OF THE SECOND ONE )  AND THE SECOND ONE    # 
#        SETS  A-REG AND X-REG (WITH ICFT NO. OF ORIGINAL LOAD   #
#        THE ORIGINAL LOAD IS  CONVERTED TO A LOAD PRIME    # 
#        THE LAST INSERTED OP WILL HAVE THE ORIGINAL LOADS  # 
#        SUCCESSORS      #
         BREGV =  0 ; 
#        GET A REGI           # 
LS00: 
$BEGIN
DB("( 9X17H LS00       IJK  O2,2X,O2,2X,O2)",REGI,REGJ,REGK,"."); 
$END
#                                                                      #
         LSFL2  [INX]  = 0 ;        #   INITIALIZE  TO ZERO            #
         ACTYP =  AT [INX]  ; 
         IF  ACTYP  LQ  QAT"LCM"  THEN        # BOTH  DIRECT  #          LARRY-R
                  BEGIN 
                  IF  OPN1 [INX]  GT 0  THEN  GOTO SC00 ; 
                  IF OPCD[TOP1] EQ QICFOP"OFFS" 
                  OR OPCD[TOP1] EQ QICFOP"PFUN" THEN GOTO SC00; 
                  GOTO  LA00 ;      #   SUBS                           #
                  END 
         IF  ACTYP  LQ  QAT"LLCM" THEN        # ALL SINGLE INDIRECT  #   LARRY-R
                  BEGIN 
                  IF  OPN1 [INX]  GT  0 THEN GOTO SC00 ;
                  IF OPCD[TOP1] EQ QICFOP"OFFS" 
                  OR OPCD[TOP1] EQ QICFOP"PFUN" THEN GOTO PAC00;
                  GOTO   PA00  ;
                  END 
#        DIND                                                          #
         IF OPCD[TOP1] EQ QICFOP"OFFS"
         OR OPCD[TOP1] EQ QICFOP"PFUN" THEN GOTO PAC00; 
         GOTO  PA00  ;
CONTROL EJECT;
#**********************************************************************#
#        SIMPLE SCALAR ITEM        #
#        LOAD , STORE, OR  LOC     #
#        A LOCAL ARRAY WITH CONSTANT OFFSET IS         #
#        CONSIDERED A SIMPLE SCALAR ITEM               #
#        AN X-REGISTER HAS BEEN CHOSEN  - IN REGI      #
#        LOAD     REGI = 1 - 5      # 
#        STORE    REGI = 6 - 7      # 
#        LOC      REGI = 0 - 7      # 
#        THE ENCODED ADDRESS  ( BASE (S.T.P) , OFFSET, OSUB )    #
#        EXISTS IN  ABSO            # 
#        THIS WILL GO INTO A-REG HISTORY     #
#        BREGV IS SET WITH BREG OF  S.T. ENTRY  OF LOAD     # 
#        LOAD AND STORE SET  X-REG AND AREG  #
#        LOC  SETS ONLY XREG        # 
#        FOR THE  30 BIT LOAD  OPN1 POINTS TO THE      #
#        SYMBOL TABLE ENTRY OR THE OFFSET ENTRY        #
#        SCALAR LOAD                                                   #
SC00: 
$BEGIN
DB("( 9X17H SC00       IJK  O2,2X,O2,2X,O2)",REGI,REGJ,REGK,"."); 
$END
#        THIS INCLUDES SCALAR PARAMETER AND CONSTANT ARRAY ELEMENT     #
         IF  ACTYP  EQ  QAT"LCM"                                         LARRY-R
         AND (OPCODE NQ QICFOP"LOC" 
          AND OPCODE NQ QICFOP"BRAI")  THEN 
XFRMLCM:                                                                 LARRY-R
                                                                         LARRY-R
           BEGIN                                                         LARRY-R
                                                                         LARRY-R
           SXAC ( ABSO , REGJ , AJOFS );   # CHECK TO SEE IF ITS ALREADY LARRY-R
                                                 THERE #                 LARRY-R
           IF  REGJ GR 0                                                 LARRY-R
           AND AJOFS EQ 0  THEN                                          LARRY-R
             GOTO LCMXRG;                                                LARRY-R
           IF OPN1[INX] GR 0                                             LARRY-R
           OR ABAS GR 0                                                  LARRY-R
                          THEN                                           LARRY-R
           BEGIN        # FIRST  TIME  THRU  ON  LCM      #              LARRY-R
           IF LCMINP
             AND OPCODE NQ QICFOP"LODP" 
           THEN 
             BEGIN
             GOTO CSCAN;     #DONT TRY TOO MANY OF THESE AT ONE TIME   #
             END
           LCMINP = TRUE;                                                LARRY-R
           CALL INN00;                                                   LARRY-R
                IINSK ( QICFOP"LOC"  , OPN1[INX] , OPN2[INX]);           LARRY-R
                    # CONTINUE TO PROTECT OPN2  #                        LARRY-R
      MPRED(INSOPA,INX);
           AT[INSOPA] = AT[INX] ;                                        LARRY-R
           GOTO  URSIA ;                                                 LARRY-R
           END                                                           LARRY-R
         ELSE                                                            LARRY-R
           BEGIN                                                         LARRY-R
           REGJ =  SUBRG;                                                LARRY-R
LCMXRG:                                                                  LARRY-R
           LCMINP = FALSE;                                               LARRY-R
      USBCN[INX] = FALSE;    #NO DIRECT REFERENCE TO SUBSCRIPT# 
           REGK =  SUDOR ;                                               LARRY-R
      AXBSET = AXBSET LAN O"3";    #DOESN"T SET A-REG MEM#
           IF  OPCD[INX]  EQ  QICFOP"REPL"    THEN                       LARRY-R
              MOP[INX] = QCFOP"WXJ" ;                                    LARRY-R
           ELSE                                                          LARRY-R
              MOP[INX] = QCFOP"RXJ" ;                                    LARRY-R
           GOTO  LAG00;                                                  LARRY-R
           END                                                           LARRY-R
           END                                                           LARRY-R
         CALL  SBC00 ( ABSO, BREGJ, BJOFS ) ; 
         IF  BREGJ LE 0  OR  BJOFS NE 0 THEN GOTO SC15 ;
#        B-REG DEDICATED TO ADDRESS OF SCALAR ITEM     #
#        SAI      BJ + B0           LOAD/STORE                         #
#        SXI      BJ + B0           LOC                                #
#        SBI      BJ + B0           BRAI                               #
         REGJ = BREGJ ; 
         REGK = BREG0 ; 
         MOP [INX] = SAI56 + SAILC ;
         GOTO  SCG00 ;
SC15: 
         CALL  SAC00 ( ABSO, AREGJ, AJOFS ) ; 
         IF AREGJ LE 0  OR AJOFS NE 0  THEN GOTO SC20 ; 
#        A-REG CONTAINS ADDRESS OF SCALAR ITEM    # 
#        SAI      AJ + B0           LOAD/STORE                         #
#        SXI      AJ + B0           LOC                                #
#        SBI      AJ + B0           BRAI                               #
         REGJ = AREGJ  ;
         REGK = BREG0  ;
         MOP [INX] =  SAI54 + SAILC ; 
         GOTO  SCG00 ;
SC20: 
         IF  ACTYP  LQ  QAT"LCM"   THEN     # DIRECT  ACCESS  #          LARRY-R
         BEGIN
#        SAI      B0 + LOC          LOAD/STORE                         #
#        SXI      B0 + LOC          LOC                                #
#        SBI      B0 + LOC          BRAI                               #
#        THE LOC COMES FROM OPN1 POINTER    # 
         INSIZ  = 2 ;               # 30 BIT INSTRUCTION #
         REGJ  =  SUDOR ; 
         REGK  =  SUDOR ; 
         MOP  [INX] = SAI51 + SAILC ; 
         GOTO  SCG00 ;
         END
#        SCALAR PARAMETER                                              #
# GAMMA  LOAD (DIR)   PARAMETER                 GAMMA                  #
# DELTA  SUBS     0, GAM                                               #
#                 LOAD  (DIR)  DELTA           CN0 (ORIG)              #
#                 BRAI  (DIR)  DELTA                                   #
#                 REPL  (DIR)  DELTA, OPN2     CN0 (ORIG)              #
         SXAC ( ABSO , XREGJ , AJOFS );                                  LARRY-R
              # CHECK TO SEE IF POINTER ADDRESS AVAIL   #                LARRY-R
         IF XREGJ GT 0 THEN                                              LARRY-R
           BEGIN                                                         LARRY-R
#            SAI   XJ       LOAD/STORE                                   LARRY-R
             SXI   XJ       LOC                                          LARRY-R
             SBI   XJ       BRAI              #                          LARRY-R
           FORCE = TRUE;                                                 LARRY-R
           REGJ = XREGJ;                                                 LARRY-R
           REGK = BREG0;                                                 LARRY-R
           KACON = AJOFS;                                                LARRY-R
           IF AJOFS EQ 0 THEN                                            LARRY-R
           MOP[INX] = SAI53 + SAILC;                                     LARRY-R
           ELSE                                                          LARRY-R
             BEGIN                                                       LARRY-R
             MOP[INX] = SAI52 + SAILC;                                   LARRY-R
             XFRMD[INX] = TRUE;    # XREGJ ALREADY CONTAINS RELOCATION # LARRY-R
             INSIZ = 2;                                                  LARRY-R
             END                                                         LARRY-R
           GOTO SCG00;                                                   LARRY-R
           END                                                           LARRY-R
         IF LODPINP THEN                                                 LARRY-R
           GOTO CSCAN;   # ONLY ONE LODP IN READY SET AT A TIME  #       LARRY-R
         IF ACTYP NQ QAT"SSSCM"  THEN                                    LARRY-R
         LODPINP = TRUE;                                                 LARRY-R
         CALL  INN00  ;             #  GET INSOPA - E                  #
#        PROTECT STOREE IF REPL                                        #
         CALL  IINSK ( QICFOP"LODP", ABAS , STREE ) ; 
         PFFVH[INSOPA] = 1;   # GIVE LODP VERY HIGH PRIOR  #             LARRY-R
  
#     REFCT OF LODP = NUMBER OF TIMES WE MIGHT MAKE USE OF IT (= NUMBER#
#     OF ENTRIES ON THE BASE ONLY CHAIN AT THE SAME LEVEL AS THE       #
#     CURRENT INSTRUCTION.                                             #
  
      I = BCHN[INX];
      FOR J = 1 WHILE I NQ INX DO 
          BEGIN 
          IF AT[I] EQ ACTYP 
          THEN
              J = J + 1;
          I = BCHN[I];
          END 
      REFCT[INSOPA] = J;
  
#     LINK THE LODP INTO THE BASE ONLY CHAIN                           #
  
      BCHN[INSOPA] = BCHN[INX]; 
      BCHN[INX] = INSOPA; 
      MPRED(INSOPA,INX);
         AT[INSOPA]  =  LOCACS[AT[INX]];                                 LARRY-R
#        UPDATE READY SET                                              #
         GOTO  URSIA  ; 
CONTROL EJECT;
#**********************************************************************#
#        LOCAL ARRAY  LOAD/STORE/LOC/BRAI                              #
LA00: 
      $BEGIN
      DB("(10X16HLA00       IJK  O2,2X,O2,2X,O2)",REGI,REGJ,REGK,".");
      $END
#        A CONSTANT SUBSCRIPTED ARRAY  WOULD HAVE BEEN #
#        PROCESSED AS  A SCALAR ITEM                   #
#        INITIALIZE FLAGS                                              #
#                                                                      #
         USBCN [INX]  =  TRUE  ;    #  USES SUBSCRIPT                  #
         IF  AT[INX] EQ QAT"LCM"                                         LARRY-R
         AND (OPCD[INX] NQ QICFOP"LOC"
          AND OPCD[INX] NQ QICFOP"BRAI")  THEN
              GOTO  XFRMLCM;                                             LARRY-R
#                                                                      #
#        SEARCH A-REGS FOR BASE,SUBSCRIPT , RELATIVE OFFSET     # 
         CALL  SAC00 ( ABSO, AREGJ, AJOFS ) ; 
#        SEARCH B-REGS FOR  SUBSCRIPT   # 
         BREGJ =  BREGL [ ASUB ] ;
#        SEARCH B-REGS FOR BASE + OFFSET     #
         CALL  SBC00 ( ABOF, BREGK, BKOFS ) ; 
         IF BREGJ  LE  0  THEN  GOTO  LA20   ;
#        TEST FOR SUBS WITH NO  BASE ADDRESS                           #
         IF  ABAS EQ 0  THEN
                  BEGIN 
                  BREGK = BREG0 ; 
                  GOTO   LA11  ;
                  END 
         IF  BREGK LE 0  OR  BKOFS NE  0  THEN  GOTO  LA12 ;
#        BASE/OFFS  AND SUBSCRIPT IN  B-REGISTERS      #
#        SAI      BJ + BK           LOAD/STORE                         #
#        SXI      BJ + BK           LOC                                #
#        SBI      BJ + BK           BRAI                               #
LA11: 
         REGJ  =  BREGJ ; 
         REGK  =  BREGK ; 
         MOP [INX] = SAI56 + SAILC ;
         GOTO  LAG00 ;
LA12: 
         IF AREGJ LE 0  OR  AJOFS NE 0  THEN  GOTO LA15  ;
#        SAI      AJ + B0           LOAD/STORE                         #
#        SXI      AJ + B0           LOC                                #
#        SBI      AJ + B0           BRAI                               #
#        AREGJ IS  EXACT ADDRESS    # 
LA13: 
         REGJ  =  AREGJ ; 
         REGK  =  BREG0 ; 
#                                                                      #
         MOP [INX] =  SAI54 + SAILC ; 
         GOTO  LAG00 ;
LA15: 
#        SAI      BJ + BASE + OFFSET    LOAD/STORE                     #
#        SXI      BJ + BASE + OFFSET    LOC                            #
#        SBI      BJ + BASE + OFFSET    BRAI                           #
#        OPN1 PTS  TO  S.T  OR  TO OFFS                                #
         REGJ  =  BREGJ  ;
         REGK  =  SUDOR  ;
         MOP [INX] = SAI51 + SAILC  ; 
         INSIZ =  2  ;
         GOTO  LAG00 ;
#        SUBSCRIPT NOT IN B-REGISTER         #
LA20: 
         XREGJ  = XREGL [ASUB]  ; 
         IF XREGJ LT XREG0 THEN GOTO LA30   ; 
#        SUBSCRIPT  LOADED IN  X-REG    # 
         IF  AREGJ  GT 0  AND AJOFS EQ  0 THEN  GOTO LA13 ; 
         IF  BREGK  GT 0  AND  BKOFS EQ 0  THEN  GOTO  LA25 ; 
#        SAI      XJ + BASE + OFFSET    LOAD/STORE                     #
#        SXI      XJ + BASE + OFFSET    LOC                            #
#        SBI      XJ + BASE + OFFSET    BRAI                           #
#        TEST FOR SUBS WITH NO BASE ADDRESS                            #
         IF ABAS EQ 0  AND OFFST EQ 0  THEN 
                  BEGIN 
                  BREGK = BREG0  ;  #   XJ + B0                        #
                  GOTO  LA25  ; 
                  END 
         REGJ  =  XREGJ ; 
         REGK  =  SUDOR  ;
#                                                                      #
         INSIZ =  2  ;
         MOP  [INX] = SAI52 + SAILC ; 
         GOTO  LAG00 ;
#        BREGK CONTAINS BASE + OFFSET   # 
LA25: 
#        SAI      XJ + BK           LOAD/STORE                         #
#        SXI      XJ + BK           LOC                                #
#        SBI      XJ + BK           BRAI                               #
         REGJ =   XREGJ  ;
         REGK =   BREGK  ;
         MOP [INX] = SAI53 + SAILC  ; 
         GOTO  LAG00 ;
#        SUBSCRIPT NOT LOADED       # 
LA30: 
         IF  AREGJ  LE  0  THEN  GOTO  LA40 ; 
         FORCE =  TRUE ;
         IF  AJOFS  EQ 0  THEN  GOTO  LA13  ; 
#        SAI      AJ + AKOFS        LOAD/STORE                         #
#        SXI      AJ + AKOFS        LOC                                #
#        SBI      AJ + AKOFS        BRAI                               #
         REGJ =   AREGJ  ;
         REGK =   SUDOR  ;
         KACON =  AJOFS ; 
         INSIZ =  2 ; 
         MOP  [INX] = SAI50 + SAILC ; 
         GOTO  LAG00 ;
LA40: 
#        THE SUBSCRIPT IS NOT AVAILABLE  IN ANY WAY    #
#        HERE A LOAD OF THE SUBSCRIPT MUST BE INSERTED #
#        IF THE SUBSCRIPT IS IN A TEMP INSERT A LOAD OF     # 
#        THE TEMP GIVING IT THE CNO OF THE SUBSCRIPT        # 
#        COMPUTATION                                        # 
#        IF THE SUBSCRIPT IS A LOAD OF A SCALAR VARIABLE    # 
#        DUPLICATE IT                                       # 
#        THE INSERTED OP  HAS  THIS LOAD AS SUCCESSOR       # 
         CALL  ISL00 ( ASUB, STREE ) ;
CONTROL EJECT;
#**********************************************************************#
SCG00:             #   SCALAR GENERATION                               #
PAG00:             #   PARAMETER ARRAY GENERATION                      #
#        LOCAL ARRAY GENERATION                                        #
LAG00:  
$BEGIN
DB("( 9X17H SCLAPAG00  IJK  O2,2X,O2,2X,O2)",REGI,REGJ,REGK,"."); 
$END
         ITYPE =  XTYPE  ;          #   X-TYPE  INSTRUCTION GEN        #
#        A STORE USES OPERAND 2 OF CNO                                 #
         IF LSTYP EQ QLT"STOR" THEN UP2CN [INX] =  TRUE  ;
         AXBFL [INX]  =  AXBSET  ;
         IF MOP[INX] EQ  QCFOP"RXJ"                                      LARRY-R
         OR MOP[INX] EQ  QCFOP"WXJ"     THEN                             LARRY-R
            FUNU  = LCMU ;         #PSEUDO  LCM  READ/WRITE  UNIT  #     LARRY-R
         ELSE                                                            LARRY-R
         CALL  GIU00 ;
         GOTO  CGIE ; 
CONTROL EJECT;
#**********************************************************************#
#        PARAMETER  ARRAY  LOAD/STORE/LOC/BRAI                         #
PA00: 
$BEGIN
DB("( 9X17H PA00       IJK  O2,2X,O2,2X,O2)",REGI,REGJ,REGK,"."); 
$END
  
#     WE TAKE CARE OF LCM LOADS AND REPLS ELSEWHERE                    #
  
         IF  CORERD [AT[INX]]  EQ  S"LCM"                                LARRY-R
         AND  OPCD [INX]  NQ  QICFOP"LOC"          THEN                  LARRY-R
           GOTO  XFRMLCM ;                                               LARRY-R
  
      USBCN[INX] = TRUE;     #CURRENT INSTR USES A SUBS COMPUTATION    #
  
#     WE SEARCH THE B-REG ADDRESS MEMORY FOR THE ENTIRE ADDRESS-       #
#     (BASE,SUBS,OFFS).  IF WE FIND IT WE CAN GENERATE SNI BJ+B0       #
#     WHERE N=A IF WE ARE PROCESSING A LOAD OR REPL  ELSE              #
#           N=X IF WE ARE PROCESSING A LOC                             #
  
      SBC00(ABSO,BREGJ,BJOFS);
      IF BREGJ GT 0 AND BJOFS EQ 0
      THEN
          BEGIN              #FOUND ADDRESS IN BJ#
          REGJ = BREGJ; 
          REGK = BREG0; 
          MOP[INX] = SAI56 + SAILC; 
          IF BREGJ EQ BREG7 
          THEN
              FORCE = TRUE;  #HAVE TO KEEP B7 FREE# 
  
#     IF BJ WAS A BPSB CALCULATION THEN THE SUBS COMPUTATION HAS       #
#     ALREADY HAD ITS REFCT DECREMENTED (BY BPSB).                     #
  
          IF OPCD[RGMEM[BREGJ]] EQ QICFOP"BPSB" 
          THEN
              USBCN[INX] = FALSE; 
  
          GOTO PAG00; 
          END 
  
#     NOW WE TRY SEARCHING THE X-REG ADDRESS MEMORY FOR THE ENTIRE     #
#     ADDRESS.  IF WE FIND IT WE CAN GENERATE SNI XJ+B0                #
  
      SXAC(ABSO,XREGJ,XJOFS); 
      IF XREGJ GT 0 AND XJOFS EQ 0
      THEN
          BEGIN              #FOUND ADDRESS IN XJ#
          REGJ = XREGJ; 
          REGK = BREG0; 
          MOP[INX] = SAI53 + SAILC; 
  
#     IF XJ WAS A BPSB CALCULATION THEN THE SUBS COMPUTATION HAS       #
#     ALREADY HAD ITS REFCT DECREMENTED (BY BPSB).                     #
  
          IF OPCD[RGMEM[XREGJ]] EQ QICFOP"BPSB" 
          THEN
              USBCN[INX] = FALSE; 
  
          GOTO PAG00; 
          END 
  
#     NEVER BEING PRONE TO GIVING UP EASILY, WE SEARCH THE A-REG MEMORY#
#     IF WE FIND IT WE CAN GENERATE SNI AJ+B0                          #
  
      SAC00(ABSO,AREGJ,AJOFS);
      IF AREGJ GT 0 AND AJOFS EQ 0
      THEN
          BEGIN              #FOUND ADDRESS IN AJ#
          REGJ = AREGJ; 
          REGK = BREG0; 
          MOP[INX] = SAI54 + SAILC; 
          FORCE = TRUE;      #CAN"T COUNT ON AJ  INDEFINATELY#
          GOTO PAG00; 
          END 
  
#     WE HAVN"T BEEN SUCCESSFUL IN FINDING THE ENTIRE ADDRESS          #
#     (BASE,OFFS,SUBS) IN A REGISTER.  PERHAPS WE CAN FIND AT LEAST    #
#     A PARTIAL ADDRESS (BASE,OFFS).                                   #
  
      SBC00(ABOF,BREGK,BKOFS);
      SXAC(ABOF,XREGK,XKOFS); 
      SAC00(ABOF,AREGK,AKOFS);
  
#     IF THE SUBSCRIPT (SUBS) IS IN A B-REG AND WE FOUND THE PARTIAL   #
#     ADDRESS THEN WE CAN GENERATE A 15-BIT INSTRUCTION OF THE TYPE    #
#     SNI BS+MK, WHERE M DEPENDS ON WHERE WE FOUND THE PARTIAL ADDRESS #
  
      BREGS = BREGL[ASUB];   #REG NUMBER IF SUBS IN A B-REG#
      IF BREGS GT 0 
      THEN
          BEGIN              #SUBS IN BS# 
  
#     IF WE FOUND THE PARTIAL ADDRESS IN A B-REG, WE CAN GENERATE      #
#     SNI BS+BK                                                        #
  
          IF BREGK GT 0 AND BKOFS EQ 0
          THEN
              BEGIN          #FOUND PARTIAL ADDRESS IN BK#
              REGJ = BREGS; 
              REGK = BREGK; 
              MOP[INX] = SAI56 + SAILC; 
              IF BREGK EQ BREG7 OR BREGS EQ BREG7 
              THEN
                  FORCE = TRUE;        #CAN"T DEPEND ON B7 FOREVER# 
              GOTO PAG00; 
              END 
  
#     IF WE FOUND THE PARTIAL ADDRESS IN AN X-REG WE CAN GENERATE      #
#     SNI BS+XK.                                                       #
  
          IF XREGK GT 0 AND XKOFS EQ 0
          THEN
              BEGIN          #FOUND PARTIAL ADDRESS IN XK#
              REGK = BREGS; 
              REGJ = XREGK; 
              MOP[INX] = SAI53 + SAILC; 
              IF BREGS EQ BREG7 
              THEN
                  FORCE = TRUE;        #CAN"T DEPEND ON B7 FOREVER# 
              GOTO PAG00; 
              END 
  
#     FINALLY, IF WE FOUND THE PARTIAL ADDRESS IN AN A-REG WE CAN      #
#     GENERATE SNI BS+AK                                               #
  
          IF AREGK GT 0 AND AKOFS EQ 0
          THEN
              BEGIN          #FOUND PARTIAL ADDRESS IN AK#
              REGK = BREGS; 
              REGJ = AREGK; 
              FORCE = TRUE;  #CAN"T DEPEND ON AJ FOREVER# 
              MOP[INX] = SAI54 + SAILC; 
              GOTO PAG00; 
              END 
          END 
  
#     IF THE SUBSCRIPT IS IN AN X-REG AND WE FOUND THE PARTIAL ADDRESS #
#     IN A B-REG WE CAN GENERATE  SNI XS+BK.                           #
#     (UNFORTUNATELY THIS MACHINE DOES NOT HAVE INSTRUCTIONS OF THE    #
#     TYPE SNI XS+AK OR SNI XS+XK)                                     #
  
      XREGS = XREGL[ASUB];   #REG NUM IF SUBS IN AN X-REG#
      IF XREGS GT 0 AND (BREGK GE 0 AND BKOFS EQ 0) 
      THEN
          BEGIN              #SUBS IN X-REG,(BASE,OFFS) IN B-REG# 
          REGJ = XREGS; 
          REGK = BREGK; 
          MOP[INX] = SAI53 + SAILC; 
          IF BREGK EQ BREG7 
          THEN
              FORCE = TRUE;  #CAN"T DEPEND ON B7 FOR LONG#
          GOTO PAG00; 
          END 
  
#     SO FAR WE HAVE TRIED ALL THE POSSIBLE WAYS TO GENERATE A NICE,   #
#     SHORT 15-BIT INSTRUCTION.  OUR LAST HOPE FOR GENERATING JUST ONE #
#     INSTRUCTION FOR THIS LOAD/LOC/REPL IS IF WE FOUND THE ENTIRE     #
#     ADDRESS IN A REGISTER BUT WITH AN OFFSET,K, REQUIRED.  IF SO     #
#     WE CAN GENERATE SNI MJ+K.                                        #
  
      IF BREGJ GT 0 
      THEN
          BEGIN              #ADDRESS IN A B-REG - OFFSET BY K# 
  
#     IF WE CAN FIND K IN EITHER A B-REG OR AN X-REG WE CAN STILL      #
#     GENERATE A 15-BIT INSTRUCTION.                                   #
  
          SBK00(BJOFS,BREGK);      #SEARCH B-REGS FOR K#
          IF BREGK GT 0 
          THEN
              BEGIN          #FOUND K IN BK#
              REGJ = BREGJ; 
              REGK = BREGK; 
              MOP[INX] = SAI56 + SAILC;          #SNI  BJ+BK# 
              END 
          ELSE
              BEGIN 
              SXK00(BJOFS,XREGJ);  #SEARCH X-REGS FOR K#
              IF XREGJ GT 0 
              THEN
                  BEGIN      #FOUND K IN XJ#
                  REGJ = XREGJ; 
                  REGK = BREGJ; 
                  MOP[INX] = SAI53 + SAILC;      #SNI XJ+BK#
                  END 
              ELSE
                  BEGIN      #K NOT IN ANY X OR B-REG#
                  SBK00(-BJOFS,BREGK);           #SEARCH B-REGS FOR -K #
                  IF BREGK GT 0 
                  THEN
                      BEGIN  #FOUND -K IN BK# 
                      REGJ = BREGJ; 
                      REGK = BREGK; 
                      MOP[INX] = SAI57 + SAILC;  #SNI  BJ-BK# 
                      END 
                  ELSE
                      BEGIN  #K NOWHERE USEFUL# 
                      REGJ = BREGJ; 
                      REGK = SUDOR; 
                      KACON = BJOFS;
                      MOP[INX] = SAI51 + SAILC;  #SNI  BJ+K#
                      INSIZ = 2; #2 PARCEL INSTRUCTION# 
                      END 
                  END 
              END 
          IF BREGJ EQ BREG7 
          THEN
              FORCE = TRUE; 
  
#     IF BJ WAS A BPSB CALCULATION THEN THE SUBS COMPUTATION HAS       #
#     ALREADY HAD ITS REFCT DECREMENTED (BY BPSB).                     #
  
          IF OPCD[RGMEM[BREGJ]] EQ QICFOP"BPSB" 
          THEN
              USBCN[INX] = FALSE; 
  
          GOTO PAG00; 
          END 
  
      IF XREGJ GT 0 
      THEN
          BEGIN              #ADDRESS IN AN X-REG- OFFSET BY K# 
          REGJ = XREGJ; 
  
#     IF WE CAN FIND K IN A B-REG WE CAN GENERATE A 15-BIT INSTRUCTION #
  
          SBK00(XJOFS,BREGK);      #SEARCH B-REGS FOR K#
          IF BREGK GT 0 
          THEN
              BEGIN          #FOUND K IN BK#
              REGK = BREGK; 
              MOP[INX] = SAI53 + SAILC;          #SNI  XJ+BK# 
              END 
          ELSE
              BEGIN          #K NOT IN ANY B-REG# 
              REGK = SUDOR; 
              KACON = XJOFS;
              MOP[INX] = SAI52 + SAILC;          #SNI  XJ+K#
              INSIZ = 2;     #2 PARCEL INSTRUCTION# 
              END 
  
#     IF XJ WAS A BPSB CALCULATION THEN THE SUBS COMPUTATION HAS       #
#     ALREADY HAD ITS REFCT DECREMENTED (BY BPSB).                     #
  
          IF OPCD[RGMEM[XREGJ]] EQ QICFOP"BPSB" 
          THEN
              USBCN[INX] = FALSE; 
  
          GOTO PAG00; 
          END 
  
      IF AREGJ GT 0 
      THEN
          BEGIN              #ADDRESS IN AN A-REG- OFFSET BY K# 
          REGJ = AREGJ; 
  
#     IF WE CAN FIND K IN A B-REG WE CAN GENERATE A 15-BIT INSTRUCTION #
  
          SBK00(AJOFS,BREGK);          #SEARCH B-REGS FOR K#
          IF BREGK GT 0 
          THEN
              BEGIN          #FOUND K IN BK#
              REGK = BREGK; 
              MOP[INX] = SAI54 + SAILC;          #SNI  AJ+BK# 
              END 
          ELSE
              BEGIN          #K NOT IN A B-REG# 
              SBK00(-AJOFS,BREGK);     #SEARCH B-REGS FOR -K# 
              IF BREGK GT 0 
              THEN
                  BEGIN      #FOUND -K IN BK# 
                  REGK = BREGK; 
                  MOP[INX] = SAI55 + SAILC;      #SNI  AJ-BK# 
                  END 
              ELSE
                  BEGIN      #K NOWHERE USEFUL# 
                  REGK = SUDOR; 
                  KACON = AJOFS;
                  MOP[INX] = SAI50 + SAILC;      #SNI  AJ+K#
                  INSIZ = 2; #2 PARCEL INSTRUCTION# 
                  END 
              END 
  
          FORCE = TRUE; 
          GOTO PAG00; 
          END 
  
#     WELL THE OLD COLLEGE TRY HAS FAILED- IT LOOKS AS IF WE WILL HAVE #
#     TO GENERATE MORE THAN ONE INSTRUCTION TO PROCESS THE CURRENT     #
#     LOAD/REPL/LOC.  BUT WAIT, YOU OF LITTLE FAITH, PERHAPS THERE IS  #
#     SOMETHING ON THE READY SET WHICH, WHEN IT GETS ISSUED, WILL LET  #
#     US GET BY WITH SAVING INSTRUCTIONS.                              #
#     THE BEST THING THAT COULD BE IN THE READY SET WOULD BE AN ADD    #
#     OF OUR BASE + SUBS, SINCE AFTER THAT WAS ISSUED WE COULD GENERATE#
#     SNI MJ (+K).                                                     #
#     TO DETERMINE IF THIS IS THE CASE, WE SEARCH OUR BASE+SUBS CHAIN  #
#     FOR A BPSB INSTRUCTION.  THIS INSTRUCTION REPRESENTS AN ADD OF   #
#     OUR BASE+SUBS.                                                   #
  
      FOR I = BSCHN[INX] WHILE (I NQ INX) 
          AND ((OPCD[I] NQ QICFOP"BPSB") OR ISUED[I]) DO
          I = BSCHN[I]; 
  
#     EITHER WE FOUND AN UNISSUED BPSB OR WE TRANSVERSED THE ENTIRE    #
#     CHAIN.                                                           #
  
      IF I NQ INX 
      THEN
          BEGIN 
          MPRED(I,INX);      #MAKE BPSB A PREDECESSOR OF CURRENT INSTR #
  
#     REMOVE CURRENT INSTRUCTION FROM READY SET AND CONTINUE SCAN      #
  
          FOL[INXA] = FOL[INX]; 
          INX = INXA; 
          GOTO CSCAN; 
          END 
  
#     IF THE SUBSCRIPT IS NOT LOADED - LOAD IT                         #
  
      IF (BREGS LE 0) AND (XREGS LE 0)
      THEN
          ISL00(ASUB,STREE);
  
#     IF THE POINTER (BASE,OFFS) IS NOT LOADED - LOAD IT               #
  
      IF (XREGK LE 0) AND (BREGK LE 0)
      THEN
          BEGIN              #POINTER NOT LOADED# 
  
#     NOW WE SEARCH TO SEE IF THERE IS A READY-BUT-NOT-ISSUED LODP IN  #
#     THE READY SET.  IF THERE IS, WE WANT TO WAIT UNTIL IT IS ISSUED  #
#     SO WE WILL FIND IT IN ONE OF THE REGISTER MEMORIES.              #
  
      FOR I = BCHN[INX] WHILE (I NQ INX)
          AND (OPCD[I] NQ QICFOP"LODP") DO
          I=BCHN[I];
  
#     NOW,EITHER WE FOUND A LODP OR WE SEARCHED THE ENTIRE CHAIN AND   #
#     CAME UP EMPTY-HANDED.                                            #
  
      IF I NQ INX 
      THEN
          BEGIN 
          MPRED(I,INX);      #MAKE LODP A PREDECESSOR OF CURRENT INSTR #
  
#     REMOVE CURRENT INSTRUCTION FROM READY SET AND CONTINUE SCAN      #
  
          FOL[INXA] = FOL[INX]; 
          INX = INXA; 
          GOTO CSCAN; 
          END 
      ELSE
          BEGIN              #BASE NOT LOADED AND NOT IN R.S.- LOAD IT #
      IF LODPINP
      THEN
          GOTO CSCAN;        #WAIT FOR BRAI-GENERATED LODP# 
          INN00;             #GET INSOPA - INSOPE # 
          IINSK(QICFOP"LODP",ABAS,SCOMP);        #PUT LODP IN ICFT# 
          AT[INSOPA] = LOCACS[ACTYP]; 
  
#     REFCT OF THE ABOVE LODP = NUMBER OF TIMES WE MIGHT MAKE USE OF IT#
#                             = NUMBER OF ENTRIES ON THE BASE-ONLY     #
#                               CHAIN OF THE CURRENT INSTRUCTION       #
  
          I = BCHN[INX];
          FOR J=1 STEP 1 WHILE I NQ INX DO
              I= BCHN[I]; 
          REFCT[INSOPA] = J;
          PFFVH[INSOPA] = 1; #GIVE LODP A HIGH PRIORITY#
  
#     LINK LODP INTO THE BASE ONLY CHAIN                               #
  
          BCHN[INSOPA] = BCHN[INX]; 
          BCHN[INX] = INSOPA; 
  
#     MAKE LODP A PREDECESSOR OF CURRENT INSTRUCTION SO IT WILL GET    #
#     BACK IN THE READY SET AFTER LODP IS ISSUED.                      #
  
          MPRED(INSOPA,INX);
  
#     MAKE SURE LODP IS THE NEXT THING SCANNED                         #
  
URSIA:  
          FOL[INXA] = INSOPA; 
          FOL[INSOPA] = FOL[INX]; 
          INX = INSOPA; 
          GOTO RESCAN;
          END 
          END 
  
#     NOW THE POINTER (BASE,OFFS) OFFSET BY SOME CONSTANT,K, IS IN     #
#     A REG REGB (X,B,A) AND THE SUBSCRIPT IS IN A REGISTER REGS (X,B).#
#     THE PROBLEM IS TO PICK THE BEST WAY TO ADD REGS AND REGB AND     #
#     LOAD/REPL/LOC THIS OFFSET BY K                                   #
  
      INN00;                 #GET INSOPA-INSOPE#
  
#     IF THERE ARN"T ANY B-REGS TO BE HAD, WE CAN"T EVEN ATTEMPT TO    #
#     BE CLEVER- WE ARE FORCED TO ADD INTO AN X-REG AND HOPE THAT      #
#     HAVING BASE+SUBS THERE ISN"T TOO AWFUL.                          #
  
          IF BRJ + BRK GQ 7 
          THEN
              BEGIN          #NO B-REGS AVAILABLE#
              IF BREGK GT 0 
              THEN
                  BEGIN      #BASE IN BK# 
                  IINSK(QICFOP"BPSB",BI-RGMEM[BREGK],ASUBI);
                  KDES[INSOPA] = BREGK; 
                  SXREG[INSOPA] = TRUE; 
                  IF BREGS NQ 0 
                  THEN
                      BEGIN  #SUBS IN BS# 
                      JDES[INSOPA] = BREGS; 
                      MOP[INSOPA] = SXI76;       #SXI  BS+BK# 
                      END 
                  ELSE
                      BEGIN  #SUBS IN XS# 
                      JDES[INSOPA] = XREGS; 
                      MOP[INSOPA] = SXI73;       #SXI  XS+BK# 
                      END 
                  END 
              ELSE
                  BEGIN 
                  IF XREGK GT 0 
                  THEN
                      BEGIN  #BASE IN XK# 
                      IINSK(QICFOP"BPSB",BI-RGMEM[XREGK],ASUBI);
                      JDES[INSOPA] = XREGK; 
                      JEQB[INSOPA] = TRUE;       #BASE IN J#
                      SXREG[INSOPA] = TRUE; 
                      IF BREGS GT 0 
                      THEN
                          BEGIN    #SUBS IN BS# 
                          KDES[INSOPA] = BREGS; 
                          MOP[INSOPA] = SXI73;   #SXI  XK+BS# 
                          END 
                      ELSE
                          BEGIN    #SUBS IN XS# 
                          KDES[INSOPA] = XREGS; 
                          MOP[INSOPA] = QICFOP"IADD";      #IXI  XK+XS# 
                          END 
                      END 
                  ELSE
                      BEGIN  #BASE IN AK# 
                      IF BREGS GT 0 
                      THEN
                          BEGIN    #SUBS IN BS# 
                          IINSK(QICFOP"BPSB",0,0);
                          JDES[INSOPA] = AREGK; 
                          JEQB[INSOPA] = TRUE;   #BASE IN J#
                          KDES[INSOPA] = BREGS; 
                          SXREG[INSOPA] = TRUE; 
                          MOP[INSOPA] = SXI74;   #SXI  AK+BJ# 
                          END 
                      ELSE
                          BEGIN    #SUBS IN XS# 
  
#     SINCE THERE IS NO WAY TO ADD AN X-REG AND AN A-REG INTO AN X-REG #
#     ON THIS MACHINE, WE MUST XMIT THE BASE TO AN X-REG.              #
  
                          IINSK(QICFOP"TMWR",0,0);
                          MPRED(INSOPA,INX);
                          GOTO URSIA; 
                          END 
                      END 
                  END 
              END 
          ELSE
              BEGIN          #B-REG AVAILABLE FOR BPSB# 
  
          IF BREGK GT 0 
          THEN
              BEGIN          # (BASE,OFFS)+K IN BK# 
              IINSK(QICFOP"BPSB",BI-RGMEM[BREGK],ASUBI);
              KDES[INSOPA] = BREGK; 
              BRK = BRK + 1; #BUMP COUNT OF B-REGS HELD FOR BPSB S# 
              IF BREGS NQ 0 
              THEN
                  BEGIN      #SBI BK+BS#
                  JDES[INSOPA] = BREGS; 
                  MOP[INSOPA] = SBI66;
                  END 
              ELSE
                  BEGIN      #SBI BK+XJ#
                  JDES[INSOPA] = XREGS; 
                  MOP[INSOPA] = SBI63;
                  END 
              END 
          ELSE
              BEGIN          # (BASE,OFFS)+K NOT IN BK# 
              IF BREGS GT 0 
              THEN
                  BEGIN      # SUBS IN BS#
                  BRK = BRK + 1;   #NUM B-REGS HELD FOR BPSB S# 
                  IF XREGK NQ 0 
                  THEN
                      BEGIN  #SBI XK+BS#
                      IINSK(QICFOP"BPSB",BI-RGMEM[XREGK],ASUBI);
                      KDES[INSOPA] = BREGS; 
                      JEQB[INSOPA] = TRUE;       #BASE IN J#
                      JDES[INSOPA] = XREGK; 
                      MOP[INSOPA] = SBI63;
                      END 
                  ELSE
                      BEGIN  #SBI AK+BS#
                      JEQB[INSOPA] = TRUE;       #BASE IN J#
                      JDES[INSOPA] = AREGK; 
                      MOP[INSOPA] = SBI64;
                      END 
                  END 
              ELSE
                  BEGIN 
  
#     NEITHER (BASE,OFFS)+K NOR SUBS IS IN A B-REG.  THIS MEANS THAT   #
#     SUBS IS IN AN X-REG AND (BASE,OFFS)+K IS IN EITHER AN A REG OR   #
#     AN X-REG.  IF (BASE,OFFS)+K IS IN AN X-REG WE CAN ADD IT TO SUBS #
#     WITH AN "IX" INSTRUCTION,OTHERWISE WE TRANSMIT THE A REG TO AN   #
#     X-REG.                                                           #
  
                  IF XREGK NQ 0 
                  THEN
                      BEGIN  # IXI XK+XJ# 
                      IINSK(QICFOP"BPSB",BI-RGMEM[XREGK],ASUBI);
                      KDES[INSOPA] = XREGK; 
                      JDES[INSOPA] = XREGS; 
                      MOP[INSOPA] = QCFOP"IADD";
                      SXREG[INSOPA] = TRUE; 
                      END 
                  ELSE
                      BEGIN 
  
#     WE TRANSMIT (BASE,OFFS)+K WHICH IS IN AN A-REG TO AN X-REG, MAKE #
#     THIS TRANSMIT A PREDECESSOR OF THE CURRENT INSTRUCTION AND EXIT  #
#     TO CSCAN.  NEXT TIME WE PROCESS THE CURRENT INSTRUCTION WE       #
#     WILL FIND (BASE,OFFS)+K IN AN X-REG.                             #
  
                      INSOPA = ICFTJ; 
                      IINSK(QICFOP"TMWR",0,0);
                      MPRED(INSOPA,INX);
                      GOTO CSCAN; 
                      END 
                  END 
              END 
          END 
  
#     SAVE POINTER TO CURRENT INSTR IN CNO OF BPSB SO WE CAN ENCODE THE#
#     ADDRESS THAT THE BPSB REPRESENTS AT ISSUE TIME                   #
  
      CNO[INSOPA] = INX;
  
#     LINK THE BPSB INTO THE BASE+SUBS CHAIN.                          #
  
          BSCHN[INSOPA] = BSCHN[INX]; 
          BSCHN[INX] = INSOPA;
  
#     MAKE THE BPSB A PREDECESSOR OF THE CURRENT INSTRUCTION AND TAKE  #
#     THE CURRENT INSTRUCTION OUT OF THE READY SET.                    #
  
          MPRED(INSOPA,INX);
          GOTO URSIA;        #INSURE BPSB IS THE NEXT THING SCANNED    #
CONTROL EJECT;
#**********************************************************************#
#        PARAMETER ARRAY WITH CONSTANT OFFSET                          #
PAC00:  
$BEGIN
DB("( 9X17H PAC00      IJK  O2,2X,O2,2X,O2)",REGI,REGJ,REGK,"."); 
$END
  
#     WE TAKE CARE OF LCM LOADS AND REPLS ELSEWHERE                    #
  
         IF  CORERD [AT[INX]]  EQ  S"LCM"                                LARRY-R
         AND OPCD [INX]  NQ  QICFOP"LOC"     THEN                        LARRY-R
           GOTO  XFRMLCM ;                                               LARRY-R
  
#     WE SEARCH THE B-REG ADDRESS MEMORY FOR THE ENTIRE ADDRESS-       #
#     (BASE,OFFS).  IF WE FIND IT WE CAN GENERATE SNI BJ+B0 WHERE      #
#     N=A IF WE ARE PROCESSING A LOAD OR REPL                          #
#     N=X IF WE ARE PROCESSING A LOC                                   #
#     N=B IF WE ARE PROCESSING A BRAI.                                 #
  
      SBC00(ABSO,BREGJ,BJOFS);
      IF BREGJ GT 0 AND BJOFS EQ 0
      THEN
          BEGIN              #FOUND ADDRESS IN BJ#
          REGJ = BREGJ; 
          REGK = BREG0; 
          MOP[INX] = SAI56 + SAILC; 
          IF BREGJ EQ BREG7 
          THEN
              FORCE = TRUE;  #HAVE TO KEEP B7 FREE# 
          GOTO PAG00; 
          END 
  
#     NOW WE TRY SEARCHING THE X-REG ADDRESS MEMORY FOR THE ENTIRE     #
#     ADDRESS.  IF WE FIND IT WE CAN GENERATE SNI XJ+B0                #
  
      SXAC(ABSO,XREGJ,XJOFS); 
      IF XREGJ GT 0 AND XJOFS EQ 0
      THEN
          BEGIN              #FOUND ADDRESS IN XJ#
          REGJ = XREGJ; 
          REGK = BREG0; 
          MOP[INX] = SAI53 + SAILC; 
          GOTO PAG00; 
          END 
  
#     NEVER BEING PRONE TO GIVING UP EASILY, WE SEARCH THE A-REG MEMORY#
#     IF WE FIND IT WE CAN GENERATE SNI AJ+B0                          #
  
      SAC00(ABSO,AREGJ,AJOFS);
      IF AREGJ GT 0 AND AJOFS EQ 0
      THEN
          BEGIN              #FOUND ADDRESS IN AJ#
          REGJ = AREGJ; 
          REGK = BREG0; 
          MOP[INX] = SAI54 + SAILC; 
          FORCE = TRUE;      #CAN"T COUNT ON AJ  INDEFINATELY#
          GOTO PAG00; 
          END 
  
#     IF WE FOUND THE ADDRESS BUT AN OFFSET, K, WAS REQUIRED, WE TRY   #
#     TO GENERATE A 15-BIT INSTR IF POSSIBLE ELSE WE GENERATE SNI MJ+K #
  
  
      IF BREGJ GT 0 
      THEN
          BEGIN              #ADDRESS IN A B-REG - OFFSET BY K# 
  
#     IF WE CAN FIND K IN EITHER A B-REG OR AN X-REG WE CAN STILL      #
#     GENERATE A 15-BIT INSTRUCTION.                                   #
  
          SBK00(BJOFS,BREGK);      #SEARCH B-REGS FOR K#
          IF BREGK GT 0 
          THEN
              BEGIN          #FOUND K IN BK#
              REGJ = BREGJ; 
              REGK = BREGK; 
              MOP[INX] = SAI56 + SAILC;          #SNI  BJ+BK# 
              END 
          ELSE
              BEGIN 
              SXK00(BJOFS,XREGJ);  #SEARCH X-REGS FOR K#
              IF XREGJ GT 0 
              THEN
                  BEGIN      #FOUND K IN XJ#
                  REGJ = XREGJ; 
                  REGK = BREGJ; 
                  MOP[INX] = SAI53 + SAILC;      #SNI XJ+BK#
                  END 
              ELSE
                  BEGIN      #K NOT IN ANY X OR B-REG#
                  SBK00(-BJOFS,BREGK);           #SEARCH B-REGS FOR -K #
                  IF BREGK GT 0 
                  THEN
                      BEGIN  #FOUND -K IN BK# 
                      REGJ = BREGJ; 
                      REGK = BREGK; 
                      MOP[INX] = SAI57 + SAILC;  #SNI  BJ-BK# 
                      END 
                  ELSE
                      BEGIN  #K NOWHERE USEFUL# 
                      REGJ = BREGJ; 
                      REGK = SUDOR; 
                      KACON = BJOFS;
                      MOP[INX] = SAI51 + SAILC;  #SNI  BJ+K#
                      INSIZ = 2; #2 PARCEL INSTRUCTION# 
                      END 
                  END 
              END 
          IF BREGJ EQ BREG7 
          THEN
              FORCE = TRUE; 
          GOTO PAG00; 
          END 
  
      IF XREGJ GT 0 
      THEN
          BEGIN              #ADDRESS IN AN X-REG- OFFSET BY K# 
          REGJ = XREGJ; 
  
#     IF WE CAN FIND K IN A B-REG WE CAN GENERATE A 15-BIT INSTRUCTION #
  
          SBK00(XJOFS,BREGK);      #SEARCH B-REGS FOR K#
          IF BREGK GT 0 
          THEN
              BEGIN          #FOUND K IN BK#
              REGK = BREGK; 
              MOP[INX] = SAI53 + SAILC;          #SNI  XJ+BK# 
              END 
          ELSE
              BEGIN          #K NOT IN ANY B-REG# 
              REGK = SUDOR; 
              KACON = XJOFS;
              MOP[INX] = SAI52 + SAILC;          #SNI  XJ+K#
              INSIZ = 2;     #2 PARCEL INSTRUCTION# 
              END 
          GOTO PAG00; 
          END 
  
      IF AREGJ GT 0 
      THEN
          BEGIN              #ADDRESS IN AN A-REG- OFFSET BY K# 
          REGJ = AREGJ; 
  
#     IF WE CAN FIND K IN A B-REG WE CAN GENERATE A 15-BIT INSTRUCTION #
  
          SBK00(AJOFS,BREGK);          #SEARCH B-REGS FOR K#
          IF BREGK GT 0 
          THEN
              BEGIN          #FOUND K IN BK#
              REGK = BREGK; 
              MOP[INX] = SAI54 + SAILC;          #SNI  AJ+BK# 
              END 
          ELSE
              BEGIN          #K NOT IN A B-REG# 
              SBK00(-AJOFS,BREGK);     #SEARCH B-REGS FOR -K# 
              IF BREGK GT 0 
              THEN
                  BEGIN      #FOUND -K IN BK# 
                  REGK = BREGK; 
                  MOP[INX] = SAI55 + SAILC;      #SNI  AJ-BK# 
                  END 
              ELSE
                  BEGIN      #K NOWHERE USEFUL# 
                  REGK = SUDOR; 
                  KACON = AJOFS;
                  MOP[INX] = SAI50 + SAILC;      #SNI  AJ+K#
                  INSIZ = 2; #2 PARCEL INSTRUCTION# 
                  END 
              END 
  
          FORCE = TRUE; 
          GOTO PAG00; 
          END 
  
#     NOW WE SEARCH TO SEE IF THERE IS A READY-BUT-NOT-ISSUED LODP IN  #
#     THE READY SET.  IF THERE IS, WE WANT TO WAIT UNTIL IT IS ISSUED  #
#     SO WE WILL FIND IT IN ONE OF THE REGISTER MEMORIES.              #
  
      FOR I = BCHN[INX] WHILE (I NQ INX)
          AND (OPCD[I] NQ QICFOP"LODP") DO
          I=BCHN[I];
  
#     NOW,EITHER WE FOUND A LODP OR WE SEARCHED THE ENTIRE CHAIN AND   #
#     CAME UP EMPTY-HANDED.                                            #
  
      IF I NQ INX 
      THEN
          BEGIN 
          MPRED(I,INX);      #MAKE LODP A PREDECESSOR OF CURRENT INSTR #
  
#     REMOVE CURRENT INSTRUCTION FROM READY SET AND CONTINUE SCAN      #
  
          FOL[INXA] = FOL[INX]; 
          INX = INXA; 
          GOTO CSCAN; 
          END 
  
#     THE ADDRESS (POINTER) IS NOT LOADED - LOAD IT                    #
  
      IF LODPINP
      THEN
          GOTO CSCAN;        #WAIT FOR BRAI GENERATED LODP# 
      IF OPCODE EQ QICFOP"BRAI" 
          AND ACTYP NQ QAT"SSSCM" 
      THEN
          LODPINP = TRUE; 
      INN00;                 #GET INSOPA-INSOPE#
      IINSK(QICFOP"LODP",ABAS,STREE); 
      AT[INSOPA] = LOCACS[ACTYP]; 
  
#     REFCT OF LODP = NUMBER OF TIMES WE MIGHT MAKE USE OF IT (= NUMBER#
#     OF ENTRIES ON THE BASE ONLY CHAIN AT THE SAME LEVEL AS THE       #
#     CURRENT INSTRUCTION.                                             #
  
      I = BCHN[INX];
      FOR J = 1 WHILE I NQ INX DO 
          BEGIN 
          IF AT[I] EQ ACTYP 
          THEN
              J = J + 1;
          I = BCHN[I];
          END 
          REFCT[INSOPA] = J;
          PFFVH[INSOPA] = 1; #GIVE LODP A HIGH PRIORITY#
  
#     LINK LODP INTO THE BASE ONLY CHAIN                               #
  
          BCHN[INSOPA] = BCHN[INX]; 
          BCHN[INX] = INSOPA; 
  
#     MAKE LODP A PREDECESSOR OF CURRENT INSTRUCTION SO IT WILL GET    #
#     BACK IN THE READY SET AFTER LODP IS ISSUED.                      #
  
          MPRED(INSOPA,INX);
      GOTO URSIA; 
      CONTROL EJECT;
#**********************************************************************#
#        CHECK FOR SCALAR LOAD REPL   SET UP TSYM                      #
    PROC SLR00    ; 
         BEGIN    #      SLR00                                         #
         IF (AT[INX]  LQ  QAT"LCM"                                       LARRY-R
         OR  AT[INX]  EQ  QAT"SSCM"  )                                   LARRY-R
         AND OPN1[INX]  GT  0      THEN                                  LARRY-R
                  BEGIN 
                  TSYM [INX] =  OPN1 [INX] ;
                  END 
SLRXIT: 
         IF  AT[INX]  EQ  QAT"SSSCM"   AND                               LARRY-R
         OPN1 [INX] GT 0 AND CKLOAD [CLAS [OPN1 [INX]]]  THEN 
                   BREGV = BREG [OPN1 [INX]] ;
         END      #      SLR00                                         #
CONTROL EJECT;
#        LOAD REGISTER NEEDED                                          #
UNL00:  
         UNTYP [0] =  QNOS"LOAD" ;
         GOTO  UNI00 ;
#        WORK REGISTER NEEDED                                          #
UNW00:  
         UNTYP [0] =  QNOS"WORK" ;
         GOTO UNI00 ; 
#        STORE REGISTER NEEDED                                         #
UNS00:  
         UNTYP [0] =  QNOS"STOR"  ; 
         GOTO  UNI00 ;
#        B REGISTER NEEDED                                             #
UNB00:  
         UNTYP [0] =  QNOS"BREG"  ; 
         GOTO  UNI00 ;
#        UNSCHEDULABLE INSTRUCTION                                     #
#**********************************************************************#
UNI00:  
$BEGIN
DB("( 9X17H UNI00      IJK  O2,2X,O2,2X,O2)",REGI,REGJ,REGK,"."); 
$END
    # UNSTP IS A PRIORITY BASED ON NUMBER OF SUCCESSORS WITH 1 PREDESSOR
        - THIS CAUSES US TO WALK DOWN ONE BRANCH OD THE TREE WHEN IN JAM MODE 
          MODE     #
  
       T1 = O"440000";
       IF PROTECT NQ CNO[INX] THEN
       BEGIN
       T1 = O"10000"; 
       SUSP = STI[INX]; 
  
       IF SUSP NQ 0 
       AND OPCD[INX] NQ QICFOP"REPL" THEN 
         BEGIN
         T1 = 1;
NEXTSUSP: 
         NEWR = ISUC[SUSP]; 
         IF NPRED[NEWR] LQ 1 THEN 
           T1 = T1 + 4; 
         SUSP = LSUC[SUSP]; 
         IF SUSP NQ 0 THEN GOTO NEXTSUSP; 
         END
  
       END
       ELSE 
         PROTECT = -1;
          # T1 IS PRIORITY  # 
       IF T1 GR UNSTP[0]
       OR NUNOP EQ 0 THEN 
         BEGIN
         UNSTP[0] = T1; 
         UNSTY[0] = UNTYP[0]; 
         UNSRJ[0] = REGJ; 
         UNSRK[0] = REGK; 
         UNSTI[0] = INX;
         END
         NUNOP =  NUNOP + 1 ; 
#                                                                      #
UNIXIT: 
         GOTO  CSCAN ;              #  CONTINUE THE SCAN               #
CG2XIT:                                                                  LARRY-R
      RETURN;                                                            LARRY-R
    END    # SELECTOR #                                                  LARRY-R
TERM                                                                     LARRY-R
