*COMDECK     COMREG     - REGISTER MANIPULATION SUBROUTINES.
#*        REG  -  REGISTER MANIPULATION SUBROUTINES.
* 
*         R. H. GOODELL.     76/10/29.
* 
*         *REG* CONTAINS SUBROUTINES FOR GENERATING CODE TO GET 
*         SPECIFIED VALUES INTO THE MACHINE REGISTERS, AND FOR
*         KEEPING TRACK OF WHAT IS IN THE REGISTERS SO THAT SUCH
*         CODE CAN BE OPTIMISED TO THE EXTENT OF ELIMINATING
*         REDUNDANT FETCH INSTRUCTIONS.  THESE SUBROUTINES ARE
*         CALLED BY MANY CODE GENERATOR PASS 1 ROUTINES.
* 
*         CONTENTS (XDEF ENTRY POINTS). 
* 
*         PROC   CRA         CLEAR REGISTER ASSOCIATES. 
*         PROC   DSR         DEPOSIT STORE REGISTER.
*         PROC   FAR         FIND A-REGISTER WITH SPECIFIED VALUE.
*         PROC   FFR         FIND AN AVAILABLE FETCH REGISTER PAIR. 
*         PROC   FXR         FIND X-REGISTER WITH SPECIFIED VALUE.
*         PROC   GAR         GET SPECIFIED VALUE INTO ANY A-REGISTER. 
*         PROC   GXR         GET SPECIFIED VALUE INTO ANY X-REGISTER. 
*         PROC   SAR         SET SPECIFIED A-REGISTER TO GIVEN VALUE. 
*         PROC   SB1         SET (B1) = 1 IF NECESSARY. 
*         PROC   SXR         SET SPECIFIED X-REGISTER TO GIVEN VALUE. 
# 
  
  
*CALL     COMDDEF            GENERAL DEFINITIONS. 
  
     XREF BEGIN               # MANAGED TABLES #
  
*CALL     COMDTCON           CONSTANT VALUES. 
  
*CALL     COMDTLIT           LITERALS.
  
          END 
*CALL     COMDREG            REGISTER INFORMATION.
  
#*        THE REGS ARRAY IS USED TO KEEP TRACK OF WHAT VALUES AND 
*         KINDS OF VALUES WILL BE IN THE 24 OPERATING REGISTERS OF
*         THE CPU AT OBJECT CODE EXECUTION TIME.  REGS CONTAINS ONE 
*         WORD FOR EACH REGISTER, CALLED THE REGISTER ASSOCIATE 
*         FOR ITS REGISTER.  IN ADDITION THERE IS A SECOND WORD FOR 
*         EACH X-REGISTER CONTAINING THE CONSTANT VALUE (IF ANY)
*         FOR THAT REGISTER.
* 
*         THE ARRAY ITEMS IN REGS ARE USED AS FOLLOWS.  IN THIS 
*         DISCUSSION, *Z* REPRESENTS ANY OF THE REGISTER CLASS
*         LETTERS A, B, OR X, AND *I* REPRESENTS A REGISTER 
*         NUMBER 0 THROUGH 7. 
* 
*         REGZ [I] = THE ENTIRE REGISTER ASSOCIATE WORD FOR ZI. 
*         USED FOR CLEARING ALL REGISTER ASSOCIATES, E.G. WHEN
*         GENERATING A SUBROUTINE CALL. 
* 
*         KINDZ [I] = THE KIND OF VALUE THAT IS CONTAINED IN THE
*         REGISTER ZI.  SEE THE STATUS LIST *RK* IN COMMON DECK 
*         *COMDREG* FOR MNEMONICS AND VALUES AND THEIR MEANINGS.
* 
*         LOCKZ [I] = TRUE WHEN THE REGISTER CONTAINS A VALUE AND 
*         THE INSTRUCTION(S) THAT WILL USE THAT VALUE HAVE NOT
*         ALL BEEN ISSUED YET.  FALSE MEANS IT IS SAFE TO STORE 
*         A NEW VALUE INTO THE REGISTER.
* 
*         FBITX [I] = THE AMOUNT BY WHICH THE WORD IN REGISTER
*         XI HAS BEEN SHIFTED LEFT-CIRCULARLY IN THE COURSE OF
*         OPERATING ON IT.  TO RETURN THE WORD TO ITS NOMINAL 
*         POSITION, ISSUE THE INSTRUCTION  LXI  WL - FBITX [I]. 
* 
*         WORDZ [I] = THE RELATIVE WORD OFFSET OF THE REGISTER
*         CONTENTS FROM THE VALUE INDICATED BY KINDZ [I] AND
*         ITEMZ [I].
* 
*         ITEMZ [I] = THE SPECIFIC VALUE THAT IS IN THE REGISTER. 
*         THE MEANING OF ITEMZ [I] DEPENDS ON KINDZ [I] AS FOLLOWS. 
*              KINDZ [I] = RK"NUL".  ALL OTHER INFORMATION IN THE 
*         REGISTER ASSOCIATE IS IMMATERIAL.  THE REGISTER DOES
*         NOT CONTAIN ANY USEFUL INFORMATION. 
*              KINDZ [I] = RK"LIT".  ITEMZ [I] IS THE TLIT INDEX
*         OF A LITERAL.  THE REGISTER CONTAINS AN ADDRESS = THE 
*         LITERAL FWA + WORDZ [I].
*              KINDZ [I] = RK"CON".  FOR AN A- OR B-REGISTER, 
*         ITEMZ [I] IS THE CONSTANT VALUE THAT IS IN THE REGISTER,
*         AND WORDZ [I] IS UNUSED.  FOR AN X-REGISTER, ITEMX [I]
*         IS EITHER -1 OR THE TLIT INDEX OF A LITERAL.  IF IT IS
*         -1 THEN VALUX [I] IS THE CONSTANT VALUE THAT IS IN THE
*         REGISTER, AND WORDX [I] IS UNUSED.  IF ITEMX [I] = A
*         TLIT INDEX THEN THE REGISTER CONTAINS THE WORD AT THE 
*         LITERAL FWA + WORDX [I], AND THE VALUE OF THAT WORD 
*         IS IN VALUX [I].
*              KINDZ [I] = RK"SRA" OR RK"TRA".  THE REGISTER
*         CONTAINS THE ADDRESS OF A WORD IN THE SOURCE/TARGET 
*         RECORD WORKING STORAGE AREA.  IF ITEMZ [I] = 0 THEN 
*         THE REGISTER CONTAINS AN ADDRESS = THE RECORD WSA 
*         FWA + WORDZ [I].  OTHERWISE, THE CURRENT ITEM IS
*         SUBSCRIPTED, ITEMZ [I] IS THE WORD ADDRESS OF THE 
*         ITEM ENTRY IN THE SCHEMA OR SUB-SCHEMA DIRECTORY, AND 
*         THE REGISTER CONTAINS AN ADDRESS = FWA (OF CURRENT
*         OCCURRENCE OF THAT ITEM) + WORDZ [I]. 
*              KINDZ [I] = RK"SRW" OR RK"TRW".  VALID FOR 
*         X-REGISTERS ONLY.  SAME AS ABOVE, EXCEPT THAT THE 
*         REGISTER CONTAINS THE CONTENTS OF THE WORD RATHER 
*         THAN ITS ADDRESS. 
*              KINDZ [I] = RK"SYM".  ITEMZ [I] IS THE TSYM INDEX
*         OF A SYMBOL THAT IDENTIFIES A LOCATION IN THE CODE
*         IMAGE.  THE REGISTER CONTAINS AN ADDRESS = THAT SYMBOL
*         ADDRESS + WORDZ [I].
*              KINDZ [I] = RK"VAL".  VALID FOR X-REGISTERS ONLY.
*         SAME AS ABOVE, EXCEPT THAT THE REGISTER CONTAINS THE
*         VALUE (CONTENTS) OF THE WORD AT THE INDICATED ADDRESS.
*              KINDZ [I] = RK"EXT".  ITEMZ [I] IS THE TEXT INDEX
*         OF AN EXTERNAL (TO THE CAPSULE) SYMBOL.  THE REGISTER 
*         CONTAINS AN ADDRESS = THAT EXTERNAL SYMBOL ADDRESS
*         + WORDZ [I].
*              KINDZ [I] = RK"EXV".  VALID FOR X-REGISTERS ONLY.
*         SAME AS ABOVE, EXCEPT THAT THE REGISTER CONTAINS THE
*         VALUE (CONTENTS) OF THE WORD AT THE INDICATED ADDRESS.
# 
  
     XREF BEGIN               # OTHER EXTERNALS # 
  
          ITEM E$SAREV ;           # ERROR - SAR EXV NOT IMPLEMENTED #
          ITEM E$SARVL ;           # ERROR - SAR VAL NOT IMPLEMENTED #
          ITEM E$SARXW ;           # ERROR - SAR XRW NOT IMPLEMENTED #
          ITEM E$SXRCC ;           # ERROR - SXR CON CPLX NOT IMPLEM #
          ITEM E$SXRCD ;           # ERROR - SXR CON DP  NOT  IMPLEM #
          ITEM QSRA ;              # NAME OF SOURCE RECORD AREA FWA # 
          ITEM QTRA ;              # NAME OF TARGET RECORD AREA FWA # 
          ITEM X$SBWP C (NC) ;     # NAME OF SOURCE BEGINNING WORD POS #
          ITEM X$TBWP C (NC) ;     # NAME OF TARGET BEGINNING WORD POS #
          FUNC EXN I ;             # EXTERNAL NAME NUMBER # 
          PROC ISSUE ;             # ISSUE INSTRUCTION TO INTERMEDIATE #
          FUNC LDN I ;             # LITERAL DESCRIPTOR NUMBER #
          FUNC LITCH I ;           # GEN LITERAL DESCR, CHARACTER (H) # 
          FUNC LITCR I ;           # GEN LITERAL DESCR, CHARACTER (R) # 
          FUNC LITCZ I ;           # GEN LITERAL DESCR, CHARACTER (L) # 
          FUNC LITDP I ;           # GEN LITERAL DESCR, DOUBLE PRECISN #
          FUNC LITFP I ;           # GEN LITERAL DESCR, FLOATING POINT #
          FUNC LITINT I ;          # GEN LITERAL DESCR, INTEGER (DEC) # 
          FUNC LITOCT I ;          # GEN LITERAL DESCR, OCTAL WORD #
          FUNC LITSI I ;           # GEN LITERAL DESCR, SHORT INTEGER # 
          PROC PUNT ;              # PROCESS INTERNAL ERROR # 
          FUNC SYN I ;             # SYMBOL NAME NUMBER # 
          PROC XCDDL ;             # CONVERT TO DECIMAL LEFT JUSTIFIED #
  
          END 
  
  
