*DECK     REG 
          IDENT  REG
 REG      SECT   ((QCG)    RESOURCE ALLOCATION.)
 REG      SPACE  4
*         IN FTN
          EXT    COD,CO.DBTB,CO.SNAP
  
*         IN FUN
          EXT    ESC
  
*         IN GEN
          EXT    EIS.PNX,RUT.REG,IJK,INS.REG
  
*         IN IDP
          EXT    IDP=SVA,IDP=SVB,IDP=SVX,REG=,RSR=,SNP=,SVB,SVR=
  
*         IN QCGC 
          EXT    DRITE,NOLDS,RGC,RGX,RREG,TYPLOD,UUC,WIN
  
*         IN PUC
          EXT    N.ST,N.TABLE,S=ST,T=SYM,T.BLKS,T.OUS,T.PAR,T.SYM,WOF 
  
*         IN QSKEL
          EXT    V=STR.I
  
          LIST   -X 
                             COMAQCG IS LISTED IN QCGC
*CALL     COMAQCG            QCG MACRO DEFINITIONS
                             COMSQCG IS LISTED IN QCGC
*CALL     COMSQCG            QCG STRUCTURE DECLARATIONS 
                             COMSQRF IS LISTED IN QCGC
*CALL     COMSQRF            QCG REGISTER ASSOCIATES
                             DEFINS IS LISTED IN QSKEL
*CALL     DEFINS             DEFINE MACHINE OPCODES 
  
          ENTRY  P2=KEEP
 P2=KEEP  BFLIT  P2,(TAG,BIAS,2ATR) 
 DEFREG   SPACE  4,10 
**        DEFREG - CONSTRUCT REGISTER TYPE SCAN WORDS.
* 
*         FOR EACH REG TYPE THERE ARE THREE WORDS --
*         1.  OPCODE AND NUMBER OF REGS IN CLASS (RS. FORMAT).
*         2.  60/N BITS FOR EACH REGISTER IN CLASS. 
*         3.  COPY OF WORD 2 (FOR INITIALIZATION).
* 
**T TYPE  6/ INST,  18/ MASK WIDTH,  18/ NUMBER,  18/ 0T0 
*   SCAN  W/ R.R1,  W/ R.R2, ..., W/ R.RN 
*   COPY  W/ R.R1,  W/ R.R2, ..., W/ R.RN 
*         REGISTERS ARE SCANNED AND ASSIGNED FROM RIGHT TO LEFT.
  
  
          MACRO  DEFREG,TYPE,INST,REGS,CLAS 
 B        SET 
*                            COUNT MEMBERS IN CLASS 
.1        IRP    REGS 
 B        SET    B+1
.1        IRP    REGS 
 D        SET    60/B 
*                            GENERATE FIELD FOR EACH MEMBER 
 A        MICRO 
.2        IRP    REGS 
 A        MICRO  1,, "A"D/R.REGS, 
.2        IRP    REGS 
* 
          ENTRY  TYPE 
 TYPE     VFD    RS.INSL/INST/1S9,RS.MSKL/D,RS.NUML/B,RS.TYPL/CLAS
          VFD    "A"
          VFD    "A"
 DEFREG   ENDM
  
  
 RG=BADR  DEFREG SB=BK,(B1,B2,B3,B4,B5),REG.B 
 RG=INTR  DEFREG SX=XK,(X0,X6,X7),REG.X 
 RG=TEMP  DEFREG SX=XK,(X0,X1,X2,X3,X4,X5),REG.X
 RG=LOAD  DEFREG SA=BK,(X1,X2,X3,X4,X5),REG.A 
 RG=LODX  DEFREG SX=BK,(X1,X2,X3,X4,X5),REG.X 
 RG=SET   DEFREG SX=XK,(X0,X1,X2,X3,X4,X5),REG.X
 RG=STOR  DEFREG SX=BK,(X7,X6),REG.X
  
          PURGMAC DEFREG
 AIR      SPACE  4,12 
**        AIR -  ASSIGN *INTERMEDIATE* REGISTER.
* 
*         ENTRY  N/A
* 
*         EXIT   IF FREE REGISTER FOUND.
*                (B2) = REGISTER - 0TR, ASSIGNED
* 
*                IF NO FREE REGISTER FOUND. 
*                (B2) = - (0TR) FOR NEXT AVAILABLE LOAD REGISTER TO USE 
*                (B5) = USE COUNT ON REGISTER.
* 
*         CALLS  DRITE,SFR
  
  
 AIR      SUBR   =           ENTRY/EXIT...
          SB3    RG=INTR
          RJ     SFR         SCAN FOR REGISTER
          ZR     X7,EXIT.    IF USE COUNT *0* 
  
**        HERE IF *INTERMEDIATE* REGISTERS NOT FREE.
  
          DRITE  DEACTIVATE 
          ZR     X2,AIR1     IF REGISTER NOT RELEASED 
          ZR     X7,EXIT.    IF LAST USE OF REGISTER
  
 AIR1     SB3    RG=LOAD
          RJ     SFR
          ZR     X7,EXIT.    IF REGISTER FREE 
          SB2    -B2
          MX0    -RG.USEL 
          SA1    RGX
          ZR     X1,EXIT.    IF NON-INTERMEDIATE NOT AVAILABLE
          SA2    X1+REGFILE 
          SB2    X1 
          BX7    -X0*X2 
          EQ     EXIT.
 ASR      SPACE  4,8
**        ASR -  FIND AVAILABLE STORE REGISTER. 
* 
*         ENTRY  N/A
* 
*         EXIT   (B2) = 0TR.
*                (X6) = 0R0.
* 
*         CALLS  DRITE,SFR,RUT,GNT,CLI
* 
*         USES   A2,A5,A6  X0,X7  B7
  
  
 ASR      SUBR   =           ENTRY/EXIT...
          SB3    RG=STOR
          RJ     SFR         SCAN FOR REGISTER
          ZR     X7,EXIT.    IF FREE REGISTER (USE COUNT = 0) 
          DRITE  DEACTIVATE 
          ZR     X2,ASR1     IF REGISTER NOT FREED
          ZR     X7,EXIT.    IF LAST USE OF REGISTER
 ASR1     SA1    B2+REGFILE 
          BX0    X1 
          SBIT   X0,P2.INTRP
          PL     X0,ASR2     IF NOT INTERMEDIATE
          SBIT   X0,P2.ARRP/P2.INTRP
          MI     X0,ASR2     IF ARRAY-LOAD
          SA2    RGX
          ZR     X2,ASR5     IF NON-INTERMEDIATE NOT AVAILABLE
          SB2    X2 
 ASR2     RJ     RUT
          EQ     EXIT.
  
 ASR5     RJ     GNT         GET NEXT TEMPORARY 
          SX2    B2 
          =X7    0
          MX0    -3 
          BX1    X6 
          BX6    X5          SAVE X5
          SA5    B2+REGFILE  TAG BEING STORED 
          SA7    A5          ZERO REGFILE ENTRY 
          SA6    ASRA 
          BX6    -X0*X2 
          LX6    3
          RJ     CLI         COMPILE LOAD (IN THIS CASE. A STORE) INS.
          SA5    ASRA        RESTORE X5 
          EQ     EXIT.
  
 ASRA     BSS    1           SAVE X5 CELL 
 AUT      SPACE  4,10 
**        AUT -  ADJUST USE TOTAL 
* 
*         NON-INTETMEDIATES:  DECRIMENTS USE FIELD OF OPERAND WORD
*                BY THE VALUE OR UC (USE COUNT INCRIMENT).
* 
*         INTERMEDIATES:  DECRINENTS THE USE TOTAL IN THE OPERATOR
*                WORD AND PLACES THIS VALUE IN THE USE FIELS OF THE 
*                OPERAND. 
* 
*         ENTRY  (A1) _ STATUS WORD 
*                (X1) = STATUS WORD 
*                (X2) = (UUC) 
*                (X5) = OPERAND 
*                (B3) = TYPE (UPPER OR LOWER) 
* 
*         EXIT   (A1,X1) - PRESERVED
*                (X5) = OPERAND WITH UPDATED USE COUNT FIELD
*                (B3) - PRESERVED 
* 
*                USES        A2,A5,A7  X0,X2,X7  B7 
* 
*         WARNING - TABLE MANAGER CALLS REQUIRE PROTECTION
*         OF THE POINTER IN (A1). 
  
  
 AUT      SUBR               ENTRY/EXIT.
          LX7    X5 
          BX0    X2 
          SBIT   X7,P2.INTRP
          PL     X7,EXIT.    IF NOT INTERMEDIATE
          SA2    T.PAR       GET FWA I. L.
          LX7    1+P2.INTRP-P2.BIASP   POSITION I. L. ORDINAL 
          SA5    B3+STATUS   GET SHIFT COUNT
          SB7    X2          ADD ORDINAL TO FWA 
          AX5    36          POSITION SHIFT COUNT 
          SA2    B7+X7       GET USE TOTAL (OPERATOR WORD)
          ERRMI  P2.BIASL-18
          LX7    P2.BIASP    RESET OPERAND
          SB7    X5          (B7) = OP.UTOTP OR OP.LTOTP
          MX1    -OP.UTOTL   SET USE TOTAL MASK 
          BX5    X1*X7       CLEAR USE FIELD OF OPERAND 
          ERRNZ  OP.UTOTL-RG.USEL 
          LX0    B7,X0
          IX7    X2-X0       SUBTRACT USE COUNT INCRIMENT 
          AX2    B7,X2       POSITION USE COUNT FOR OPERAND 
          BX2    -X1*X2      EXTRACT USE COUNT
          SA7    A2          RESET USE TOTAL
          IX5    X5+X2       ADD USE TOTAL INTO OPERAND 
          ERRNZ  OP.UTOTL-RG.USEL 
          SA1    A1          RESET STATUS WORD
          EQ     EXIT.
 CDS      SPACE  4,15 
**        CDS -  CHECK DELAYED STORE. 
* 
*         NOTE
*                *CDS* SHOULD ALWAYS BE CALLED VIA MACRO *DRITE*
* 
*         ENTRY  (X0) = 0 PROCESS DELAYED STORE IF SET
*                       "0 PROCESS ONLY IF = TO (DRITE) 
*                       THAT BEING PROCESSED. 
*                (X1) = TAG CURRENTLY BEING PROCESSED 
* 
*         EXIT   (X2) = 0 IF DELAYED STORE NOT PROCESSED. 
*                       (X1) PRESERVED. 
*                (X2) " 0 DELAYED STORE PROCESSED.
*                       (X1) DESTROYED. 
*                (B2) = REGISTER FOR *DRITE* RELEASED - 0TR.
*                (X6) = 0R0 OF REGISTER FREED.
* 
*         USES   A1,A2,A3  X0  B2,B7
*                (SCR2+4) 
*         CALLS  CIW
  
  
 CDS      SUBR   =           ENTRY/EXIT...
          SA2    DRITE
          ZR     X2,EXIT.    IF NO DELAYED STORE ACTIVE 
          SX7    B6 
          SA7    CDSA        SAVE *B6*
  
**        IF THE HARD REGISTER FLAG IS SET, WE TURN IT OFF TO PREVENT 
*         ITS BEING DESTROYED BY A STORE INTO AN *FP*, THEN RESTORE IT. 
  
          SA1    RREG 
          MI     X1,CDS15    IF NO HARD REGISTER
          BX7    -X1
          SA7    A1          TURN OFF FLAG
          RJ     CIW         COMPILE STORE
          SA1    RREG 
          BX7    -X1
          SA7    A1          RESTORE FLAG 
          EQ     CDS20
  
 CDS15    RJ     CIW         COMPILE STORE
  
 CDS20    SA1    DRITE
          BX7    0
          =X0    1
          SA3    CDSA 
          SA7    A1          CLEAR DELAYED STORE FLAG 
          SB6    X3 
          SA2    B2+REGFILE 
          MX3    -RG.USEL 
          BX1    X1-X2
          BX7    -X3*X2 
          NZ     X1,EXIT.    IF RGFILE TAG NOT SAME AS DRITE TAG
          IX7    X2-X0       USE COUNT-1
          SA7    A2 
          BX7    -X3*X7      USE COUNT ONLY 
          EQ     EXIT.
  
 CDSA     DATA   0           SAVE *B6*
 CIA      SPACE  4,10 
**        CIA -  CHECK IF ANY ACTIVE STORES / CLEAR ASSOCIATE.
* 
*         ENTRY  N/A
* 
*         EXIT   ASSOCIATES CLEARED, INTERMEDIATES STORED.
* 
*         USES   A1,A2,A3  X0  B2,B7
* 
*         CALLS  DRITE,RUT
  
 CIAA     BSSZ   1           LOCK CLEAR FLAG
  
 CIA      SUBR   =           ENTRY/EXIT...
          DRITE  DEACTIVATE 
          SB7    L.RGFILE-1 
          MX0    -RG.USEL 
          MX7    0
          SA7    RUT.REG     CLEAR IJK OF PREVIOUS INSTRUCTION
          EQ     CIA2 
  
 CIA1     MX7    0
          SA7    A2          ZERO OUT REGFILE ENTRY 
  
 CIA2     ZR     B7,EXIT.    IF FINISHED
          SA2    B7+REGFILE 
          SB2    B7 
          BX1    -X0*X2 
          LX2    59-8 
          =B7    B7-1 
          ZR     X1,CIA1     IF USE COUNT ZERO
          PL     X2,CIA3     IF REGISTER UN-LOCKED
          SA3    CIAA 
          ZR     X3,CIA2     IF REGISTER TO REMAIN LOCKED 
          MX0    1
          BX7    -X0*X2      REMOVE LOCK BIT
          LX7    9
          SA7    A2          RESTORE IN REGFILE 
  
 CIA3     RJ     RUT         RESET TAG
          MX0    -RG.USEL 
          =B7    B2-1 
          EQ     CIA2        CONTINUE 
  
 CIW      SPACE  4,12 
**        CIW -  COMPILE WRITE INSTRUCTIONS 
* 
*         ENTRY  (DRITE)  SET.
* 
*         EXIT   (B2) = REGISTER FOR WRITE - 0TR. 
*                (X6) = 0R0.
* 
*         USES   A1,A2,A3,A6,A7  X0  B2,B3,B7 
* 
*         CALLS  DRITE,WCODE,CLI
  
  
 CIW      SUBR               ENTRY/EXIT...
          SA2    DRITE
          MX0    -3 
          =A1    A2+1        TAG FOR INSTRUCTION + *I* REGISTER 
          MX7    -RG.USEL 
          BX0    -X0*X2      =00R (*A* REGISTER FOR LEFT MEMBER)
          BX6    -X7*X1      =0R0 (*I* REGISTER)
          IX7    X0+X6
          ZR     X0,CIW10    IF LEFT MEMBER NOT IN *A* REGISTER 
          SA3    X0+REGFILE+REG.A 
          SX7    X7+SA=AB/1S3 
          BX0    X2-X3
          LX7    PB.INSTP+3 
          BX3    X6 
          AX0    RG.USEL
          NZ     X0,CIW10    IF NOT SAME TAG
          WCODE  X7 
          BX6    X3 
          AX3    3
          SB2    X3+REG.X 
          EQ     EXIT.
  
 CIW10    BX2    X6 
          SA3    P2=KEEP
          AX2    3
          BX1    X3*X1
          BX7    X5 
          SA7    CIWA        SAVE X5
          BX5    X1 
          SB2    X2+REG.X 
          RJ     CLI
          SA5    CIWA        RESTORE X5 
          EQ     EXIT.
  
 CIWA     DATA   0
 CLI      SPACE  4
