*DECK     REG 
          IDENT  REG
 REG      SECT   (REGISTER ALLOCATOR ROUTINES),1
  
          SST    B,D,EXIT.
          NOREF  B,D,EXIT.
  
 B=REG    RPVDEF             DEFINE ROUTINE FWA FOR REPRIEVE UTILITY
  
          ENTRY  CLOADJ,REGLK,CRJ,CAR,CDS,CIA,DIT,GST,GNR,LTG 
          ENTRY  LFP,RLL,RUL,SST,ABR,ASR,AIR,LSC,RUT,SFR,SDS,CLI,CWI
          ENTRY  CLP,CLT,STRGLK 
  
*         IN FTN
          EXT    CO.TBK 
  
*         IN TABLES 
          EXT    DRITE,REGA,REGX
          EXT    RGC,REGFILE,RGX,RG=BADR,RG=INTR,RG=FPRG,UUC
          EXT    RG=LOAD,RG=LODX,RG=STOR,RREG 
          EXT    TG.TEM,TT.PAR,TT.SCR,TS.SYM
  
*         IN PIG
          EXT    WIN
  
*         IN GEN
          EXT    ALREG
          EXT    FMASK,LSHF,SA=AB,SA=AK,SA=BKS3 
          EXT    SB=BK,SB=BB,SB=XB,SB=XK,SX=BK,XOR,XMITS3 
          EXT    SA=XKS3,SA=ABS3,SA=ABS6,SA=AKS6,REGPRO 
          EXT    CRTTAB 
  
*         IN INIT 
          EXT    SCR
  
 ALX      SPACE  4,8
 ABR      SPACE  4,8
**        ABR -  ASSIGN *B* REGISTER
*         ENTRY  (X1) = TAG 
* 
*         EXIT   (B2) = 0TR - WHERE T = B TYPE
*                (X6) = 0R0 - REGISTER ASSIGNED 
* 
*         USES   A1,A2,A3  X0  B2,B3,B5,B7
*         CALLS  RUT, SFR 
  
  
 ABR      SUBR               ENTRY/EXIT...
          SB3    RG=BADR
          RJ     SFR         SCAN FOR REGISTER
          ZR     X7,EXIT.    IF USE COUNT *0* 
          RJ     RUT         RESET USE TABLE
          EQ     EXIT.
 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    -L.RUSE
          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 
          IFBIT  X0,-INTR,ASR2
          IFBIT  X0,2ARY/INTR,ASR2
          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 
 CAR      SPACE  4,8
**        CAR -  CLEAR REGISTER FILE (RGFILE).
* 
*         ENTRY  N/A
* 
*         EXIT   *RGFILE* CLEARED.
  
  
 CAR      SUBR               ENTRY/EXIT...
          =X6    0
          SB7    L.RGFILE 
 CAR5     SA2    B7+REGFILE 
          ZR     B7,EXIT.    IF FINISHED
          =B7    B7-1 
          IFBIT  X2,RLOCK,CAR5
          SA6    A2 
          EQ     CAR5        LOOP 
 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 
          =A1    A2+1 
          ZR     X0,CDS10    IF FORCED PROCESSING.
          BX7    X2-X0
          =A3    A1+1 
          AX7    P.TYPE 
          ZR     X7,CDS10    IF TAG SAME AS LEFT MEMBER 
          BX6    X3-X0
          AX6    P.TYPE 
          ZR     X6,CDS10    IF TAG SAME AS RIGHT MEMBER
          IFBIT  X0,-2EQUIV,EXIT.  IF TAG NOT EQUIVALENCED
  
**        COMPILE STORE OF TAG FOUND IN *B3* REGISTER FILE ENTRY. 
  
 CDS10    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    -L.RUSE
          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
  
 #FID     IFNE   .FID,0 
          ENTRY  CIAA 
 #FID     ENDIF 
 CIAA     BSSZ   1           LOCK CLEAR FLAG
  
 CIA      SUBR               ENTRY/EXIT...
          DRITE  DEACTIVATE 
          SB7    L.RGFILE 
          MX0    -L.RUSE
          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    -L.RUSE
          =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    -L.RUSE
          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+REGA
          SX7    X7+SA=ABS3 
          BX0    X2-X3
          LX7    P.LI15+3 
          BX3    X6 
          AX0    L.RUSE 
          NZ     X0,CIW10    IF NOT SAME TAG
          WCODE  X7 
          BX6    X3 
          AX3    3
          SB2    X3+REG.X-RGFILE
          EQ     EXIT.
  
 CIW10    BX2    X6 
          MX0    L.2TAG+L.2BIAS+L.2FPNO 
          AX2    3
          BX1    X0*X1
          BX7    X5 
          SA7    CIWA        SAVE X5
          BX5    X1 
          SB2    X2+REG.X-RGFILE
          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) = STATUS WORD OF TAG TO LOAD. 
*                       ONLY TAG, BIAS AND FPNO FIELDS ARE USED.
*                (X5) = STATUS WORD OF X1 TAG  OR 
*                     = PARSED FILE OPERAND WORD OF X1 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 ... 
          MX0    -L.2BIAS 
          LX0    P.2BIAS
          BX3    -X0*X1      TAG *BIAS* 
          MX2    -L.2FPNO 
  
**        CHECK FOR FORMAL PARAMETER. 
* 
*         (B3) = REGISTER TO USE - 00R. 
*         (B5) = 0TR. 
*         (X1) = TAG TO BE LOADED.
*         (X2) = MX2   -L.2FPNO 
*         (X3) = TAG *BIAS* 
*         (X6) = REGISTER TO USE - 0R0. 
  
 CLI2     LX2    P.2FPNO
          AX3    P.2BIAS-P.LBIAS
          BX0    -X2*X1      EXTRACT *FP* NO. 
          SB5    B2 
          BX2    X1 
          AX2    P.TGB
          SB7    X2-C.TEM/1S13
          SX7    X6+SA=BKS3  (X6) = 0R0 FOR *I* REG 
          ZR     B7,CLI18A   IF TEMP TAG, COMPILE  SAI TAG
          AX0    P.2FPNO
          ZR     X0,CLI15    IF NOT *FP*
  
**        TAG IS FORMAL PARAMETER 
*         SAVE SOME REGISTERS 
  
          SX7    B5 
          SA7    CLI.B5      SAVE B5  (0TR) 
          BX7    X1 
          SA7    CLI.X1      SAVE X1  STATUS WORD TAG 
          BX7    X3 
          SA7    CLI.X3      SAVE X3  BIAS
          BX7    X6 
          SB7    B2-R.X6+RGFILE 
          NG     B7,CLI5     IF NOT STORE REGISTER
  
**        GET LOAD REGISTER FOR INDIRECT STORE. 
  
          SA6    CLI.X6      SAVE X6 (0R0)
          BX6    X0 
          SA6    CLI.X0      SAVE X0 (PARAMETER NO.)
          SB3    RG=LOAD
          RJ     GNR         GET LOAD REGISTER
          BX7    X6          (0R0) LOAD REGISTER
  