*CALL     COMDCF             CONSTANT FORMATS.
  
  
*CALL     COMDCHAR           DISPLAY CODE CHARACTERS. 
  
  
*CALL     COMDOPS            OPERATION CODES. 
  
  
*CALL     COMDPSOP           PSEUDO OPERATION ISSUING DEFS. 
  
  
#         LOCAL DATA. 
# 
          DEF  INFA  #2**AL# ;     # INFINITE ADDRESS # 
  
  
          BEGIN 
  
  
  
  
#***      CRA  -  CLEAR REGISTER ASSOCIATES.
# 
          XDEF PROC CRA ; 
          PROC CRA ;
  
#         *CRA* IS CALLED AT THE BEGINNING OF A CAPSULE AND 
*         AFTER A RETURN JUMP IS GENERATED, TO INDICATE THAT
*         THE REGISTERS CONTAIN NO MEANINGFUL INFORMATION.
****
# 
          BEGIN 
          ITEM I ;
  
          CFRN = 1 ;                    # RESET CURRENT FETCH AND # 
          CSRN = 6 ;                     # STORE REGISTER NUMBERS # 
          CSRA = -1 ;                     # AND STORE ADDRESS # 
          FOR  I = 0 THRU 7  DO 
               BEGIN
               REGX [I] = 0 ;           # CLEAR ALL REGISTER #
               REGA [I] = 0 ;            # ASSOCIATES # 
               REGB [I] = 0 ; 
               END
          KINDB [0] = S"CON" ;          # INDICATE (B0) = 0 # 
          LOCKB [0] = TRUE ;
          ITEMB [0] = 0 ; 
          KINDB [1] = S"CON" ;          # INDICATE (B1) = 1 # 
          LOCKB [1] = TRUE ;
          ITEMB [1] = 0 ;               # CHANGED TO 1 BY *SB1* # 
          RETURN ;
  
          END 
  
  
  
  
#***      DSR  -  DEPOSIT STORE REGISTER. 
# 
          XDEF PROC DSR ; 
          PROC DSR ;
  
#         *DSR* GENERATES CODE TO STORE THE CURRENT STORE REGISTER
*         (X6 OR X7) INTO THE PROPER WORD OF THE TARGET RECORD
*         AREA, IF THE REGISTER STILL CONTAINS DATA FOR THE LOGICAL 
*         RECORD IMAGE BEING FORMED.  ALSO, *DSR* TOGGLES THE STORE 
*         REGISTER NUMBER BETWEEN 6 AND 7 UNLESS THE OTHER REGISTER 
*         IS LOCKED.
****
# 
          BEGIN 
          ITEM K ;
  
          IF  CSRA GE 0                      # IF ANYTHING TO STORE # 
          THEN BEGIN
               IF  FBITX [CSRN] NE 0              # IF SHIFTING NEEDED #
               THEN BEGIN 
                    K = WL - FBITX [CSRN] ;       # AMOUNT TO SHIFT # 
                    FBITX [CSRN] = 0 ;
                    ISSUE (OP"LEFTK", CSRN, 0, K) ; # GEN LXR K        #
                    END 
               KINDX [CSRN] = S"TRW" ;            # UPDATE X-REGISTER # 
               ITEMX [CSRN] = CSRI ;               # ASSOCIATES # 
               WORDX [CSRN] = CSRA ;
               CALL SAR (CSRN, RK"TRA", CSRI, CSRA) ; # SET A-REGISTER #
               LOCKX [CSRN] = FALSE ;             # UNLOCK X-REGISTER # 
               CSRA = -1 ;                        # FLAG NIL TO STORE # 
               END
          IF  NOT LOCKX [13-CSRN]            # TOGGLE REGISTER NUMBER # 
          THEN CSRN = 13 - CSRN ; 
          RETURN ;
  
          END 
  
  
  
  
#***      FAR  -  FIND A-REGISTER WITH A SPECIFIED VALUE. 
# 
          XDEF PROC FAR ; 
          PROC FAR (R, (K), (I), (W)) ; 
  
          ITEM R I ;               # REGISTER NUMBER FOUND #
          ITEM K S:RK ;            # REGISTER KIND #
          ITEM I I ;               # ITEM POINTER OR CON VALUE #
          ITEM W I ;               # WORD OFFSET #
  