**        CLI - COMPILE LOAD INSTRUCTION. 
* 
*         ENTRY  (B2) = REGISTER TO USE - 0TR 
*                (X1) = OPERAND TO LOAD (C.SYM TAG).
*                (X5) = OPERAND TO LOAD (C.OUS TAG).
*                (X6) = REGISTER TO USE - 0R0.
* 
*         EXIT   (B2) = PRESERVED.
*                (X5) = PRESERVED.
* 
*         USES   A2,A3,A6,A7  X0  B2,B3,B5,B7 
* 
*         CALLS  GNR,WCODE,CLT,RLL,RUL,CLP
  
  
 CLI      SUBR   =           ...ENTRY/EXIT... 
          BX7    X5 
          SA7    CLI.X5 
          MX7    0
          SA7    STORE
          MX0    1
          LX0    1+P2.ADDRP 
          BX7    X0*X5
          SA7    ADDR 
          BX7    X1 
          SA7    CLI.X1      SAVE X1 (TAG)
          MX0    -PB.BIASL
          LX0    P2.BIASP 
          BX7    -X0*X1      BIAS 
  
**        CHECK FOR FORMAL PARAMETER. 
* 
*         (B3) = REGISTER TO USE - 00R. 
*         (B5) = 0TR. 
*         (X1) = TAG TO BE LOADED.
*         (X2) = MX2   -P2.FPNOL
*         (X3) = TAG *BIAS* 
*         (X6) = REGISTER TO USE - 0R0. 
  
          LX7    -P2.BIASP+PB.BIASP 
          SA7    CLI.X3      SAVE BIAS FIELD
          SX7    B2 
          SA7    CLIA 
  
**        GET LOAD REGISTER FOR INDIRECT STORE. 
  
          SA6    CLI.X6      SAVE X6 (0R0)
          SB7    B2-R.X6
          MI     B7,CLI1     IF NOT STORE 
          =X7    1
          SA7    STORE
  
 CLI1     BX2    X1 
          HX2    P2.LCM 
          MI     X2,CLI100   IF LCM REF 
          LX2    P2.LCMP-P2.FPP 
          BX7    X6 
          PL     X2,CLI15    IF NOT FP
          MI     B7,CLI5     IF NOT STORE 
          SB3    RG=LOAD
          RJ     GNR         GET LOAD REGISTER
          BX7    X6          (0R0) LOAD REGISTER
  
*         RESTORE REGISTERS 
  
          SA3    CLI.X6 
          BX6    X3          RESTORE X6 
          SA1    CLI.X1      RESTORE (X1) 
  
 CLI5     BX5    X1 
          AX7    3
          SB5    X7          00R FPREG
          SB5    X6+B5
          BX6    X7 
          LX6    6
          RJ     LPA         LOAD FP ADDRESS
          SA2    ADDR 
          SA3    CLI.X3 
          SX7    B5+SA=XK/1S3 
          ZR     X2,CLI10E   IF NOT ADDRESS 
          SB2    -SA=XK/1S3 
          ZR     X3,CLI10D   IF ZERO BIAS 
          SX7    X7-SA=XK/1S3+SX=XK/1S3 
          EQ     CLI11
  
 CLI10D   SB2    B2+XMT/1S3 
          SX7    X7+B2
          EQ     CLI11
  
 CLI10E   NZ     X3,CLI11    IF BIAS NE 0 
          SX7    B5+SA=XB/1S3 
  
 CLI11    LX7    PB.INSTP+3 
  
          IX7    X7+X3       ADD IN *BIAS*
          EQ     CLI20       COMPLETE LOAD
  
**        NOT FORMAL PARAMETER. 
  
 CLI15    MX0    P2.ORDL
          LX0    P2.ORDL+P2.ORDP
  
*         RESTORE REGISTERS 
  
          SA3    CLI.X3      RESTORE X3  (BIAS) 
          SA1    CLI.X1      RESTORE X1  (TAG)
  
          BX2    X0*X1       TAG
          MX0    P2.PFXL
          LX0    P2.PFXL+P2.PFXP
          BX0    X0*X1       EXTRACT TAG PREFIX 
          LX2    -P2.TAGP+PB.TAGP-PB.INSTP-3+60 
          LX0    -P2.PFXP+PB.TAGP+P=PFX-PB.INSTP-3+60      REPOSITION PF
          BX2    X2+X0
          SX7    X6+SA=BK/1S3 
          SA5    ADDR 
          ZR     X5,CLI18A   IF NOT ADDR REF
          SX7    X6+SX=BK/1S3 
  
 CLI18A   IX0    X7+X2
          LX0    PB.INSTP+3 
          BX7    X3+X0       ADD IN *BIAS*
  
 CLI20    WCODE  X7 
  
 CLI90    SA5    CLI.X5 
          MX0    -3 
          SA3    CLIA 
          SB2    X3 
          BX6    -X0*X3 
          LX6    3           =0R0 
          EQ     EXIT.
  
*         LCM REF.
  
 CLI100   MX7    0
          SA7    AFREG
          SX7    B2 
          SA7    ALREG
          BX5    X1 
          SX0    B2-R.X6
          MI     X0,CLI110   IF NOT STORE 
          MX0    -3 
          BX0    -X0*X7 
          SB7    X0 
          RJ     RLL         LOCK HARD STORE REG
  
 CLI110   RJ     LLA         LOAD LCM ADDRESS 
          RJ     LLV         LOAD LCM VALUE 
          EQ     CLI90
  
 CLIA     DATA   0
 CLI.X1   BSS    1
 CLI.X3   BSS    1
 CLI.X5   BSS    1
 CLI.X6   BSS    1
 CPL      SPACE  4,20 
**        CLP -  COMPILE LOAD OF POINTER WORD 
* 
*         ENTRY  (X5) = ECS/LCM NAME TAG
* 
*         EXIT   INSTRUCTION COMPILED TO LOAD POINTER WORD
* 
*         USES   A1,A2,A3,A6  X0,X7  B2,B3,B6,B7
  
  
 CLP      SUBR               ...ENTRY/EXIT... 
          RJ     GPT         GET POINTER TAG
          LX2    PB.TAGP-CB.TAGP     ALIGN POINTER TAG
          SX1    SA=BK
          IX7    X1+X6       ADD IN *I* REGISTER
          LX7    PB.INSTP     ALIGN 
          IX7    X7+X2       ADD IN TAG 
          WCODE  X7,EXIT.    COMPILE LOAD OF POINTER
          SPACE  4,8
**        CRJ -  COMPILE RETURN JUMP SEQUENCE 
* 
*         SHOULD ALWAYS BE CALLED BY MACRO *CRJ*. 
* 
*         COMPILES AN *RJ* TO A TAG, AND THE (OPTIONAL,DEPENDING ON 
*                (CO.TBK)) TRACE-BACK INFORMATION.
*         ALSO DEACTIVATES ANY DELAYED STORE, AND CLEARS ALL REGISTER 
*                ASSOCIATES.
*         ENTRY  (X1)<0 IF TRACEBACK IS MANDATORY.
*                   = 0 IF TRACEBACK IS PROHIBITED
*                   > 0 IF TRACEBACK IS PERMITTED 
*                (X3) = LINE/SEQUENCE NUMBER FOR TRACEBACK
*                X6 = 18/TAG,42/XXXX
*         USES   A2,A3,A6,A7
* 
*         CALLS  CIA, WCODE 
  
 CRJ      SUBR   =           ENTRY/EXIT...
          SA2    CO.DBTB     TRACEBACK FLAG 
          AX6    P2.TAGP       REMOVE LOW-ORDER GARBAGE 
          =X7    I.RJ3
          LX6    PB.TAGP-PB.GHIJP 
          ZR     X1,CRJ4     IF TRACE PROHIBITED
          MI     X1,CRJ2     IF TRACE MANDATORY 
          PL     X2,CRJ4     IF T-OPTION NOT SELECTED 
  
 CRJ2     SX7    I.RJ6
          LX3    PB.BIASP-PB.GHIJP
          BX6    X6+X3
  
 CRJ4     BX6    X6+X7
          LX6    PB.GHIJP 
          SA6    CRJA 
          SA7    CIAA        SET LOCK CLEAR FLAG
          RJ     CIA         CLEAR REGISTER ASSOCIATES
          MX6    0
          SA6    CIAA        CLEAR LOCK FLAG
          SA2    CRJA 
          BX7    X2 
          WCODE  X7          RJ WORD TO LONG  FILE
          EQ     EXIT.
  
 CRJA     BSS    1           TEMP CELL FOR INSTRUCTION
 CRT      EJECT  4,50 
**        CRT - CHECK REGISTER TYPE 
* 
*         ENTRY  B2 = REGISTER TYPE TAG IS IN (0TR) 
*                B3 = REGISTER TYPE WANTED (0TR)
*                *T* BIT VALUES 
*                    =000 *B* REGISTER
*                    =010 *A* REGISTER
*                    =020 *X* REGISTER
* 
*         EXIT   IF B7 = 0 IF TYPES MATCH 
*                X7 = INSTRUCTION TO TRANSFER TO SAME TYPE
* 
*                IF B7 = INSTRUCTION TO TRANSFER IF DIFFERENT TYPES 
*                X7 = B7
* 
*         THE FOLLOWING MATRIX IS USED TO DETERMINE INSTRUCTION 
* 
* 
*                     WANT REGISTER TYPE
* 
*                        X         A           B
* 
*                 +----------+----------+----------+
*                 +          +          +          +
*   I             +   SX=BB  +   SX=BB  +  -SB=BB  +
*   N             +          +          +          +
*                 +----------+----------+----------+
*   R             +          +          +          +
*   E             +   SA=AB  +  -SA=AB  +   SB=AB  +
*   G             +          +          +          +
*   I             +----------+----------+----------+
*   S             +          +          +          +
*   T             +  -XMIT   +  -XMIT   +   SB=XB  +
*   E             +          +          +          +
*   R             +----------+----------+----------+
* 
* 
*         USES   A2  X0,X1,X2,X7  B7
  
  
 CRT      SUBR               ENTRY/EXIT...
          SA3    B3 
          SX2    B2          REGISTER TYPE TAG IS IN
          SX3    X3          REGISTER TYPE WANTED 
          AX2    3           ORDINAL INTO TABLE 
          MX0    -16         INSTRUCTION MASK 
          AX3    3
          SA2    X2+CRTTAB   GET INSTRUCTION TABLE ENTRY
          LX3    4           16*TYPE WANTED 
          SB7    X3          SHIFT COUNT
          AX2    B7,X2       SHIFT TO APPROPRIATE INSTRUCTION 
          BX7    -X0*X2 
          LX7    60-16
          AX7    60-13       SIGN EXTEND
          SB7    X7          INSTRUCTION TO B7
          PL     X7,EXIT.    IF NOT TYPE MATCH - EXIT 
          =B7    0           FLAG TYPE MATCH
          BX7    -X7
          EQ     EXIT.
  
 CRTI     MACRO  A,B,C
          VFD    12/0,16/A,16/B,16/C
          ENDM
  
 CRTTAB   CRTI   SX=BB,SX=BB,-SB=BB 
          CRTI   SA=AB,-SA=AB,SB=XB    **** TEMP SB=XB **** 
          CRTI   -XMT,-XMT,SB=XB
  
          PURGMAC CRTI
 CWI      SPACE  4,10 
**        CWI -  COMPILE WRITE OF INTERMEDIATE. 
* 
*         CALLED TO STORE TO TEMP CELL AN INTERMEDIATE THAT IS BEING
*         CLOBBERED AND HAS AT LEAST ONE REMAINING USE. 
* 
*         ENTRY  (B2) = 0TR.TO PROCESS. 
*                (X5) = TAG TO PROCESS. 
* 
*         EXIT   (B2) = REGISTER USED. (0TR)
*                (X6) = TEMPORARY TAG  (TEMP-TAG, 2ATR).
* 
*                (SCR, SCR+1) 
* 
*         CALLS  GNT,ASR,WCODE,CLI
  
  
 CWI      SUBR   =           ENTRY/EXIT...
          MX6    0
          BX1    X5 
          SA6    B2+REGFILE  CLEAR REGISTER FILE FOR INTER. BEING STORED
          RJ     GNT
          MX0    -3 
          SX5    B2 
          BX5    -X0*X5      00R
          SB3    X5+REG.X    0XR
          SB7    B3-R.X6
          PL     B7,CWI20    IF IN STORE REGISTER 
          SA6    CWIA        REMEMBER TAG 
          BX7    X5 
          =A7    A6+1        SAVE REG 
          RJ     ASR
          SA3    CWIA+1      RETRIEVE REGISTER = 00L
          IX0    X3+X6       =RL
          SX7    X0+XMT/1S3 
          BX5    X6 
          LX7    PB.INSTP+3 
          WCODE  X7          COMPILE *XMIT* TO *R*
          SA1    CWIA        RETRIEVE TAG 
          AX5    3           =00L  (L-R  = R) 
          BX6    X1 
  
*         (X5) = REGISTER INTERMEDIATE IS IN = 00R
*         (X6) = TEMP-TAG, 2ATR 
*         (B6) _ INTERMEDIATE 
  
 CWI20    BX1    X6 
          BX6    X5 
          LX6    3
          SB5    X5+REG.X 
          BX5    X1 
          SX7    X6+SA=BK/1S3 
          MX0    -PB.BIASL
          LX0    P2.BIASP 
          BX3    -X0*X1      BIAS 
          LX3    PB.BIASP-P2.BIASP
          MX0    -P2.TAGL 
          LX0    P2.TAGP
          BX1    -X0*X1      TAG
          LX1    PB.TAGP-P2.TAGP
          LX7    PB.INSTP+3 
          BX0    X3+X7
          BX7    X0+X1
          WCODE  X7 
          SB2    B5 
          BX6    X5 
          EQ     EXIT.
  
 CWIA     BSS    2           SAVE TAG, REGISTER 
 DIT      SPACE  4,10 
**        DIT -  DEFINE INTERMEDIATE RESULTS. 
*         DIT IS CALLED WHEN AN INTERMEDIATE HAS JUST BEEN
*         CREATED.  SINCE AN OPERAND WORD FOR THE INTERMEDIATE
*         ONLY EXISTS AT SOME UNKNOWN PLACE FURTHER ON IN THE 
*         I. L.,  DIT IS CALLED TO CREATE AN INTERMEDIATE OPER- 
*         AND WORD TO STICK IN THE REGFILE. 
* 
*         ENTRY  (B2) = REGISTER FOR INTERMEDIATE.
*                (B3) = UP/LOW
*                (B4) = ADDRESS OF TURPLE FOR INTERMEDIATE. 
*                (X5) = ATTR AMD CLASS BITS FOR INTERMEDIATE. 
*                       IE. ARY, ADDR  ETC. 
* 
*         EXIT   (B2) = 0TR, FOR INTERMEDIATE.
*                (A1,X1) (_,=) STATUS WORD OF INTERMEDIATE
*                (X6) = 0R0, FOR INTERMEDIATE.
*                INTERMEDIATE TAG PUT IN REGISTER FILE. 
* 
*         USES   A1,A2,A3,A5,A6,A7  X0  B2,B3,B5,B6,B7
* 
*         CALLS  STS
  
 DIT      SUBR   =           ENTRY/EXIT...
          SA2    B3+STATUS   GET SHIFT COUNT WORD FOR STATUS ROUTINES 
          =A3    B4+OR.OPR   GET OPERATOR 
          AX2    36          POSITION USE TOTAL SHIFT COUNT 
          SB7    X2          (B7) = OP.UTOTP OR OP.LTOTP
          MX0    OP.2MODL    SET MODE MASK
          AX2    B7,X3       POSITION USE TOTAL 
          SA1    T.OUS
          MX6    -OP.UTOTL   GET USE TOTAL (UTOTL = LTOTL NOW)
          LX0    OP.2MODP+OP.2MODL
          SB7    X1          (B7) = FWA OUS 
          BX6    -X6*X2      EXTRACT USE TOTAL
          SA2    T.PAR       GET FWA I. L.
          BX0    X0*X3       EXTRACT MODE 
          LX0    -OP.2MODP
          SX1    X0-M.DBL 
          MX0    -1 
          BX1    X0*X1
          ZR     X1,DIT1     IF DOUBLE OR COMPLEX 
          MX0    60 
  
 DIT1     LX0    P2.LONGP 
          SB5    X2          (B5) = FWA I. L. 
          HX3    OP.2ORD     POSITION OUS ORD 
          AX3    -OP.2ORDL   ISOLATE OUS ORD
          SX2    B4-B5       (X2) = I. L. ORD OF INTERMEDIATE 
          SA1    B7+X3       GET STATUS WORD
          LX2    P2.BIASP-P2.TAGP  PLACE I. L. ORD IN BIAS FIELD
          IX3    X3+X2       ADD TAG TO BIAS
  