*         RESTORE REGISTERS 
  
          SA3    CLI.B5 
          SB5    X3          RESTORE B5 
          SA3    CLI.X6 
          BX6    X3          RESTORE X6 
          SA3    CLI.X0 
          BX0    X3          RESTORE X0 
          SA3    CLI.X3      RESTORE X3 
  
**        OUTPUT TO LONG FILE 
*         SAI A0+FPNO-1  OR  SAI A0 
  
 CLI5     AX7    3           (00R) LOAD REGISTER
          SB3    X7 
          SX1    X0-1 
          SX0    X7+SA=AKS6 
          NZ     X1,CLI10    IF NOT 1ST PARAMETER 
          SX0    X7+SA=ABS6 
 CLI10    LX0    P.LI15+6 
          LX1    P.LBIAS
          SB5    X6+B3       =0RR 
          IX7    X0+X1
          WCODE  X7 
 #MD      IFEQ   .DAL,0 
  
**        FOR NON-LCM VALUE LOAD,  COMPILE- SAI XJ+BIAS.(0TR) 
*         OF *I* REG IS IN CLI.B5 AND (XJ) = (A0+FPNO-1). 
  
          SX7    B5+SA=XKS3 
          SA3    CLI.X3      RETRIEVE BIAS
          BX2    X5 
          IFBIT  X2,-ADDR,CLI11    IF VALUE LOAD, TAG IS SCM. 
  
 #MD      ENDIF 
  
*         SAVE SOME REGISTERS 
  
          SX7    B5 
          SA7    CLIA         SAVE (0RR)
          BX7    X5 
          SA7    CLI.X5      SAVE X5
          SA5    CLI.X1      TAG FOR *CLT*
          RJ     CLT         CHECK FOR LCM TAG
          SA2    CLIA 
          SB5    X2          RESTORE B5 (0RR) 
          SA5    CLI.X5      RESTORE X5 
          NZ     X3,CLI109   IF NOT LCM TAG 
  
**        FORMAL LCM TAG
  
          SA2    CLI.B5       (0TR) 
          =X0    M.ADDR 
          SA3    CLI.X3      RESTORE X3 (BIAS)
          NZ     X3,CLI103   IF NONZERO BIAS
  
 #MD      IFEQ   .DAL,1 
  
          BX0    X0*X5
          ZR     X0,CLI105   IF NOT ADDRESS 
  
 #MD      ENDIF 
  
**        ADDRESS IS TO BE LOADED, BIAS IS ZERO 
  
          SX7    B5+XMITS3
          EQ     CLI11
  
**        BIAS IS NONZERO -- COMPUTE ADDRESS
*         OUTPUT TO INTERMEDIATE FILE 
*                SXI    BIAS
*                IXI    XI+XJ 
  
 CLI103   MX0    -3 
          BX2    -X0*X2      (00R) OF UNBIASED ADDRESS
          SB7    X2 
          RJ     RLL         LOCK ADDRESS REGISTER
          SA7    CLI.PR      SAVE ADDRESS REGISTER (00R)
          =B3    =XRG=SET 
          RJ     GNR         GET SET REGISTER 
          SA2    CLI.PR      (00R) ADDRESS REGISTER 
          SB7    X2 
          RJ     RUL         UNLOCK ADDRESS REGISTER
          SX7    X6+=XSX=BKS3      OPCODE + *I* REGISTER
          SA6    CLI.SR      SAVE SET REGISTER (0R0)
          SA3    CLI.X3      RELOAD BIAS
          LX7    P.LI15+3 
          BX7    X7+X3       ADD IN BIAS
          WCODE X7           COMPILE SET INSTRUCTION
          SA2    CLI.PR      (00R) ADDRESS REGISTER 
          SA3    CLI.SR      (0R0) SET REGISTER 
          SX7    X2+=XIADD   OPCODE + *K* REGISTER
          LX2    6           (R00) ADDRESS REGISTER 
          BX7    X7+X3       ADD IN *J* REGISTER
          BX7    X7+X2       ADD IN *I* REGISTER
          LX7    P.LI15 
          SA5    CLI.X5 
          =X0    M.ADDR 
          BX0    X0*X5
          SA2    CLI.B5 
          SB5    X2          (0TR) ADDRESS REGISTER 
  
 #MD      IFEQ   .DAL,1 
  
          NZ     X0,CLI20    IF ADDRESS ONLY
          WCODE  X7 
  
**        OUTPUT TO INTERMEDIATE FILE 
*                RXJ    XK
*         OR
*                WXJ    XK
  
 CLI105   SB5    X2          (0TR)
          SB7    B5-R.X6+RGFILE 
          SA2    CLIA        (0RR)
          NG     B7,CLI107   IF NOT STORE REGISTER
          SX7    X2+=XLCMW   OPCODE + *J* AND *K* REGISTERS 
          EQ     CLI108 
  
 CLI107   SX7    X2+=XLCMR   OPCODE + *J* AND *K* REGISTERS 
  
 CLI108   LX7    P.LI15 
  
 #MD      ENDIF 
  
          EQ     CLI20
  
  
**        NON-LCM FORMAL PARAMETER, (XJ) = (A0+FPNO-1)
*         AND (0TR) OF *I* REG IN CLI.B5 .
  
 CLI109   SA3    CLI.X3 
          =X0    M.ADDR 
          SX7    B5+SA=XKS3 
          BX0    X0*X5
          ZR     X0,CLI11    IF VALUE LOAD, COMPILE SAI XJ+BIAS.
          SB2    SA=XKS3
          SB2    -B2
          ZR     X3,CLI10D   IF ZERO BIAS, COMPILE  BXI XJ. 
  
*         NONZERO BIAS, COMPILE  SXI XJ+BIAS. 
  
          SB2    B2+=XSX=XKS3 
          SX7    X7+B2
          SA3    CLI.X3      RELOAD BIAS
          EQ     CLI11
  
 CLI10D   SB2    B2+XMITS3
          SX7    X7+B2
 CLI11    LX7    P.LI15+3 
          SA2    CLI.B5 
          IX7    X7+X3       ADD IN *BIAS*
          SB5    X2          RESTORE (0TR)
          EQ     CLI20       COMPLETE LOAD
  
**        NOT FORMAL PARAMETER. 
  
 CLI15    MX0    L.TAG
 #MD      IFEQ   .DAL,0 
  
          BX2    X5 
          IFBIT  X2,-ADDR,CLI18A   NOT FP/LCM, COMPILE  SAI TAG.
  
 #MD      ENDIF 
  
*         SAVE SOME REGISTERS 
  
          BX7    X1 
          SA7    CLI.X1      SAVE X1
          BX7    X3 
          SA7    CLI.X3      SAVE X3
          BX7    X5 
          SA7    CLI.X5      SAVE X5
          SX7    B5 
          SA7    CLI.B5      SAVE B5
          BX5    X1          TAG FOR *CLT*
          RJ     CLT         CHECK FOR LCM TAG
          NZ     X3,CLI18    IF NOT LCM TAG 
  
**        LOAD LCM TAG
  
          SA6    CLI.LR      SAVE LOAD REGISTER 
          RJ     CLP         COMPILE LOAD OF POINTER
          SX2    B5          (0TR) POINTER LOAD REGISTER
          MX0    -3 
          BX2    -X0*X2      (00R)
          SB7    X2 
          RJ     RLL         LOCK POINTER REGISTER
          SA7    CLI.PR      SAVE POINTER REGISTER (00R)
  