#         *FAR* FINDS AN ADDRESS (A) REGISTER THAT ALREADY CONTAINS 
*         THE SPECIFIED VALUE.  FOR K = RK"SRA/TRA/SYM/EXT", *FAR*
*         FINDS THE A-REGISTER HAVING THAT VALUE WITH THE SMALLEST
*         RELATIVE WORD OFFSET.  FOR OTHER K, *FAR* FINDS THE A-REG 
*         HAVING EXACTLY THE SPECIFIED VALUE.  UPON RETURN, FOR ALL 
*         CASES, (R) = THE REGISTER NUMBER FOUND, OR (R) = -1 IF
*         NO SATISFACTORY REGISTER WAS FOUND. 
****
# 
          BEGIN 
  
          ITEM J, M, N, T ; 
  
          LABEL NUL, LIT, CON, XRA, XRW, SYM, VAL, EXT, EXV ; 
  
          SWITCH  KIND: RK      NUL: NUL,   LIT: LIT,   CON: CON, 
                    XRA: SRA,   XRW: SRW,   XRA: TRA,   XRW: TRW, 
                    SYM: SYM,   VAL: VAL,   EXT: EXT,   EXV: EXV ;
          GO TO KIND [K] ;
               BEGIN
  
      NUL:                         # NUL - REGISTER NOT IN USE #
               FOR  J = 7 STEP -1 UNTIL 0  DO 
                    BEGIN 
                    IF  KINDA [J] EQ S"NUL"       # SEARCH REGISTERS #
                    THEN BEGIN
                         R = J ;                  # FOUND ONE # 
                         RETURN ; 
                    END  END
               FOR  J = 7 STEP -1 UNTIL 0  DO     # NONE FOUND - TRY #
                    BEGIN                          # FOR AN UNLOCKED #
                    IF  NOT LOCKA [J]               # REGISTER #
                    THEN BEGIN
                         IF  J NE 0               # FOUND ONE - IF IT # 
                           AND  J LT 6             # IS A FETCH REG., # 
                           AND  NOT LOCKX [J]       # (1-5) CHECK ITS # 
                         THEN BEGIN                  # X-REGISTER # 
                              R = J ; 
                              RETURN ;            # REGISTER FOUND #
                    END  END  END 
               R = -1 ;                           # NONE FOUND #
               RETURN ; 
  
      LIT:                         # LIT - ADDRESS OF A LITERAL # 
               I = LDN (I) ;                      # GET LIT DESCR NO. # 
               GO TO XRA ;                        # CONTINUE BELOW #
  
      CON:                         # CON - KNOWN CONSTANT VALUE # 
               FOR  J = 7 STEP -1 UNTIL 0  DO 
                    BEGIN 
                    IF  KINDA [J] EQ S"CON"       # SEARCH RESISTERS #
                      AND  ITEMA [J] EQ I 
                    THEN BEGIN
                         R = J ;                  # FOUND ONE # 
                         RETURN ; 
                    END  END
               R = -1 ;                           # NONE FOUND #
               RETURN ; 
  
      XRA:                         # SRA/TRA - SOURCE/TARGET REC ADDR # 
               M = INFA ;                         # MINIMUM OFFSET #
               N = -1 ;                           # CORRESPONDING REG. #
               FOR  J = 7 STEP -1 UNTIL 0  DO 
                    BEGIN 
                    IF  KINDA [J] EQ K            # SEARCH REGISTERS #
                      AND  ITEMA [J] EQ I 
                    THEN BEGIN
                         T = ABS (WORDA [J] - W) ;    # ADDRESS OFFSET #
                         IF  T LT M 
                         THEN BEGIN 
                              M = T ;                 # SET NEW MIN # 
                              N = J ; 
                    END  END  END 
               R = N ;
               RETURN ; 
  
      XRW:                         # SRW/TRW - SOURCE/TARGET RECORD WD #
               FOR  J = 7 STEP -1 UNTIL 0  DO 
                    BEGIN 
                    IF  KINDA [J] EQ K            # SEARCH REGISTERS #
                      AND  ITEMA [J] EQ I 
                      AND  WORDA [J] EQ W 
                    THEN BEGIN
                         R = J ;                  # FOUND ONE # 
                         RETURN ; 
                    END  END
               R = -1 ;                           # NONE FOUND #
               RETURN ; 
  
      SYM:                         # SYM - ADDRESS OF A LABEL # 
               I = SYN (I) ;                      # CONVERT NAME #
               GO TO XRA ;
  
      VAL:                         # VAL - SYMBOL VALUE (CONTENTS) #
               I = SYN (I) ;                      # CONVERT NAME #
               GO TO XRW ;
  
      EXT:                         # EXT - ADDRESS OF AN EXTERNAL # 
               I = EXN (I) ;                      # CONVERT NAME #
               GO TO XRA ;
  
      EXV:                         # EXV - EXTERNAL VALUE (CONTENTS) #
               I = EXN (I) ;                      # CONVERT NAME #
               GO TO XRW ;
  
               END                 # OF REGISTER KIND CASES # 
  
          END 
  
  
  
  
#***      FFR  -  FIND AN AVAILABLE FETCH REGISTER PAIR.
# 
          XDEF PROC FFR ; 
          PROC FFR ;
  
#         *FFR* FINDS AN A-REGISTER/X-REGISTER PAIR THAT CAN BE 
*         USED FOR FETCHING (I.E. NUMBERED 1-5) AND IS AVAILABLE
*         FOR USE (I.E. NOT LOCKED).  THE SEARCH IS END-AROUND
*         STARTING WITH THE CURRENT FETCH REGISTER NUMBER + 1.
****
# 
          BEGIN 
          ITEM I, L ; 
  
          L = CFRN ;
          IF  CFRN EQ 5 
          THEN CFRN = 0 ;                    # SEARCH REGISTERS 1 - 5 # 
          FOR  I = CFRN+1  STEP  1            # END AROUND #
                  WHILE  I NE L  DO 
               BEGIN
               IF  NOT LOCKX [I] AND NOT LOCKA [I]
               THEN BEGIN 
                    CFRN = I ;               # AVAILABLE REG. FOUND # 
                    RETURN ;
                    END 
               IF  I EQ 5 
               THEN I = 0 ; 
               END
          CFRN = CFRN + 1 ;                  # ARBITRARILY TAKE REG. #
          RETURN ;                            # CFRN+1 (END AROUND) # 
  
          END 
  
  
  
  
#***      FXR  -  FIND X-REGISTER WITH A SPECIFIED VALUE. 
# 
          XDEF PROC FXR ; 
          PROC FXR (R, (K), (I), (W)) ; 
  
          ITEM R I ;               # REGISTER NUMBER FOUND #
          ITEM K S:RK ;            # REGISTER KIND #
          ITEM I I ;               # ITEM POINTER # 
          ITEM W I ;               # WORD OFFSET #
  
#         *FXR* FINDS AN OPERAND (X) REGISTER THAT ALREADY CONTAINS 
*         THE SPECIFIED VALUE.  FOR K = RK"SRA/TRA/SYM/EXT", *FXR*
*         FINDS THE X-REGISTER HAVING THAT VALUE WITH THE SMALLEST
*         RELATIVE WORD OFFSET.  FOR OTHER K, *FXR* FINDS THE X-REG 
*         HAVING EXACTLY THE SPECIFIED VALUE.  UPON RETURN, FOR ALL 
*         CASES, (R) = THE REGISTER NUMBER FOUND, OR (R) = -1 IF
*         NO SATISFACTORY REGISTER WAS FOUND. 
****
# 
          BEGIN 
  
          ITEM J, M, N, T ; 
  
          LABEL NUL, LIT, CON, XRA, XRW, SYM, VAL, EXT, EXV ; 
  
          SWITCH  KIND: RK      NUL: NUL,   LIT: LIT,   CON: CON, 
                    XRA: SRA,   XRW: SRW,   XRA: TRA,   XRW: TRW, 
                    SYM: SYM,   VAL: VAL,   EXT: EXT,   EXV: EXV ;
          GO TO KIND [K] ;
               BEGIN
  
      NUL:                         # NUL - REGISTER NOT IN USE #
               FOR  J = CFRN+1  STEP  1 
                       WHILE  J NE CFRN  DO 
                    BEGIN 
                    IF  KINDX [J] EQ S"NUL"       # SEARCH REGISTERS #
                      AND  NOT LOCKX [J]
                    THEN BEGIN
                         R = J ;                  # FOUND ONE # 
                         RETURN ; 
                         END
                    IF  J EQ 7                    # SEARCH END-AROUND # 
                    THEN J = -1 ; 
                    END 
               FOR  J = CFRN+1  STEP  1           # NONE FOUND - LOOK # 
                       WHILE  J NE CFRN  DO        # FOR AN UNLOCKED #
                    BEGIN                           # X-REGISTER #
                    IF  NOT LOCKX [J] 
                    THEN BEGIN
                         R = J ;                  # FOUND ONE # 
                         RETURN ; 
                         END
                    IF  J EQ 7                    # SEARCH END-AROUND # 
                    THEN J = -1 ; 
                    END 
               R = -1 ;                           # NONE FOUND #
               RETURN ; 
  
      LIT:                         # LIT - ADDRESS OF A LITERAL # 
               I = LDN (I) ;                      # GET LIT DESCR NO. # 
               GO TO XRA ;                        # CONTINUE BELOW #
  
      CON:                         # CON - KNOWN CONSTANT VALUE # 
               FOR  J = 7 STEP -1 UNTIL 0  DO 
                    BEGIN 
                    IF  KINDX [J] EQ S"CON"       # SEARCH REGISTERS #
                      AND  VALUX [J] EQ I 
                    THEN BEGIN
                         R = J ;                  # FOUND ONE # 
                         RETURN ; 
                    END  END
               R = -1 ;                           # NONE FOUND #
               RETURN ; 
  
      XRA:                         # SRA/TRA - SOURCE/TARGET REC ADDR # 
               M = INFA ;                         # MINIMUM OFFSET #
               N = -1 ;                           # CORRESPONDING REG. #
               FOR  J = 7 STEP -1 UNTIL 0  DO 
                    BEGIN 
                    IF  KINDX [J] EQ K            # SEARCH REGISTERS #
                      AND  ITEMX [J] EQ I 
                    THEN BEGIN
                         T = ABS (WORDX [J] - W) ;    # ADDRESS OFFSET #
                         IF  T LT M 
                         THEN BEGIN 
                              M = T ;                 # SET NEW MIN # 
                              N = J ; 
                    END  END  END 
               R = N ;
               RETURN ; 
  
      XRW:                         # SRW/TRW - SOURCE/TARGET RECORD WD #
               FOR  J = 7 STEP -1 UNTIL 0  DO 
                    BEGIN 
                    IF  KINDX [J] EQ K            # SEARCH REGISTERS #
                      AND  ITEMX [J] EQ I 
                      AND  WORDX [J] EQ W 
                    THEN BEGIN
                         R = J ;                  # FOUND ONE # 
                         RETURN ; 
                    END  END
               R = -1 ;                           # NONE FOUND #
               RETURN ; 
  
      SYM:                         # SYM - ADDRESS OF A LABEL # 
               I = SYN (I) ;                      # CONVERT NAME #
               GO TO XRA ;
  
      VAL:                         # VAL - SYMBOL VALUE (CONTENTS) #
               I = SYN (I) ;                      # CONVERT NAME #
               GO TO XRW ;
  
      EXT:                         # EXT - ADDRESS OF AN EXTERNAL # 
               I = EXN (I) ;                      # CONVERT NAME #
               GO TO XRA ;
  
      EXV:                         # EXV - EXTERNAL VALUE (CONTENTS) #
               I = EXN (I) ;                      # CONVERT NAME #
               GO TO XRW ;
  
               END                 # OF REGISTER KIND CASES # 
  
          END 
  
  
  
  
