*COMDECK     COMISSUE   - ISSUE INSTRUCTION TO INTERMEDIATE.
#*        ISSUE - ISSUE INSTRUCTION TO INTERMEDIATE.
* 
*         R. H. GOODELL.     76/06/30.
* 
*         EACH CALL TO *ISSUE* ADDS ONE MACHINE INSTRUCTION OR
*         PSEUDO INSTRUCTION TO THE INTERMEDIATE CODE TABLE 
*         (TXEQ) OR THE VARIABLE/APLIST TABLE (TVAR).  THIS 
*         IS USED BY ALL PASS 1 CODE GENERATING ROUTINES. 
*         ALTERNATIVELY, *ISSUE* CAN BE CALLED WITH A *CODE*
*         TABLE ENTRY AS ITS ARGUMENT, TO ISSUE A SERIES OF 
*         PREVIOUSLY ASSEMBLED ABSOLUTE INSTRUCTIONS TO TXEQ. 
* 
*         CONTENTS (XDEF ENTRY POINTS). 
* 
*         PROC   ISSUE       ISSUE ONE INSTRUCTION TO TXEQ OR TVAR, 
*                            OR ISSUE A SERIES OF INSTRUCTIONS TO TXEQ. 
# 
  
  
*CALL     COMDDEF            GENERAL DEFINITIONS. 
  
     XREF BEGIN               # MANAGED TABLES #
  
*CALL     COMDTCON           CONSTANT VALUES. 
  
*CALL     COMDTEXT           EXTERNAL NAMES.
  
*CALL     COMDTLIT           LITERALS.
  
*CALL     COMDTREF           REFERENCES TO EXTERNALS (PASS 1).
  
*CALL     COMDTSYM           SYMBOL TABLE.
  
*CALL     COMDTVAR           VARIABLES AND APLISTS (INTERMEDIATE).
  
*CALL     COMDTXEQ           EXECUTABLE CODE + PSEUDO OPS (INTERMEDIATE)
  
          END 
  
  
     XREF BEGIN               # OTHER EXTERNALS # 
  
          ITEM ILEN I ;            # INSTRUCTION LENGTH: PARCELS - 1 #
          ITEM ILOC I ;            # LOCATION COUNTER FOR TXEQ #
          ITEM INST U ;            # INSTR. LEFT JUST. FOR TXEQ/TVAR #
          ITEM INTW U ;            # INSTRUCTION WORD GOING TO TXEQ # 
          ITEM IPAR I ;            # PARCEL NUMBER OF INSTR. (0-3) #
          ITEM VBLW U ;            # INSTRUCTION WORD GOING TO TVAR # 
          ITEM VLOC I ;            # LOCATION COUNTER FOR TVAR #
          ITEM VPAR I ;            # PARCEL NUMBER OF INSTR. (0-3) #
          ITEM VPOS I ;            # NEXT BIT POSITION IN VBLW #
          ITEM XPOS I ;            # NEXT BIT POSITION IN INTW #
          PROC ALLOC ;             # ALLOCATE TABLE SPACE # 
          FUNC EXN I ;             # EXTERNAL NAME NUMBER # 
          FUNC LDN I ;             # LITERAL DESCRIPTOR NUMBER #
          PROC MOVEI ;             # MOVE DATA, INDIRECT ADDRESS #
          PROC PADV ;              # PAD *TVAR* TO WORD BOUNDARY #
          PROC PADX ;              # PAD *TXEQ* TO WORD BOUNDARY #
          FUNC SYN I ;             # SYMBOL NAME NUMBER # 
  
          END 
  
  
          DEF  VAR  #GH NE OP"PSEUDO"# ;
  
  
*CALL     COMDOPS            OPERATION CODES. 
  
  
*CALL     COMDPSOP           PSEUDO OPERATION ISSUING DEFS. 
  
  
#         LOCAL DATA. 
# 
          BASED ARRAY CODE ;       # CODE SEQUENCE #
               ITEM CODEW ;             # CODE WORD # 
          ITEM A C (WC) ;          # CHARACTER TEMP # 
          ITEM L, N ;              # INTEGER TEMPS #
          ITEM LONG U = O"7760 0000 0000 0340 7016" ;  # 30-BIT INSTR. #
          ITEM RELF S:RT = S"NO" ; # RELOCATION FLAG #
          ITEM SLOC ;              # TEMP SAVE FOR INSTRUCTION #
          ITEM SPAR ;              # LOCATION AND PARCEL COUNTERS # 
  
  
  
  