**        CONSTRUCT REGFILE ENTRY FOR INTERMIDIATE
*         (A1) _ STATUS WORD
*         (X0) = MODE IN P2.2MOD FIELD
*         (X1) = STATUS WORD
*         (X3) = 18/I. L. ORD,24/0,18/OUS ORD 
*         (X5) = SELECTIVE BITS(ADDR,ARR,ETC.)
*         (X6) = USE COUNT
  
  
          CLAS=  X7,P2,(INTR) 
          LX6    RG.USEP
          BX7    X7+X5       SET *INTERMEDIATE* ATTRIBUTE 
          LX3    P2.TAGP     POSITION TAG AND BIAS
          BX5    -X0+X3      OUS ORD + I.L. ORD + LONG
          IX5    X5+X6       ADD IN DUMMY USE COUNT 
          ERRNZ  OP.UTOTL-P2.USEL 
          BX5    X7+X5       (X5) NOW SUITABLE FOR ENTRY INTO REGFILE 
 .TEST    IFEQ   TEST,ON
          NZ     X6,DIT8     IF INTERMEDIATE NEEDED (USE .NE. 0)
          SA2    CO.SNAP
          LX2    1RW
          PL     X2,DIT8     IF NOT REQUESTED 
 USE=0    REG    (A1,X5)
 DIT8     BSS 
 .TEST    ENDIF 
  
          ZR     X6,DIT9     IF USE COUNT ZERO NO REGFILE ENTRY 
          RJ     STS         SET TAG STATUS 
 DIT9     SX3    B2          =0TR 
          MX2    -3 
          BX6    -X2*X3      =00R 
          LX6    3
          EQ     EXIT.
 DSC      SPACE  4,8
**        DSC -  DETERMINE STATUS CLASS 
*         DSC GETS A TAG'S REGISTER STATUS,  COMPARES ITS 
*         (0TR) TO A DESIRED REGISTER CLASS,  AND,  IF NEC- 
*         ESSARY,  PASSES BACK AN INSTRUCTION AND REGISTER
*         CLASS TO SEARCH TO ACHIEVE CORRECT REGISTER STATUS. 
*         NOTE - DSC IS REALLY JUST A GST WITH REGISTER CLASS 
*         CHECKING. 
* 
*         ENTRY  (X5) = OPERAND/REGFILE ENTRY 
*                (B2) = MODE TYPE (0 UPPER, 1 LOWER)
*                (B3) = RG=XXXX :  THE REGISTER CLASS DESIRED 
* 
*         EXIT   (A1,X1) _,= STATUS WORD RESP.
*                (X5) = SAME OPERAND
*                (X7) = TRANSFER INSTRUCTION OR N/A 
*                (B2) = (0TR)[OPERAND] OR 0 
*                (B3) = REGISTER CLASS TO SEARCH
*                (B7) = 1 OF(0TR)[OPERAND] O. K.,  ELSE 0 
* 
*         USES   A1,A2,A3,A6,A7,  X0,X1,X2,X3,X6,X7  B2,B3,B7 
* 
*         CALLS  CRT,GST
  
  
 DSC      SUBR   =           ENTRY/EXIT 
          RJ     GST         GET STATUS OF TAG
          ZR     B2,EXIT. 
          RJ     CRT         CHECK REGISTER TYPE
          NZ     B7,DSC1     IF TYPES DO NOT MATCH
          SA2    RREG        GET HARD REGISTER
          MX3    -3          SET (00R) MASK 
          SX0    B2          (X0) = (0TR)[OPERAND]
          MI     X2,EXIT.    IF NO HARD REGISTER
          BX0    X0-X2       COMPARE (0TR)[OPERAND] TO HARD REG (0TR) 
          BX0    -X3*X0      CLEAR ALL BUT DIFFERENCE IN REG NUMBER 
          NZ     X0,DSC1     IF NOT IN CORRECT REGISTER 
          BX7    -X2         CLEAR HARD REGISTER ASSIGNMENT 
          SA7    A2 
          EQ     EXIT.       FINISH UP
  
*         TAG IS NOT IN CORRECT REGISTER. 
*         (X7) = INSTRUCTION TO USE.
*         (B2) = (0TR)[OPERAND] 
  
 DSC1     SB7    X7+
          SX0    B2-R.X6     (X0) = (0TR)[OPREAND] - (0TR)[X6]
          MI     X0,DSC2     IF NOT STORE REGISTER
  
**        TAG IS CURRENTLY IN A STORE REGISTER.  THE REGISTER TO WHICH
*         IT WILL BE TRANSMITTED MAY NOT BE FREE AND MAY THEREFORE
*         REQUIRE A STORE REGISTER TO CONVEY ITS CONTENTS TO MEMORY.
*         WE LOCK THE STORE REGISTER NOW,REMEMBER IT, AND UNLOCK ITS
*         REGFILE ENTRY WHEN IT IS SAFE TO DO SO. 
  
          SX7    B2 
          SA7    STRGLK      REGISTER TO CLEAR
          SA2    B2+REGFILE  GET REGFILE ENTRY OF OPERAND 
          SX0    RLOCK
          BX7    X0+X2       LOCK ON
          SA7    A2          RESET REGFILE ENTRY WITH LOCK ON 
          EQ     DSC3 
  
 DSC2     =X0    REG.A       (X0) = (0T0) FOR AN A-REG
          SX2    B2          (X2) = (0TR)[OPERAND]
          BX7    0
          SX3    B7          (X3) = INSTRUCTION (GHIJ)
          BX2    X0*X2       EXTRACT A-REG TYPE BIT 
          SA7    B2+REGFILE 
          ZR     X2,DSC3     IF TAG NOT IN *A* REGISTER 
          SA2    A7+REG.X-REG.A   GET ASSOCIATE *X* REG 
          NO
          BX7    X2-X5
          AX7    RG.USEL
          NZ     X7,DSC3     IF NOT SAME TAGE IN *X* REGISTER 
          SA7    A2          CLEAR ASSIGNMENT 
 DSC3     AX3    9           (X3) = *G* PART OR TRANSFER INSTRUCTION
          SB3    RG=LODX
          SX7    B7          (X7) = INSTRUCTION 
          MX0    -2          SET MASK FOR ORDINAL INTO DSCTAB 
          SX2    B7-XMT/1S3  (X2) = TRANSFER INST (GHIJ) - XMT/1S3S3
          SB7    B1 
          ZR     X2,EXIT.    IF XMIT
  
**        THE TRANSFER INSTRUCTION IS AN INCRIMENT INSTRUCTION
*         SO, WE USE THE BOTTOM 2 BITS OF THE *G* PORTION TO INDEX
*         INTO THE DSC.LOD TABLE, RG=XXX VALUES FOR CORRESPONDING 
*         INCRIMENT REGISTER CLASSES. 
  
          BX0    -X0*X3      (X0) = 0-1 BIT OF *G* PART OR TRANSFER INST
          SA2    X0+DSC.LOD  GET TYPE OF LOAD TO USE
          SB3    X2          (B3) = RG=LOAD,  RG=BADR OR RG=LODX
          EQ     EXIT.       FINISH UP
  
 DSC.LOD  BSS    0
          VFD    42/0,18/RG=LOAD
          VFD    42/0,18/RG=BADR
          VFD    42/0,18/RG=LODX
          SPACE  4,8
 GNR      SPACE  4,8
**        GNR -  GET NEXT REGISTER. 
* 
*         *GNR* IS CALLED WHEN A REGISTER IS NEEDED FOR A LOAD/SET
*         INSTRUCTION.  IT WILL ALWAYS ASSIGN A REGISTER NOTING 
*         WHETHER A *HARD* REGISTER AND REGISTER TYPES AGREE. 
* 
*         ENTRY  (B3) = RG=XXXX REGISTER TYPE 
*                (X5) = TAG.
* 
*         EXIT   (B2) = 0TR, FOR REGISTER ASSIGNED. 
*                (X6) = 0R0, FOR (B2) 
* 
*         USES   A1,A2,A3,A5  X0  B2,B3,B6,B7 
* 
*         CALLS  SFR,RUT
*                (SCR,SCR+1)
  
  
 GNR      SUBR   =           ENTRY/EXIT...
          RJ     SFR         FIND AVAILABLE REGISTER
          ZR     X7,GNR5     IF REGISTER FREE 
          SA2    RGX
          SX7    B3 
          ZR     X2,GNR2     IF NON-INTERMEDIATE NOT AVAILABLE
          SB2    X2 
 GNR2     SA7    GNRA 
          RJ     RUT         CLEAR REGISTER 
          SA2    GNRA 
          SB3    X2 
 GNR5     SB7    RG=LOAD
          SX0    B3-B7
          NZ     X0,EXIT.    IF NOT *A* REGISTER LOAD 
          SB2    B2-REG.X+REG.A 
          SA1    B2+REGFILE 
          MX0    -RG.USEL 
          BX1    -X0*X1      USE COUNT ONLY 
          ZR     X1,EXIT.    IF *A* REGISTER IS FREE
          RJ     RUT         CLEAR *A* REGISTER 
          EQ     EXIT.
  
 GNRA     DATA   0
 GPN      SPACE  4,10 
**        GPN - GET PARAMETER NUMBER. 
* 
*         ENTRY  (X1) = ORDINAL OF SYMBOL.
*                NOTE - SYMBOL MUST BE A FORMAL PARAMETER.
* 
*         EXIT   (X1) = FORMAL PARAMETER NUMBER.
* 
*         USES   A1,A2  X0  B7
  
  
 GPN      SUBR               ...ENTRY/EXIT... 
          LX2    X1,B1
          IX1    X2+X1       (X1) = INDEX = ORDINAL * L.SYM 
          ERRNZ  3-Z=SYM
 .TEST    IFNE   TEST 
          MI     X1,"BLOWUP"       IF ILLEGAL SYMORD
          SA2    T=SYM
          IX2    X1-X2
          PL     X2,"BLOWUP"       IF INDEX .GE. SYMTAB LENGTH
 .TEST    ENDIF 
          SA2    T.SYM
          =B7    X2+WB.W
          SA1    X1+B7       FETCH SYMTAB WORD (WB) 
          MX0    -WB.FPNOL
 .TEST    IFEQ   TEST,ON
          BX2    X1 
          HX2    WB.FP
          PL     X2,"BLOWUP"       IF NOT A FORMAL PARAMETER
 .TEST    ENDIF 
          LX1    -WB.FPNOP
          BX1    -X0*X1      ISOLATE (X1) = F.P. NUMBER 
          EQ     EXIT.
 GNT      SPACE  4,20 
**        GNT - GENERATE TEMPORARY TAG. 
* 
*         ENTRY  (X1) = INTERMEDIATE TO PROCESS 
*                (B2) = 0TR OF REGISTER INTERMEDIATE IS IN
* 
*         EXIT   (B2) = PRESERVED 
*                (X6) = TEMP, P2 TAG-FORM 
* 
*         USES   A1,A2,A3,A6,A7 X0 B3,B7. 
* 
*         CALLS  NONE.
  
  
 GNT      SUBR               ENTRY/EXIT...
          MX0    -1 
          SA3    T.OUS       GET FWA OUS TAB
          LX1    -RG.TYPP 
          SB3    X3          START OF OUS TABLE 
          BX7    -X0*X1      TAG TYPE (0 = UPPER HALF, 1 = LOWER HALF)
          SA2    N.ST        NUMBER OF SET TEM CELLS
          SB7    X7          (B7) = UP/LOW INDICATOR
          =X7    X2+1        ADVANCE N.ST 
          LX1    RG.TYPP-P2.TAGP
          MX0    -P2.TAGL 
          BX0    -X0*X1 
          LX1    P2.TAGP-1-P2.LONGP 
          SA3    X0+B3       LOAD STATUS WORD 
  
**        NOW WE ARE READY TO CREATE A TEMP CELL IF 
*         HASN'T ALREADY BEEN DONE.  THE INTERMEDIAT'S
*         STATUS WORD WILL RECIEVE THE FOLLOWING FORMAT:  
*         P2.TAGL/SYM TAB ORDINAL OF TEMP ARRAY,
*         P2.BIASL/(N.ST) OFFSET IN TEMP ARRAY, 
*         24/NORMAL STATUS WORD FIELDS. 
* 
*         (X0) = 0-BIT MASK FOR MODE CHECK
*         (A2,X2) _,= (N.ST)
*         (A3,X3) _,= STATUS WORD 
*         (X6) = MODE 
*         (X7) = (N.ST) + 1 
*         (N.ST) = NUMBER OF TEMPS ALREADY ALOCATED 
  
          LX2    P2.BIASP    BIAS[STWD] = OFFSET OF TEM IN TEM-ARRAY
          BX6    X1 
          LX1    X3 
          SX0    -1 
          PL     X6,GNT5     IF NOT DOUBLE OR COMPLEX 
          SX7    X7+1        ADVANCE (N.ST) TWICE IF DOUBLE-WORD
  
 GNT5     AX1    P2.TAGP     ISOLATE TAG FIELD
          ERRNZ  60-P2.TAGP-P2.TAGL 
          NZ     X1,GNT10    IF ALREADY DEFINED 
          MX6    60-P2.BIASL
          SA1    S=ST        GET TEMP ORDINAL 
          LX6    P2.BIASP 
          ERRNZ  K.SYM
          BX3    X6*X3       CLEAR BIAS FIELD 
          SA7    A2          RESET TEM COUNTER
          LX1    P2.TAGP     POSITION ARRAY ORDINAL IN TAG FIELD
          IX2    X1+X2       ADD TAG TO BIAS
          BX3    X2+X3       ADD NEW TAG AND BIAS TO STATUS WORD FIELDS 
  