#***      GAR  -  GET SPECIFIED VALUE INTO ANY FETCH A-REGISTER.
# 
          XDEF PROC GAR ; 
          PROC GAR (R, (K), (I), (W)) ; 
  
          ITEM R I ;               # REGISTER NUMBER FOUND #
          ITEM K S:RK ;            # KIND OF VALUE #
          ITEM I I ;               # ITEM POINTER OR CON VALUE #
          ITEM W I ;               # WORD OFFSET #
  
#         *GAR* FINDS AN ADDRESS (A) REGISTER (OTHER THAN A0) THAT
*         ALREADY CONTAINS EXACTLY THE VALUE SPECIFIED BY K, I, W.
*         IF NONE IS FOUND, *GAR* ALLOCATES A FETCH REGISTER PAIR 
*         AND GENERATES WHATEVER CODE IS NEEDED TO GET THE VALUE
*         INTO THE A-REGISTER OF THAT PAIR.  IN ANY CASE, UPON
*         RETURN, (R) = THE A-REGISTER NUMBER FOUND.
****
# 
          BEGIN 
  
          CALL FAR (R, K, I, W) ;            # FIND A-REGISTER #
          IF  R LE 0
            OR  WORDA [R] NE W               # IF NONE FOUND #
          THEN BEGIN
               CALL FFR ;                    # FIND FETCH REGISTER #
               R = CFRN ; 
               CALL SAR (R, K, I, W) ;       # SET A-REGISTER # 
               END
          RETURN ;
  
          END 
  
  
  
  
#***      GXR  -  GET SPECIFIED VALUE INTO ANY X-REGISTER.
# 
          XDEF PROC GXR ; 
          PROC GXR (R, (K), (I), (W)) ; 
  
          ITEM R I ;               # REGISTER NUMBER FOUND #
          ITEM K S:RK ;            # KIND OF VALUE #
          ITEM I I ;               # ITEM POINTER # 
          ITEM W I ;               # WORD OFFSET #
  
#         *GXR* FINDS AN OPERAND (X) REGISTER THAT ALREADY CONTAINS 
*         EXACTLY THE VALUE SPECIFIED BY K, I, W.  IF NONE IS FOUND,
*         *GXR* ALLOCATES A FETCH REGISTER PAIR AND GENERATES WHAT
*         EVER CODE IS NEEDED TO GET THE VALUE INTO THE X-REGISTER
*         OF THAT PAIR.  IN ANY CASE, UPON RETURN, (R) = THE
*         X-REGISTER NUMBER FOUND.
****
# 
          BEGIN 
  
          CALL FXR (R, K, I, W) ;            # FIND X-REGISTER #
          IF  R LT 0
            OR  WORDX [R] NE W               # IF NONE FOUND #
                AND  K NE S"CON"
          THEN BEGIN
               CALL FFR ;                    # FIND FETCH REGISTER #
               R = CFRN ; 
               CALL SXR (R, K, I, W) ;       # SET X-REGISTER # 
               END
          RETURN ;
  
          END 
  
  
  
  
#***      POW2  -  POWER OF TWO.
# 
          FUNC POW2 ((M)) I ; 
  
          ITEM M I ;
  
#         IF (M) IS A POWER OF TWO, THE FUNCTION VALUE IS P SUCH
*         THAT  2**P = M.  OTHERWISE, THE FUNCTION VALUE IS -1. 
****
# 
          BEGIN 
          ITEM P, S ; 
  
          IF  M LAN (M-1) NE 0               # IF NOT A POWER OF TWO #
          THEN P = -1 ; 
          ELSE BEGIN
               P = WL / 2 ;                  # DO A BINARY SEARCH # 
               FOR  S = WL / 4  STEP -S/2     # ON POWERS OF TWO #
                    WHILE  2**P NE M  DO       # ZERO TO WL-1 # 
                    BEGIN 
                    IF  2**P GT M 
                    THEN P = P - S ;
                    ELSE P = P + S ;
               END  END 
          POW2 = P ;
          RETURN ;
  
          END 
  
  
  
  
#***      SAR  -  SET SPECIFIED A-REGISTER TO GIVEN VALUE.
# 
          XDEF PROC SAR ; 
          PROC SAR ((R), (K), (I), (W)) ; 
  
          ITEM R I ;               # REGISTER NUMBER #
          ITEM K S:RK ;            # KIND OF VALUE #
          ITEM I I ;               # ITEM POINTER OR CON VALUE #
          ITEM W I ;               # WORD OFFSET #
  