#***      ISSUE - ISSUE INSTRUCTION TO INTERMEDIATE.
  
          PROC ISSUE (GH, I, J, K)
# 
          ITEM GH ;                # OPERATION CODE # 
          ITEM I  ;                # RESULT REGISTER #
          ITEM J  ;                # 1ST OPERAND REGISTER # 
          ITEM K  ;                # 2ND OPERAND REGISTER OR ADDRESS #
#***
# 
          BEGIN 
  
          IF  GH GT OP"VAR"        # IF ARGUMENT IS A CODE POINTER #
          THEN BEGIN
               CALL ICS ;               # ISSUE CODE SEQUENCE # 
               RETURN ; 
               END
          IF  GH NE OP"VAR"        # IF NOT VARIABLE/APLIST PSEUDO ... #
          THEN BEGIN
               IF  GH EQ OP"PSEUDO"     # ISSUE PSEUDO INSTRUCTION  OR #
               THEN CALL IPI ;          # ISSUE MACHINE INSTRUCTION # 
               ELSE CALL IMI ;
               N = ILEN * 15 + 15 ;     # N = INSTR. LENGTH IN BITS # 
               IF  XPOS + N LE WL 
               THEN L = N ;             # L = BITS TO GO INTO INTW #
               ELSE L = WL - XPOS ; 
               B<XPOS,L> INTW = B<0,L> INST ;     # PACK INSTRUCTION #
               XPOS = XPOS + L ;
               IF  XPOS EQ WL           # IF INTW IS FULL # 
               THEN BEGIN 
                    ALLOC (P<TXEQ>, 1) ;     # APPEND IT TO TXEQ #
                    XEQW [TXEQL-1] = INTW ; 
                    INTW = 0 ;               # START NEW INTW # 
                    XPOS = N - L ;
                    IF  XPOS NE 0 
                    THEN B<0,XPOS> INTW = B<L,XPOS> INST ;
               END  END 
          ELSE BEGIN               # IF VARIABLE/APLIST PSEUDO ... #
               SLOC = ILOC ;
               SPAR = IPAR ;            # SAVE AND RESET INSTRUCTION #
               ILOC = VLOC ;            # LOCATION AND PARCEL COUNTERS #
               IPAR = VPAR ;
               CALL IPI ;               # ISSUE PSEUDO INSTRUCTION #
               VLOC = ILOC ;
               VPAR = IPAR ;            # SET AND RESTORE INSTRUCTION # 
               ILOC = SLOC ;            # LOCATION AND PARCEL COUNTERS #
               IPAR = SPAR ;
               N = ILEN * 15 + 15 ;     # N = INSTR. LENGTH IN BITS # 
               IF  VPOS + N LE WL 
               THEN L = N ;             # L = BITS TO GO INTO VBLW #
               ELSE L = WL - XPOS ; 
               B<VPOS,L> VBLW = B<0,L> INST ;     # PACK INSTRUCTION #
               VPOS = VPOS + L ;
               IF  VPOS EQ WL           # IF VBLW IS FULL # 
               THEN BEGIN 
                    ALLOC (P<TVAR>, 1) ;     # APPEND IT TO TVAR #
                    VARW [TVARL-1] = VBLW ; 
                    VBLW = 0 ;               # START NEW VBLW # 
                    VPOS = N - L ;
                    IF  VPOS NE 0 
                    THEN B<0,VPOS> VBLW = B<L,VPOS> INST ;
               END  END 
          RETURN ;
  
  
  
  
#***      FUP  -  FORCE UPPER.
# 
          PROC FUP ;
  
#***
# 
          BEGIN 
  
          IF  IPAR NE 0 
          THEN BEGIN               # IF NOT AT TOP OF WORD #
               IPAR = 0 ;           # THEN START NEW WORD # 
               ILOC = ILOC + 1 ;
               END
          RETURN ;
  
          END 
  
  
  
  
#***      ICS  -  ISSUE CODE SEQUENCE.
# 
          PROC ICS ;
  