**        (X0) = -1 (BIT MASK)
*         (A3,X3) _,= STATUS WORD 
*         (B7) = TAG TYPE (UPPER/LOWER) 
  
 GNT10    CLAS=  X2,P2,(TAG,BIAS) 
          BX6    X2*X3       ISOLATE TAG AND BIAS FOR STORE WORD
          LX0    ST.STATP 
          LX2    X0,B7       MASK FOR SPECIFIED STATUS BIT
          SX1    B7          (X1) = TYPE (0-UPPER:1-LOWER)
          BX7    X2*X3       CLEAR STATUS BIT 
          LX1    P2.BIASP    POSITION TYPE IN BIAS FIELD
  
 .TEST    IFEQ   TEST,ON
          SA2    CO.SNAP
          LX2    1RH
          PL     X2,GNT22    IF SNAP = H NOT SELECTED 
 SNP=H    SNAP   GNT,,1,(B6,B2,A3,A7,X5,X7,X6,X1) 
 GNT22    BSS 
 .TEST    ENDIF 
  
          SA7    A3          CLEAR STATUS OF TAG
          IX6    X1+X6       ADD TYPE TO BIAS OF STORE WORD 
          EQ     EXIT.
 GPT      SPACE  4,8
**        GPT -  GET POINTER TAG
*         GPT ALSO INCREMENTS *BIAS* BY OFFSET IN COMMON BLOCK. 
* 
*         ENTRY  (X5) = ECS/LCM NAME TAG
* 
*         EXIT   (X2) = POINTER-WORD TAG
*                (X5) = PRESERVED 
* 
*         USES   A2,A3  B2,B7  X0,X2,X3,X7
  
 GPT      SUBR   0
          SA3    T.SYM
          =B7    X3+WC.W
          MX2    -TG.ORDL 
          LX5    -P2.TAGP 
          BX2    -X2*X5      (X2) = TAG ORDINAL 
          LX5    P2.TAGP            RESTORE X5
          LX3    X2,B1
          IX2    X3+X2       (X2) = INDEX = 3 * SYMORD
          ERRNZ  3-Z=SYM
          SA3    T.BLKS 
          SA2    X2+B7       (X2) = ADDRESS TABLE ENTRY 
          BX7    X2 
          HX7    WC.RA
          SB2    X3+CB.W
          AX7    -WC.RAL     SIGN EXTEND OFFSET IN BLOCK/CLASS
          MX3    -WC.RBL
          AX2    WC.RBP 
          BX2    -X3*X2      (X2) = BLOCK NUMBER
          =A3    A2+WB.W-WC.W 
          HX3    WB.EQV 
          MX0    -WB.BASEL
          PL     X3,GPT10    IF NOT EQUIVALENCED
          LX3    WB.EQVP+1-WB.BASEP 
          BX3    -X0*X3 
          LX0    B1,X3
          IX3    X3+X0
          SA3    X3+B7       WC(BASE) 
          HX3    WC.RA
          AX3    -WC.RAL     SIGN EXTEND OFFSET OF CLASS IN BLOCK 
          IX7    X3+X7       RELOCATE CLASS IN BLOCK
  
 GPT10    SA3 BIAS
          MX0    -P2.BIASL
          LX3    59-23
          AX3    59-23       SIGN EXTEND BIAS 
          IX7    X3+X7       ADD IN BLOCK/CLASS OFFSET
          BX7    -X0*X7 
          SA7    A3 
          SA2    X2+B2       BLOCK TABLE ENTRY
          MX3    CB.TAGL
          LX3    CB.TAGL+CB.TAGP
          BX2    X3*X2       (X2) = POINTER-WORD TAG
          EQ     GPTX              EXIT.. 
 GST      SPACE  4,8
**        GST -  GET STATUS OF TAG
*         GST CHECKS IF THE GETS THE STATUS WORD OF 
*         AN OPERAND OR REGFILE ENTRY.  IT THEN CHECKS
*         THE STATUS BIT OF THE STATUS WORD AND PASSES
*         THE REGISTER STATUS OF THE OPERAND BACK TO
*         THE CALLER. 
* 
*         ENTRY  (X5) = OPERAND/REGFILE ENTRY 
*                (B2) = MODE TYPE (0 UPPER, 1 LOWER)
* 
*         EXIT   (A1,X1) _,= STATUS WORD
*                (X5) - PRESERVED 
*                (X6) = (0R0) 
*                (B2) = (0TR) IF OPERAND IN REG,  ELSE 0
* 
*         USES   A1,A2,A6,  X0,X1,X2,X6,  B2,B7 
* 
*         CANNOT DESTROY A4,X4  B4,B5,B6
  
  
 GST      SUBR   =           ENTRY/EXIT.
          MX6    -P2.TAGL    SET MASK FOR ORDINAL INTO OUS TABLE
          SA2    T.OUS       GET FWA OF OUS TABLE 
          LX5    -P2.TAGP    POSITION ORDINAL 
          SB7    X2          (B7) = FWA OUS TAB 
          BX0    -X6*X5      EXTRACT OUS ORDINAL
          SX2    A2          (X2) _ T.OUS 
  
 .TEST    IFEQ   TEST,ON     VALIDITY CHECK FOR TYPE AND OPERAND
          MI     B2,"BLOWUP" IF BAD TYPE
          SA1    X2+N.TABLE  GET TABLE LENGTH 
          LT     B1,B2,"BLOWUP"    IF TYPE BAD
          IX6    X1-X0
          MI     X6,"BLOWUP" IF ORDINAL NOT WITHIN TABLE
 .TEST    ENDIF 
  
          LX2    18          POSITION TABLE FWA FOR STATUS WORD POINTER 
          SA1    B7+X0       GET STATUS WORD
          LX5    P2.TAGP     RESET OPERAND WORD 
          IX6    X0+X2       (X6) = 42/T.OUS,18/ORDINAL, ST. WD. POINTER
          SA2    B2+STATUS   GET STATUS SHIFT COUNTS
          SA6    GSTC        SET STATUS WORD POINTER
          BX0    -X2
          AX2    18          POSITION NEXT SHIFT COUNT
          SB7    59+X0       (B7) = SHIFT COUNT TO MOVE ST. BIT TO TOP
          LX0    B7,X1       POSITION STATUS BIT
          =B2    0
          SB7    X2          (B7) = ST.UREGP OR ST.LREGP
          MX6    -ST.UREGL   SET (0TR) MASK 
          ERRMI  ST.UREGL-3 
          PL     X0,GST1     IF NOT IN REG EXIT WITH (B2) = 0 
          AX0    B7,X1       POSITION (0TR) 
          BX6    -X6*X0      EXTRACT (0TR)
          SB2    X6 
  
**        SOMETIMES A TAG IS REMOVED FROM THE REGFILE WITHOUT 
*         HAVING ITS STATUS BIT CLEARED. EXAMPLE: WHEN ITS USE
*         COUNT IS ZERO (SEE EIS.AT). THIS FACT MOTIVATES THE 
*         THE APARENTLY USELESS CODE THAT FOLLOWS.
  
          SA2    B2+REGFILE  GET REGFILE ENTRY  INDICATED BY STAT WORD
          BX0    X2-X5
          CLAS=  X2,P2,(USE,LONG) 
          BX2    -X2*X0 
          NZ     X2,GST1     IF NOT SAME OPERAND
          SX0    REG.A       (X0) = (0T0) FOR A REG 
          BX0    X0*X6
          ZR     X0,GST2     IF NOT IN AN A-REG CLEAN UP
          SA2    B2+REGFILE+REG.X-REG.A  GET ASSOCIATE X-REG
          BX2    X2-X5
          AX2    RG.USEL     CLEAR USE FIELD(PROBABLY DOES DIFFER)
          ZR     X2,GST2     IF X-REG ENTRY NOT THE SAME
  
 GST1     SB2    0           SET NOT IN REG FLAG
          SX6    0           (0R0) = 0
  
 GST2     MX0    -3 
          BX6    -X0*X6      (X6) = (00R) 
          LX6    3           (X6) = (0R0) 
          EQ     EXIT.
  
 STATUS   VFD    24/OP.UTOTP,18/ST.UREGP,18/ST.USTP 
          VFD    24/OP.LTOTP,18/ST.LREGP,18/ST.LSTP 
  
 GSTC     BSSENT 0
          VFD    24/0,18/T.OUS,18/"BLOWUP"
 GTR      SPACE  4,7
**        GTR -GET TEMPORARY REGISTER 
* 
*         ENTRY  NONE 
*         EXIT   (B2) = 0TR OF REG GOTTEN - SET BY SUBROUTINES
*                (X6) = 0R0 OF REG GOTTEN - SET BY SUBROUTINES
* 
*         SAVES  B4,B6 A4,X4,X5 
* 
*         CALLS  ASR, RUT AND SFR 
  
 GTR      SUBR   =           ENTRY/EXIT 
          SB3    RG=TEMP
          RJ     SFR
          ZR     X7,EXIT.    IF TEMP REGISTER AVAILABLE 
          SA1    RGX
          ZR     X1,GTR5     IF NON-INTERMEDIATE NOT AVAILABLE
          SB2    X1 
          RJ     RUT
          EQ     EXIT.
  
  
**        TAKE CARE TO AVOID DEADLOCK THAT WILL OCCUR IF BOTH STORE 
*         REGISTERS ARE LOCKED. 
  
 GTR5     SA1    REGFILE+R.X6 
          SA2    REGFILE+R.X7 
          =X3    RLOCK
          MX0    -RG.USEL 
          BX1    -X0*X1      USE COUNT ON *X6*
          IX1    X1-X3
          PL     X1,GTR10    IF *X6* IS LOCKED
          BX2    -X0*X2      USE COUNT ON *X7*
          IX1    X2-X3
          PL     X1,GTR10    IF *X7* IS LOCKED
  
*         NEITHER *X6* NOR *X7* IS LOCKED 
  
          RJ     ASR         ASSIGN STORE REGISTER
          EQ     EXIT.
  
*         USE TEMP REGISTER OF LOWEST USE COUNT.
  
 GTR10    RJ     RUT
          EQ     EXIT.
 LFP      SPACE  4,8
**        LFP -  LOAD FORMAL PARAMETER ADDRESS
* 
*         ENTRY  (X1) = TAG 
*         EXIT   (B6) = (R00) *FP* LOAD REGISTER USED FOR *SAJ* 
*                (B2) = (0TR) *FP* SET REGISTER USED FOR *SBK* OR *SXI* 
* 
*         OUTPUTS TO INTERMEDIATE FILE
*                SAJ    A0+FP 
*         AND EITHER
*                SBK    XJ+BIAS    (CM/SCM TAG) 
*         OR
*                SXI    R+BIAS     (ECS/LCM TAG -- R CONTAINS SUBSCRIPT)
* 
*         USES   A1,A2,A3  X0,X5  B2,B3,B5,B6 
* 
*         CALLS  GNR, GPN, RLL, RUL, RUT, SFR, WCODE. 
  
  
 LFP      SUBR               ...ENTRY/EXIT... 
          SA3    ALREG
          MX0    -3 
          SB7    X3-R.X6
          BX6    -X0*X3 
          BX5    X1 
          LX6    6           =R00 
          NG     B7,LFP4     IF *AREG NOT STORE REGISTER
          SB3    RG=LOAD
          RJ     GNR
          LX6    3           R00
 LFP4     SA6    LFPA 
          RJ     LPA         LOAD FP BASE ADDRESS 
          SA3    LFPA 
  
*         NOW OUTPUT LOAD OF ACTUAL ADDRESS VIA A *B* SET.
  
          SB6    X3          SAVE ADDRESS FUNCTION REGISTER 
          =B3    RG=BADR
          RJ     SFR         GET NEXT *B* REGISTER
          LX6    3
          SX3    B6 
          AX3    3
          MX0    -PB.BIASL
          IX6    X6+X3
          AX5    P2.BIASP 
          SX7    SB=XK
          BX2    -X0*X5      BIAS ON TAG
          NZ     X2,LFP10    IF NOT *0* BIAS
          SX7    SB=XB
 LFP10    BX6    X6+X7
          LX2    PB.BIASP 
          LX6    PB.INSTP     OP-CODE + REGISTERS 
          IX7    X2+X6       ADD IN OP-CODE 
          SB5    B2 
          WCODE  X7 
          SB2    B5 
          EQ     EXIT.
  
 FPREG    DATA   0           FORMAL PARAMETER REGISTER
 LFPA     BSS    1
 LLA      EJECT 