**        OUTPUT TO INTERMEDIATE FILE 
*                SXI    RELADD+BIAS 
*         RELADD = RELATIVE ADDRESS OF NAME IN BLOCK
  
          =B3    =XRG=SET 
          RJ     GNR         GET SET REGISTER 
          SA2    CLI.PR      (00R) POINTER REGISTER 
          SB7    X2 
          RJ     RUL         UNLOCK POINTER REGISTER
          SX7    X6+=XSX=BKS3      OPCODE + *I* REGISTER
          SA6    CLI.SR      SAVE SET REGISTER (0R0)
          SA1    CLI.X1      RELOAD TAG 
          SA2    =XTA.NAM 
          MX0    -L.PWF 
          LX1    -P.2TAG
          SB3    X2          (B3) = FWA ADDRESS TABLE 
          BX2    -X0*X1      (X2) = TAG ORDINAL 
          AX2    1
          SA2    X2+B3       FETCH ADDRESS TABLE ENTRY
          MX0    -L.RELADD
          BX2    -X0*X2      (X2) = BLOCK-RELATIVE ADDRESS
          LX2    P.LBIAS
          SA3    CLI.X3      RELOAD BIAS
          IX3    X2+X3       RELADD + BIAS
          LX7    P.LI15+3 
          BX7    X7+X3
          WCODE  X7          COMPILE SET INSTRUCTION
  
**        OUTPUT TO INTERMEDIATE FILE 
*                IXI    XI+XJ 
  
          SA2    CLI.PR      (00R) POINTER REGISTER 
          SA3    CLI.SR      (0R0) SET REGISTER 
          SX7    X2+=XIADD   OPCODE + *K* REGISTER
          LX2    6           (R00) ADDRESS REGISTER 
          BX7    X7+X3       ADD IN *J* REGISTER
  
 #MD      IFEQ   .DAL,1 
  
          SA5    CLI.X5 
          SX0    M.ADDR 
          BX0    X0*X5
          NZ     X0,CLI17A   IF ADDRESS SET 
          BX7    X7+X2       ADD IN *I* REGISTER
          LX7    P.LI15 
          WCODE  X7          COMPILE ADD INSTRUCTION
  
**        OUTPUT TO INTERMEDIATE FILE 
*                RXJ    XK
*         OR
*                WXJ    XK
  
          SA3    CLI.B5      (0TR) LOAD REGISTER
          SA2    CLI.PR      (00R) ADDRESS REGISTER 
          SB5    X3 
          SA3    CLI.LR      (0R0) LOAD REGISTER
          SB7    B5-R.X6+RGFILE 
          NG     B7,CLI16    IF NOT STORE REGISTER
          SX7    X2+=XLCMW   OPCODE + *K* REGISTER
          EQ     CLI17
  
 CLI16    SX7    X2+=XLCMR   OPCODE + *K* REGISTER
  
 CLI17    BX7    X7+X3       ADD IN *J* REGISTER
          LX7    P.LI15 
          EQ     CLI20
  
 #MD      ENDIF 
  
 CLI17A   SA3    CLI.LR 
          LX3    6-3
          BX7    X7+X3
          LX7    P.LI15 
          SA3    CLI.B5 
          SB5    X3 
          SA5    CLI.X5 
          EQ     CLI20
  
  
*         RESTORE REGISTERS 
  
 CLI18    SA1    CLI.B5      (0TR)
          SA3    CLI.X3      RESTORE X3  (BIAS) 
          SB5    X1          RESTORE B5  (0TR OF LOAD REGISTER) 
          SA5    CLI.X5      RESTORE X5  (TAG)
          SA1    CLI.X1      RESTORE X1  (TAG)
  
          SX0    M.ADDR 
          SX7    X6+SA=BKS3 
          BX0    X0*X5
          ZR     X0,CLI18A   IF NOT ADDRESS SET 
          SX7    X6+SX=BKS3 
  
 CLI18A   MX0    L.TAG
          BX2    X0*X1
          IX0    X7+X2
          LX0    P.LI15+3 
          BX7    X3+X0       ADD IN *BIAS*
  
 CLI20    WCODE  X7 
          SX6    B5 
          MX0    -3 
          SB2    B5 
          BX6    -X0*X6 
          LX6    3           =0R0 
          EQ     EXIT.
  
 CLIA     DATA   0
  
 CLI.X0   BSS    1
 CLI.X1   BSS    1
 CLI.X3   BSS    1
 CLI.X5   BSS    1
 CLI.X6   BSS    1
 CLI.B5   BSS    1
 CLI.LR   BSS    1
 CLI.PR   BSS    1
 CLI.SR   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
*                (B5) = 0TR OF REGISTER USED
* 
*         USES   A1,A2,A3,A6  X0,X7  B2,B3,B6,B7
  
  
 CLP      SUBR               ENTRY/EXIT ... 
          RJ     GPT         GET POINTER TAG
          LX2    P.LTAG-P.CTAG     ALIGN POINTER TAG
          BX6    X2 
          SA6    CLPA        SAVE POINTER TAG 
          =B3    RG=LOAD
          RJ     GNR         GET POINTER-WORD LOAD REGISTER 
          LX6    3           (R00)
          SX1    =XSA=BK
          IX7    X1+X6       ADD IN *I* REGISTER
          LX7    P.LI15      ALIGN
          SA2    CLPA        RELOAD POINTER TAG 
          IX7    X7+X2       ADD IN TAG 
          SB5    B2 
          WCODE  X7,EXIT.    COMPILE LOAD OF POINTER
  
 CLPA     BSS    1
          SPACE  4,8
**        CLT -  CHECK FOR LCM/ECS TAG
* 
*         ENTRY  (X5) = TAG IN *PASS 2* TAG FIELD 
* 
*         EXIT   (X3) = 0    IF TAG IS LCM OR ECS 
*                     " 0    IF TAG IS SCM OR CM
*                (X5) = PRESERVED 
* 
*         USES   A1,A3  X0  B5,B7 
* 
*         CALLS  GLN
  
  
 CLT      SUBR   0
          LX5    -P.2TAG
          MX0    -L.2TAG+L.PWF
          LX0    L.PWF
          BX0    -X0*X5 
          LX5    P.2TAG      RESTORE X5 
          SX0    X0-C.SYM 
          ZR     X0,CLT2     IF SYMBOL TAG
          =X3    1
          EQ     CLTX        EXIT.. 
  
 CLT2     RJ     GLN         GET LEVEL NUMBER OF TAG
          SX3    X1-3 
          ZR     X3,CLTX     IF LEVEL 3, EXIT.. 
  
 .76      IFEQ   .CPU,76
  
          SX3    X1-2 
  
 .76      ENDIF 
  
          EQ     CLTX        EXIT.. 
          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 NO. FOR TRACEBACK (IF SELECTED)
*                X6 = 18/TAG,42/XXXX
*         USES   A2,A3,A6,A7
* 
*         CALLS  CIA, WCODE 
  