#         CODE SEQUENCES ARE ISSUED BY CALLS OF THE FORM
*                      ISSUE (C$NAME, 0, 0, 0)
*         WHERE C$NAME IS THE (XREF) ITEM NAME OF AN ENTRY IN 
*         THE *CODE* TABLE, WHICH IS A COMPASS SUBPROGRAM.
****
# 
          BEGIN 
  
          P<CODE> = B<ZL,AL> GH ;       # FWA OF CODE SEQUENCE #
          N = B<0,30> GH ;              # NUMBER OF 15-BIT PARCELS #
          L = 0 ;                       # NEXT CODE BIT POSITION #
          FOR  N = N-1 STEP -1 UNTIL 0  DO
               BEGIN
               IF  B<L,15> CODEW EQ O"46000"
               THEN BEGIN 
                    L = L + 15 ;        # IGNORE NO-OP INSTRUCTION #
                    IF  L EQ WL 
                    THEN BEGIN               # IF END OF CODE WORD #
                         L = 0 ;              # THEN START NEW ONE #
                         P<CODE> = P<CODE> + 1 ;
                         END
                    TEST N ;
                    END 
               GH = B<L,6> CODEW ;      # ILEN = 0 IF 15-BIT INSTR. # 
               IF  GH GE WL             #     OR 1 IF 30-BIT INSTR. # 
               THEN ILEN = 0 ;
               ELSE ILEN = B<GH> LONG ; 
               IF  IPAR + ILEN GE 4     # IF INSTRUCTION WILL NOT # 
               THEN BEGIN                # FIT INTO CURRENT WORD #
                    ILOC = ILOC + 1 ;     # THEN START NEW WORD # 
                    IPAR = ILEN + 1 ; 
                    END                 # UPDATE PARCEL NUMBER #
               ELSE IPAR = IPAR + ILEN + 1 ;
               N = N - ILEN ; 
               FOR  ILEN = ILEN STEP -1 UNTIL 0  DO 
                    BEGIN                    # MOVE PARCEL #
                    B<XPOS,15> INTW = B<L,15> CODEW ; 
                    L = L + 15 ;
                    IF  L EQ WL              # IF END OF CODE WORD #
                    THEN BEGIN                # THEN START NEW ONE #
                         L = 0 ;
                         P<CODE> = P<CODE> + 1 ;
                         END
                    XPOS = XPOS + 15 ;
                    IF  XPOS EQ WL           # IF INTW IS FULL #
                    THEN BEGIN
                         ALLOC (P<TXEQ>, 1) ;     # APPEND IT TO TXEQ # 
                         XEQW [TXEQL-1] = INTW ;
                         INTW = 0 ;               # START NEW INTW #
                         XPOS = 0 ; 
               END  END  END            # LOOP FOR ALL PARCELS #
          IF  IPAR GE 4 
          THEN BEGIN
               IPAR = 0 ;               # IF WORD IS NOW FULL # 
               ILOC = ILOC + 1 ;         # THEN START NEW ONE # 
               END
          RETURN ;
  
          END 
  
  
  
  
#***      IMI  -  ISSUE MACHINE INSTRUCTION.
# 
          PROC IMI ;
  
#         MACHINE INSTRUCTIONS ARE ISSUED BY CALLS OF THE FORM
*                   ISSUE (OP"MNEMONIC", I, J, K) 
*         WHERE OP"MNEMONIC" IS AS DEFINED IN COMMON DECK *COMDOPS* 
*         AND I, J, AND K ARE THE INSTRUCTION FIELDS AS IN THE CPU
*         HARDWARE REFERENCE MANUAL.  IF THE INSTRUCTION HAS A
*         SIX-BIT SHIFT COUNT JK, CALL ISSUE WITH J = 0 AND K = 
*         THE JK VALUE.  IF THE INSTRUCTION HAS AN 18-BIT ADDRESS 
*         K AND IT IS NOT AN ABSOLUTE ADDRESS, PRECEDE THIS 
*         INSTRUCTION WITH A PSEUDO INSTRUCTION (XNO OR XFORCE) 
*         THAT SETS THE RELOCATION MODE (SEE PROC ISSUE/ISA FOR 
*         DETAILS). 
****
# 
          BEGIN 
  
          IF  GH GE WL                  # ILEN = 0 IF 15-BIT INSTR. # 
          THEN ILEN = 0 ;               #     OR 1 IF 30-BIT INSTR. # 
          ELSE ILEN = B<GH> LONG ;
          IF  IPAR + ILEN GE 4          # IF INSTRUCTION WILL NOT # 
          THEN BEGIN                     # FIT INTO CURRENT WORD #
               ILOC = ILOC + 1 ;          # THEN START NEW WORD # 
               IPAR = 0 ; 
               END
          B<0,6> INST = GH ;
          B<6,3> INST = I  ;            # ASSEMBLE                    # 
          B<9,3> INST = J  ;            #          BINARY             # 
          IF  ILEN EQ 0                 #                 INSTRUCTION # 
          THEN BEGIN
               B< 9,3> INST = J + B<0,WL-3> K ; 
               B<12,3> INST = K ; 
               END
          ELSE BEGIN
               CALL ISA ;               # ISSUE SYMBOLIC ADDRESS #
               B<12,AL> INST = K ;
               END
          IPAR = IPAR + ILEN + 1 ;      # UPDATE PARCEL NUMBER #
          IF  IPAR GE 4 
          THEN BEGIN
               ILOC = ILOC + 1 ;        # IF WORD IS NOW FULL # 
               IPAR = 0 ;                # THEN START NEW ONE # 
               END
          RETURN ;
  
          END 
  
  
  
  