**        LLA - LOAD LCM ADDRESS. 
* 
*         ENTRY  (ALREG) = 0TR OF FINAL REFERENCE REGISTER
*                (AFREG) = 0TR OF ADDRESS FUNCTION OR 0 
*                (X5) = TAG 
*                (STORE) NZ IFF THIS IS STORE OPERATION 
*                (ADDR) NZ IFF THIS IS ADDRESS REF. 
*                AFREG LOCKED.
*                ALREG LOCKED IF STORE NZ9
*         EXIT   (X5) PRESERVED 
*         ALREG AND AFREG UNLOCKED
*                (SETREG) 00R OF REGISTER WITH ADDRESS. 
  
 LLA      SUBR
          MX6    0
          SA6    BIASF       INITIALIZE 
          MX0    -P2.BIASL
          BX6    X5 
          LX6    -P2.BIASP
          BX6    -X0*X6 
          SA6    BIAS 
          SA1    ALREG
          SA2    STORE
          SB2    X1          SETREG = ALREG 
          MX0    -3 
          BX6    -X0*X1 
          ZR     X2,LLA10    IF NOT STORE 
          SB3    RG=SET 
          RJ     GNR         SETREG = GNR(RG=SET. 
          AX6    3
  
 LLA10    BX2    X6 
          SX6    B2 
          MX0    -3 
          BX6    -X0*X6 
          SA6    SETREG 
          BX0    X5 
          HX0    P2.FP
          PL     X0,LLA11    IF NOT FORMAL PARAMETER
          SA3    STORE
          NZ     X3,LLA11    IF STORE 
          SB7    X2 
          RJ     RLL
  
 LLA11    RJ     LLB         LOAD BASE ADDRESS(FROM A0 OR LC.)
          SA6    FPREG
          SA6    LLAA        T1 = FPREG 
          SA2    BIAS 
          LX2    -P2.BIASL
          MX0    TP.ORBIL+3 
          AX2    -P2.BIASL
          PL     X2,LLA13    IF BIAS NOT MINUS
          BX2    -X2
 LLA13    BX7    X0*X2
          SA7    BIASF
          SA1    AFREG
          MX0    -3 
          SA2    BIAS 
          BX7    -X0*X1 
          ZR     X1,LLA50    IF NOT INDEXED REF.
          SA7    LLAB        T2 = AFREG 
          ZR     X2,LLA90    IF NO BIAS 
          SA3    SETREG 
          BX7    X3 
          SA7    LLAA        T1 = SETREG
          SA6    LLAB        T2 = FPREG 
          BX1    -X0*X1 
          LX1    PB.KP
          LX6    PB.JP
          SX2    IA 
          BX0    X1+X6
          LX3    PB.IP
          LX2    PB.INSTP 
          BX2    X2+X3
          BX7    X0+X2
          WCODE  X7          IX_SETREG FPREG+AFREG
          SA2    SETREG 
          SA3    LLAB 
          SB7    X2          IN CASE OF RLL CALL
          BX2    X3-X2
          NZ     X2,LLA30    IF NO CONFLICT 
          RJ     RLL         LOCK SETREG
          SA2    BIASF
          NZ     X2,LLA14    IF ABS(BIAS) GT 2**17
          SB3    RG=SET      CHECK REGISTERS 0-5
          RJ     SFR
          ZR     X7,LLA14A   IF FREE
          SB3    RG=STOR     CHECK REGISTERS 6-7
          RJ     SFR
          ZR     X7,LLA14A   IF FREE
  
 LLA14    SB3    RG=LOAD
          RJ     GNR         GET A LOAD REGISTER
  
 LLA14A   AX6    3
          SA6    LLAB 
          EQ     LLA30
  
 LLA15    SA1    FPREG
          SB7    X1 
          RJ     RLL         LOCK FPREG 
          SB3    RG=LOAD
          RJ     GNR         GET A LOAD REG 
          AX6    3
          SA6    LLAB        T2 = GRN(LOAD) 
  
 LLA30    SA2    BIAS 
          SA3    BIASF
          ZR     X3,LLA40    IF ABS(BIAS) LT 2**17
          BX6    X5 
          SA6    LLAC 
          MX0    1
          LX0    1+P2.SHRTP  FAKE 
          LX2    P2.BIASP 
          BX5    X0+X2
          CALL   ESC         EXPAND SHORT CONSTANT
          SA5    LLAC 
          SX0    SA=BK
          LX0    PB.INSTP 
          LX3    PB.BIASP 
          LX1    PB.TAGP
          BX6    X0+X3
          SA3    LLAB 
          BX7    X6+X1
          LX3    PB.IP
          BX7    X7+X3
          WCODE  X7,LLA90    SA_T2 CON.+K 
  
 LLA40    MX0    -PB.BIASL
          BX2    -X0*X2 
          LX2    PB.BIASP 
          SX0    SX=BK
          SA3    LLAB 
          LX0    PB.INSTP 
          LX3    PB.IP
          BX0    X0+X2
          BX7    X0+X3
          WCODE  X7,LLA90    SX_T2 BIAS 
  
*         NON-INDEXED (SCALAR OR CON ARRAY ELEMENT) 
  
 LLA50    SA1    BIAS 
          NZ     X1,LLA15    IF BIAS
          SA1    SETREG 
          SA2    FPREG
          LX1    PB.IP
          LX2    PB.JP
          SX0    XMT
          BX6    X1+X2
          LX0    PB.INSTP 
          BX7    X0+X6
          WCODE  X7,LLA100   BX_SETREG FPREG
  
 LLA90    SA1    SETREG 
          SA2    LLAA 
          SA3    LLAB 
          SX0    IA 
          LX0    PB.INSTP 
          LX1    PB.IP
          BX0    X0+X1
          LX2    PB.JP
          LX3    PB.KP
          BX0    X0+X2
          BX7    X0+X3
          WCODE  X7          IX_SETREG T1+T2
  
 LLA100   SA1    FPREG
          SB7    X1 
          RJ     RUL         UNLOCK FPREG 
          SA1    AFREG
          ZR     X1,LLA110   NO ADDRESS FUNCTION
          MX0    -3 
          BX1    -X0*X1 
          SB7    X1 
          RJ     RUL         UNLOCK AFREG 
  
 LLA110   SA2    SETREG 
          SB7    X2 
          RJ     RUL         UNLOCK SETREG
          EQ     EXIT.
  
 BIAS     BSS    1
 SETREG   BSS    1
 LLAA     BSS    1
 LLAB     BSS    1
 LLAC     BSS    1
 BIASF    BSS    1
 LLB      SPACE  4,10 
**        LLB - LOAD LCM BASE ADDRESS.
*         ENTRY  (X5) = TAG 
* 
*         EXIT   (X5) PRESERVED 
*                X6 = 00R USED FOR LOAD 
  
 LLB      SUBR
          SB3    RG=LOAD
          RJ     GNR
* 
*         CHECK IF REGISTER JUST SELECTED INTERFERS WITH A UEM READ 
*         IF SO TRANSFER UEM RESULT TO X6 ONLY IF X6 AND X7 FREE. 
* 
          SA1    LINS        LAST UEM INSTRUCTION 
          ZR     X1,LLB9     IF NO UEM INST 
          SA2    REGE 
          ZR     X2,LLB9     IF REGFILE ENTRY FREE
          SX2    DRL
          MX0    PB.GHL+PB.IL 
          BX3    X0*X1
          LX2    PB.INSTP 
          BX2    X2-X3
          NZ     X2,LLB9     IF LAST INST NOT 014, READ UEM 
          LX1    PB.INSTL 
          MX0    PB.JL
          LX0    PB.JL+PB.KL
          BX2    X0*X1
          BX3    X2-X6
          NZ     X3,LLB9     IF LOAD REG DOES NOT CONFLICT WITH UEM READ
          SA1    REGFILE+REG.X+6
          NZ     X1,LLB9     IF X6 REG NOT AVAILABLE
          SA3    A1+1 
          NZ     X3,LLB9     IF X7 REG NOT AVAILABLE
          SX7    B2 
          SA7    LLSV        SAVE B2
          SA6    A7+1        SAVE X6
          LX7    X5 
          SA7    A6+1        SAVE X5
          LX7    X2 
          SA7    SVX2        REG BEING WIPED OUT
          SA5    REGE        REGFILE ENTRY OF REG WIPED OUT 
          MX0    -1 
          BX3    X5 
          AX3    RG.TYPP
          BX7    -X0*X3 
          SB2    X7 
          SA7    SVB2        UPPER/LOWER FLAG 
          RJ     GST         GET STATUS FOR STS CALL
          SB2    R.X6 
          SA3    SVB2 
          SB3    X3          UPPER/LOWER FLAG 
          RJ     STS         SET STATUS 
          SB7    R.X6-REG.X 
          RJ     RLL         LOCK X6
          SA1    INS.REG     I REG FOR NEXT INST
          SX0    MAX.USEC 
          BX7    X0*X1
          SA2    SVX2        REG WIPED OUT
          AX2    PB.KL
          BX7    X2-X7
          NZ     X7,LLB8     IF I REG OF NEXT AND REG WIPED OUT NOT SAME
          SX7    R.X6-REG.X 
          SA7    INS.REG     UPDATE TO NEW REG
          SA1    REGLK
          SA3    A1+1 
          BX0    X1-X3
          NZ     X0,LLB8     IF NO LOCK 
          BX0    X1-X2
          NZ     X0,LLB8     IF REG NOT JUST WIPED OUT
          SA7    REGLK
          SA7    A7+1        UPDATE REGLK 
          SA2    SVX2        RESTORE X2 FOR WCODE 
          SX1    R.X6-REG.X 
          SX0    XMT
          LX1    PB.JL+PB.KL
          BX0    X0+X1
          BX7    X0+X2
          LX7    PB.INSTP 
          WCODE  X7,LLB8
  
 LLB8     SA1    LLSV 
          SB2    X1          RESTORE B2 
          SA2    A1+1 
          LX6    X2          RESTORE X6 
          SA3    A2+1 
          BX5    X3          RESTORE X5 
  
 LLB9     LX6    3
          MX7    0
          SA7    LINS 
          SA6    LFPA 
          BX0    X5 
          HX0    P2.FP
          PL     X0,LLB20    IF NOT FORMAL
          RJ     LPA         LOAD FP BASE ADDRESS 
  
 LLB10    SA3    LFPA 
          AX3    6
          BX6    X3 
          EQ     EXIT.
  
 LLB20    RJ     CLP         LOAD COMMON POINTER
          EQ     LLB10
  
 LLSV     BSS    3           SAVE AREA
 SVX2     BSS    1
 SVB2     BSS    1
 LINS     CON    0
 LLV      SPACE  4,10 
**        LLV - LOAD LCM VALUE. 
  
 LLV      SUBR
          SA1    ADDR 
          SA2    T.SYM
          NZ     X1,EXIT.    IF ADDRESS REF.
 #MD      IFEQ   .DAL,1 
          MX0    -P2.TAGL 
          BX1    X5 
          =B7    X2+WB.W
          LX1    -P2.TAGP 
          BX6    -X0*X1 
          LX1    B1,X6
          IX3    X6+X1
          SA6    LLVTAG 
          SA2    B7+X3
          MX0    -WB.LEVNL
          BX7    X2 
          LX2    -WB.LEVNP
          BX6    -X0*X2 
          SA2    ALREG
          MX0    -3 
          SA1    SETREG 
          BX2    -X0*X2 
          SA3    STORE
          ZR     X6,LLV20    IF LEVEL 0 REF.
          LX3    PB.IP-PB.INSTP 
          SX3    DRL+X3 
          LX2    PB.JP
          LX3    PB.INSTP 
          LX1    PB.KP
          BX0    X3+X2
          BX7    X1+X0
          SA7    LINS        LAST UEM INSTRUCTION 
          WCODE  X7,EXIT. 
  
 LLV20    SX3    I.LD0+X3 
          LX2    PB.H2P+3 
          LX1    PB.H2P 
          LX3    PB.GHIJP 
          MX0    -WB.FPOL 
          LX7    -WB.FPOP 
          BX0    -X0*X7 
          BX3    X3+X2
          BX7    X1+X3
          SA1    LLVTAG 
          LX1    PB.TAGP
          BX7    X7+X1
          SA1    =XT.FPI
          SB7    X1-1 
          SA2    B7+X0
          =X3    1
          LX3    FP.SUB0P 
          IX6    X2+X3
          SA6    =XENT.SB0   FLAG LEVEL0 REF ISSUED 
          SA6    A2          INCREMENT FP.SUB0
          WCODE  X7,EXIT. 
  
 LLVTAG   BSS    1
 #MD      ELSE
          EQ     "BLOWUP" 
 #MD      ENDIF 
 LPA      SPACE  4,8
**        LPA - LOAD FORMAL PARAMETER BASE ADDRESS. 
  
 LPA      SUBR
          LX5    -P2.TAGP 
          MX0    -P2.TAGL 
          BX1    -X0*X5 
          LX5    P2.TAGP
          RJ     GPN         GET PARAMETER NUMBER 
          SX7    X1-1 
          SX0    X6+SA=AK 
          NZ     X7,LPA10    IF NOT FIST FP 
          SX0    X6+SA=AB 
  
 LPA10    LX7    PB.BIASP 
          LX0    PB.INSTP 
          IX7    X0+X7
          WCODE  X7 
          EQ     EXIT.
 LSC      SPACE  4,8
 LSC      SPACE  4,8
**        LSC - LOAD SHORT CONSTANT.
* 
*         ENTRY  (B3) = RG=XXXX - SCAN TYPE FOR REGISTER LOAD.
*                (B4) = PARSED FILE ADDRESS FOR CURRENT TURPLE. 
*                (X1) = T.OUS FORM OF TAG TO BE LOADED. 
*                (X5) = I. L. FORM OF TAG TO BE LOADED. 
* 
*         EXIT   (B2) = REGISTER - (0TR)
*                (X6) = REGISTER (0R0)
* 
*         USES    ALL REGISTERS EXCEPT A0,A4,  X4,X5, AND  B4 
* 
*         CALLS  ASR,GNR,WCODE
  
 LSC      SUBR   =           ENTRY/EXIT...
          MX7    -OP.CHINL   MASK FOR OPERATOR TYPE 
          =A2    B4+OR.OPR
          AX2    OP.CHINP    POSITION OPERATOR TYPE 
          BX2    -X7*X2      EXTRACT OPERATOR TYPE
          BX6    X1 
          SX7    B3          SCAN TYPE FOR SFR
          SA3    RREG        GET HARD REG CELL
          SA6    LSCA        (LSCA) = STATUS WORD OF SHORT CON
          =A7    A6+1        (LSCA+1) = REGISTER SCAN TYPE
          PL     X3,LSC10    IF REGISTER ALREADY ASSIGNED 
          SB7    X2-O.= 
          NZ     B7,LSC10    IF NOT PROCESSING STORE TURPLE 
          RJ     ASR         ASSIGN STORAGE REGISTER
          EQ     LSC20
  
 LSC10    RJ     GNR         GET REGISTER 
  
 LSC20    BX7    X6          (0R0)
          SA3    LSCA+1      GET SCAN TYPE
          LX7    3           (X7) = (R00) 
          =A2    A3-1        GET STATUS WORD OF SHORT CON 
          SB7    RG=BADR
          SB7    -B7
          SB7    X3+B7       (B7) = (SCAN TYPE)-RG=BADR 
          HX2    P2.BIAS     POSITION SIGN BIT OF CONSTANT VALUE
          SX1    X7+SX=BK    OPCODE+I00 
          NZ     B7,LSC21    IF NOT *B* REGISTER LOAD 
          SX1    X7+SB=BK    OPCODE+I00 
 LSC21    AX2    -P2.BIASL   SIGN EXTENDED CONSTANT, (X2) = CONSTANT. 
          NZ     B7,LSC22    IF NOT *B* REGISTER LOAD 
          NZ     X2,LSC30    IF NOT CONSTANT ZERO 
          SX1    X7+SB=BB    OPCODE+I00 
          EQ     LSC30
  
*         IF *0* COMPILE: BXI XI-XI (IF +0), BXI -XI-XI (IF -0) 
  
 LSC22    NZ     X2,LSC30    IF CONSTANT NOT ZERO 
          SX1    X7+CLR      OP-CODE + I00
          PL     X2,LSC24    IF CONSTANT = POSITIVE ZERO
          SX1    X7+EQV      OP-CODE + I00
 LSC24    AX7    6           (X7) = 00I 
          IX7    X1+X7       OP-CODE + I0I
          IX1    X7+X6       OP-CODE + I0I+0I0
          MX2    0           MAKE SURE BIAS IS ZERO 
  
*         (X1) = OP-CODE + REGISTER (RIGHT JUSTIFIED) 
*         (X2) = CONSTANT.
*         (B2) = REGISTER (0TR) 
  
 LSC30    MX0    -PB.BIASL   MASK FOR SHORT CONSTANT
          LX1    PB.INSTP    POSITION OPCODE
          BX2    -X0*X2      MASK OFF SIGN BITS 
          SB5    B2          SAVE (0TR) ACROSS WCODE
          LX2    PB.BIASP    POSITION CONSTANT IN PB. BIAS FIELD
          IX7    X1+X2       ADD CONSTANT INTO INSTRUCTION
          WCODE  X7 
          SX6    B5          (0TR)
          MX0    -3 
          SB2    B5          (B2) = (0TR) 
          BX6    -X0*X6      (00R)
          LX6    3           (X6) = (0R0) 
          EQ     EXIT.
  
 LSCA     DATA   0,0
 LTG      EJECT  4,20 
**        LTG -  LOAD TAG 
* 
*         ENTRY  (B2) = 0 (LOAD UPPER HALF) 
*                     = 1 (LOAD LOWER HALF) 
*                (B3) = REGISTER GROUP FOR LOAD (RG=XXX). 
*                (X1) = STATUS WORD OF TAG TO BE LOADED.
*                (X5) = TAG TO BE LOADED. 
* 
*         EXIT   (B2) = REGISTER (0TR)
*                (B6) = STATUS WORD FOR TAG.
*                (X6) = REGISTER (0R0)
* 
*         USES   ALL REGISTERS EXCEPT A0,A4 B4. 
* 
*         CALLS  GNR,CLI
  
  
 LTG      SUBR   =           ENTRY/EXIT...
          BX6    X1 
          SX3    B2          (X3) = TYPE (UPPER/LOWER)
          LX3    P2.BIASP    POSITION TYPE TO OFFSET BIAS 
          IX6    X6+X3       ADD (TYPLOD) INTO BIAS 
          SA6    LTGA        SAVE TAG TO BE USED IN INSTRUCTION 
          RJ     GNR         GET REGISTER 
          SA1    LTGA 
          RJ     CLI         COMPILE LOAD INSTRUCTION 
          EQ     EXIT.
  
  
 LTGA     DATA   0
  
 RLL      SPACE  4,8
**        RLL -  LOCK REGISTER *X* AND *A* REGISTER.
* 
*         ENTRY  (B7) = REGISTER TO LOCK - 00R. 
* 
*         EXIT   REGISTER LOCKED. 
*                (X7) = LOCK REGISTER - 00R.
* 
*         USES   A1,A2,A7  X0 
*         CANNOT DESTROY *X6* 
  
  
 RLL      SUBR   =           ENTRY/EXIT...
          =X0    RLOCK
          SA1    B7+REGFILE+REG.X 
          BX7    X1+X0
          SA2    B7+REGFILE+REG.A 
          SA7    A1          LOCK ON *X*
          BX7    X2+X0
          SA7    A2          LOCK ON *A*
          SX7    B7          REGISTER = 00R.
          EQ     EXIT.
 RUL      SPACE  4,8
**        RUL -  UNLOCK REGISTER *X* AND *A* REGISTER.
* 
*         ENTRY  (B7) = REGISTER TO UNLOCK - 00R. 
* 
*         EXIT   REGISTER UNLOCKED. 
* 
*         USES   A1,A2,A7  X0 
*         CANNOT DESTROY *X6* 
  
  
 RUL      SUBR   =           ENTRY/EXIT...
          =X0    RLOCK
          LT     B7,EXIT.    IF NO REGISTER TO UNLOCK 
          SA1    B7+REGFILE+REG.X 
  
*         DO NOT TOUCH TEMP *X* REGISTER
  
          MX2    -RG.USEL 
          BX7    -X2*X1      USE COUNT
          =X2    MAX.USEC 
          BX2    X7-X2
          ZR     X2,RUL1     IF TEMP REGISTER 
          BX7    -X0*X1 
          SA7    A1          CLEAR LOCK ON *X*
 RUL1     SA2    B7+REGFILE+REG.A 
          BX7    -X0*X2 
          SA7    A2          CLEAR LOCK ON *A*
          EQ     EXIT.
  
 REGLK    BSSENT 3           LOCK REGISTER
 CLOADK   EQU    REGLK+1     *K* PORTION
 CLOADJ   EQUENT REGLK+2     *J* PORTION
 STRGLK   BSSENT 1
 RUT      SPACE  4,8
**        RUT -  RESET USAGE TABLE FOR REGISTER BEING CLOBBERED.
* 
*         ENTRY  (B2) = 0TR OF REGISTER BEING CLOBBERED.
* 
*         EXIT   (B2) = PRESERVED.
*                (B3) = 00R (R FROM *B2*) 
*                RGFILE, USEFILE CLEARED FOR (B2).
* 
*         USES   A1,A2,A3,A6,A7  X0  B3,B5,B7 
*                DESTORYS (A5) BUT NOT (X5) 
* 
*         (SCR2) FOR SAVING *X5*
* 
*         CALLS  GST,SFR,DRITE,WCODE
  
  
 RUT.X    SA5    RUTA        RESTORE (X5) 
          SX6    B5 
          BX7    0
          SB2    B5          RESTORE*B2*
          MX0    -3 
  
**        CLEAR REGFILE ENTRY.
  
          SB5    B5-REG.X 
          SA1    B2+REGFILE 
          MI     B5,RUT35    IF NOT X REG CLEAR ONLY ONE ENTRY
          SA2    B5+REGFILE+REG.A  FETCH CORRESPONDING A-REG
          BX2    X2-X1
          AX2    RG.USEL
          NZ     X2,RUT35    IF TAGS NOT EQUAL
          SA7    A2+         CLOBBER A REG
 RUT35    BX6    -X0*X6 
          SA7    A1          (B2+REGFILE) IS ALWAYS CLOBBERED.
          SB3    X6          =00R 
          LX6    3           =0R0 
  
 RUT      SUBR   =           ENTRY/EXIT...
          BX7    X5 
          SB5    B2 
          SA7    RUTA 
          SX6    RUT.X
          SA5    B2+REGFILE 
          SA6    RUT.ADR
 RUT5     BX1    X5 
          MX0    -1 
          =B7    0           STATUS OF TAG ONLY 
          AX1    RG.TYPP
          BX7    -X0*X1 
          SB2    X7          TAG TYPE (0 = UPPER HALF, 1 = LOWER HALF)
          SA7    RUT.TYP
          RJ     GST         GET STATUS OF TAG
          SA2    RUT.ADR
          SB7    X2 
          NZ     B2,RUT6     IF STATUS NOT SET CLEAR ENTRY
          JP     B7 
  
  
*         TAG IS ACTIVE, IF IT IS A SIMPLE TAG INDICATE IN REGISTER 
*         POINTER WORD THAT TAG IS NO LONGER IN A REGISTER - PUT TAG
*         BACK IN TABLE FROM REGISTER FILE AND CLEAR REGISTER ENTRY 
*         FROM *0TR* ON ENTRY.
  
 RUT6     SA2    RUT.TYP
          MX0    -1 
          BX7    X5 
          SB3    X2+ST.STATP
          LX0    X0,B3
          BX6    X0*X1       INDICATE TAG NOT IN REGISTER 
          SA6    A1 
          SBIT   X7,P2.INTRP
          MI     X7,RUT20    IF INTERMEDIATE
          JP     B7 
  
*         FOUND INTERMEDIATE IN REGISTER -- MUST SAVE IN TEMPORARY
*         (B2) = 0TR
*         (X5) = TAG
  
*RUT20    SBIT   X2,P2.ADDRP/P2.INTRP 
*         MI     X2,RUT30 
 RUT20    BSS    0
  
 SNAP=H   IFNE   TEST 
          SX6    3RRUT
          RJ     REGPRO 
 SNAP=H   ENDIF 
          SBIT   X7,P2.ARRP/P2.INTRP
          PL     X7,RUT25    IF NOT ARRAY-LOAD
  
**        INTERMEDIATE IS ARY-LOD -- INDICATE POST-PROCESSING REQUIRED. 
  
          JP     B7 
  
 RUT25    SX0    B5-R.X6
          BX7    X5 
          SB2    B5 
          PL     X0,RUT28    IF ALREADY IN STORE REGISTER 
          SX6    B5 
          SB3    RG=STOR
          SA6    INT.REG     SAVE 0TR OF REGISTER BEING CLOBBERED 
          SA7    INT.TAG
          RJ     SFR         GET STORE REGISTER 
          SA2    RUT.REG     IJK OF PREVIOUS INSTRUCTION
          ZR     X2,RUT26A   IF IJK OF PREVIOUS INST CLEARED
          AX2    6
          AX6    3           STORE REGISTER SELECTED
          BX0    X2-X6
          NZ     X0,RUT26    IF STORE REG NOT I OF PREVIOUS INST
          NZ     X7,RUT26    IF NON ZERO USE COUNT
  
 RUT25A   SX3    B2-R.X6
          NZ     X3,RUT25B   IF STORE REG SELECTED NOT X6 
          SB2    R.X7 
          SA5    B2+REGFILE 
          EQ     RUT25C 
  
 RUT25B   SB2    R.X6 
          SA5    B2+REGFILE 
  
 RUT25C   SX7    RUT27
          SA7    RUT.ADR
          SB5    B2 
          EQ     RUT5 
  
 RUT26    SA3    IJK
          NZ     X3,RUT26A   IF K PART OF INST NOT JUST PROCESSED 
          SA1    INS.REG     K OF CURRENT INSTRUCTION 
          BX3    X1-X6
          ZR     X3,RUT25A   IF STORE REG IS *K* OF CURRENT INSTRUCTION 
  
 RUT26A   SB5    B2 
          ZR     X7,RUT27    IF REGISTER AVAILABLE
          DRITE  DEACTIVATE 
          SA5    B2+REGFILE 
          SX7    RUT27
          SA7    RUT.ADR     RESET JUMP ADDRESS 
          ZR     X2,RUT5     IF REGISTER NOT FREED
          MX0    -RG.USEL 
          SB5    B2 
          BX2    -X0*X5 
          NZ     X2,RUT5     IF NOT LAST USE OF REGISTER
  
**        TRANSFER INTERMEDIATE TO STORE REGISTER.
  
 RUT27    SX6    B5          0TR *I* REGISTER 
          MX0    -3 
          SA1    INT.REG     0TR *J* REGISTER 
          BX2    -X0*X6 
          BX7    -X0*X1 
          LX2    3
          IX7    X7+X2
          SX7    X7+XMT/1S3 
          LX7    PB.INSTP+3 
          WCODE  X7 
          SB7    RUT.X
          SA2    INT.REG
          SB2    B5 
          SA5    INT.TAG
          SB5    X2 
  
**        STORE INTERMEDIATE IN TEMPORARY.
*         (X5) = INTERMEDIATE TAG.
*         (B2) = 0TR OF STORE REGISTER. 
  
 RUT28    SX6    B5 
          SX7    B7 
          SA6    RUTA+1 
          SA7    RUT.ADR
          RJ     CWI         STORE INTERMEDIATE IN TEMPORARY
          SA1    RUTA+1 
          SA2    RUT.ADR
          SB5    X1 
          SB7    X2 
          JP     B7 
  
 RUTA     BSS    3           RUT SCRATCH
 RUT.ADR  DATA   0
 INT.TAG  DATA   0           INTERMEDIATE TAG 
 INT.REG  DATA   0           0TR OF REGISTER INTERMEDIATE IS IN 
 RUT.TYP  DATA   0           TYPE OF TAG
 SDS      SPACE  4,20 
**        SDS -  SET DELAYED STORE IN MOTION. 
* 
*         ENTRY  (B3) = REGISTER NUMBER FOR RIGHT MEMBER RESULTS = 0TR. 
*                       MUST INDICATE EITHER *X6* OR *X7* 
*                (X1) = TAG FOR LEFT MEMBER.
* 
*         NOTE -- 
*         IF CURRENT TAG BEING SET IS SAME AS *DRITE*, *DRITE* IS IGNORE
* 
*         EXIT   TAG FOR LEFT MEMBER SET INTO *RGFILE* *X* ASSOCIATE
*                (DRITE) = - 0TR. FOR LEFT MEMBER IF ALREADY IN *A* REG 
*                            TAG, IF NOT IN AN *A* REGISTER.
* 
*         USES   A1,A2,A3,A5,A6,A7  X0  B2,B3,B5,B7 
*                (SDSA,SDSA+1)
* 
*         CALLS  DRITE,GST,SST,SFR,WCODE
  
  
 SDS.X    SA2    SDSA 
          MX0    -3 
          NO
          BX6    -X0*X2 
          SB2    X2 
          LX6    3
  
  
 SDS      SUBR   =           ENTRY/EXIT...
          SX7    B3 
          SX0    B2 
          SA3    DRITE
          BX6    X5 
          LX0    RG.TYPP
          SA7    SDSA        SAVE REGISTER
          BX5    X5+X0
          BX0    X5-X3
          =A6    A7+1        SAVE REGISTER
          AX0    RG.TYPP
          SB6    B2 
          ZR     X0,SDS10    IF CURRENT TAG ALREADY DELAYED- IGNORE OLD 
          ZR     X3,SDS10    IF NO *DRITE*
          DRITE  DEACTIVATE  FORCE PROCESSING OF ANY DELAYED STORE
  
*         (X6) = TAG CURRENTLY PROCESSING.
  
 SDS10    SB2    B6 
          =B7    0           STATUS OF TAG ONLY 
          RJ     GST         GET STATUS OF TAG
          MX0    -3 
          =X3    REG.A
          BX6    X0*X5
          SX2    B2 
          ZR     B2,SDS15    IF TAG NOT IN REGISTER 
          BX7    X3*X2
          MX3    -1 
          SB7    B6+ST.STATP
          LX3    X3,B7
          ZR     X7,SDS12    IF NOT IN *A* REGISTER 
          =X7    0
          BX2    -X0*X2      =00R (LEFT MEMBER) 
          SB2    B2+REG.X-REG.A 
          IX6    X6+X2
  
 SDS12    SA7    B2+REGFILE  CLEAR REGISTER FILE
          BX7    X3*X1       CLEAR STATUS OF TAG
          SA7    A1 
 SDS15    SA2    SDSA        *X* REGISTER FOR LEFT MEMBER 
          SA6    DRITE       SET DRITE IN MOTION
          SB2    X2 
          BX6    -X0*X2 
          MX3    -RG.USEL 
          LX6    3           =0R0 (RIGHT MEMBER)
          SA2    B2+REGFILE 
          BX0    X3*X1       CLEAR USE COUNT
          BX7    -X3*X2      USE COUNT (RIGHT MEMBER) 
          IX6    X0+X6
          SX0    B6 
          SB3    B6 
          LX0    P2.BIASP 
          IX6    X6+X0
          =A6    A6+1 
          =A7    A6+1 
          NZ     X7,SDS20    IF NOT LAST USE OF RIGHT MEMBER
          SB7    SDS16
          EQ     SDS32       POSSIBLY FORCE RELOAD OF CURRENT TAG 
 SDS16    RJ     STS         SET TAG STATUS 
  
          EQ     SDS.X       FINISH UP
  
 SDS20    BX7    X2 
          =X0    1
          =A7    A6+1 
          IX2    X5-X0       USE COUNT - 1 (LEFT MEMBER)
          BX0    -X3*X2 
          SA2    GSTC        REMEMBER LOCATION OF STATUS WORD 
          BX7    X2 
          ZR     X0,SDS.X    IF LAST USE OF LEFT MEMBER 
          SB7    SDS22
          EQ     SDS32       POSSIBLY FORCE RELOAD OF CURRENT TAG 
 SDS22    SA7    SDSA+1 
  
          SB3    RG=LODX
          RJ     SFR
          NZ     X7,SDS.X    IF X REGISTER NOT AVAILABLE
          SA1    SDSA        =0TR) (RIGHT MEMBER) 
          MX0    -3 
          SX3    X6+XMT/1S3 
          BX1    -X0*X1      =00R 
          SB5    B2 
          IX7    X3+X1
          LX7    PB.INSTP+3 
          WCODE  X7 
          SA2    SDSA+1 
          SB2    B5 
          SB7    X2          ORDINAL IN TABLE OF STATUS WORD
          AX2    18 
          SA2    X2          FETCH ORIGIN OF TABLE
          SA1    X2+B7
          SB3    B6 
          RJ     STS         SET TAG STATUS 
          EQ     SDS.X       FINISH UP
  