#         *SAR* GENERATES CODE TO SET ADDRESS (A) REGISTER NUMBER 
*         R TO THE VALUE DESIGNATED BY  K, I, W,  AND UPDATES THE 
*         REGISTER ASSOCIATES ACCORDINGLY.
*         NOTE - *SAR* DOES NOT CALL *SXR*. 
****
# 
          BEGIN 
  
          ITEM A C (WC) ; 
          ITEM B S:RT ; 
          ITEM J, M, N, T ; 
  
          LABEL NUL, LIT, CON, XRA, XRW, SYM, VAL, EXT, EXV ; 
          LABEL LITX, SYM1, EXITX, EXITA ;
  
          SWITCH  KIND: RK      NUL: NUL,   LIT: LIT,   CON: CON, 
                    XRA: SRA,   XRW: SRW,   XRA: TRA,   XRW: TRW, 
                    SYM: SYM,   VAL: VAL,   EXT: EXT,   EXV: EXV ;
          GO TO KIND [K] ;
               BEGIN
  
      NUL:                         # NUL - REGISTER NOT IN USE #
               REGA [R] = 0 ;                     # CLEAR REG. ASSOC. # 
               RETURN ; 
  
      LIT:                         # LIT - ADDRESS OF A LITERAL # 
               IF  I LT 0 
               THEN BEGIN                         # IF LIT DESCR ADDR # 
                    I = LDN (I) ;                  # CONVERT TO INDEX # 
                    W = 0 ; 
                    END 
               CALL FAR (J, K, I, W) ;            # FIND A-REGISTER # 
               IF  J LT 0 
               THEN BEGIN                         # IF NONE WAS FOUND # 
                    IF  W EQ 0
                    THEN BEGIN                    # IF NO OFFSET #
                         ISSUE (XNO, RT"LIT") ;     # GEN SAR =LITERAL #
                         ISSUE (OP"SABK", R, 0, I) ;
                         GO TO LITX ;             # NO MORE TO DO # 
                         END
                    ELSE BEGIN
                         ISSUE (XNO, RT"LIT") ;     # GEN SA0 =LITERAL #
                         ISSUE (OP"SABK", 0, 0, I) ;
                         J = 0 ;
                         REGA [0] = 0 ;           # UPDATE A[0] ASSOC. #
                         KINDA [0] = K ;
                         ITEMA [0] = I ;
                    END  END
                                        # A [J] = BASE ADDRESS OF LIT # 
               N = W - WORDA [J] ;
               IF  ABS (N) LE 1                   # N = REL. OFFSET # 
               THEN BEGIN                         # IF N = 0, +1, -1 #
                    IF  N NE 0
                    THEN CALL SB1 ;               # SET (B1) = 1 #
                    IF  N LT 0
                    THEN ISSUE (OP"SAAMB", R, J, 1) ;  # GEN SAR AJ-B1 #
                    ELSE ISSUE (OP"SAAB",  R, J, N) ;  # GEN SAR AJ+BN #
                    END 
               ELSE ISSUE (OP"SAAK", R, T, N) ;        # GEN SAR AJ+N  #
  
      LITX:    IF  R NE 0               # A [R] = SPECIFIED ADDRESS # 
                 AND  R LT 6
               THEN BEGIN                         # IF FETCH REGISTER # 
                    REGX  [R] = 0 ; 
                    KINDX [R] = S"CON" ;          # RESET X [R] ASSOC. #
                    ITEMX [R] = I ; 
                    WORDX [R] = W ; 
                    VALUX [R] = CONW [LITA [I] + W] ; 
                    END 
               GO TO EXITA ;                      # GO UPDATE A [R] # 
  
      CON:                         # CON - KNOWN CONSTANT VALUE # 
               IF  I GE -1
                 AND  I LE 2                      # CHECK SMALL CONST. #
               THEN BEGIN 
                    IF  I EQ 0                    # IF ZERO # 
                    THEN ISSUE (OP"SABB", R, 0, 0) ;   # GEN SAR B0    #
                    ELSE BEGIN
                         CALL SB1 ;               # SET (B1) = 1 #
                         IF  I EQ -1
                         THEN ISSUE (OP"SABMB", R, 0, 1) ; # SAR -B1   #
                         ELSE ISSUE (OP"SABB", R, 1, I-1) ;  # B1(+B1) #
                    END  END
               ELSE BEGIN 
                    CALL FAR (J, K, I, W) ;       # FIND A-REGISTER # 
                    IF  J GE 0
                    THEN BEGIN                    # IF FOUND AND IF # 
                         IF  J NE R                # NOT REGISTER R # 
                         THEN ISSUE (OP"SAAB", R, J, 0) ;  # SAR AJ    #
                         END
                    ELSE BEGIN
                         CALL FXR (J, K, I, W) ;  # FIND X-REGISTER # 
                         IF  J GE 0 
                         THEN ISSUE (OP"SAXB", R, J, 0) ;  # SAR XJ    #
                         ELSE ISSUE (OP"SABK", R, 0, I) ;  # SAR VALUE #
                    END  END
               IF  R NE 0                         # IF FETCH REGISTER # 
                 AND  R LT 6                       # CLEAR X [R] REG. # 
               THEN REGX [R] = 0 ;                  # ASSOCIATE # 
               GO TO EXITA ;                      # GO UPDATE A [R] # 
  
      XRA:                         # SRA/TRA - SOURCE/TARGET REC ADDR # 
               CALL FAR (T, K, I, W) ;            # FIND A-REGISTER # 
               CALL FXR (J, K, I, W) ;            # FIND X-REGISTER # 
               IF  T LT 0 
               THEN N = INFA ;                    # N = REL. OFFSET OF #
               ELSE N = ABS (WORDA [T] - W) ;      # REGISTER A [T] # 
               IF  J LT 0                         # M = REL. OFFSET OF #
               THEN M = INFA ;                     # REGISTER X [J] # 
               ELSE M = ABS (WORDX [J] - W) ; 
               IF  N LT M 
               THEN BEGIN               # A [T] = BASE ADDRESS #
                    N = W - WORDA [T] ; 
                    IF  ABS (N) LE 1
                    THEN BEGIN                    # IF N = 0, +1, -1 #
                         IF  N NE 0 
                         THEN CALL SB1 ;          # SET (B1) = 1 #
                         IF  N LT 0 
                         THEN ISSUE (OP"SAAMB", R, T, 1) ; # SAR AT-B1 #
                         ELSE ISSUE (OP"SAAB",  R, T, N) ; # SAR AT+BN #
                         END
                    ELSE ISSUE (OP"SAAK", R, T, N) ;       # SAR AT+N  #
                    END 
               ELSE BEGIN 
                    IF  M EQ INFA       # BASE ADDRESS NOT FOUND IN # 
                                        # ANY REGISTER - GET IT INTO #
                    THEN BEGIN          # SOME OPERAND REGISTER X [J] # 
  
                         IF  K EQ S"SRA"     # SET NAME OF RECORD AREA #
                         THEN N = QSRA ;      # INDIRECT ADDRESS WORD # 
                         ELSE N = QTRA ;
                         N = EXN (N) ;            # EXTERNAL NUMBER # 
                         CALL FXR (J, RK"EXV", N, 0) ;   # FIND X-REG. #
                         IF  J LT 0 
                         THEN BEGIN               # IF NONE FOUND # 
                              CALL FFR ;          # FIND A FETCH REG. # 
                              J = CFRN ;
                              CALL FAR (T, RK"EXT", N, 0) ;   # FIND A #
                              IF  T GE 0
                              THEN ISSUE (OP"SAAB", J, T, 0) ; # FETCH #
                              ELSE BEGIN                    # INDIRECT #
                                   ISSUE (XNO, RT"EXT") ;    # ADDRESS #
                                   ISSUE (OP"SABK", J, 0, N) ;  # WORD #
                                   END
                              REGA  [J] = 0 ;     # SET THE REGISTER #
                              KINDA [J] = S"EXT" ; # ASSOCIATES FOR # 
                              ITEMA [J] = N ;       # A[J] AND X[J] # 
                              REGX  [J] = 0 ; 
                              KINDX [J] = S"EXV" ;
                              ITEMX [J] = N ; 
                              END 
                         IF  I NE 0               # IF SUBSCRIPTED #
                         THEN BEGIN 
                              IF  K EQ S"SRA"     # PREPARE TO GET #
                              THEN A = X$SBWP ;    # THE ITEM WORD #
                              ELSE A = X$TBWP ;     # OFFSET WORD # 
                              N = EXN (A) ;       # EXTERNAL NUMBER # 
                              CALL FXR (M, RK"EXV", N, 0) ;  # FIND X # 
                              IF  M LT 0
                              THEN BEGIN          # IF NONE FOUND # 
                                   IF  J NE R 
                                     AND  R NE 0       # IF R IS FETCH #
                                     AND  R LT 6       # REG AND NOT J #
                                   THEN M = R ;        # THEN USE IT #
                                   ELSE BEGIN 
                                        CALL FFR ;     # FIND FETCH # 
                                        M = CFRN ;
                                        END 
                                   CALL FAR (T, RK"EXT", N, 0) ;
                                   IF  T GE 0                 # OFFSET #
                                   THEN ISSUE (OP"SAAB", M, T, 0) ; 
                                   ELSE BEGIN                   # WORD #
                                        ISSUE (XNO, RT"EXT") ;
                                        ISSUE (OP"SABK", M, 0, N) ; 
                                        END 
                                   REGA  [M] = 0 ;     # SET REGISTER # 
                                   KINDA [M] = S"EXT" ; # ASSOCIATES  # 
                                   ITEMA [M] = N ;       # FOR A [M]  # 
                                   REGX  [M] = 0 ;        # AND X [M] # 
                                   KINDX [M] = S"EXV" ; 
                                   ITEMX [M] = N ;
                                   END
                              ISSUE (OP"IADD", J, J, M) ;  # IXJ XJ+XM #
                              KINDX [J] = K ; 
                              ITEMX [J] = I ;     # UPDATE X [J] ASSOC #
                         END  END 
                                        # X [J] = BASE ADDRESS #
                    M = W - WORDX [J] ; 
                    IF  M GE 0                    # M = REL. OFFSET # 
                      AND  M LE 1 
                    THEN BEGIN                    # IF M = 0 OR 1 # 
                         IF  M EQ 1 
                         THEN CALL SB1 ;
                         ISSUE (OP"SAXB", R, J, M) ;   # GEN SAR XJ+BM #
                         END
                    ELSE ISSUE (OP"SAXK", R, J, M) ;   # GEN SAR XJ+M  #
                    END 
               GO TO EXITX ;                      # GO UPDATE ASSOC. #
  
      XRW:                         # SRW/TRW - SOURCE/TARGET RECORD WD #
               PUNT (E$SARXW) ;                   # NOT IMPLEMENTED # 
  
      SYM:                         # SYM - ADDRESS OF A LABEL # 
               I = SYN (I) ;                      # CONVERT NAME #
               B = S"SYM" ; 
      SYM1:                        # ENTRY FROM *EXT* PROCESSOR BELOW # 
               CALL FAR (T, K, I, W) ;            # FIND A-REGISTER # 
               CALL FXR (J, K, I, W) ;            # FIND X-REGISTER # 
               IF  T LT 0 
               THEN N = INFA ;                    # N = REL. OFFSET OF #
               ELSE N = ABS (WORDA [T] - W) ;      # REGISTER A [T] # 
               IF  J LT 0                         # M = REL. OFFSET OF #
               THEN M = INFA ;                     # REGISTER X [J] # 
               ELSE M = ABS (WORDX [J] - W) ; 
               IF  N LE M                         # IF M NOT SMALLER #
               THEN BEGIN 
                    IF N EQ INFA        # BASE ADDRESS WAS NOT FOUND #
                    THEN BEGIN
                         IF  W EQ 0               # IF NO OFFSET #
                         THEN BEGIN 
                              ISSUE (XNO, B) ;      # GEN SAR SYMBOL   #
                              ISSUE (OP"SABK", R, 0, I) ; 
                              GO TO EXITX ;       # GO UPDATE ASSOC. #
                              END 
                         ELSE BEGIN 
                              ISSUE (XNO, B) ;      # GEN SA0 SYMBOL   #
                              ISSUE (OP"SABK", 0, 0, I) ; 
                              T = 0 ; 
                              REGA  [0] = 0 ;     # UPDATE A [0] REG. # 
                              KINDA [0] = K ;      # ASSOCIATES # 
                              ITEMA [0] = I ; 
                         END  END 
                                        # A [T] = BASE ADDRESS #
                    N = W - WORDA [T] ; 
                    IF  ABS (N) LE 1
                    THEN BEGIN                    # IF N = 0, +1, -1 #
                         IF  N NE 0 
                         THEN CALL SB1 ;          # SET (B1) = 1 #
                         IF  N LT 0 
                         THEN ISSUE (OP"SAAMB", R, T, 1) ; # SAR AT-B1 #
                         ELSE ISSUE (OP"SAAB",  R, T, N) ; # SAR AT+BN #
                         END
                    ELSE ISSUE (OP"SAAK", R, T, N) ;       # SAR AT+N  #
                    END 
               ELSE BEGIN               # X [J] = BASE ADDRESS #
                    M = W - WORDX [J] ; 
                    IF  M GE 0                    # M = REL. OFFSET # 
                      AND  M LE 1 
                    THEN BEGIN                    # IF M = 0 OR 1 # 
                         IF  M EQ 1 
                         THEN CALL SB1 ;
                         ISSUE (OP"SAXB", R, J, M) ;   # GEN SAR XJ+BM #
                         END
                    ELSE ISSUE (OP"SAXB", R, J, M) ;   # GEN SAR XJ+M  #
                    END 
               GO TO EXITX ;                      # GO UPDATE REG ASSOC#
  
      VAL:                         # VAL - SYMBOL VALUE (CONTENTS) #
               PUNT (E$SARVL) ;                   # NOT IMPLEMENTED # 
  
      EXT:                         # EXT - ADDRESS OF AN EXTERNAL # 
               I = EXN (I) ;                      # CONVERT NAME #
               B = S"EXT" ; 
               GO TO SYM1 ;                       # CONTINUE ABOVE #
  
      EXV:                         # EXV - EXTERNAL VALUE (CONTENTS) #
               PUNT (E$SAREV) ;                   # NOT IMPLEMENTED # 
  
               END                 # OF REGISTER KIND CASES # 
  
 EXITX:   IF  R NE 0                    # UPDATE X [R] REG. ASSOC. #
          THEN BEGIN
               REGX  [R] = 0 ;          # IF A FETCH OR STORE REGISTER #
               KINDX [R] = K + 1 ;
               ITEMX [R] = I ;               # INDICATE CONTENTS OF # 
               WORDX [R] = W ;
               IF  R GE 6 
               THEN BEGIN                    # IF A STORE REGISTER #
                    IF  REGX [13-R] EQ REGX [R] 
                    THEN REGX [13-R] = 0 ;        # CLEAR ALL OTHER   # 
                    FOR  J = 0 THRU 5  DO          # X-REGISTER ASSOC. #
                         IF  REGX [J] EQ REGX [R]   # WITH SAME VALUE # 
                         THEN REGX [J] = 0 ;
               END  END 
 EXITA:   REGA  [R] = 0 ;               # UPDATE A [R] REGISTER # 
          KINDA [R] = K ;                # ASSOCIATES # 
          ITEMA [R] = I ; 
          WORDA [R] = W ; 
          RETURN ;
  
          END 
  
  
  
  