#***      IPI  -  ISSUE PSEUDO INSTRUCTION. 
# 
          PROC IPI ;
  
#         PSEUDO INSTRUCTIONS ARE ISSUED BY CALLS OF THE FOLLOWING
*         FORMS.          GH      I _ J    J _ K     K _ I
*              ISSUE (OP"PSEUDO", PS"P0", P0"NO", RT"RELOC")
*              ISSUE (OP"PSEUDO", PS"P0", P0"FORCE", RT"RELOC") 
*              ISSUE (OP"PSEUDO", PS"P0", P0"CON", VALUE) 
*              ISSUE (OP"PSEUDO", PS"P0", P0"IMMED", ILIT)
*              ISSUE (OP"PSEUDO", PS"P0", P0"SUBR", 0)
*                         GH      I _ J    J _ I       K
*              ISSUE (OP"PSEUDO", PS"P1", P1"LINE", LINENO) 
*              ISSUE (OP"PSEUDO", PS"P1", P1"LABEL", TSYM INDEX)
*              ISSUE (OP"PSEUDO", PS"P1", P1"BSS", NWORDS)
*              ISSUE (OP"PSEUDO", PS"P1", P1"SCON", NWORDS) 
*              ISSUE (OP"PSEUDO", PS"P1", P1"SVFD", KVALUE) 
*                         GH      I _ J      J _ I       K
*              ISSUE (OP"PSEUDO", PS"ARG", RT"RELOC", ADDRESS)
*              ISSUE (OP"PSEUDO", PS"EQU", RT"RELOC", ADDRESS)
* 
*         THE FIRST ARGUMENT CAN BE OP"PSEUDO" TO PUT THE PSEUDO
*         INSTRUCTION INTO TXEQ, OR OP"VAR" TO PUT IT INTO TVAR.
* 
*         DEFS PROVIDING SHORT FORMS OF THE ABOVE ARE IN COMMON 
*         DECK *COMDPSOP*.
*         FOR THE *IMMED* PSEUDO OP, THE ARGUMENT (K) IS A WORD 
*         CONTAINING (1) A CONSTANT IN SOURCE FORM, UP TO SEVEN 
*         CHARACTERS LEFT JUSTIFIED IN THE LEFT 42 BITS, AND (2)
*         THE CHARACTER COUNT AS A BINARY INTEGER IN THE RIGHT
*         18 BITS.  THIS PSEUDO OP HAS NO EFFECT ON BINARY OUTPUT 
*         BUT HELPS OBJECT CODE LISTING READABILITY.
*         FOR THE *SCON* AND *SVFD* PSEUDO OPERATIONS, *ISSUE* WILL 
*         SUPPLY ANY PADDING NEEDED SO THAT THE PSEUDO INSTRUCTION
*         ENDS AT A WORD BOUNDARY IN TXEQ/TVAR.  THE CALLER MUST
*         THEN ADD THE (K) DATA WORDS TO TXEQ/TVAR. 
*         FOR THE *SVFD* PSEUDO OPERATION, THE *KVALUE* ARGUMENT IS 
*         OF THE FORM    NWORDS + NFIELDS * 2**24 + NBITS * 2**18 
*         WHERE   NWORDS  = NUMBER OF WORDS OF VFD INFORMATION, 
*                 NFIELDS = TOTAL NUMBER OF FIELDS IN THEM, AND 
*                 NBITS   = NUMBER OF BITS PER FIELD. 
****
# 
          BEGIN 
          ARRAY ;                       # TO DETERMINE PARCEL COUNT # 
               BEGIN                         # FOR VALUE OF *CON* # 
               ITEM K1 I (0, 45, 15) ;
               ITEM K2 I (0, 30, 30) ;
               ITEM K3 I (0, 15, 45) ;
               ITEM K4 I (0,  0, 60) ;
               END
          ITEM W ;
  
          LABEL PP0, PP1, PARG, PEQU, P30 ; 
          LABEL PNO, PFORCE, PCON, PIMMED, PSUBR ;
          LABEL PLINE, PLABEL, PBSS, PSCON, PSVFD ; 
  
          SWITCH  PPSEUDO: PS 
                    PP0: P0,  PP1: P1,  PARG: ARG,  PEQU: EQU ; 
          GO TO PPSEUDO [I] ; 
               BEGIN
  