CRJ       SUBR               ENTRY/EXIT 
          SA2    CO.TBK      TRACEBACK FLAG (T-OPTION)
          AX6    P.TAG       REMOVE LOW-ORDER GARBAGE 
          =X7    I.RJ 
          LX6    P.TAG       REPOSITION 
          ZR     X1,CRJ4     IF TRACE PROHIBITED
          MI     X1,CRJ2     IF TRACE MANDATORY 
          PL     X2,CRJ4     IF T-OPTION NOT SELECTED 
 CRJ2     SX7    X3-7777B 
          MI     X7,CRJ3     IF LINE NO. .LT. 4096
          SX7    X3 
          SA7    CRJB        SAVE LINE NO.
          SX3    7777B       FLAG IN LINE NO. 
 CRJ3     =X7    I.CALL 
          LX3    P.LI12-P.TRC 
          BX6    X6+X3
 CRJ4     BX6    X6+X7
          LX6    P.LI12 
          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
          SA2    CRJB 
          ZR     X2,EXIT.    IF LINE NO. WAS .LT. 4096
          SA3    CRJC 
          WCODE  X3          SB0 B0+0 TO LONG FILE  (FILLER)
          SA2    CRJB        LINE NO. 
          SA3    CRJC        SB0 SKELETON 
          LX2    P.LBIAS     POSITION LINE NO. TO BIAS FIELD
          BX7    X3+X2
          WCODE  X7          SB0 B0+LINE NO.  TO LONG FILE
          =X7    0
          SA7    CRJB        CLEAR FLAG FOR NEXT TIME 
          EQ     EXIT.
  
 CRJA     BSS    1           TEMP CELL FOR INSTRUCTION
 CRJB     BSSZ   1           TEMP CELL FOR LINE NO. IF .GT. 4095
 CRJC     VFD    12/6100B,48/0  LONG FILE WORD FOR SB0 B0+K 
 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.
 STINS    SPACE  4,8
**        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. (18/T-TAG,24/0,18/MODE)
* 
*                (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
          SX5    B2-R.X0+RGFILE 
          SB7    B2-R.X6+RGFILE 
          PL     B7,CWI20    IF IN STORE REGISTER 
          SA6    SCR         SAVE TAG 
          BX7    X5 
          =A7    A6+1        SAVE REG 
          RJ     ASR
          SA3    SCR+1       REGISTER =00L
          IX0    X3+X6       =RL
          SX7    X0+XMITS3
          BX5    X6 
          LX7    P.LI15+3 
          WCODE  X7          COMPILE *XMIT* TO *R*
          SA1    SCR         RELOAD TAG 
          AX5    3           =00L  (L-R  = R) 
          BX6    X1 
  
*         (X5) = REGISTER INTERMEDIATE IS IN = 00R
*         (X6) = TEMP TAG - 18/TAG,24/0,15/0,3/MODE 
*         (B6) _ INTERMEDIATE 
  
 CWI20    BX1    X6 
          BX6    X5 
          LX6    3
          SB5    X5+R.X0-RGFILE 
          BX5    X1 
          SX7    X6+SA=BKS3 
          MX0    -L.2BIAS 
          LX0    P.2BIAS
          BX3    -X0*X1      BIAS 
          LX3    P.LBIAS-P.2BIAS
          MX0    -L.2TAG
          LX0    P.2TAG 
          BX1    -X0*X1      TAG
          LX1    P.LTAG-P.2TAG
          LX7    P.LI15+3 
          BX0    X3+X7
          BX7    X0+X1
          WCODE  X7 
          SB2    B5 
          BX6    X5 
          EQ     EXIT.
 DIT      SPACE  4,8
**        DIT -  DEFINE INTERMEDIATE RESULTS. 
* 
*         ENTRY  (B2) = REGISTER FOR INTERMEDIATE.
*                (B4) = CURRENT PASS 1 ENTRY. 
*                (X5) = SPECIAL MODE BITS FOR INTERMEDIATE. 
*                       IE. ARY, OPVAL ETC. 
* 
*         EXIT   (B2) = 0TR, FOR 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  SST
  
 DIT      SUBR               ENTRY/EXIT...
          =A1    B4+OR.OPR   CURRENT OPERATOR.
          BX2    X1 
          MX0    -L.DMOD
          SA3    TT.PAR      FWA
          LX0    P.DMOD 
          MX7    -L.RUSE
          BX0    -X0*X1      RESULTANT MODE.
          AX2    P.MODC 
          SB5    X3          FWA
          BX6    -X7*X2      USE COUNT
  
**        CONSTRUCT INTERMEDIATE. 
  
          SX3    B4-B5       ORDINAL
          SX7    X5+M.INTR
          LX3    P.TAG
          IX5    X3+X0       ORDINAL + MODE 
          MX2    -3 
          IX5    X5+X6
          BX5    X7+X5
          SX3    B2          =0TR 
          BX6    -X2*X3      =00R 
          LX6    3
          RJ     SST         SET STATUS OF TAG
          EQ     EXIT.
          SPACE  4,8
**        GLN -  GET LEVEL NUMBER OF TAG
* 
*         ENTRY  (X5) = TAG IN *PASS 2* TAG FIELD 
* 
*         EXIT   (X1) = LEVEL NUMBER OF TAG 
*                (X5) = PRESERVED 
* 
*         USES   A1,A3  X0  B5,B7 
  
  
 GLN      SUBR   0
  
*         THE TAG WORD MAY NOW BE IN TT.USE.  WE LOOK FOR IT THERE FIRST
*         AND, IF NOT FOUND, WE GO TO TS.SYM. 
  
          SA1    =XTT.USE 
          SA3    =XTT=USE 
          =B5    X1          (B5) = FWA TT.USE
          =B7    X3 
          =B7    B7-1 
          MX0    L.TAG
          LX5    -P.2TAG-L.TAG
          BX3    X0*X5       (X3) = TAG ONLY
          LX5    P.2TAG+L.TAG 
          LT     B7,GLN6     IF NULL USE TABLE, AVOID 
  
GLN2      SA1    B5+B7       FETCH TT.USE ENTRY 
          LX1    -P.TAG-L.TAG 
          BX0    X0*X1       (X0) = TAG ONLY
          IX0    X0-X3
          ZR     X0,GLN8     IF TAG FOUND 
          MX0    L.TAG       RESTORE X0 
          =B7    B7-1 
          PL     B7,GLN2     IF NOT END OF TABLE, LOOP
  
 GLN6     LX3    -P.TAG 
          MX0    -L.PWF 
          BX3    -X0*X3      (X3) = TS.SYM ORDINAL
          SA1    TS.SYM 
          =B7    X3 
          SA1    X1+B7       FETCH TS.SYM ENTRY 
 GLN8     IFBIT  X1,-LEV,GLN9      IF NOT *LEVEL* TAG 
          MX0    -L.LEVN
          LX1    P.LEV+1-P.LEVN 
          BX1    -X0*X1      (X1) = LEVEL NUMBER
          EQ     GLNX        EXIT.. 
  
 GLN9     SX1    1
          EQ     GLNX        EXIT.. 
          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    -L.RUSE
          BX1    -X0*X1      USE COUNT ONLY 
          ZR     X1,EXIT.    IF *A* REGISTER IS FREE
          RJ     RUT         CLEAR *A* REGISTER 
          EQ     EXIT.
  
 GNRA     DATA   0
 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.TAG + ORDINAL OF INTR + INTR BIT + USE CT
* 
*         USES   A1,A2,A3,A6,A7 X0 B3,B5. 
* 
*         CALLS  NONE.
  
  
 GNT      SUBR               ENTRY/EXIT...
          MX0    -1 
          SA3    TT.PAR 
          AX1    P.TYPE 
          SB3    X3          START OF PARSED FILE 
          BX6    -X0*X1      TAG TYPE (0 = UPPER HALF, 1 = ;OWER HALF)
          SA2    TG.TEM 
          MX0    -L.DMOD
          SB7    X6 
          AX1    P.DMOD-P.TYPE
          =X7    X2+1          ADVANCE TG.TEM 
          BX6    -X0*X1        MODE OF INTERMEDIATE 
          AX1    P.JPAD-P.DMOD
          MX0    L.2TAG+L.2BIAS 
          SA3    X1+B3         LOAD INTERMEDIATE CELL 
          LX2    P.2TAG 
          BX1    X3 
          IFBIT  X6,LONG,GNT4 
          ZR     B7,GNT5
 GNT4     SX7    X7+1        ADVANCE (TG.TEM) TWICE IF DOUBLE-WORD
  
 GNT5     AX1    P.TGB
          SB3    X1-C.TEM/1S13
          MX1    -1 
          SB7    B7+P.2STAT 
          ZR     B3,GNT10      IF TEMPORARY TAG ALREADY DEFINED 
          BX3    -X0*X3 
          SA7    A2            UPDATE TG.TEM
          BX3    X2+X3
  
 GNT10    MX0    L.2TAG+L.2BIAS+L.2FPNO 
          BX6    X0*X3
          LX2    X1,B7
          SX1    B7-P.2STAT 
          BX7    X2*X3
          LX1    P.2BIAS
          SA7    A3            CLEAR STATUS OF TAG
          BX6    X1+X6
          EQ     EXIT.
 GST      SPACE  4
**        GPT -  GET POINTER TAG
* 
*         ENTRY  (X5) = ECS/LCM NAME TAG
* 
*         EXIT   (X2) = POINTER-WORD TAG
*                (X5) = PRESERVED 
* 
*         USES   A2,A3  B7
  
 GPT      SUBR   0
          SA3    =XTA.NAM 
          SB7    X3                (B7) = FWA ADDRESS TABLE 
          MX2    -L.PWF 
          LX5    -P.2TAG
          BX2    -X2*X5      (X2) = TAG ORDINAL 
          LX5    P.2TAG            RESTORE X5 
          SA3    =XTS.BLK 
          AX2    1           (X2) = ADDRESS TABLE ORDINAL 
          SA2    X2+B7       (X2) = ADDRESS TABLE ENTRY 
          SB7    X3+B1             (B7) = FWA+1 BLOCK TABLE 
          MX3    -L.BLOCK 
          AX2    P.BLOCK
          BX2    -X3*X2      (X2) = BLOCK NUMBER
          SA2    X2+B7       (X2) = BLOCK TABLE ENTRY 
          MX3    L.CTAG 
          BX2    X3*X2       (X2) = POINTER-WORD TAG
          EQ     GPTX              EXIT.. 
          SPACE  4,8
**        GST - GET STATUS OF TAG.
* 
*         ENTRY  (X5) = TAG.
*                (B2) = 0 (STATUS OF UPPER HALF)
*                       1 (STATUS OF LOWER HALF)
*                (B3) = RG=XXXX REGISTER TYPE 
*                (B7) = 0 STATUS OF TAG ONLY. 
*                     " 0 FULL STATUS. IF TAG IS IN A REGISTER, CRT IS
*                         CALLED TO CHECK IF REGISTER TYPES MATCH.
* 
*         EXIT.  (B2) = 0 (TAG NOT IN REGISTER) 
*                     " 0 (TAG IN REGISTER - 0TR OF REGISTER) 
*                (A1) _ ADDRESS OF TAG
*                (X1) = (ADDRESS) 
*                (X5) PRESERVED)
*                (X6) = 0R0 - IF TAG IN REGISTER. 
*                (GSTC) = LOCATION OF STATUS WORD --
**T  GSTC 42/ TABLE, 18/ ORDINAL
* 
*         USES   A1,A2  X0,X3,X6  B2,B3,B7
*                UNDER NO CONDITION CAN *GST* DESTROY *B5* OR *B6*. 
* 
*         CALLS  CRT
  
  
 GSTX     SX6    B2 
          MX0    -3 
          BX6    -X0*X6 
          LX6    3           =0R0 
 GST      SUBR   -           ENTRY/EXIT...
          SX7    B7 
          SA7    GSTA 
          MX0    -1 
          BX1    X5 
          AX1    60-4 
          BX3    -X0*X1      EXTRACT 4 BIT
          AX1    1           UPPER 3 TAG BITS ONLY
          IX6    X1+X3       TABLE ORDINAL
  