*         FORCE RELOAD OF CURRENT TAG IF TAG IS A SUBSCRIPTED STORE WITH
*         SCALAR OFFSET AND IS NOT LAST USE OF TAG AND A SUBSCRIPTED
*         STORE WITH VARIABLE SUBSCRIPTS IS FOUND BEFORE SECOND USE OF
*         TAG.
  
 SDS32    LX0    X6 
          BX6    X5 
          SA6    SDSX5       SAVE X5
          BX6    X2 
          SA6    SDSX2       SAVE X2
          LX6    X0 
          SA5    B4+OR.2OP
          LX3    X5 
          SBIT   X5,P2.ARRP 
          PL     X5,SDS42    IF NOT ARRAY REFERENCE 
          MX0    P2.TAGL
          SA5    A5-OR.2OP   SET A5 
  
 SDS34    SA5    A5+Z=TURP   NEXT TURPLE
          ZR     X5,SDS42    IF END OF T.PAR
  
 SDS35    HX5    OP.SKEL
          AX5    -OP.SKELL   EXTRACT SKELTON ORDINAL
          BX5    -X5
          SA2    A5+OR.2OP
          SB5    X5+V=STR.I 
          NZ     B5,SDS34    IF NOT STORE (V=STR.I) 
          LX5    X2 
          SBIT   X5,P2.INTRP
          PL     X5,SDS40    IF NOT INTERMEDIATE
          SBIT   X5,P2.ARRP/P2.INTRP
          PL     X5,SDS40    IF NOT ARRAY (LEFT MEMBER) 
  
 SDS38    LX5    X2 
          SA2    T.PAR
          HX5    P2.BIAS
          AX5    -P2.BIASL
          SB5    X5 
          SB5    X2+B5
          SA2    B5+OR.1OP   ARRAY (LEFT MEMBER)
          BX5    X2-X1       X1 = TAG FOR LEFT MEMBER(T.OUS)
          BX2    X0*X5
          ZR     X2,SDS.X    IF ARRAY WITH VARIABLE SUBSCRIPT FOUND 
          EQ     SDS34       LOOP 
  
 SDS40    SA2    A5+OR.1OP
          LX5    X2 
          SBIT   X5,P2.INTRP
          MI     X5,SDS34    IF INTERMEDIATE
          SBIT   X5,P2.ARRP/P2.INTRP
          PL     X5,SDS34    IF NOT ARRAY(RIGHT MEMBER) 
          BX5    X2-X3       X3 = TAG FOR LEFT MEMBER(T.PAR)
          BX2    X0*X5
          NZ     X2,SDS34    IF ARRAY WITH SCALAR OFFSET NOT FOUND
  
 SDS42    SA2    SDSX2       RELOAD X2
          SA5    SDSX5       RELOAD X5
          JP     B7          RETURN TO SDS16 OR SDS22 
  
 SDSX2    DATA   0           X2 SAVED HERE
 SDSX5    DATA   0           X5 SAVED HERE
  
 SDSA     DATA   0,0         SAVE REQUESTED REGISTER
 SFR      SPACE  4,8