#                             PROCESS PSEUDOS WITH I = PS"P0".
# 
      PP0:     B< 0,6> INST = OP"PSEUDO" ;   # GH = OPCODE         #
               B< 6,3> INST = K ;            #  I = RELOC OR COUNT #
               B< 9,3> INST = PS"P0" ;       #  J = SUB-OPCODE     #
               B<12,3> INST = J ;            #  K = SUB-SUB-OPCODE #
               ILEN = 0 ;                    # SET 15-BIT LENGTH   #
  
               SWITCH  PPP0: P0 
                         PNO: NO,  PFORCE: FORCE,  PCON: CON, 
                         PIMMED: IMMED,  PSUBR: SUBR ;
               GO TO PPP0 [J] ; 
                    BEGIN 
  
           PNO:                    # 00R00        NO-OP (PADDING)      #
                    RELF = K ;
                    RETURN ;            # SET RELOCATION FOR NEXT *Q* # 
  
           PFORCE:                 # 00R01        FORCE UPPER          #
                    CALL FUP ;          # FORCE UPPER # 
                    RELF = K ;          # SET RELOCATION FOR NEXT *Q* # 
                    RETURN ;
  
           PCON:                   # 00N02 XXXX   CON WORD             #
                    CALL FUP ;          # FORCE UPPER # 
                    ILOC = ILOC + 1 ;   # ADVANCE ONE WORD #
                    K4 = K ;
                    IF  K1 EQ K         # SET N = NUMBER OF PARCELS # 
                    THEN N = 1 ;        # NEEDED TO HOLD VALUE OF K # 
                    ELSE IF  K2 EQ K
                         THEN N = 2 ; 
                         ELSE IF  K3 EQ K 
                              THEN N = 3 ;
                              ELSE N = 4 ;
                    B<6,3> INST = N ;   # INSERT IN I-FIELD # 
                    IF  N LT 4
                    THEN BEGIN          # IF VALUE IS 1 TO 3 PARCELS #
                         ILEN = N ;      # PACK IT WITH INSTRUCTION # 
                         L = 15 * N ; 
                         B<15,L> INST = B<WL-L,L> K ; 
                         END
                    ELSE BEGIN          # IF 4-PARCEL VALUE # 
                         IF  VAR         # MAKE OPCODE END #
                         THEN BEGIN      # AT WORD BOUNDARY # 
                              ALLOC (P<TVAR>, 1) ;
                              B<45,15> VBLW = B<0,15> INST ;
                              VARW [TVARL-1] = VBLW ; 
                              VBLW = 0 ;
                              VPOS = 0 ;
                              END 
                         ELSE BEGIN 
                              ALLOC (P<TXEQ>, 1) ;
                              B<45,15> INTW = B<0,15> INST ;
                              XEQW [TXEQL-1] = INTW ; 
                              INTW = 0 ;
                              XPOS = 0 ;
                              END 
                         ILEN = 3 ;     # RETURN VALUE AS A # 
                         INST = K ;     # 4-PARCEL INSTRUCTION #
                         END
                    RETURN ;
  
           PIMMED:                 # 00N03 XXXX   IMMEDIATE LITERAL    #
                    N = B<ZL,AL> K ;
                    B<15,45> INST = B<0,45> K ;   # STORE CHARACTERS #
                    ILEN = N / 3 + 1 ;
                    RETURN ;
  
           PSUBR:                  # 00004        SUBROUTINE ENTRY/EXIT#
                    CALL FUP ;               # FORCE UPPER #
                    ALLOC (P<TSYM>, 1) ;     # DEFINE *EXIT.* SYMBOL #
                    SYMN [TSYML-1] = "EXIT." ;
                    SYMA [TSYML-1] = ILOC ; 
                    ILOC = ILOC + 1 ;        # ADVANCE ONE WORD # 
                    RETURN ;
  
                    END            # OF PS"P0" CASES #
  