*         (X6) = ORDINAL INTO *GST.TBL* DEFINED FROM THE *UPPER *4* BITS
*                OF THE TAG.
  
 GST5     SA2    X6+GST.TBL 
          SA3    B2+GST.STAT
          LX6    X2 
          SA1    X2          LOAD BASE TABLE POINTER WORD 
          AX6    P.GSTSFT 
          SB7    X1          FWA OF TABLE 
          AX2    P.GSTTAG 
          SB2    X6          SHIFT COUNT FOR ORDINAL
          MX0    60-15
          AX7    X5,B2
          IX6    X7-X2       TABLE ORDINAL
          SB2    B0          INDICATE NOT IN REGISTER 
          BX6    -X0*X6 
          SX7    A1 
          LX7    18 
          IX7    X6+X7
          SA1    X6+B7
          MX0    -L.UREG
          SB7    X3          SHIFT COUNT TO CHECK STATUS
          LX2    X1,B7
          SA7    GSTC        SAVE LOCATION OF STATUS WORD 
          PL     X2,EXIT.    IF NOT IN REGISTER 
          AX3    18 
          SB7    X3 
          AX7    X1,B7
          BX6    -X0*X7      REGISTER (0TR) 
          SB2    X6 
          SA2    B2+REGFILE 
          BX6    X2-X5
          AX6    L.RUSE 
          IFBIT  X2,-INTR,GST6     IF NOT INTERMEDIATE
          AX6    P.2TAG-L.RUSE
 GST6     NZ     X6,GST7     IF NOT SAME TAG
          SX2    B2 
          =X0    REG.A-RGFILE 
          BX2    X0*X2
          ZR     X2,GST8     IF NOT *A* REGISTER
          SA2    A2+REG.X-REG.A 
          BX6    X2-X5
          AX6    L.RUSE 
          ZR     X6,GST8     IF SAME TAG
 GST7     SB2    B0          INDICATE NOT IN REGISTER 
          EQ     EXIT.
  
 GST8     SA2    GSTA 
          ZR     X2,GSTX     IF FULL STATUS NOT REQUESTED 
          RJ     CRT         CHECK REGISTER TYPES 
          NZ     B7,GST10    IF TYPES DO NOT MATCH
          SA2    RREG 
          MX3    -3 
          SX0    B2 
          MI     X2,GSTX     IF NO HARD REGISTER
          BX6    X0-X2
          BX0    -X3*X6 
          NZ     X0,GST10    IF NOT IN CORRECT REGISTER 
          BX6    -X2         CLEAR HARD REGISTER ASSIGNMENT 
          SA6    A2 
          EQ     GSTX 
  