**        SFR -  SCAN FOR REGISTER. 
* 
*         *SFR* SCANS THE REGISTER FILE FINDING THE LOWEST USE COUNT
*         REGISTER AVAILABLE OF THE TYPE REQUESTED.  *SFR* MAKES A
*         SPECIAL CASE WHEN *RREG* IS SET OR A LOAD REGISTER IS 
*         REQUESTED TO STOP *J* AND *K* FROM GETTING THE SAME REGISTER. 
* 
*         UPON EXIT *SFR* RESTORES THE REGISTER SCAN WORD REPOSITIONED
*         TO POINT TO THE NEXT REGISTER TO START SCANNING.
*         (ALL REGISTER SCAN WORDS ARED DEFINED TO BE USED CYCLICALLY). 
* 
*         ENTRY  (B3) = RG=XXXX, TYPE OF REGISTER.
* 
*         EXIT   (B2) = 0TR, OF REGISTER FOUND. 
*                (B3) = PRESERVED 
*                (X6) = 0R0.
*                (X7) = USE COUNT 
* 
*         USES   A1,A2,A3  X0,X6,X7  B2,B3,B5,B7
*                (SCR2 FOR SAVING *X5*) 
  
  
 SFR.X    SA1    REGE        ADD OF REGFILE ENTRY SELECTED
          SA1    X1 
          BX6    X1 
          SA6    REGE        REGFILE ENTRY IF NOT ZERO USE COUNT ELSE 0 
          BX6    X2 
          SX3    B2 
          MX0    -3 
          =A6    B3+1        RESET REGISTER SKELETON WORD 
          SA5    SFRA        RESTORE *X5* 
          BX6    -X0*X3 
          LX6    3
  
 SFR      SUBR   =           ...ENTRY/EXIT... 
          SA1    B3 
          BX6    0
          SA2    RREG 
          LX1    -RS.NUMP 
          BX7    -X2
          SA6    RGX
          MI     X2,SFR5     IF NO HARD REGISTER
          MX0    -RG.USEL 
          SA7    A2 
          SB2    X2 
          MX1    -3 
          BX6    -X1*X2 
          SA3    B2+REGFILE 
          LX6    3           =0R0 
          BX7    -X0*X3      USE COUNT FOR HARD REGISTER
          EQ     EXIT.
  
 SFR5     SB7    X1          NUMBER OF REGISTERS
          ERRNZ  18-RS.NUML 
          MX3    1
          BX7    X5 
          LX1    RS.NUMP-RS.MSKP
          SX5    RLOCK
          SA7    SFRA 
          SB5    X1-1        LENGTH OF MASK - 1 
          ERRNZ  18-RS.MSKL 
          AX0    B5,X3       FORM MASK FOR REGISTER WORD
          =A2    A1+1        LOAD REGISTER SKELETON WORD
          =B5    B5+1        RESTORE LENGTH 
          LX0    B5,X0       SHIFT MASK TO LOW ORDER
          MX1    -RG.USEL 
          LX2    B5,X2       NEXT REGISTER ORDINAL
          BX6    X0*X2
          SA3    X6+REGFILE 
          BX1    -X1*X3      EXTRACT USE COUNT
  
 SFR10    SB2    X6 
          SX6    A3 
          SA6    REGE        RETAIN ADD OF REGFILE SELECTED 
          BX7    X1 
          NZ     X7,SFR12    IF REGISTER NOT FREE 
          MX6    0
          SA6    A3          A3 => CURRENT REGFILE ENTRY
          EQ     SFR.X
  
 SFR12    ZR     B7,SFR.X    IF FINISHED
          BX6    X0*X2       NEXT REGISTER ORDINAL
          MX1    -RG.USEL 
          SA3    X6+REGFILE 
          BX1    -X1*X3      EXTRACT USE COUNT
          IX3    X1-X7
          NG     X3,SFR10    IF NEW LOW 
          =B7    B7-1 
          LX2    X2,B5       SHIFT REGISTER WORD FOR NEXT ORDINAL 
          SA3    X6+REGFILE 
          IX1    X1-X5
          SBIT   X3,P2.INTRP
          MI     X3,SFR12    IF INTERMEDIATE
          PL     X1,SFR12    IF NOT NEW LOW (NON-INTERMEDIATE)
          IX5    X1+X5
          SA6    RGX
          EQ     SFR12
  
 SFRA     BSS    1
 REGE     BSS    1           REGFILE ENTRY IF NOT ZERO USE COUNT ELSE 0 
 STS      SPACE  4,8
**        STS - SET TAG STATUS
* 
*         ENTRY  (B2) = REGISTER (0TR)
*                (B3) = TYPE OF LOAD. 
*                       0 = UPPER HALF OF TAG.
*                       1 = LOWER HALF OF TAG.
*                (A1) = STATUS WORD ADDRESS.
*                (X1) = STATUS WORD.
* 
*         EXIT   (A1,X1) _,= STATUS WORD
*                (X5) = OPERAND OR REGFILE ENTRY WITH CURRENT USE COUNT 
*                (STATUS WORD) - APROPRIATE ST BIT AND REG FIELD SET
*                (REGFILE(0TR)) - UPDATED WITH CORRECT USE COUNT
* 
*         USES   A2,  X0,X2,X7,  B7 
* 
*         CALLS  AUT
* 
* 
*         NOTE - X1 AND X5 HAVE SOME FIELDS UPDATED,  BUT 
*         THEY RETAIN THE SAME DATA STRUCTURE ACROSS STS. 
* 
*         WARNING - IF THESE ROUTINES EVER MAKE TABLE MAN-
*         AGER CALLS IN THE FUTURE.  CARE MUST BE TAKEN TO
*         PRESERVE (A1) AS THE STATUS WORDPOINTER.
  
  
 STS      SUBR   =           ENTRY/EXIT.
          SA2    UUC         GET USE COUNT INCREMENT
          RJ     AUT         ADJUST USE TOTAL 
          ZR     B2,EXIT.    IF NO REGISTER REQUIRED
          SA2    B3+STATUS   GET SHIFT COUNTS FOR STATUS ROUTINES 
          =X0    1
          SB7    X2          SET SHIFT COUNT TO ST.LST OR ST.UST
          LX7    B7,X0       POSITION STATUS BIT
          =X0    B2          (X0) = (0TR) 
          AX2    18          POSITION NEXT SHIFT COUNT
          BX1    X1+X7       INSERT STATUS BIT IN STATUS WORD 
          SB7    X2          (B7) = ST.UREGP OR ST.LREGP
          MX2    -ST.UREGL   SET (0TR) MASK 
          LX2    B7,X2       POSITION (0TR) MASK
          LX7    B7,X0       POSITION (0TR) 
          BX1    X2*X1       CLEAR APROPRIATE REG FIELD 
          SX0    B3          (X0) = TYPE (1 OR 0) 
          IX1    X7+X1       ADD (0TR) INTO STATUS WORD 
          LX0    RG.TYPP     POSITION TYPE BIT
          BX5    X5+X0       ADD IN TYPE BIT TO REGFILE ENTRY 
          LX7    X1 
          SA7    A1          RESET STATUS WORD
          SA2    B2+REGFILE 
          MX0    -P2.USEL 
          LX7    X2 
          BX2    -X0*X2      USE COUNT
          ZR     X2,STS1     IF NO USE COUNT
          SX0    RLOCK
          BX0    X0*X2       LOCK BIT EXTRACTION
          NZ     X0,STS1     IF LOCK BIT SET
          BX0    X5-X7
          AX0    P2.USEL     ELIMINATE USE COUNT
          NZ     X0,STS1     IF TAGS NOT EQUAL
          SB3    X2          REGFILE USE COUNT
          MX0    -P2.USEL 
          BX7    -X0*X5 
          SB7    X7          INCOMING OPERAND USE COUNT 
          BX5    X0*X5
          GT     B7,B3,STSA  IF OPERAND USE COUNT .GT. REGFILE USE CNT
          IX5    X5+X2       ELSE RETAIN REGFILE USE COUNT
          EQ     STS1 
  
 STSA     IX5    X5+X7       RETAIN INCOMING OPERAND USE COUNT
  
  
 STS1     SX0    B2-REG.A    (XO) = (OTR) - (010) 
          SA2    UUC         GET USE COUNT DECREMENT VALUE
          AX0    3           (X0) = (00T) = (001) 
          IX7    X5-X2       SUBTRACT USE COUNT INCRIMENT 
          NZ     X0,STS2     IF NOT AN A-REG
          BX2    X5 
          SA7    B2+REGFILE+REG.X-REG.A    PLACE TAG IN ASOCIATED X-REG 
          SBIT   X2,P2.LCMP 
          MI     X2,EXIT.    IF LCM, DONT PLACE IN A-REG
  
 STS2     SA7    B2+REGFILE  MAKE REGFILE ENTRY FOR TAG 
          EQ     EXIT.
          TITLE  SUBSCRIPT PROCESSING.
 ALTAG    DATA   0           PASS 3 ARRAY LOAD TAG
 SAVEB4   BSS    3
 ALREG    CON    0
 AFREG    CON    0
 ADDR     DATA   0
 STORE    BSS    1
 ADDRS    BSS    1
 STORES   BSS    1
 SAVEB2   DATA   0
 TRIP     DATA   0
 SAVEX1   DATA   0
 AFSTS    CON    "BLOWUP"    LOCATION OF ADDRESS FUNCTION STATUS WORD 
  
**        O=PAR - PROCESS ARRAY REFERENCE.
* 
*         ENTRY HERE FROM ARITH WHEN SUBSCRIPT TURPLE FOUND.
*         PROCESSING IS DEFERRED UNTIL USE OF SUBSCRIPTED ARRAY IS
*         DETERMINED.  IF THE SUBSCRIPT IS A SUBSCRIPTED ARRAY, THEN
*         ARRAY IS PROCESSED. 
* 
*         ENTRY  (B4) _ START OF SUBSCRIPT ARRAY TURPLE. (OPERATOR WORD)
*                (B4+1)_ ARRAY TAG.+ BIAS    (OR.1OP) 
*                (B4+2)  INTERMEDIATE        (OR.2OP) 
* 
*         EXIT   (B4) UPDATED, EXIT TO EIS.PNX. 
*         USES   CANNOT DESTROY *B4*. 
  
  
 O=PAR    BSSENT 0           ENTRY... 
 .T       IFEQ   TEST,ON
          SA5    B4+OR.2OP
          CLAS=  X0,TP,(ARR,INTR) 
          BX1    X0*X5
          BX1    X0-X1
          ZR     X1,"BLOWUP" IF SUBSCRIPTED SUBSCRIPT 
 .T       ENDIF 
          SB4    B4+Z=TURP
          EQ     EIS.PNX     SET POST PROCESSING FLAG 
  
 SLD      SPACE  4,15 
**        SLD -  SUBSCRIPT LOAD.
* 
*         CALLED WHEN PROCESSING AN INTERMEDIATE AND FOUND THAT IT IS AN
*         ARRAY LOAD. 
* 
*         EXIT   SUBSCRIPT LOADED IN (X6) REGISTER. 
*                (X6) = REGISTER - (0R0). 
*                (B3) = REGISTER - (0TR). 
* 
*         (NOLDS) = (NOLDS) +1
* 
*         USES   A1,A2,A3,A4,A5  X0  B2,B3,B5,B6,B7 
*                CELLS -  SCR2 TO SCR2+6
  
 SLD      SUBR   =           ENTRY/EXIT...
          SX6    B4 
          BX7    X4 
          SA2    T.PAR
          LX1    X5 
          IX6    X6-X2
          HX1    P2.BIAS
          AX1    -P2.BIASL   ISOLATE I. L. ORDINAL OF ARRAY TURPLE
          SA6    SAVEB4      SAVE *B4*
          SB4    X1 
          SX6    A4 
          =A6    A6+1        SAVE *A4*
          SB4    X2+B4       SUBSCRIPT TURPLE 
          =A7    A6+1        SAVE *X4*
          =X7    0           SET VALUE WANTED FLAG
          SA7    STORES 
          SBIT   X5,P2.ADDRP
          PL     X5,SLD1     IF NOT ADDRESS REFERENCE 
          =X7    SX=AK-SA=AK ADD IN TO OP-CODE FOR ADDRESS/VALUE
  
 SLD1     SA7    ADDRS       NZ IF NO VALUE LOAD
          SA5    B4+OR.2OP   ADDRESS FUNCTION TAG 
          SA1    RREG 
          MX6    -0 
          BX7    X1 
          SA6    A1 
          SX6    B2 
          SA7    ALREG       SAVE HARD REGISTER FLAG
          SA7    ALREGS 
          SA6    TYPLOD 
          SX0    X7-R.X6
          MI     X0,SLD15    IF NOT STORE REGISTER
  
*         LOCK STORE REGISTER TO FORCE THE OTHER STORE REGISTER TO BE 
*         USED FOR ANY STORES TO TEMPORARIES
  
          MX0    -3 
          BX0    -X0*X7 
          SB7    X0          (00R) HARD REGISTER FLAG 
          RJ     RLL         LOCK HARD REGISTER 
          =X7    1
          SA7    STORES 
 SLD15    DRITE  X5 
          BX6    0
          SA6    TRIP        RESET RE-TRY INDICATOR 
          SB3    RG=LOAD
          SB2    B0 
          SB7    B1 
          RJ     GST         GET STATUS OF ADDRESS FUNCTION 
          SA2    GSTC 
          BX7    X2          SAVE LOCATION OF ADDRESS FUNCTION STATUS 
          SA7    AFSTS
          SB6    "BLOWUP"    **** DEBUG ****
          ZR     B2,SLD2     IF TAG NOT IN REGISTER 
          BX0    X6 
          AX0    3
          SA2    X0+REGFILE+REG.X 
          BX0    X5-X2
          SBIT   X2,P2.INTRP
          MI     X2,SLD3     IF INTERMEDIATE, NO CONFLICT 
          AX0    RG.USEL
          ZR     X0,SLD3     IF CORRECT TAG 
 SLD2     SA2    P2=KEEP
          BX1    X2*X1
          SB2    B0          INDICATE TYPLOD = UPPER
          RJ     LTG         LOAD ADDRESS FUNCTION
          BX2    X5 
          HX2    P2.LCM 
          PL     X2,SLD21    IF NOT LCM ADDRESS FUNCTION
          BX2    X6 
          AX2    3
          SB2    X2+REG.X    USE X-REG FOR STATUS 
          SA2    ALREGS 
          BX7    X2 
          SA7    ALREG       RESTORE FROM POSSIBLE CLI USE
  
 SLD21    SA2    TRIP 
          ZR     X2,SLD3     IF NO RECORD OF TROUBLE
          SA3    SAVEB2      (0TR) ARRAY LOAD REG 
          SB3    X3 
          SA1    B4+OR.1OP
          HX1    P2.LCM 
          PL     X1,SLD23    IF NOT UEM LOAD/STORE
          SB3    B3+REG.X-REG.A     USE X REGISTER FOR UEM
  
 SLD23    NE     B2,B3,SLD3  IF NO CONFLICT 
  