#                             PROCESS PSEUDOS WITH I = PS"P1".
# 
      PP1:     B< 0, 6> INST = OP"PSEUDO" ;  # GH = OPCODE         #
               B< 6, 3> INST = J ;           #  I = SUB-SUB-OPCODE #
               B< 9, 3> INST = PS"P1" ;      #  J = SUB-OPCODE     #
               B<12,18> INST = B<ZL,AL> K ;  #  K = ADDRESS        #
               ILEN = 1 ;                    # SET 30-BIT LENGTH   #
  
               SWITCH  PPP1: P1 
                         PLINE: LINE,  PLABEL: LABEL,  PBSS: BSS, 
                         PSCON: SCON,  PSVFD: SVFD ;
               GO TO PPP1 [J] ; 
                    BEGIN 
  
           PLINE:                  # 0001KKKKKK   PRINT SOURCE LINE NO.#
                    RETURN ;
  
           PLABEL:                 # 0011KKKKKK   DEFINE GEN.STMT.LABEL#
                    CALL FUP ;          # FORCE UPPER # 
                    K = SYN (K) ;       # LOOK UP SYMBOL #
                    SYMA [K] = ILOC ;   # STORE SYMBOL VALUE #
                    B<12,18> INST = K ; # RESET INSTRUCTION ADDRESS # 
                    RETURN ;
  
           PBSS:                   # 0021KKKKKK   BSS K WORDS          #
                    CALL FUP ;          # FORCE UPPER # 
                    ILOC = ILOC + K ;   # ADVANCE LOCATION COUNTER #
                    RETURN ;
  
           PSCON:                  # 0031KKKKKK   K WORDS OF CON 0LID+N#
                    CALL FUP ;          # FORCE UPPER # 
                    ILOC = ILOC + K ;   # ADVANCE LOCATION COUNTER #
                    IF  VAR 
                    THEN BEGIN          # MAKE PSEUDO OP END #
                         IF  VPOS GT 30  # AT WORD BOUNDARY # 
                         THEN BEGIN 
                              ALLOC (P<TVAR>, 1) ;
                              VARW [TVARL-1] = VBLW ; 
                              VBLW = 0 ;
                              END 
                         VPOS = 30 ;
                         END
                    ELSE BEGIN
                         IF XPOS GT 30
                         THEN BEGIN 
                              ALLOC (P<TXEQ>, 1) ;
                              XEQW [TXEQL-1] = INTW ; 
                              INTW = 0 ;
                              END 
                         XPOS = 30 ;
                         END
                    RETURN ;
  
           PSVFD:                  # 0041KKKKKK   K WORDS OF VFD N/Q...#
                    CALL FUP ;          # FORCE UPPER # 
                    IF  VAR 
                    THEN CALL PADV ;    # PAD CODE TABLE TO WORD BNDRY #
                    ELSE CALL PADX ;
                    ILEN = 3 ;          # SETUP 60-BIT PSEUDO OP #
                    B<30, 6> INST = B<36, 6> K ;
                    B<36,24> INST = B<12,24> K ;
                    K = B<ZL,AL> K ;
                    ILOC = ILOC + K ;   # ADVANCE LOCATION COUNTER #
                    RETURN ;
  
                    END            # OF PS"P1" CASES #
  