*         TAG IS NOT IN CORRECT REGISTER. 
*         (B2) = REGISTER (0TR) 
*         (X7) = INSTRUCTION TO USE.
  
 GST10    SX0    B2-R.X6+RGFILE 
          MI     X0,GST11    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. 
  
          SX6    B2 
          SA6    STRGLK      REGISTER TO CLEAR
          SA2    B2+REGFILE 
          SX0    RLOCK
          BX6    X0+X2       LOCK ON
          SA6    A2 
          EQ     GST12
  
 GST11    =X0    REG.A-RGFILE 
          SX2    B2 
          BX6    0
          LX3    X7 
          BX2    X0*X2
          SA6    B2+REGFILE 
          ZR     X2,GST12    IF TAG NOT IN *A* REGISTER 
          SA2    A6+REG.X-REG.A   GET ASSOCIATE *X* REG 
          NO
          BX6    X2-X5
          AX6    L.RUSE 
          NZ     X6,GST12    IF NOT SAME TAGE IN *X* REGISTER 
          SA6    A2          CLEAR ASSIGNMENT 
 GST12    AX3    9
          SB3    RG=LODX
          MX0    -2 
          SB7    XMITS3 
          SB7    -B7
          SX6    X7+B7
          SB7    B1 
          BX2    -X0*X3 
          ZR     X6,GSTX     IF XMIT
          SA2    X2+GSTA     GET TYPE OF LOAD TO USE
          SB3    X2 
          EQ     GSTX 
  
 GSTA     BSS    1
          VFD    42/0,18/RG=LOAD
          VFD    42/0,18/RG=BADR
          VFD    42/0,18/RG=LODX
          ENTRY  GSTC 
 GSTC     CON    "BLOWUP"    LOCATION OF STATUS WORD
  
 GST.STAT BSS    0
          VFD    24/0,18/P.UREG,18/59-P.USTAT 
          VFD    24/0,18/P.LREG,18/59-P.LSTAT 
 TBLOOK   SPACE  4,8
**        TBLOOK - SET UP TABLE FOR TAG LOOK UP.
* 
*         TAG   = BIAS TO SUBSTRACT FROM TAG TO GET ORDINAL RELATIVE
*                TO TABLE.
*         SHFTCNT= SHIFT COUNT TO USE TO EXTRACT TAG. 
*         TBLADR = ADDRESS OF *TABLE* POINTER WORD. 
  
 GSTTBL   DEFINE 0,18        TABLE POINTER
 GSTSFT   DEFINE 18,18       SHIFT COUNT FOR TABLE ORDINAL
 GSTTAG   DEFINE 36,18       BIAS FOR TAG ORDINAL 
  
          MACRO  TBLOOK,TAG,BIAS,SHFTCNT,TBLADR 
 TAG      VFD    6/0,L.GSTTAG/BIAS,L.GSTSFT/SHFTCNT,L.GSTTBL/TBLADR 
 TBLOOK   ENDM
  
  
 GST.TBL  BSS    0           START OF TABLE.
 GST.INTR TBLOOK 0,P.TAG,TT.PAR 
 GST.SCR  TBLOOK C.SCR,P.2TAG,TT.SCR
 GST.SYM  TBLOOK C.SYM,P.TAG,TS.SYM 
  
.TEST     IFNE   TEST 
 GST..    BSS    0
          DUP    2,1         DUMMYS IN CASE SOMEONE BLOWS IT. 
          TBLOOK 0,0,"BLOWUP" 
.TEST     ENDIF 
 LFP      SPACE  4,8
**        LFP -  LOAD FORMAL PARAMETER ADDRESS
*         ENTRY  (X1) = TAG 
*                (X2) = FORMAL PARAMETER NUMBER.
*         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  SFR,RUT,WCODE,CLT,RLL,GNR,RUL
  
  
 LFP      SUBR               ENTRY/EXIT...
          SA3    ALREG
          SX7    X2-1        ACTUAL ARGUMENT NUMBER 
          MX0    -3 
          SB7    X3-R.X6+RGFILE 
          BX6    -X0*X3 
          BX5    X1 
          LX6    6           =R00 
          NG     B7,LFP4     IF *AREG NOT STORE REGISTER
          SA7    LFPA        SAVE *FP* NO.
          SB3    RG=LOAD
          RJ     SFR         GET A LOAD REGISTER
          ZR     X7,LFP2     IF *A* AVAILABLE 
          RJ     RUT
 LFP2     SA1    B2+REGFILE+REG.X-REG.A 
          MX0    L.RUSE 
          BX2    -X0*X1 
          ZR     X2,LFP3     IF *X* REGISTER AVAILABLE
          SB2    B2+REG.X-REG.A 
          RJ     RUT
          SB2    B2-REG.X+REG.A 
 LFP3     SA2    LFPA 
          LX6    3           =R00 
          BX7    X2 
 LFP4     SX0    X6+SA=AK 
          NZ     X7,LFP5     IF NOT 1ST *FP*
          SX0    X6+SA=AB 
 LFP5     LX7    P.LBIAS
          BX3    X6 
          LX0    P.LI15 
          IX7    X0+X7
          WCODE  X7          SAI = A0+FP
  
*         NOW OUTPUT LOAD OF ACTUAL ADDRESS VIA A *B* SET.
  
          SB6    X3          SAVE ADDRESS FUNCTION REGISTER 
          RJ     CLT         CHECK FOR LCM/ECS TAG
          NZ     X3,LFP8     IF NOT LCM OR ECS TAG
          SX6    B6          (R00)
          AX6    6           (00R)
          SA6    FPREG       SAVE FORMAL PARAMETER REGISTER 
          SB7    X6 
          RJ     RLL         LOCK FORMAL PARAMETER REGISTER 
          =B3    =XRG=SET 
          RJ     GNR         GET NEXT SET REGISTER
          LX6    3           (R00) SET REGISTER 
          SA3    FPREG
          SB7    X3          (00R)
          RJ     RUL         UNLOCK FORMAL PARAMETER REGISTER 
          SA3    =XAFREG     (0TR) ADDRESS FUNCTION REGISTER
          BX2    X3 
          MX0    -3 
          BX2    -X0*X2      EXTRACT REGISTER 
          LX2    3
          MX0    -L.2BIAS 
          IX6    X6+X2
          AX5    P.2BIAS
          AX3    3
          BX2    -X0*X5      BIAS ON TAG
          ZR     X3,LFP7     IF IN *B* REGISTER 
          SX7    =XSX=XK
          NZ     X2,LFP10    IF NOT *0* BIAS
          SX7    =XSX=XB
          EQ     LFP10
  
 LFP7     SX7    SX=BK
          NZ     X2,LFP10    IF NOT *0* BIAS
          SX7    =XSX=BB
          EQ     LFP10
  
 LFP8     =B3    RG=BADR
          RJ     SFR         GET NEXT *B* REGISTER
          LX6    3
          SX3    B6 
          AX3    3
          MX0    -L.2BIAS 
          IX6    X6+X3
          AX5    P.2BIAS
          SX7    SB=XK
          BX2    -X0*X5      BIAS ON TAG
          NZ     X2,LFP10    IF NOT *0* BIAS
          SX7    SB=XB
 LFP10    BX6    X6+X7
          LX2    P.LBIAS
          LX6    P.LI15      OP-CODE + REGISTERS
          IX7    X2+X6       ADD IN OP-CODE 
          SB5    B2 
          WCODE  X7 
          SB2    B5 
          EQ     EXIT.
  
 LFPA     DATA   0           SAVE *B2*
 FPREG    DATA   0           FORMAL PARAMETER REGISTER
 LSC      SPACE  4,8