#***      SB1  -  GENERATE CODE TO SET (B1) = 1 IF NECESSARY. 
# 
          XDEF PROC SB1 ; 
          PROC SB1 ;
  
#         *SB1* IS CALLED WHEN AN INSTRUCTION SUCH AS SA3 A2+1
*         IS ABOUT TO BE ISSUED.  IF THE REGISTER B1 ASSOCIATE
*         HAS BEEN CLEARED BY *CRA* THEN *SB1* ISSUES THE 
*         INSTRUCTION SB1 1 SO THAT ALL SUBSEQUENT INSTRUCTIONS 
*         SUCH AS  SA3 A2+1  WILL BE COMPILED AS  SA3 A2+B1.
****
# 
          BEGIN 
  
          IF  ITEMB [1] NE 1                 # TEST REGISTER ASSOCIATE #
          THEN BEGIN
               ITEMB [1] = 1 ;
               ISSUE (OP"SBBK", 1, 0, 1) ;          # GEN SB1  1       #
               END
          RETURN ;
  
          END 
  
  
  
  
#***      SXR  -  SET SPECIFIED X-REGISTER TO GIVEN VALUE.
# 
          XDEF PROC SXR ; 
          PROC SXR ((R), (K), (I), (W)) ; 
  
          ITEM R I ;               # REGISTER NUMBER #
          ITEM K S:RK ;            # KIND OF VALUE #
          ITEM I I ;               # ITEM POINTER OR CON VALUE #
          ITEM W I ;               # WORD OFFSET #
  
#         *SXR* GENERATES CODE TO SET OPERAND (X) REGISTER NUMBER 
*         R TO THE VALUE DESIGNATED BY  K, I, W,  AND UPDATES THE 
*         REGISTER ASSOCIATES ACCORDINGLY.
*         NOTE - *SXR* DOES CALL *SAR*. 
****
# 
          BEGIN 
  
          ITEM A C (WC) ; 
          ITEM B S:RT ; 
          ITEM J, M, N, T ; 
          ITEM IJ, WJ ; 
  
          LABEL NUL, LIT, CON, XRA, XRW, SYM, VAL, EXT, EXV ; 
          LABEL CON1, CON2, CON3, SYM1, EXIT ;
          LABEL CHH, CHL, CHR, CPLX, DP, FP, INT, OCT ; 
  
          SWITCH  KIND: RK      NUL: NUL,   LIT: LIT,   CON: CON, 
                    XRA: SRA,   XRW: SRW,   XRA: TRA,   XRW: TRW, 
                    SYM: SYM,   VAL: VAL,   EXT: EXT,   EXV: EXV ;
          GO TO KIND [K] ;
               BEGIN
  
      NUL:                         # NUL - REGISTER NOT IN USE #
               REGX [R] = 0 ;                     # CLEAR REG. ASSOC. # 
               RETURN ; 
  
      LIT:                         # LIT - ADDRESS OF A LITERAL # 
               IF  I LT 0 
               THEN BEGIN                         # IF LIT DESCR ADDR # 
                    I = LDN (I) ;                  # CONVERT TO INDEX # 
                    W = 0 ; 
                    END 
               B = S"LIT" ;                       # SET RELOC. BASE # 
               GO TO SYM1 ;                       # CONTINUE BELOW #
  
      CON:                         # CON - KNOWN CONSTANT VALUE # 
  