#                             PROCESS PSEUDOS WITH I = OTHER. 
# 
      PARG:                        # 00R2KKKKKK   APLIST WORD          #
               CALL FUP ;               # FORCE UPPER # 
               IPAR = 2 ; 
               RELF = J ;               # SET RELOCATION FLAG # 
               CALL ISA ;               # ISSUE SYMBOLIC ADDRESS #
               CALL FUP ;               # FORCE UPPER # 
               GO TO P30 ;
  
      PEQU:                        # 00R3KKKKKK   EQUATE SYMBOL        #
               RELF = J ;               # SET RELOCATION FLAG # 
               CALL ISA ;               # ISSUE SYMBOLIC ADDRESS #
               GO TO P30 ;
  
               END            # OF PSEUDO OPERATION CASES # 
  
 P30:     B< 0, 6> INST = OP"PSEUDO" ;       # GH = OPDODE         #
          B< 6, 3> INST = J ;                #  I = RELOCATION     #
          B< 9, 3> INST = I ;                #  J = SUB-OPCODE     #
          B<12,18> INST = B<ZL,AL> K ;       #  K = ADDRESS        #
          ILEN = 1 ;                         # SET 30-BIT LENGTH   #
          RETURN ;
  
          END 
  
  
  
  
#***      ISA  -  ISSUE SYMBOLIC ADDRESS. 
# 
          PROC ISA ;
  
#         ISSUE CALL FORMATS SHOWING (K) AS *ADDRESS* REQUIRE K TO
*         HAVE VALUE FORMATS DEPENDING ON RT"RELOC" ACCORDING TO
*         THE FOLLOWING.
*              RT"NO"         K = ABSOLUTE ADDRESS. 
*              RT"LIT"        K = EITHER THE INDEX OF A *TLIT*
*                             ENTRY (I.E. RESULT OF *LDN* FUNC) 
*                             OR THE COMPLEMENT OF THE FWA OF A 
*                             LITERAL DESCRIPTOR (I.E. RESULT OF
*                             A *LITXX* FUNCTION).
*              RT"EXT"        K = EITHER THE EXTERNAL NAME, LEFT
*                             JUSTIFIED WITH SPACE FILL, OR THE 
*                             INDEX OF A *TEXT* ENTRY (I.E. 
*                             RESULT OF *EXN* FUNCTION).
*              RT"SYM"        K = EITHER THE SYMBOL NAME, LEFT
*                             JUSTIFIED WITH SPACE FILL, OR THE 
*                             INDEX OF A *TSYM* ENTRY (I.E. 
*                             RESULT OF *SYN* FUNCTION).
****
# 
          BEGIN 
  
          LABEL NIL, EXT, LIT, SYM ;
  
          SWITCH  ADDRESS: RT           # DEPENDING ON RELOCATION TYPE #
                    NIL: NO,  EXT: EXT,  LIT: LIT,  SYM: SYM ;
          GO TO ADDRESS [RELF] ;
               BEGIN
  
      NIL:                         # NO RELOCATION, K = ABSOLUTE ADDR # 
               B<0,ZL> K = 0 ;          # CLEAR SIGN EXTENSION #
               RETURN ; 
  
      EXT:                         # EXTERNAL RELOCATION, K = EXTERNAL #
                                        # SYMBOL NAME (LEFT JUSTIFIED) #
               K = EXN (K) ;            # OR INDEX OF A *TEXT* ENTRY #
               L = EXTA [K] ; 
               IF  L GE 0               # IF *TREF* WORD EXISTS # 
                 AND  REF2 [L] EQ 0      # AND IS NOT FULL #
               THEN BEGIN 
                    REFQ [L] = IPAR + 1 ;    # FILL IN REFERENCE #
                    REFB [L] = ILOC ; 
                    END                 # OTHERWISE # 
               ELSE BEGIN 
                    ALLOC (P<TREF>, 1) ;     # ALLOCATE REFERENCE WORD #
                    L = TREFL - 1 ; 
                    EXTA [K] = L ;           # MAKE IT AND TEXT ENTRY # 
                    REFW [L] = K ;            # POINT TO EACH OTHER # 
                    REFP [L] = IPAR + 1 ; 
                    REFA [L] = ILOC ;        # FILL IN REFERENCE #
                    END 
               RELF = S"NO" ; 
               RETURN ; 
  
      LIT:                         # CONSTANT RELOCATION, K = VALUE OF #
                                        # TLIT ENTRY, OR COMPLEMENT OF #
               K = LDN (K) ;            # FWA OF LITERAL DESCRIPTOR # 
               RELF = S"NO" ; 
               RETURN ; 
  
      SYM:                         # SYMBOL RELOCATION, K = SYMBOL #
                                        # NAME (LEFT JUSTIFIED) OR #
               K = SYN (K) ;            # INDEX OF TSYM ENTRY # 
               RELF = S"NO" ; 
               RETURN ; 
  
               END                 # OF RELF CASES #
  
          END 
  
     END  TERM