**        LSC - LOAD SHORT CONSTANT.
* 
*         ENTRY  (B3) = TYPE OF LOAD. 
*                (B4) = PARSED FILE ADDRESS FOR CURRENT TURPLE. 
*                (X1) = TT.SCR FORM 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  ASR,GNR,WCODE
  
 LSC      SUBR               ENTRY/EXIT...
          =A2    B4+OR.OPR
          BX6    X1 
          SX7    B3          TYPE OF LOAD 
          SA3    RREG 
          SA6    LSCA 
          =A7    A6+1 
          PL     X3,LSC10    IF REGISTER ALREADY ASSIGNED 
          SB7    X2-O.= 
          NZ     B7,LSC5     IF NOT PROCESSING *=* TURPLE 
          RJ     ASR         ASSIGN STORAGE REGISTER
          EQ     LSC20
  
 LSC5     SB7    X2-O.DOB 
          NZ     B7,LSC10    IF NOT PROCESSING DO-BEGIN 
          SX6    R.X6-RGFILE USE *X6* 
          SA6    A3 
  
 LSC10    RJ     GNR         GET REGISTER 
  
 LSC20    BX7    X6 
          SA3    LSCA+1 
          LX7    3
          =A2    A3-1 
          SB7    RG=BADR
          SB7    -B7
          SB7    X3+B7
          AX2    P.SHC
          SX1    X7+SX=BK 
          NZ     B7,LSC21    IF NOT *B* REGISTER LOAD 
          SX1    X7+SB=BK 
 LSC21    MX0    -L.LBIAS 
          BX2    -X0*X2 
          NZ     X2,LSC25    IF NOT CONSTANT OF*0*
          =X1    X7+SB=BB 
          ZR     B7,LSC30    IF *B* REGISTER LOAD 
  
*         CONSTANT LOAD OF *0*. CHECK FOR MASK TYPE CONSTANT. 
  
          BX3    X5 
          MX0    -L.MSHORT
          SX1    X7+FMASK 
          AX3    P.MSHORT 
          BX0    -X0*X3 
          IX1    X1+X0
          LX3    X6 
          NZ     X0,LSC30    IF MASK TYPE CONSTANT
  
*         *0* CONSTANT. COMPILE (BXI   XI-XI) 
  
          SX1    X7+XOR      OP-CODE + I00
          AX3    3           =00I 
          IX7    X1+X6       OP-CODE + II0
          IX1    X7+X3       OP-CODE + III
          EQ     LSC30
  
*         (X1) = INSTRUCTION. 
*         (X2) = CONSTANT 
*         (X5) = TAG. 
*         (X6) = REGISTER TO USE (0TR)
*         (X7) = REGISTER TO USE (R00)
  
 LSC25    MX0    -L.MODE
          SX3    X7 
          LX0    P.2FPNO
          BX0    -X0*X5      MODE BITS
          AX0    P.2FPNO
          SB7    X0-M.REAL
          NZ     B7,LSC30    IF NOT REAL CONSTANT 
          LX2    P.LBIAS
          LX1    P.LI15 
          IX7    X1+X2
          SB5    B2 
          WCODE  X7 
          SX1    X3+LSHF+60-L.SHC 
          SB2    B5 
          BX2    0
  
*         (X1) = OP-CODE + REGISTER (RIGHT JUSTIFIED) 
*         (X2) = CONSTANT.
*         (B2) = REGISTER (0TR) 
  
 LSC30    LX1    P.LI15 
          SB5    B2 
          LX2    P.LBIAS
          IX7    X1+X2
 LSC35    WCODE  X7 
          SX6    B5 
          MX0    -3 
          SB2    B5 
          BX6    -X0*X6 
          LX6    3           =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) = TYPE OF LOAD. 