#*        FOR (K) = S"CON",  (I) = THE WORD VALUE TO BE LOADED INTO 
*         X [R],  AND   (W) = L * 8 + F   WHERE (F) IS THE CONSTANT 
*         FORMAT CODE (SEE *COMDCF*) AND (L) IS THE CHARACTER COUNT 
*         (L = 0 UNLESS F = S"H" OR S"L" OR S"R").
# 
               IJ = -1 ;
               WJ = 0 ; 
               M = ABS (I) ;
                                        # TRY TO FIND CONSTANT VALUE #
                                        # ALREADY IN SOME X-REGISTER #
               FOR  J = 7 STEP -1 UNTIL 0  DO 
                    BEGIN                         # SEARCH X-REGS FOR # 
                    IF  KINDX [J] EQ S"CON"        # VALUE OR COMPL. #
                      AND  ABS (VALUX [J]) EQ M 
                    THEN GO TO CON2 ;             # FOUND IT #
                    END 
                                        # TRY TO FORM THE VALUE # 
                                        # WITH IN-LINE CODE # 
               IF  I EQ 0                         # VALUE = 0 # 
               THEN BEGIN 
                    ISSUE (OP"XOR", R, R, R) ;      # GEN BXR XR-XR    #
                    GO TO CON3 ;
                    END 
               IF  I EQ 1  OR  I EQ 2             # VALUE = 1 OR 2 #
               THEN BEGIN 
                    CALL SB1 ;                    # SET (B1) = 1 #
                    ISSUE (OP"SXBB", R, 1, I-1) ;   # GEN SXR B1(+B1)  #
                    GO TO CON3 ;
                    END 
               IF  I LT 0                         # VALUE = SIMPLE MASK#
                 AND (-I) LAN (1-I) EQ 0           # = 77--7700--00B #
               THEN BEGIN 
                    T = 1 - I ; 
                    IF  T EQ 0                    # IF ONE-BIT MASK # 
                    THEN T = 1 ;
                    ELSE T = WL - POW2 (T) ;
                    ISSUE (OP"MASK", R, 0, T) ;     # GEN MXR NBITS    #
                    GO TO CON3 ;
                    END 
               IF  M LT INFA                      # VALUE = SHORT INT. #
               THEN BEGIN 
                    T = B<WL-3,3> W ;             # CONSTANT FORMAT # 
                    IF  T EQ CF"INT"
                    THEN BEGIN
                         CALL XCDDL (M, A, N) ;   # CONVERT TO DECIMAL #
                         N = N / CL ; 
                         IF  I LT 0               # IF NEGATIVE # 
                         THEN BEGIN 
                              C<1,N> A = C<0,N> A ; 
                              C<0,1> A = "-" ;         # LEADING MINUS #
                              N = N + 1 ; 
                              END 
                         B<ZL,AL> A = N ;         # ISSUE IMMEDIATE # 
                         ISSUE (XIMMED, A) ;       # LITERAL CODE # 
                         END
                    ELSE
                    IF  T EQ CF"R"                # IF R-CHARACTER #
                    THEN BEGIN
                         N = W / 8 ;              # CHARACTER COUNT # 
                         B<0,CL> A = N + CHARACTER"ZERO" ;
                         C<1,1> A = "R" ;         # FORM NRXXX #
                         C<2,N> A = C<WC-N,N> I ; 
                         B<ZL,AL> A = N + 2 ;     # ISSUE IMMEDIATE # 
                         ISSUE (XIMMED, A) ;       # LITERAL CODE # 
                         END
                    ISSUE (OP"SXBK", R, 0, I) ;     # GEN SXR VALUE    #
                    GO TO CON3 ;
                    END 
               IF  B<AL,ZL> M EQ 0                # VALUE = SHORT F.P. #
               THEN BEGIN 
                    T = B<0,AL> M ;               # GET EXPONENT AND #
                    IF  I LT 0                     # TOP BITS OF THE #
                    THEN T = - T ;                  # COEFFICIENT  #
                    ISSUE (OP"SXBK", R, 0, T) ;     # GEN SXR VAL/1S42 #
                    ISSUE (OP"LEFTK", R, 0, 42) ;   # GEN LXR 42       #
                    GO TO CON3 ;
                    END 
               IF  I LAN (1+I) EQ 0               # VALUE = COMPL.MASK #
               THEN BEGIN 
                    T = 1 + I ; 
                    IF  T EQ 0                    # IF ONE-BIT MASK # 
                    THEN T = 1 ;
                    ELSE T = WL - POW2 (T) ;
                    ISSUE (OP"MASK", R, 0, T) ;     # GEN MXR NBITS    #
                    ISSUE (OP"COMP", R, R, R) ;     # GEN BXR -XR      #
                    GO TO CON3 ;
                    END 
               T = 1 ;                            # CHECK IF VALUE IS # 
               FOR  N = 0 STEP 1                   # A SHIFTED MASK  #
                    WHILE  T LAN M NQ T 
                    DO  T = T + T ;               # N = RIGHTMOST BIT # 
               T = M + T ;                         # POSITION # 
               IF  T LT 0 
               THEN T = WL - 1 ;                  # T = LEFMMOST BIT #
               ELSE T = POW2 (T) ;                 # POSITION + 1 # 
               IF  T GE 0 
               THEN BEGIN                         # M = MASK LENGTH # 
                    M = T - N ; 
                    IF  I LE 0                    # COMP IF END AROUND #
                    THEN M = WL - M ; 
                    ISSUE (OP"MASK", R, 0, M) ;     # GEN MXR M        #
                    ISSUE (OP"LEFTK", R, 0, N) ;    # GEN LXR N        #
                    GO TO CON3 ;
                    END 
                                        # MUST FETCH VALUE FROM MEMORY #
                                        # AS A LITERAL CONSTANT # 
               IF  R NE 0                         # IF R IS A FETCH REG#
                 AND  R LT 6                       # AND A [R] IS NOT # 
                 AND  NOT LOCKA [R]                 # LOCKED, USE IT #
               THEN J = R ; 
               ELSE BEGIN 
                    CALL FFR ;                    # FIND A FETCH REG. # 
                    J = CFRN ;
                    END 
               N = W / 8 ;                        # PREPARE A LITERAL # 
               T = W - N * 8 ;                     # IN SOURCE FORMAT # 
  
               SWITCH  CONFORM: CF
                         OCT: OCT,   CHH: H,   CHL: L,   CHR: R,
                         INT: INT,   FP: FP,   DP: DP,   CPLX: CPLX ; 
               GO TO CONFORM [T] ;
                    BEGIN 
  
           CHH:          # CHARACTER STRING, LEFT JUSTIFIED, SPACE FILL#
                    A = C<0,N> I ;
                    IJ = - LITCH (N, A) ;         # =(N)H(STRING) # 
                    GO TO CON1 ;
  
           CHL:          # CHARACTER STRING, LEFT JUSTIFIED, ZERO FILL #
                    A = C<0,N> I ;
                    IJ = - LITCZ (N, A) ;         # =(N)L(STRING) # 
                    GO TO CON1 ;
  
           CHR:          # CHARACTER STRING, RIGHT JUSTIFIED, ZERO FILL#
                    A = C<WC-N,N> I ; 
                    IJ = - LITCR (N, A) ;         # =(N)R(STRING) # 
                    GO TO CON1 ;
  
           CPLX:         # COMPLEX FLOATING POINT CONSTANT #
                    PUNT (E$SXRCC) ;              # NOT IMPLEMENTED # 
  
           DP:           # DOUBLE PRECISION FLOATING POINT CONSTANT # 
                    PUNT (E$SXRCD) ;              # NOT IMPLEMENTED # 
  
           FP:           # SINGLE PRECISION FLOATING POINT CONSTANT # 
                    IJ = - LITFP (I) ;            # =(INT).(FRAC)E(EXP)#
                    GO TO CON1 ;
  
           INT:          # INTEGER BINARY NUMBER IN DECIMAL SOURCE FORM#
                    IJ = - LITINT (I) ;           # =(INTEGER) #
                    GO TO CON1 ;
  
           OCT:          # ARBITRARY WORD VALUE IN OCTAL SOURCE FORM #
                    IJ = - LITOCT (I) ;           # =(OCTAL)B # 
                    GO TO CON1 ;
  
                    END                 # OF LITERAL FORMAT CASES # 
  
      CON1:    CALL SAR (J, RK"LIT", IJ, 0) ;       # GEN SAJ =VALUE   #
  
      CON2:                        # X [J] = VALUE WANTED OR ITS COMPL.#
               IF  B<0> VALUX [J] EQ B<0> I 
               THEN BEGIN                         # IF TRUE VALUE # 
                    IF  J EQ R
                    THEN RETURN ;                 # IF SAME REGISTER #
                    ELSE BEGIN
                         IJ = ITEMX [J] ;         # IF NOT SAME REG. #
                         WJ = WORDX [J] ;           # GEN BXR XJ       #
                         ISSUE (OP"COPY", R, J, J) ;
                    END  END                      # IF COMPL. OF VALUE #
               ELSE ISSUE (OP"COMP", R, J, J) ;     # GEN BXR -XJ      #
      CON3: 
               REGX  [R] = 0 ;                    # UPDATE X [R] #
               KINDX [R] = S"CON" ;                # REGISTER # 
               ITEMX [R] = IJ ;                     # ASSOCIATES #
               WORDX [R] = WJ ; 
               VALUX [R] = I ;
               RETURN ; 
  
      XRA:                         # SRA/TRA - SOURCE/TARGET REC ADDR # 
               CALL FAR (T, K, I, W) ;            # FIND A-REGISTER # 
               CALL FXR (J, K, I, W) ;            # FIND X-REGISTER # 
               IF  T LT 0 
               THEN N = INFA ;                    # N = REL. OFFSET OF #
               ELSE N = ABS (WORDA [T] - W) ;      # REGISTER A [T] # 
               IF  J LT 0                         # M = REL. OFFSET OF #
               THEN M = INFA ;                     # REGISTER X [J] # 
               ELSE M = ABS (WORDX [J] - W) ; 
               IF  N LT M 
               THEN BEGIN               # A [T] = BASE ADDRESS #
                    N = W - WORDA [T] ; 
                    IF  ABS (N) LE 1
                    THEN BEGIN                    # IF N = 0, +1, -1 #
                         IF  N NE 0 
                         THEN CALL SB1 ;          # SET (B1) = 1 #
                         IF  N LT 0 
                         THEN ISSUE (OP"SXAMB", R, T, 1) ; # SXR AT-B1 #
                         ELSE ISSUE (OP"SXAB",  R, T, N) ; # SXR AT+BN #
                         END
                    ELSE ISSUE (OP"SXAK", R, T, N) ;       # SXR AT+N  #
                    END 
               ELSE BEGIN 
                    IF  M EQ INFA       # BASE ADDRESS NOT FOUND IN # 
                                        # ANY REGISTER - GET IT INTO #
                    THEN BEGIN          # SOME OPERAND REGISTER X [J] # 
  
                         IF  K EQ S"SRA"     # SET NAME OF RECORD AREA #
                         THEN N = QSRA ;      # INDIRECT ADDRESS WORD # 
                         ELSE N = QTRA ;
                         N = EXN (N) ;            # EXTERNAL NUMBER # 
                         CALL FXR (J, RK"EXV", N, 0) ;   # FIND X-REG. #
                         IF  J LT 0 
                         THEN BEGIN               # IF NONE FOUND # 
                              IF  R NE 0
                                AND  R LT 6       # IF R IS A FETCH # 
                                AND  NOT LOCKA [R] # REG. AND A [R] IS #
                              THEN J = R ;          # UNLOCKED, USE R # 
                              ELSE BEGIN
                                   CALL FFR ;     # FIND A FETCH REG. # 
                                   J = CFRN ; 
                                   END            # FETCH IND. ADDRESS #
                              CALL SAR (J, RK"EXT", N, 0) ;    # SET A #
                              END 
                         IF  I NE 0               # IF SUBSCRIPTED #
                         THEN BEGIN 
                              IF  K EQ S"SRA"     # PREPARE TO GET #
                              THEN A = X$SBWP ;    # THE ITEM WORD #
                              ELSE A = X$TBWP ;     # OFFSET WORD # 
                              N = EXN (A) ;       # EXTERNAL NUMBER # 
                              CALL FXR (M, RK"EXV", N, 0) ;  # FIND X # 
                              IF  M LT 0
                              THEN BEGIN          # IF NONE FOUND # 
                                   IF  J NE R 
                                     AND  R NE 0       # IF R IS FETCH #
                                     AND  R LT 6       # REG AND NOT J #
                                     AND NOT LOCKA [R] # AND A [R] NOT #
                                   THEN M = R ;        # LOCKED, USE R #
                                   ELSE BEGIN 
                                        CALL FFR ;     # FIND FETCH REG#
                                        M = CFRN ;
                                        END       # FETCH OFFSET WORD # 
                                   CALL SAR (M, RK"EXT", N, 0) ;  #SETA#
                                   END
                              IF  W EQ 0               # IF BIT OFFSET #
                              THEN BEGIN                    # IXR XJ+XM#
                                   ISSUE (OP"IADD", R, J, M) ;
                                   GO TO EXIT ; 
                                   END                 # OTHERWISE #
                              ISSUE (OP"IADD", J, J, M) ;  # IXJ XJ+XM #
                              KINDX [J] = K ; 
                              ITEMX [J] = I ;     # UPDATE X [J] ASSOC #
                         END  END 
                                        # X [J] = BASE ADDRESS #
                    M = W - WORDX [J] ; 
                    IF  M GE 0                    # M = REL. OFFSET # 
                      AND  M LE 1 
                    THEN BEGIN                    # IF M = 0 OR 1 # 
                         IF  M EQ 1 
                         THEN CALL SB1 ;
                         ISSUE (OP"SXXB", R, J, M) ;   # GEN SXR XJ+BM #
                         END
                    ELSE ISSUE (OP"SXXK", R, J, M) ;   # GEN SXR XJ+M  #
                    END 
               GO TO EXIT ;                       # GO UPDATE ASSOC. #
  
      XRW:                         # SRW/TRW - SOURCE/TARGET RECORD WD #
               CALL FXR (J, K, I, W) ;            # FIND X-REGISTER # 
               IF  J LT 0 
               THEN BEGIN                         # IF NONE FOUND # 
                    IF  R NE 0
                      AND  R LT 6                 # IF R IS A FETCH REG#
                      AND  NOT LOCKA [R]           # AND A [R] IS NOT # 
                    THEN J = R ;                    # LOCKED, USE IT #
                    ELSE BEGIN
                         CALL FFR ;               # FIND A FETCH REG. # 
                         J = CFRN ; 
                         END                      # FETCH RECORD WORD # 
                    CALL SAR (J, K-1, I, W) ;     # SET A-REGISTER #
                    END 
               IF  FBITX [J] NE 0 
               THEN BEGIN                         # IF X [J] IS SHIFTED#
                    M = WL - FBITX [J] ;           # MUST UNSHIFT IT #
                    FBITX [J] = 0 ; 
                    ISSUE (OP"LEFTK", J, 0, M) ;    # GEN LXJ M        #
                    END 
               IF  J NE R                         # IF X[J] NOT X[R] #
               THEN ISSUE (OP"COPY", R, J, J) ;     # GEN BXR XJ       #
               GO TO EXIT ;                       # GO UPDATE ASSOC. #
  
      SYM:                         # SYM - ADDRESS OF A LABEL # 
               I = SYN (I) ;                      # CONVERT NAME #
               B = S"SYM" ; 
      SYM1:                        # ENTRY FROM *EXT* PROCESSOR BELOW # 
               CALL FAR (T, K, I, W) ;            # FIND A-REGISTER # 
               CALL FXR (J, K, I, W) ;            # FIND X-REGISTER # 
               IF  T LT 0 
               THEN N = INFA ;                    # N = REL. OFFSET OF #
               ELSE N = ABS (WORDA [T] - W) ;      # REGISTER A [T] # 
               IF  J LT 0                         # M = REL. OFFSET OF #
               THEN M = INFA ;                     # REGISTER X [J] # 
               ELSE M = ABS (WORDX [J] - W) ; 
               IF  N LE M                         # IF M NOT SMALLER #
               THEN BEGIN 
                    IF N EQ INFA        # BASE ADDRESS WAS NOT FOUND #
                    THEN BEGIN
                         IF  W EQ 0               # IF NO OFFSET #
                         THEN BEGIN 
                              ISSUE (XNO, B) ;      # GEN SXR SYMBOL   #
                              ISSUE (OP"SXBK", R, 0, I) ; 
                              GO TO EXIT ;        # GO UPDATE ASSOC. #
                              END 
                         ELSE BEGIN 
                              ISSUE (XNO, B) ;      # GEN SA0 SYMBOL   #
                              ISSUE (OP"SABK", 0, 0, I) ; 
                              T = 0 ; 
                              REGA  [0] = 0 ;     # UPDATE A [0] REG. # 
                              KINDA [0] = K ;      # ASSOCIATES # 
                              ITEMA [0] = I ; 
                         END  END 
                                        # A [T] = BASE ADDRESS #
                    N = W - WORDA [T] ; 
                    IF  ABS (N) LE 1
                    THEN BEGIN                    # IF N = 0, +1, -1 #
                         IF  N NE 0 
                         THEN CALL SB1 ;          # SET (B1) = 1 #
                         IF  N LT 0 
                         THEN ISSUE (OP"SXAMB", R, T, 1) ; # SXR AT-B1 #
                         ELSE ISSUE (OP"SXAB",  R, T, N) ; # SXR AT+BN #
                         END
                    ELSE ISSUE (OP"SXAK", R, T, N) ;       # SXR AT+N  #
                    END 
               ELSE BEGIN               # X [J] = BASE ADDRESS #
                    M = W - WORDX [J] ; 
                    IF  M GE 0                    # M = REL. OFFSET # 
                      AND  M LE 1 
                    THEN BEGIN                    # IF M = 0 OR 1 # 
                         IF  M EQ 1 
                         THEN CALL SB1 ;
                         ISSUE (OP"SXXB", R, J, M) ;   # GEN SXR XJ+BM #
                         END
                    ELSE ISSUE (OP"SXXB", R, J, M) ;   # GEN SXR XJ+M  #
                    END 
               GO TO EXIT ;                       # GO UPDATE REG ASSOC#
  
      VAL:                         # VAL - SYMBOL VALUE (CONTENTS) #
               I = SYN (I) ;                      # CONVERT NAME #
               GO TO XRW ;
  
      EXT:                         # EXT - ADDRESS OF AN EXTERNAL # 
               I = EXN (I) ;                      # CONVERT NAME #
               B = S"EXT" ; 
               GO TO SYM1 ;                       # CONTINUE ABOVE #
  
      EXV:                         # EXV - EXTERNAL VALUE (CONTENTS) #
               I = EXN (I) ;                      # CONVERT NAME #
               GO TO XRW ;
  
               END                 # OF REGISTER KIND CASES # 
  
 EXIT:    REGX  [R] = 0 ;     # UPDATE REGISTER ASSOCIATES #
          KINDX [R] = K ; 
          ITEMX [R] = I ; 
          WORDX [R] = W ; 
          RETURN ;
  
          END 
  
     END  TERM