**        PROBLEM DUE TO ADDRESS FUNCTION AND ARRAY LOAD CLAIMING 
*         SAME REGISTER.  ADDRESS FUNCTION MUST BE COPIED TO ANOTHER
*         REGISTER. 
  
  
 .TEST    IFEQ   TEST,ON
          =X0    1
          BX0    -X0*X2 
 S=SLDCL  SNAP   SLD,,,(B2,B4,X5) 
 S=SLDTP  SNAP   *SAVEB4,,3,NONE
          NZ     X0,"BLOWUP" TRIP NE 1 OR +0 IS ILLEGAL 
 .TEST    ENDIF 
  
          AX6    3           (00R)  ADDRESS FUNCTION REGISTER 
          SB7    X6 
          CALL   RLL         LOCK ADDRESS FUNCTION REGISTER 
          RJ     AIR         ASSIGN INTERMEDIATE REGISTER 
          PL     B2,SLD25    IF REGISTER FREE 
          RJ     ASR         ASSIGN STORE REGISTER
 SLD25    SA3    SAVEB2      (0TR) ADDRESS FUNCTION REGISTER
          SB5    X3 
          SX6    B2          (0TR) *I* REGISTER 
          MX0    -3 
  
*         MAKE ADJUSTMENTS TO *REGFILE* 
  
          BX7    0
          SA7    B5+REGFILE+REG.X-REG.A  CLEAR OLD REGFILE ENTRY
  
*         COMPILE TRANSMIT INSTRUCTION
  
          BX2    -X0*X6      (00R) *I* REGISTER 
          BX7    -X0*X3      (00R) *J* REGISTER 
          LX2    3
          IX7    X7+X2
          SX7    X7+XMT/1S3 
          LX7    PB.INSTP+3 
          SB5    B2 
          WCODE  X7 
  
*         ADJUST/RESTORE REGISTERS
  
          SB2    B5          (0TR) NEW ADDRESS FUNCTION REGISTER
          MX0    -3 
          SX6    B2 
          BX6    -X0*X6 
          LX6    3           (0R0) NEW ADDRESS FUNCTION REGISTER
 SLD3     SA1    AFSTS
          SB7    X1          ORDINAL IN TABLE OF STATUS WORD
          AX1    18 
          SA2    X1          FETCH TABLE ORIGIN 
          SA3    UUC         GET USE COUNT DECRIMENT
          SA1    X2+B7       GET STATUS WORD OF ADDRESS FUNCTION
          BX7    X5 
          SA2    TRIP        GET TROUBLE INDICATOR
          SBIT   X7,P2.INTRP
          PL     X7,SLD31    IF NOT INTERMEDIATE
          BX7    -X2*X3      (X7) = 0 IF TRIP=1 OR UUC IF TRIP=0
          SA7    UUC         RESET UUC TO AVOID DOUBLE USE DECRIMENT
 SLD31    SB3    0           TYPE=UPPER 
          RJ     STS         SET TAG STATUS 
          BX7    X3 
          SA7    UUC         RESTORE UUC
          AX6    3
          SB7    X6 
          RJ     RLL         LOCK ADDRESS FUNCTION REGISTER 
          SA1    ALREG
          SX6    B2 
          BX7    X1 
          SA6    AFREG
          SA7    RREG        RESET HARD REGISTER FLAG 
          SX0    X7-R.X6
          MI     X0,SLD32    IF NOT STORE REGISTER
          MX0    -3 
          BX0    -X0*X7 
          SB7    X0          (00R) HARD REGISTER FLAG 
          RJ     RUL         UNLOCK HARD REGISTER 
 SLD32    SB3    RG=LOAD
          RJ     GNR         GET ARRAY LOAD REGISTER
          SX7    B2 
          SA7    SAVEB2 
          SA5    B4+OR.2OP    ADDRESS FUNCTION TAG
          SB3    RG=LOAD
          SB2    B0 
          SB7    B1 
          RJ     GST         GET STATUS OF ADDRESS FUNCTION (AGAIN) 
          SA2    GSTC 
          BX7    X2          SAVE LOCATION OF ADDRESS FUNCTION STATUS 
          SA7    AFSTS
          SB6    "BLOWUP"    **** DEBUG ****
          NZ     B2,SLD35    IF TAG IN REGISTER 
          SA2    TRIP 
          =X6    X2+1 
          SA6    A2          INCREMENT TRIP HISTORY 
          EQ     SLD2 
  
 SLD35    SA5    SAVEB2 
          SB2    X5          RESTORE B2 
          SB2    B2+REG.X-REG.A 
          SA5    B4+OR.1OP
          SX6    B2 
          BX7    X5          ARRAY TAG - PASS 3 FORMAT
          SA6    ALREG
          SA7    ALTAG
          SA3    AFREG
          MX7    -3 
          BX6    -X7*X3      (00R)
          AX3    3           (00T)
          SB7    X6          (00R) FOR *RUL*
          SX4    SA=BK
          ZR     X3,SLD4     IF *B* REGISTER
          SX4    SA=XK
          RJ     RUL         UNLOCK ADDRESS FUNCTION REGISTER 
 SLD4     SA3    TYPLOD      TYPE OF LOAD (0=UPPER HALF, 1= LOWER HALF) 
          SA1    ADDRS
          BX7    X1 
          SA7    ADDR 
          SA1    STORES 
          BX7    X1 
          SA7    STORE
          SA1    ALTAG       ARRAY LOAD TAG 
          LX3    P2.BIASP 
* 
*         (X1)    = ARRAY TAG 
*         (X5)    = ARRAY TAG 
*         (X4)    = SA=XK OR SA=BK
*         (ALREG) =  I REGISTER (OTR) 
*         (AFREG) = J REGISTER (OTR)
*         (ADDR)  = 0 IF VALUE WANTED 
*                 = 20000 IF ADDRESS WANTED 
* 
          SA2    ADDR 
          IX1    X1+X3
          BX3    X1 
          IX4    X2+X4       ADD IN VALUE FLAG
          BX7    X3 
          HX7    P2.LCM 
          MI     X7,SLD40    IF LCM REF 
          SBIT   X3,P2.FPP
          PL     X3,SLD8     IF ARRAY-LOAD NOT FORMAL PARAMETER 
  
*         RELOCK ADDRESS FUNCTION REGISTER TO AVOID CONFLICT WITH 
*         *FP* LOAD REGISTER IN LCM/ECS CASE. 
  
 SLD40    BX7    X1 
          SA7    SAVEX1      SAVE X1
          RJ     RLL
          SA1    ALREG
          SX2    X1-R.X6
          MI     X2,SLD42    IF NOT STORE REG, REG LOCK  IS NOT ON. 
          SB7    X1-REG.X 
          RJ     RLL         HARD STORE REG MUST BE LOCKED. 
  
 SLD42    SA1    SAVEX1 
          BX7    X1 
          HX7    P2.LCM 
          MI     X7,SLD100   IF LCM REF 
          RJ     LFP         LOAD ADDRESS OF FP 
          SA3    ALREG
          SX0    X3-R.X6
          MI     X0,SLD44    IF NOT A STORE REG 
          SB7    X3-REG.X 
          RJ     RUL         UNLOCK HARD STORE REG
 SLD44    SA3    AFREG
          MX0    -3 
          BX3    -X0*X3      (00R) ADDRESS FUNCTION REGISTER
          SB7    X3 
          RJ     RUL         UNLOCK ADDRESS FUNCTION REGISTER 
          SA3    AFREG       (0TR) ADDRESS FUNCTION 
          SX6    B2          (00R) *FP* B REGISTER
          AX3    3           (00T) ADDRESS FUNCTION REGISTER
          SX1    SA=XB
          SA2    ADDR 
          NZ     X3,SLD6     IF NOT IN *B* REGISTER 
          SX1    SA=BB
 SLD6     IX4    X1+X2       ADD IN ADDRESS/VALUE FUNCTION
          BX7    X6+X4       SET *K* REGISTER IN INSTRUCTION
          LX7    PB.INSTP 
          EQ     SL.CMP      CONTINUE 
  
**        ADD IN BIAS FIELD FOR TAG IN (X1) 
  
 SLD8     MX0    -P2.BIASL
          BX7     X1
          LX7    -P2.BIASP
          BX7    -X0*X7      (X7) = BIAS
          BX2    X7 
          SA7    BIAS 
          LX2    -P2.BIASL
          AX2    -P2.BIASL+17 
          LX4    PB.INSTP    OP-CODE
          NZ     X2,SLD102   IF ABS(BIAS) .GT. 2**17
          MX0    -PB.BIASL
          LX1    -P2.BIASP
          BX7    -X0*X1 
          LX1    P2.BIASP-P2.TAGP 
          MX0    -P2.TAGL 
          LX7    PB.BIASP 
          BX4    X7+X4       PB.BIAS = TRUNC(P2.BIAS) 
          BX7    -X0*X1 
          LX7    PB.TAGP
          BX7    X7+X4       PB.TAG = P2.TAG
  
**        OUTPUT CODE TO LOAD ARRAY INTO REGISTER.
* 
*         (AFREG) = REGISTER FOR *J* PART OF INSTRUCTION. 
*         (ALREG) = REGISTER FREE FOR LOAD. (0TR) 
*         (X7) = INSTRUCTION OP-CODE IN HIGH ORDER + BIAS IF PRESENT
  
 SL.CMP   SA2    AFREG
          MX0    -3 
          BX4    -X0*X2      EXTRACT *J* REGISTER 
          LX4    -12
          IX7    X7+X4       ADD IN *J* REGISTER
          SA1    ALREG
          BX6    -X0*X1 
          LX6    60-9        *I* REGISTER 
          IX7    X6+X7       ADD IN *I* REGISTER
          WCODE  X7          COMPILE ARRAY LOAD 
  
 SLCMPQ   SA5    ADDR 
          SA2    ALREG       (0TR)
          ZR     X5,SL.CMP0  IF ADDRESS NOT REQUESTED 
          =X5    P2.ADDRM 
 SL.CMP0  =X5    X5+P2.ARRM 
          SA1    TYPLOD 
          SB2    X2 
          SB3    X1 
  
*         DEFINE ARRAY LOAD RESULTS.
  
          RJ     DIT         DEFINE INTERMEDIATE
  
*         RESTORE REGISTERS AND EXIT. 
  
          SA5    SAVEB4 
          =X7    0
          =A1    A5+1 
          SA2    T.PAR
          IX5    X5+X2
          SB4    X5          RESTORE *B4* 
          =A2    A1+1 
          SA3    NOLDS
          SA7    AFREG
          SA4    X1          RESTORE *A4* 
          =X7    X3+1 
          BX4    X2          RESTORE *X4* 
          SA7    A3          UPDATE NO. OF LOADS
          EQ     EXIT.
  
 SLD100   SA5    ALTAG
          SA1    TYPLOD 
          LX1    P2.BIASP 
          IX5    X1+X5       ADD 1 IF LOWER 
          RJ     LLA         LOAD LCM ADDRESS 
          RJ     LLV         LOAD LCM VALUE 
          EQ     SLCMPQ 
  
*         HERE IF CA FIELD OVERFLOWS
  
 SLD102   MX0    -P2.TAGL 
          LX1    P2.TAGL
          BX7    -X0*X1 
          LX7    PB.TAGP
          BX7    X7+X4
          SA7    SLAA 
          SB3    RG=LOAD
          CALL   GNR
          AX6    3
          SA6    SLBB        CA LOAD REG
          MX0    1
          LX0    1+P2.SHRTP 
          SA2    BIAS 
          LX2    P2.BIASP 
          BX5    X0+X2
          CALL   ESC         EXPAND SHORT CONSTANT
          SX0    SA=BK
          LX0    PB.INSTP 
          LX3    PB.BIASP    (X3) = BIAS IN T.CON 
          LX1    PB.TAGP     (X1) = (S=CON) 
          BX6    X0+X3
          SA3    SLBB        CA LOAD REG
          BX7    X6+X1
          LX3    PB.IP
          BX7    X7+X3
          WCODE  X7          SA    CON.+K 
          SX2    IA 
          LX2    PB.INSTP    OP-CODE
          SA3    AFREG
          MX0    -3 
          BX4    -X0*X3 
          BX3    X4 
          LX4    PB.IP       I REG
          BX4    X4+X2
          LX3    PB.JP       J REG
          BX2    X4+X3
          SA5    SLBB 
          LX5    PB.KP       K REG
          BX7    X2+X5
          WCODE  X7          IX    JX + KX
          SA2    SLAA 
          BX7    X2 
          EQ     SL.CMP 
  
 SLAA     BSS    1
 SLBB     BSS    1
 ALREGS   BSS    1           LOCAL COPY ALREG 
          TITLE  SNAPS. 
 REGPRO   SPACE  4,20 
**        REGPRO - HELP ME DETERMINE IF REGISTERS ARE BEING ASSIGNED
*         CORRECTLY.
* 
*         ENTRY  (B2) = REGISTER BEING CLOBBERED, RESET ETC.
*                (X6) = CALLER NAME IN 3R FORMAT. 
* 
*         EXIT   MESSAGE PRINTED. 
* 
*         DESTROYS *A1,X1, X6*
  
 .TEST    IFEQ   TEST,ON     IF TEST MODE 
  
 REGPRO   SUBR               ...ENTRY/EXIT... 
          SA1    CO.SNAP
          LX1    1RH
          PL     X1,REGPROX  IF NOT REQUESTED.
          SA1    =7L
          BX6    X1+X6
          SA6    REGLNN      CALLER NAME. 
 REGFILE  CORE   REGFILE,L.RGFILE 
          CALL   SVR= 
          SA1    SVB+4
          SA2    T.PAR
          SX0    X1 
          IX1    X0-X2
          CALL   COD         CONVERT TO DPC 
          SA6    REGLNO 
          SA1    SVB+2
          SX1    X1 
          CALL   COD         CONVERT TO DPC 
          SA6    REGLNW 
          SA1    RGC
          CALL   COD
          SA6    REGRGC 
          SA1    RGX
          CALL   COD
          SA6    REGRGX 
          PLINE  REGLN,10    PRINT CONTENTS OF RGC, RGX 
          CALL   RSR= 
          EQ     REGPRO      CONTINUE 
  
 REGLN    DATA   30H REGISTER REASSIGNMENT -HELP- 
 REGLNO   DATA   10H
 REGLNW   DATA   10H
 REGLNN   DATA   0
          DATA   10H  RGC = 
 REGRGC   DATA   0
          DATA   10H  RGX = 
 REGRGX   DATA   0
  
 .TEST    ENDIF 
 END      SPACE  4,10 
          LIST   D
          END 