*                (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 
          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 DESTORY *X6* 
  
  
 RLL      SUBR               ENTRY/EXIT...
          =X0    RLOCK
          SA1    B7+REGX
          BX7    X1+X0
          SA2    B7+REGA
          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 DESTORY *X6* 
  
  
 RUL      SUBR               ENTRY/EXIT...
          =X0    RLOCK
          LT     B7,EXIT.    IF NO REGISTER TO UNLOCK 
          SA1    B7+REGX
  
*         DO NOT TOUCH TEMP *X* REGISTER
  
          MX2    -L.RUSE
          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+REGA
          BX7    -X0*X2 
          SA7    A2          CLEAR LOCK ON *A*
          EQ     EXIT.
  
 REGLK    BSS    3           LOCK REGISTER
 CLOADK   EQU    REGLK+1     *K* PORTION
 CLOADJ   EQU    REGLK+2     *J* PORTION
 STRGLK   BSS    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
  
  
 RUTX     SA5    RUTA        RESTORE *X5* 
          SX6    B5 
          BX7    0
          SB2    B5          RESTORE*B2*
          MX0    -3 
  
**        CLEAR REGFILE ENTRY.
  
          SB5    B5-REG.X 
          SA1    B2+=XREGFILE 
          MI     B5,RUT35    IF NOT X REG CLEAR ONE REG ONLY. 
          SA2    B5+REGA     FETCH CORESPONDING A REG.
          BX2    X2-X1
          AX2    L.RUSE 
          NZ     X2,RUT35    IF TAGS NOT EQUAL CLOBBER X REG ONLY.
          SA7    A2+         CLOBBER A REG. 
 RUT35    BX6    -X0*X6 
          SA7    A1          (B2+REGFILE) IS ALWAYS CLEARED.
          SB3    X6          =00R 
          LX6    3           =0R0 
  
 RUT      SUBR   -           ENTRY/EXIT...
          BX7    X5 
          SB5    B2 
          SA7    RUTA 
          SX6    RUTX 
          SA5    B2+REGFILE 
          SA6    RUT.ADR
 RUT5     BX1    X5 
          MX0    -1 
          =B7    0           STATUS OF TAG ONLY 
          AX1    P.TYPE 
          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 IN REGISTER 
          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+P.2STAT 
          LX0    X0,B3
          BX6    X0*X1       INDICATE TAG NOT IN REGISTER 
          SA6    A1 
          IFBIT  X7,INTR,RUT20
          JP     B7 
  
*         FOUND INTERMEDIATE IN REGISTER -- MUST SAVE IN TEMPORARY
*         (B2) = 0TR
*         (X5) = TAG
  
*RUT20    IFBIT  X2,ADDR/INTR,RUT30 
 RUT20    BSS    0
  
 SNAP=H   IFNE   TEST 
          SX6    3RRUT
          RJ     REGPRO 
 SNAP=H   ENDIF 
          IFBIT  X7,-2ARY/INTR,RUT25
  
**        INTERMEDIATE IS ARY-LOD -- INDICATE POST-PROCESSING REQUIRED. 
  
          JP     B7 
  
 RUT25    SX0    B5-R.X6+RGFILE 
          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 
          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    -L.RUSE
          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+XMITS3
          LX7    P.LI15+3 
          WCODE  X7 
          SB7    RUTX 
          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
  
  
 SDSX     SA2    SDSA 
          MX0    -3 
          NO
          BX6    -X0*X2 
          SB2    X2 
          LX6    3
  
  
 SDS      SUBR   -
          SX7    B3 
          SX0   B2
          SA3    DRITE
          BX6    X5 
          LX0    P.TYPE 
          SA7    SDSA        SAVE REGISTER
          BX5    X5+X0
          BX0    X5-X3
          =A6    A7+1        SAVE REGISTER
          AX0    P.TYPE 
          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-RGFILE 
          BX6    X0*X5
          SX2    B2 
          ZR     B2,SDS15    IF TAG NOT IN REGISTER 
          BX7    X3*X2
          MX3    -1 
          SB7    B6+P.2STAT 
          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    -L.RUSE
          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    P.2BIAS
          IX6    X6+X0
          =A6    A6+1 
          =A7    A6+1 
          NZ     X7,SDS20    IF NOT LAST USE OF RIGHT MEMBER
          RJ     SST         SET STATUS OF TAG (LEFT MEMBER)
          EQ     SDSX 
  
 SDS20    BX7    X2 
          =X0    1
          =A7    A6+1 
          IX2    X5-X0       USE COUNT - 1 (LEFT MEMBER)
          BX0    -X3*X2 
          SA2    =XGSTC      REMEMBER LOCATION OF STATUS WORD 
          BX7    X2 
          ZR     X0,SDSX     IF LAST USE OF LEFT MEMBER 
          SA7    SDSA+1 
          SB3    RG=LODX
          RJ     SFR
          NZ     X7,SDSX     IF *X* REGISTER NOT AVAILABLE
          SA1    SDSA        =0TR) (RIGHT MEMBER) 
          MX0    -3 
          SX3    X6+XMITS3
          BX1    -X0*X1      =00R 
          SB5    B2 
          IX7    X3+X1
          LX7    P.LI15+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     SST         SET STATUS OF TAG
          EQ     SDSX 
  
 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*) 
  
  
 SFRX     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 
          AX1    P.RGNUM
          BX7    -X2
          SA6    RGX
          MI     X2,SFR5     IF NO HARD REGISTER
          MX0    -L.RUSE
          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
          MX3    1
          BX7    X5 
          AX1    L.RGMSK     MASK COUNT 
          SX5    RLOCK
          SA7    SFRA 
          SB5    X1-1        LENGTH OF MASK - 1 
          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    -L.RUSE
          LX2    B5,X2       NEXT REGISTER ORDINAL
          BX6    X0*X2
          SA3    X6+REGFILE 
          BX1    -X1*X3      EXTRACT USE COUNT
  
 SFR10    SB2    X6 
          BX7    X1 
          ZR     X7,SFRX     IF REGISTER FREE 
  
 SFR12    ZR     B7,SFRX     IF FINISHED
          BX6    X0*X2       NEXT REGISTER ORDINAL
          MX1    -L.RUSE
          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
          IFBIT  X3,INTR,SFR12
          PL     X1,SFR12    IF NOT NEW LOW (NON-INTERMEDIATE)
          IX5    X1+X5
          SA6    A6 
          EQ     SFR12
  
 SFRA     BSS    1
 SST      SPACE  4,8
**        SST - SET STATUS OF TAG.
* 
*         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   STATUS BIT SET INDICATING TAG IN REGISTER + REGISTER.
* 
*         USES   A1,A2,A3  X0,X7  B5,B7 
* 
*         CALLS  CLT
  
  
 SST      SUBR               ENTRY/EXIT...
          SA2    B2+REGFILE 
          MX0    -L.RUSE
          SX3    RLOCK
          LX7    X2 
          BX2    -X0*X2      REGFILE USE COUNT
          ZR     X2,SST1     IF NO USE COUNT
          BX3    X3*X2       LOCK BIT EXTRACTION
          NZ     X3,SST1     IF LOCK BIT SET
          BX3    X5-X7
          AX3    L.RUSE      ELIMINATE USE COUNT
          NZ     X3,SST1     IF TAGS NOT EQUAL DO NOTHING 
          BX5    X0*X5
          IX5    X5+X2       ELSE RETAIN REGFILE USE COUNT
 SST1     SA2    B3+SST.STAT
          =X3    1
          SB7    X2 
          LX7    X3,B7
          SX0    B2          0TR
          AX2    18 
          BX1    X1+X7       INDICATE IN REGISTER 
          MX3    -L.UREG
          SB7    X2 
          LX2    X3,B7       POSITION MASK
          LX7    X0,B7       POSITION REGISTER
          SX3    B3 
          BX1    X2*X1
          LX3    P.TYPE 
          IX7    X1+X7
          BX5    X5+X3
          SA7    A1 
          SX3    REG.A-RGFILE 
          SA2    UUC
          BX3    X3*X0
          IX7    X5-X2
          ZR     X3,SST4     IF NOT *A* REGISTER
  
*         AVOID *A* REGISTER IF LCM TAG 
  
  
 .DAL     IFEQ   .DAL,0 
          BX2    X5 
          IFBIT  X2,-ADDR,SST7     IF NOT ADDRESS REFERENCE,TAG IN SCM
 .DAL     ENDIF 
  
          LX1    -P.2TAG
          MX0    -L.2TAG+L.PWF
          LX0    L.PWF
          BX0    -X0*X1 
          LX1    P.2TAG 
          SX0    X0-C.SYM 
          NZ     X0,SST7     IF NOT SYMBOL TAG
          LX2    X5          SAVE PARSED FILE OPERAND WORD ACROSS CLT 
          BX5    X1          STATUS WORD TAG FORMAT IN X5 FOR CLT 
          RJ     CLT         CHECK FOR LCM TAG. 
          BX5    X2          RESTORE X5.
          NZ     X3,SST7     IF NOT LCM TAG 
          SA7    B2+=XREGX-REG.A   SET REGFILE ENTRY (X-REG). 
          EQ     EXIT.
  
 SST4     SA7    B2+REGFILE  TAG TO REGFILE 
          EQ     EXIT.
  
 SST7     SA7    B2+REGFILE  TAG TO REGFILE 
          SA7    A7+REG.X-REG.A    TAG TO ASSOCIATE *X* REGISTER
          EQ     EXIT.
  
  
 SST.STAT VFD    24/0,18/P.UREG,18/P.USTAT
          VFD    24/0,18/P.LREG,18/P.LSTAT
          LIST   D
          END 
