*COMDECK     COMEDITR  - OBJECT CODE LISTING OUTPUT ROUTINES. 
#*        EDITOR - OBJECT CODE LISTING OUTPUT ROUTINES. 
* 
*         R. H. GOODELL.     76/06/23.
* 
*         EDITOR CONTAINS THE ROUTINES FOR FORMATTING AND WRITING 
*         THE OPTIONAL LISTING OF OBJECT CODE CAPSULES GENERATED
*         BY *DDL*, WITH INSTRUCTIONS IN OCTAL AND A COMPASS-LIKE 
*         SYMBOLIC NOTATION, IN 2 COLUMNS PER PAGE TO SAVE PAPER. 
*         EDITOR DOES NOTHING WHEN THE OBJECT CODE LISTING OPTION 
*         IS NOT SELECTED.
* 
*         CONTENTS (XDEF ENTRY POINTS). 
* 
*         PROC   PCP         PRINT CAPSULE PREAMBLE.
*         PROC   PIG         PRINT INSTRUCTION GENERATED. 
*         PROC   PLT         PRINT LITERALS TABLE.
# 
  
  
*CALL     COMDDEF            GENERAL DEFINITIONS. 
  
     XREF BEGIN               # MANAGED TABLES #
  
*CALL     COMDTCON           CONSTANT VALUES. 
  
*CALL     COMDTEPT           ENTRY POINTS.
  
*CALL     COMDTEXI           EXTERNAL IDENTIFIERS.
  
*CALL     COMDTEXT           EXTERNAL NAMES.
  
*CALL     COMDTLIT           LITERALS.
  
*CALL     COMDTPAG           LISTING PAGE FOR PRINTING TWO COLUMNS. 
  
*CALL     COMDTREL           RELOCATION BITS. 
  
*CALL     COMDTSYM           SYMBOL TABLE.
  
*CALL     COMDTXEQ           EXECUTABLE CODE + PSEUDO OPS (INTERMEDIATE)
  
          END 
  
     XREF BEGIN               # OTHER EXTERNALS # 
  
*CALL     COMDHEAD           CAPSULE HEADER TABLE.
*CALL     COMDPRFX           CAPSULE PREFIX TABLE.
          ITEM EXTB I ;            # EXTERNALS BLOCK BASE ADDRESS # 
          ITEM ILEN I ;            # INSTRUCTION LENGTH: PARCELS - 1 #
          ITEM ILOC I ;            # LOCATION COUNTER # 
          ITEM INST U ;            # INSTRUCTION, LEFT JUST, FROM TXEQ #
          ITEM INSW U ;            # INSTRUCTION WORD GOING TO TCAP # 
          ITEM INTW U ;            # INSTRUCTION WORD FROM TXEQ # 
          ITEM IPAR I ;            # PARCEL NUMBER OF INSTR. (0-3) #
          ITEM LINECT ;            # COUNT OF LOGICAL LINES IN *TPAG* # 
          ITEM LINECTR ;           # COUNT OF LINES ON CURRENT PAGE # 
          ITEM LINELIM ;           # MAX NUMBER OF LINES PER PAGE # 
          ITEM LITB ;              # LITERALS BLOCK BASE ADDRESS #
          ITEM LOBJF B ;           # TRUE IF *LO=O* ON CONTROL CARD # 
          ITEM REALMH C (30) ;     # REALM NAME IN 30H FORMAT # 
          ITEM RECORDH C (30) ;    # RECORD TYPE NAME IN 30H FORMAT # 
          PROC FEED ;              # PRINT N BLANK LINES #
          FUNC OCTAL C (WC) ;      # CONVERT HALF WORD TO OCTAL # 
          PROC OCT20 ;             # CONVERT WORD TO 20 OCTAL DIGITS #
          PROC SPREAD ;            # UNPACK CHARACTERS TO STRING BUFFER#
          PROC SQUEEZE ;           # PACK CHARACTERS FROM STRING BUFFER#
          FUNC XCDD C (WC) ;       # CONVERT TO DECIMAL DISPLAY CODE #
          PROC XCDDL ;             # CONVERT TO DECIMAL LEFT JUSTIFIED #
          FUNC XCOD C (WC) ;       # CONVERT TO OCTAL DISPLAY CODE #
          PROC XCODL ;             # CONVERT TO OCTAL, LEFT JUSTIFIED # 
          FUNC XSFW C (WC) ;       # SPACE FILL WORD #
          END 
  
  
          DEF  EJECT  #LINECTR = LINELIM# ;  # START NEW PAGE # 
  
  
*CALL     COMDCHAR           DISPLAY CODE CHARACTERS. 
  
  
*CALL     COMDOPS            OPERATION CODES. 
  
  
#         LOCAL DATA. 
# 
          ARRAY LINE [0:6] S ;     # CURRENT LINE IMAGE # 
               BEGIN
               ITEM LL C (0, 0, 70) ;             # LOGICAL LINE #
               ITEM LW C (0, 0, WC) = [7(" ")] ;  # WORD OF LINE #
               END
          BASED ARRAY MEM ;        # USED FOR PRINTING #
               ITEM CM ;            # WORDS OF TABLES # 
  
          ARRAY ST [0:31] ;        # STRING BUFFER USED IN FORMATTING # 
               ITEM S S:CHARACTER ;           # SYMBOLIC INSTRUCTIONS # 
  
          ITEM A C (WC) ;          # CHARACTER TEMPORARY #
          ITEM C ;                 # STRING BUFFER CHARACTER COUNT #
          ITEM GH, I, J, K ;       # BINARY INSTRUCTION FIELDS #
          ITEM ILIT ;              # IMMEDIATE LITERAL STRING # 
          ITEM RELCH C (2) ;       # RELOCATION INDICATOR CHARACTER # 
          ITEM RELF S:RT ;         # RELOCATION FLAG #
          ITEM WORD ;              # CURRENT TABLE WORD # 
  
  
          BEGIN 
  
  
  
  
#***      PCP  -  PRINT CAPSULE PREAMBLE. 
# 
          XDEF PROC PCP ; 
          PROC PCP ;
  
#         *PCP* PRINTS THE HEADER LINES PRECEDING THE LISTING 
*         OF THE CAPSULE PROPER, IN THE FOLLOWING FORMAT. 
* 
*           FUNCTION  XXXXX   SCHEMA    X(30) 
*           REC. NO. ZZZZ9    SUBSCHEMA X(30) 
*           GROUP   XXXXXXX   REALM     X(30) 
*           CAPSULE XXXXXXX   RECORD    X(30) 
*           LENGTH  ZZZZZ7B   ENTRY POINT  ZZZZZ7B   XXXXXXX
*           EXTERNALS.        XXXXXXX   XXXXXXX   XXXXXXX   XXXXXXX 
*                   XXXXXXX   XXXXXXX   XXXXXXX   XXXXXXX   XXXXXXX 
* 
*         ALSO, IF *EDITOR* WAS COMPILED IN DEBUG MODE (SYMPL 
*         CONTROL STATEMENT *E* OPTION), THIS IS FOLLOWED BY
*         THE PREFIX TABLE AND THE THREE-WORD CAPSULE HEADER
*         IN OCTAL. 
****
# 
          BEGIN 
  
          IF  NOT LOBJF  THEN  RETURN ; 
  
#         PRINT HEADER LINES. 
# 
          SPACE (4,6) ; 
  
          LW [0] = "  FUNCTION" ; 
          C<2,5> LW [1] = PRFXKIND ;
          LW [2] = "SCHEMA    " ; 
          C<30,30> LL [0] = PRFXSCHEMA ;
          PRINT ; 
  
          LW [0] = "  REC. NO." ; 
          C<1,5> LW [1] = PRFXRECO ;
          ILIT = 0 ;
          LW [2] = "SUBSCHEMA " ; 
          C<30,30> LL [0] = PRFXSUBSCH ;
          PRINT ; 
  
          LW [0] = "  GROUP   " ; 
          LW [1] = XSFW (HEADGROUP) ; 
          LW [2] = "REALM     " ; 
          C<30,30> LL [0] = REALMH ;
          PRINT ; 
  
          LW [0] = "  CAPSULE " ; 
          LW [1] = XSFW (HEADCAP) ; 
          LW [2] = "RECORD    " ; 
          C<30,30> LL [0] = RECORDH ; 
          PRINT ; 
  
          A = XCOD (HEADLENGTH) ; 
          C< 0,20> LL [0] = "  LENGTH  123456B   " ;
          C<10, 6> LL [0] = C<4,6> A ;
          A = XCOD (EPTA [0]) ; 
          C<20,20> LL [0] = "ENTRY POINT  123456B" ;
          C<33, 6> LL [0] = C<4,6> A ;
          C<43,NC> LL [0] = XSFW (EPTN [0]) ; 
          PRINT ; 
  
          LW [0] = "  EXTERNAL" ; 
          LW [1] = "S.        " ; 
          J = 1 ; 
          K = HEADNEXT - 1 ;
          FOR  I = 0 THRU K  DO 
               BEGIN
               J = J + 1 ;
               IF  J GE 6 
               THEN BEGIN 
                    J = 1 ; 
                    PRINT ; 
                    END 
               LW [J] = XSFW (EXTN [I]) ; 
               END
          PRINT ; 
  
          $BEGIN
  
#         PRINT PRFX TABLE. 
# 
          SPACE (1, 3) ;
          C<0,20> LL [0] = "  PRFX TABLE." ;
          PRINT ; 
          FOR  I = 0 THRU PRFXWDCT  DO
               BEGIN
               WORD = CM [LOC (PRFX) + I] ; 
               A = XCOD (I) ; 
               LW [0] = C<2,8> A ;
               CALL OCT20 (WORD, LINE, 1) ; 
               LW [4] = XSFW (WORD) ; 
               PRINT ;
               END
  
#         PRINT CAPSULE HEADER. 
# 
          SPACE (1, 4) ;
          C<0,20> LL [0] = "  CAPSULE HEADER." ;
          PRINT ; 
          FOR  I = 0 THRU 2  DO 
               BEGIN
               WORD = CM [LOC (HEAD) + I] ; 
               A = XCOD (I) ; 
               LW [0] = C<2,8> A ;
               CALL OCT20 (WORD, LINE, 1) ; 
               LW [4] = XSFW (WORD) ; 
               PRINT ;
               END
          $END
  
#         PRINT TITLE OF CODE IMAGE.
# 
          SPACE (1, 3) ;
          C<0,20> LL [0] = "  CODE IMAGE." ;
          PRINT ; 
  
          RELF = S"NO" ;
          RETURN ;
  
          END 
  
  
  
  
#***      PIG  -  PRINT INSTRUCTION GENERATED.
# 
          XDEF PROC PIG ; 
          PROC PIG ;
  
#         *PIG* IS CALLED BY PASS2/WIN ET AL. AS EACH INSTRUCTION 
*         IS PROCESSED, TO PRINT THE INSTRUCTION (BOTH OCTAL AND
*         SYMBOLIC) IN THE OBJECT CODE LISTING. 
****
# 
          BEGIN 
  
          IF  NOT LOBJF  THEN  RETURN ; 
          GH = B<0,6> INST ;            # BREAK DOWN FIELDS OF #
          I  = B<6,3> INST ;             # BINARY INSTRUCTION # 
          J  = B<9,3> INST ;
          IF  ILEN EQ 0 
          THEN K = B<12, 3> INST ;      # 15-BIT  -   3-BIT K # 
          ELSE K = B<12,18> INST ;      # 30-BIT  -  18-BIT K # 
          IF  GH EQ OP"PSEUDO"
          THEN CALL PPI ;               # PROCESS PSEUDO INSTR.  OR # 
          ELSE CALL PMI ;               # PRINT MACHINE INSTRUCTION # 
          RETURN ;
  
          END 
  
  
  
  
#***      PLC  -  PRINT LOCATION COUNTER. 
# 
          PROC PLC ;
  
#         IF THE PRESENT INSTRUCTION BEGINS AT A WORD BOUNDARY, 
*         *PLC* PRINTS THE OCTAL LOCATION IN THE LEFT MARGIN. 
****
# 
          BEGIN 
  
          ITEM A C (WC) ; 
  
          IF  IPAR EQ 0                 # IF AT BEGINNING OF WORD # 
          THEN BEGIN
               A = XCOD (ILOC) ;        # CONVERT LOC CTR TO OCTAL #
               LW [0] = C<2,8> A ;      # STORE INTO PRINT LINE # 
               END
          RETURN ;
  
          END 
  
  
  
  
#***      PLT  -  PRINT LITERALS TABLE. 
# 
          XDEF PROC PLT ; 
          PROC PLT ;
  
#         *PLT* PRINTS THE CONTENT OF THE LITERALS BLOCK AS A 
*         SERIES OF *DATA* STATEMENTS, WITH THE VARIABLE FIELD
*         COMING FROM THE SOURCE REPRESENTATION OF THE LITERALS 
*         IN TLIT, AND THE OCTAL WORD VALUES COMING FROM THE
*         CORRESPONDING WORDS IN TCON.  THEN, IF *EDITOR* WAS 
*         COMPILED IN DEBUG MODE (SYMPL CONTROL STATEMENT *E* 
*         OPTION), *PLT* PRINTS THE ENTRY POINTS FROM TEPT, THE 
*         EXTERNAL NAMES AND REFERENCES FROM TEXT, AND THE
*         RELOCATION BITS FROM TREL.  FINALLY, *PLT* PRINTS AN
*         *END* STATEMENT TO MARK THE END OF THE CAPSULE. 
****
# 
          BEGIN 
  
          ITEM L, N ; 
          ITEM B, W ; 
          ITEM OC C (5) ; 
          ITEM PARCEL C (4) = " UML" ;
          ITEM RELOC C (32) = "     L KM M N N U U ULUKV V VL VK" ; 
  
          IF  NOT LOBJF  THEN  RETURN ; 
  
#         PRINT LITERALS BLOCK. 
# 
          SPACE (1, 3) ;
          C<0,20> LL [0] = "  LITERALS." ;
          PRINT ; 
          FOR  I = 0  STEP  LITN [I]  WHILE  I LT TLITL  DO 
               BEGIN
               B = WL ;                      # CHARACTER POSITION # 
               W = I ;                       # WORD POINTER IN TLIT # 
               K = LITC [I] ;                # CHARACTER COUNT #
               ILOC = LITA [I] + LITB ;      # CONSTANT ADDRESS # 
               L = ILOC + LITL [I] ;
               IF  K GT 20                   # IF LONG VALUE #
               THEN BEGIN                    # FABRICATE LABEL #
                    A = OCTAL (ILOC) ;
                    C<2,1> LW [3] = CHARACTER"L" ;
                    C<3,6> LW [3] = C<4,6> A ;
                    END 
               OC = "DATA " ; 
               FOR  J = 0  WHILE  ILOC LT L  OR  J LT K  DO 
                    BEGIN 
                    IF  ILOC LT L            # IF MORE OCTAL WORDS #
                    THEN BEGIN
                         CALL PLC ;          # PRINT LOCATION COUNTER # 
                         CALL OCT20 (CONW [ILOC-LITB], LINE, 1) ; 
                         ILOC = ILOC + 1 ;
                         END
                    IF  J LT K               # IF MORE CHARACTERS # 
                    THEN BEGIN                # OF SYMBOLIC VALUE # 
                         C = 0 ;
                         SPREAD (5, OC, 0, ST, C) ;    # OPCODE # 
                         OC = "-    " ; 
                         FOR  B = B  WHILE  C LT 25  AND  J LT K  DO
                              BEGIN 
                              B = B + CL ;                # CHARACTER # 
                              IF  B GE WL                  # POSITION # 
                              THEN BEGIN
                                   B = 0 ;                # ADVANCE TO #
                                   W = W + 1 ;             # NEXT WORD #
                                   N = LITW [W] ; 
                                   END
                              S [C] = B<B,CL> N ;  # EXTRACT CHARACTER #
                              C = C + 1 ; 
                              J = J + 1 ;          # BUMP COUNTERS #
                              END 
                         SQUEEZE (C, ST, 0, LINE, 4) ;    # PACK LINE # 
                         END
                    PRINT ;                  # PRINT THE LINE # 
               END  END 
  
          $BEGIN
  
#         PRINT ENTRY POINTS. 
# 
          SPACE (1, 2) ;
          C<0,20> LL [0] = "  ENTRY POINTS." ;
          PRINT ; 
          ILOC = HEADEPTFWA ; 
          L = TEPTL - 1 ; 
          FOR  I = 0 THRU L  DO 
               BEGIN
               WORD = CM [LOC (TEPT) + I] ; 
               CALL PLC ;                    # PRINT LOCATION COUNTER # 
               CALL OCT20 (WORD, LINE, 1) ;            # OCTAL WORD # 
               C<2,NC> LW [3] = XSFW (EPTN [I]) ;      # NAME # 
               A = XCOD (EPTA [I]) ;                   # ENTRY ADDRESS #
               C<0,6> LW [4] = C<4,6> A ; 
               C<7,1> LW [4] = CHARACTER"PLUS" ;
               PRINT ;                       # PRINT THE LINE # 
               ILOC = ILOC + 1 ;
               END
  
#         PRINT EXTERNAL NAMES AND REFERENCES.
# 
          SPACE (1, 3) ;
          C<0,30> LL [0] = "  EXTERNAL REFERENCES." ; 
          PRINT ; 
          L = HEADNEXT - 1 ;
          FOR  I = 0 THRU L  DO         # FOR EACH EXTERNAL NAME #
               BEGIN
               ILOC = EXTB + I ;
               CALL PLC ;                    # PRINT LOCATION COUNTER # 
               CALL OCT20 (EXTW [I], LINE, 1) ;        # OCTAL WORD # 
               C<2,NC> LW [3] = XSFW (EXTN [I]) ;      # EXTERNAL NAME #
               A = XCOD (EXTA [I]) ;                   # REF CHAIN FWA #
               C<0,6> LW [4] = C<4,6> A ; 
               C<7,1> LW [4] = CHARACTER"PLUS" ;
               PRINT ;                       # PRINT THE LINE # 
               N = 1 ;
               FOR  ILOC = EXTA [I]  STEP 1  WHILE  N NE 0  DO
                    BEGIN                         # FOR EACH WORD OF #
                    W = EXTW [ILOC-EXTB] ;         # REFERENCE CHAIN #
                    CALL PLC ;               # PRINT LOCATION COUNTER # 
                    CALL OCT20 (W, LINE, 1) ;          # OCTAL WORD # 
                    FOR  J = 0 THRU 2  DO 
                         BEGIN
                         N = B<20*J, 2> W ;            # PARCEL NO. # 
                         K = B<20*J+2, 18> W ;         # ADDRESS #
                         IF  N NE 0 
                         THEN BEGIN 
                              C<1> LW [J+4] = C<N> PARCEL ; 
                              A = XCOD (K) ;
                              C<4,6> LW [J+3] = C<4,6> A ;
                         END  END 
                    PRINT ;                  # PRINT THE LINE # 
               END  END 
  
#         PRINT RELOCATION BITS.
# 
          SPACE (1, 6) ;
          C<0,20> LL [0] = "  RELOCATION BITS." ; 
          PRINT ; 
          ILOC = HEADRELFWA ;                # SET LOCATION COUNTER # 
          K = 0 ;                            # SET RELOCATED LOCATION # 
          L = TRELL - 1 ; 
          FOR  I = 0 THRU L  DO              # FOR EACH WORD OF TREL #
               BEGIN
               W = RELW [I] ;                # EXTRACT WORD # 
               CALL PLC ;                    # PRINT LOCATION COUNTER # 
               CALL OCT20 (W, LINE, 1) ;     # OCTAL WORD # 
               J = 0 ;
               FOR  B = 0 STEP 4 UNTIL 56  DO     # FOR EACH REL #
                    BEGIN 
                    N = B<B,4> W ;                # EXTRACT REL BITS #
                    IF  N NE 0
                    THEN BEGIN                    # IF NOT ABS #
                         C<1,2> LW [J+4] = C<N*2,2> RELOC ; 
                         A = XCOD (K) ; 
                         C<4,6> LW [J+3] = C<4,6> A ; 
                         J = J + 1 ;              # ADVANCE PRINT # 
                         IF  J GE 3                # WORD POINTER # 
                         THEN BEGIN 
                              J = 0 ;             # PRINT LINE #
                              PRINT ;              #  IF FULL  #
                         END  END 
                    K = K + 1 ;              # BUMP RELOCATED LOCATION #
                    END 
               IF  J NE 0  OR  LW [0] NE " "      # IF LINE NOT EMPTY # 
               THEN PRINT ;                            # PRINT IT # 
               ILOC = ILOC + 1 ;
               END
          $END
  
#         END OF CAPSULE. 
# 
          SPACE (1, 2) ;
          C<0,20> LL [0] = "  END OF CAPSULE." ;
          PRINT ; 
          ILOC = HEADLENGTH ; 
          CALL PLC ;                         # PRINT LOCATION COUNTER # 
          LW [4] = "END" ;                   # *END* OPCODE # 
          PRINT ;                            # PRINT THE LINE # 
          RETURN ;
  
          END 
  
  
  
  
#***      PMI  -  PRINT MACHINE INSTRUCTION.
# 
          PROC PMI ;
  
#         CALLED BY *PIG* TO PROCESS A MACHINE INSTRUCTION. 
*         PRINTS THE INSTRUCTION IN OCTAL AND A COMPASS-LIKE
*         SYMBOLIC NOTATION.
****
# 
          BEGIN 
  
          ARRAY  [0:63]  ;         # INSTRUCTION TEMPLATES #
               ITEM IT C (0, 0, WC) = 
                    [ "PS Q      "      # 00IJKKKKKK   PSEUDO          #
                    , "RJ Q      "      # 0100KKKKKK   RJ              #
                    , "JP Q+CI   "      # 02IIKKKKKK   JP              #
                    , "XC,XJ Q   "      # 03IJKKKKKK   XC      SEE JM  #
                    , "EQ,CI,CJ Q"      # 04IJKKKKKK   EQ              #
                    , "NE,BI,CJ Q"      # 05IJKKKKKK   NE              #
                    , "GE,BI,CJ Q"      # 06IJKKKKKK   GE              #
                    , "LT,BI,CJ Q"      # 07IJKKKKKK   LT              #
                    , "BXI XJ    "      # 10IJJ        COPY            #
                    , "BXI XJ*XK "      # 11IJK        AND             #
                    , "BXI XJ+XK "      # 12IJK        IOR             #
                    , "BXI XJ-XK "      # 13IJK        XOR             #
                    , "BXI -XK   "      # 14IKK        COMP            #
                    , "BXI -XK*XJ"      # 15IJK        ANDN            #
                    , "BXI -XK+XJ"      # 16IJK        IORN            #
                    , "BXI -XK-XJ"      # 17IJK        XORN            #
                    , "LXI M     "      # 20IJK        LEFTK           #
                    , "AXI M     "      # 21IJK        RIGHTK          #
                    , "LXI YK,CJ "      # 22IJK        LEFTB           #
                    , "AXI YK,CJ "      # 23IJK        RIGHTB          #
                    , "NXI,CJ YK "      # 24IJK        NORM            #
                    , "ZXI,CJ YK "      # 25IJK        RNORM           #
                    , "UXI,CJ YK "      # 26IJK        UNPK            #
                    , "PXI YK,CJ "      # 27IJK        PACK            #
                    , "FXI XJ+XK "      # 30IJK        FADD            #
                    , "FXI XJ-XK "      # 31IJK        FSUB            #
                    , "DXI XJ+XK "      # 32IJK        DADD            #
                    , "DXI XJ-XK "      # 33IJK        DSUB            #
                    , "RXI XJ+XK "      # 34IJK        RADD            #
                    , "RXI XJ-XK "      # 35IJK        RSUB            #
                    , "IXI XJ+XK "      # 36IJK        IADD            #
                    , "IXI XJ-XK "      # 37IJK        ISUB            #
                    , "FXI XJ*XK "      # 40IJK        FMUL            #
                    , "RXI XJ*XK "      # 41IJK        RMUL            #
                    , "DXI XJ*XK "      # 42IJK        DMUL            #
                    , "MXI M     "      # 43IJK        MASK            #
                    , "FXI XJ/XK "      # 44IJK        FDIV            #
                    , "RXI XJ/XK "      # 45IJK        RDIV            #
                    , "NO        "      # 46000        NOP             #
                    , "CXI XK    "      # 47IKK        COUNT           #
                    , "SAI AJ+Q  "      # 50IJKKKKKK   SAAK            #
                    , "SAI Q+CJ  "      # 51IJKKKKKK   SABK            #
                    , "SAI XJ+Q  "      # 52IJKKKKKK   SAXK            #
                    , "SAI XJ+CK "      # 53IJK        SAXB            #
                    , "SAI AJ+CK "      # 54IJK        SAAB            #
                    , "SAI AJ-BK "      # 55IJK        SAAMB           #
                    , "SAI BJ+CK "      # 56IJK        SABB            #
                    , "SAI CJ-BK "      # 57IJK        SABMB           #
                    , "SBI AJ+Q  "      # 60IJKKKKKK   SBAK            #
                    , "SBI Q+CJ  "      # 61IJKKKKKK   SBBK            #
                    , "SBI XJ+Q  "      # 62IJKKKKKK   SBXK            #
                    , "SBI XJ+CK "      # 63IJK        SBXB            #
                    , "SBI AJ+CK "      # 64IJK        SBAB            #
                    , "SBI AJ-BK "      # 65IJK        SBAMB           #
                    , "SBI BJ+CK "      # 66IJK        SBBB            #
                    , "SBI CJ-BK "      # 67IJK        SBBMB           #
                    , "SXI AJ+Q  "      # 70IJKKKKKK   SXAK            #
                    , "SXI Q+CJ  "      # 71IJKKKKKK   SXBK            #
                    , "SXI XJ+Q  "      # 72IJKKKKKK   SXXK            #
                    , "SXI XJ+CK "      # 73IJK        SXXB            #
                    , "SXI AJ+CK "      # 74IJK        SXAB            #
                    , "SXI AJ-BK "      # 75IJK        SXAMB           #
                    , "SXI BJ+CK "      # 76IJK        SXBB            #
                    , "SXI CJ-BK "      # 77IJK        SXBMB           #
                    ] ; 
  
          ARRAY  [0:7]  ;          # X-REGISTER JUMP MNEMONICS #
               ITEM JM C (0, 0, 2)
                    = ["ZR", "NZ", "PL", "MI", "IR", "OR", "DF", "ID"] ;
  
          ITEM B I ;               # BIT POSITION IN TEMPLATE *T* # 
          ITEM CH S:CHARACTER ;    # CHARACTER FROM TEMPLATE #
          ITEM L I ;               # TEMP # 
          ITEM N I ;               # TEMP # 
          ITEM T C (WC) ;          # INSTRUCTION TEMPLATE # 
          ITEM VARF B ;            # VARIABLE FIELD FLAG #
  
          LABEL PMI1, NEXT, PMI2, PMI3 ;
          LABEL PC, PI, PJ, PK, PM, PQ, PS, PX, PY ;
          LABEL P0, P1, P2, P3 ;
  
          RELCH = "  " ;                # RESET FLAGS # 
          VARF = FALSE ;
          T = IT [GH] ;                 # GET INSTRUCTION TEMPLATE #
          IF  GH EQ OP"XC"
          THEN C<0,2> T = JM [I] ;           # SET X-JUMP MNEMONIC #
          IF  GH GE OP"EQ"  AND  GH LE OP"LT" 
              AND  I NE 0  AND  J EQ 0       # SET B-JUMP MNEMONIC #
          THEN C<0,2> T = JM [GH-OP"EQ"] ;
          S [0] = B< 0,CL> T ;          # STORE FIRST 2 CHARACTERS OF # 
          S [1] = B<CL,CL> T ;          # TEMPLATE INTO STRING BUFFER # 
          B = 2 * CL ;
          C = 2 ;                       # INITIALISE COUNTERS # 
  
 PMI1:    CH = B<B,CL> T ;         # GET NEXT CHARACTER OF TEMPLATE # 
  
          SWITCH  PROCESS: CHARACTER
               PX:  A,   PX:  B,   PC:  C,   PI:  I,   PJ:  J,
               PK:  K,   PM:  M,   PQ:  Q,   PX:  X,   PY:  Y,
               PX: PLUS, PX:MINUS, PX: STAR, PX:SLASH, PS:SPACE,
               PX:COMMA ; 
          GO TO PROCESS [CH] ;          # INTERPRET TEMPLATE CHARACTER #
               BEGIN
  
      PC:      CH = B<B+CL,CL> T ;      # PROCESS CONDITIONAL # 
               IF  CH EQ S"I"           # B-REGISTER *CN* # 
               THEN N = I ; 
               ELSE IF  CH EQ S"J"      # GET NEXT CHARACTER #
                    THEN N = J ;        #  I  OR  J  OR  K   #
                    ELSE N = K ;
               IF  N NE 0               # TEST INSTRUCTION FIELD #
               THEN BEGIN 
                    CH = S"B" ;         # IF NON-ZERO, TREAT #
                    GO TO PX ;          #  *CN*  AS  *BN*  #
                    END 
               CH = S [C-1] ;           # GET PRECEDING CHARACTER # 
               IF  CH EQ S"PLUS"
                   OR  CH EQ S"MINUS"   # IF *+* OR *-* OR *,* #
                   OR  CH EQ S"COMMA"   # THEN ERASE IT # 
               THEN C = C - 1 ; 
               B = B + CL ;             # SKIP *CN* IN TEMPLATE # 
               GO TO NEXT ; 
  
      PI:      S [C] = I + CHARACTER"ZERO" ;      # PROCESS *I* # 
               C = C + 1 ;
               GO TO NEXT ; 
  
      PJ:      S [C] = J + CHARACTER"ZERO" ;      # PROCESS *J* # 
               C = C + 1 ;
               GO TO NEXT ; 
  
      PK:      S [C] = K + CHARACTER"ZERO" ;      # PROCESS *K* # 
               C = C + 1 ;
               GO TO NEXT ; 
  
      PM:      CALL XCDDL (J*8+K, CH, L) ;        # PROCESS *M* # 
               SPREAD (0, CH, 0, ST, C) ;    # STORE JK VALUE IN DEC #
               GO TO NEXT ; 
  
      PQ:      CALL PSA ;                         # PROCESS *Q* # 
               GO TO NEXT ;             # PRINT SYMBOLIC ADDRESS #
  
      PS:      IF  VARF                           # PROCESS SPACE # 
               THEN GO TO PMI2 ;        # DONE IF END OF VAR FIELD #
               VARF = TRUE ;
               IF  C LE 2 
               THEN N = 5 - C ;         # END OF OPCODE FIELD # 
               ELSE N = 2 ; 
               FOR  L = 1 THRU N  DO
                    BEGIN               # LEAVE AT LEAST TWO #
                    S [C] = CH ;        # SPACES BEFORE START # 
                    C = C + 1 ;         # OF VARIABLE FIELD # 
                    END 
               GO TO NEXT ; 
  
      PX:      S [C] = CH ;                       # PROCESS OTHER # 
               C = C + 1 ;              # COPY CHARACTER FROM TEMPLATE #
               GO TO NEXT ; 
  
      PY:      IF  K EQ I                         # PROCESS *YK* #
               THEN B = B + 2 * CL ;
               ELSE BEGIN               # IF  *XK* = *XI* # 
                    S [C] = S"X" ;      # THEN SKIP *YK,* # 
                    C = C + 1 ;         # ELSE PRINT *XK* # 
                    END 
               GO TO NEXT ; 
  
               END       # OF TEMPLATE CHARACTER CASES #
  
 NEXT:    B = B + CL ;                  # ADVANCE TO NEXT CHARACTER # 
          CH = B<B,CL> T ;
          IF  B LT WL                   # LOOP TO END OF TEMPLATE # 
          THEN GO TO PMI1 ; 
  
 PMI2:    SQUEEZE (C, ST, 0, LINE, 4) ; # PUT SYMBOLIC INSTRUCTION #
                                         # INTO PRINT LINE IMAGE  # 
          CALL OCT20 (INSW, LINE, 1) ;  # CONVERT INSTRUCTION WORD TO # 
                                           # OCTAL IN PRINT LINE AREA # 
          SWITCH  PARCEL  P0, P1, P2, P3 ;  # AND THEN BLANK OUT ANY #
          GO TO PARCEL [IPAR] ;              # UNWANTED OCTAL DIGITS #
               BEGIN
  
      P0:      IF  ILEN EQ 0                      # PARCEL ZERO # 
               THEN C<5,5> LW [1] = "     " ; 
               LW [2] = RELCH ; 
               GO TO PMI3 ; 
  
      P1:      C<0,5> LW [1] = "     " ;          # PARCEL ONE #
               IF  ILEN EQ 0
               THEN LW [2] = "          " ; 
               ELSE C<5,5> LW [2] = RELCH ; 
               GO TO PMI3 ; 
  
      P2:      LW [1] = "          " ;            # PARCEL TWO #
               IF  ILEN EQ 0
               THEN C<5,5> LW [2] = "     " ; 
               ELSE C<0,2> LW [3] = RELCH ; 
               GO TO PMI3 ; 
  
      P3:      LW [1] = "          " ;            # PARCEL THREE #
               C<0,5> LW [2] = "     " ;
               GO TO PMI3 ; 
  
               END       # OF PARCEL CASES #
  
 PMI3:    CALL PLC ;                    # PRINT LOCATION COUNTER #
          PRINT ;                       # PRINT THE LINE #
          RETURN ;
  
          END 
  
  
  
  
#***      PPI  -  PROCESS PSEUDO INSTRUCTION. 
# 
          PROC PPI ;
  
#         CALLED BY *PIG* TO PROCESS A PSEUDO INSTRUCTION.
****
# 
          BEGIN 
  
          ITEM F ;
          ITEM L, M, N ;
          ITEM LD, ND, XD ; 
          ITEM T, V, W ;
  
          LABEL PP0, PP1, PARG, PEQU ;
          LABEL PNO, PFORCE, PCON, PIMMED, PSUBR ;
          LABEL PLINE, PLABEL, PBSS, PSCON, PSVFD ; 
          LABEL PABS, PEXT, PLIT, PSYM ;
          LABEL PCON1, PEQU1 ;
  
          SWITCH  PPSEUDO: PS 
                    PP0: P0,  PP1: P1,  PARG: ARG,  PEQU: EQU ; 
          GO TO PPSEUDO [J] ; 
               BEGIN
  
#                             PROCESS PSEUDOS WITH J = PS"P0".
# 
               SWITCH  PPP0: P0 
                         PNO: NO,  PFORCE: FORCE,  PCON: CON, 
                         PIMMED: IMMED,  PSUBR: SUBR ;
      PP0:     GO TO PPP0 [K] ; 
                    BEGIN 
  
           PNO:                    # 00R00        NO-OP (PADDING)      #
                    RELF = I ;
                    RETURN ;            # SET RELOCATION FOR NEXT *Q* # 
  
           PFORCE:                 # 00R01        FORCE UPPER          #
                    IF  LW [3] NE " " 
                    THEN LW [3] = "  +  " ;  # SET LOCATION FIELD *+* # 
                    RELF = I ;          # SET RELOCATION FOR NEXT *Q* # 
                    RETURN ;
  
           PCON:                   # 00N02        CON WORD             #
                    C = 0 ; 
                    SPREAD (5, "CON  ", 0, ST, C) ;         # OPCODE #
  
                              # ENTRY FROM *ARG* PROCESSOR BELOW. # 
  
           PCON1:   IF  ILIT NE 0            # IF IMMEDIATE LITERAL # 
                    THEN CALL PSA ;          # PRINT SYMBOLIC ADDRESS # 
                    ELSE BEGIN
                         K = INSW ; 
                         IF  K LT 0          # IF WORD IS NEGATIVE #
                         THEN BEGIN 
                              K = -K ;            # UNCOMPLEMENT VALUE #
                              S [5] = S"MINUS" ;
                              C = 6 ;             # PRINT MINUS SIGN #
                              END 
                         IF  B<0,30> K NE 0  # IF VALUE > 30 BITS # 
                         THEN N = B<0,30> K ;     # DO UPPER HALF FIRST#
                         ELSE N = K ; 
                         CALL XCODL (N, A, J) ;   # CONVERT TO OCTAL #
                         SPREAD (0, A, 0, ST, C) ;  # INTO PRINT LINE # 
                         IF  B<0,30> K NE 0 
                         THEN BEGIN          # IF VALUE > 30 BITS # 
                              A = OCTAL (K) ;     # DO LOWER HALF NOW # 
                              SPREAD (WC, A, 0, ST, C) ;
                              END 
                         IF  K GT 7          # IF VALUE > 3 BITS #
                         THEN BEGIN               # ADD *B* SUFFIX #
                              S [C] = S"B" ;
                              C = C + 1 ; 
                         END  END 
                    SQUEEZE (C, ST, 0, LINE, 4) ; # PRINT VARIABLE FLD #
                    CALL OCT20 (INSW, LINE, 1) ;  # PRINT OCTAL WORD #
                    CALL PLC ;                    # PRINT LOCN COUNTER #
                    PRINT ;                  # PRINT THE LINE # 
                    RETURN ;
  
           PIMMED:                 # 00N03 XXXX   IMMEDIATE LITERAL Q  #
                    ILIT = "          " ; 
                    J = -CL ; 
                    N = I ;                  # MOVE N CHARACTERS FROM # 
                    FOR  I = 1 THRU N  DO    # PSEUDO INSTRUCTION TO  # 
                         BEGIN               # ILIT FOR USE IN NEXT Q # 
                         J = J + CL ; 
                         B<J,CL> ILIT = B<J+15,CL> INST ; 
                         END
                    B<ZL,AL> ILIT = N ;      # CHARACTER COUNT #
                    RETURN ;
  
           PSUBR:                  # 00004        SUBROUTINE ENTRY/EXIT#
                    CALL PLC ;          # PRINT LOCATION COUNTER #
                    LW [1] = OCTAL (O"0400 400000" + ILOC) ; #EQ *+1S17#
                    LW [2] = " +" ; 
                    LW [4] = "SUBR" ;   # OPCODE AND COMMENT #
                    LW [5] = "      ENTR" ; 
                    LW [6] = "Y/EXIT" ; 
                    PRINT ;             # PRINT THE LINE #
                    RETURN ;
  
                    END            # OF PS"P0" CASES #
  
#                             PROCESS PSEUDOS WITH J = PS"P1".
# 
               SWITCH  PPP1: P1 
                         PLINE: LINE,  PLABEL: LABEL,  PBSS: BSS, 
                         PSCON: SCON,  PSVFD: SVFD ;
      PP1:     GO TO PPP1 [I] ; 
                    BEGIN 
  
           PLINE:                  # 0001KKKKKK   PRINT SOURCE LINE NO.#
                    A = LW [3] ;             # SAVE LOCATION FIELD #
                    LW [3] = "  *       " ;       # MAKE UP A # 
                    LW [5] = "      LINE" ;       # COMMENT LINE #
                    N = XCDD (K) ;           # CONVERT SOURCE LINE #
                    LW [6] = C<4,6> N ;       # NUMBER TO DECIMAL # 
                    PRINT ;                  # PRINT THE LINE # 
                    LW [3] = A ;             # RESTORE LOCATION FIELD # 
                    RETURN ;
  
           PLABEL:                 # 0011KKKKKK   DEFINE GEN.STMT.LABEL#
                    IF  LW [3] NE "   " 
                        AND LW [3] NE "  +  " 
                        AND  C<2,NC> LW [3] NE SYMN [K] 
                    THEN BEGIN               # IF LABEL ALREADY IN #
                         LW [4] = "BSS  0" ;  # LOCATION FIELD #
                         CALL PLC ;          # PRINT LOCATION COUNTER # 
                         PRINT ;              # AND " LABEL  BSS  0 " # 
                         END
                    C<2,NC> LW [3] = SYMN [K] ;   # STORE NEW LABEL # 
                    RETURN ;
  
           PBSS:                   # 0021KKKKKK   BSS K WORDS          #
                    C = 0 ; 
                    SPREAD (5, "BSS  ", 0, ST, C) ;         # OPCODE #
                    CALL PSA ;               # PRINT SYMBOLIC ADDRESS # 
                    SQUEEZE (C, ST, 0, LINE, 4) ; 
                    A = XCOD (K) ;           # PRINT SIZE OF BSS #
                    LW [2] = C<4,6> A ; 
                    CALL PLC ;               # PRINT LOCATION COUNTER # 
                    PRINT ;                  # PRINT THE LINE # 
                    RETURN ;
  
           PSCON:                  # 0031KKKKKK   K WORDS OF CON 0LID+N#
                    FOR  I = 0 THRU K-1  DO  # FOR EACH OF THE NEXT # 
                         BEGIN                # (K) WORDS OF TXEQ # 
                         W = XEQW [I] ; 
                         A = XCOD (ILOC + I) ;    # PRINT LOCN COUNTER #
                         LW [0] = C<2,8> A ;
                         CALL OCT20 (W, LINE, 1) ;  # PRINT OCTAL WORD #
                         C = 0 ;                  # PRINT OPCODE #
                         SPREAD (5, "CON  ", 0, ST, C) ;
                         IF  B<0,NL> W NE 0       # IF NAME PRESENT # 
                         THEN BEGIN 
                              A = "0L  " ;        # PRINT *0LNAME* #
                              C<2,NC> A = C<0,NC> W ; 
                              SPREAD (0, A, 0, ST, C) ; 
                              W = B<ZL,AL> W ;    # CLEAR NAME #
                              IF  B<ZL,1> W EQ 0
                              THEN BEGIN          # IF POSITIVE # 
                                   S [C] = S"PLUS" ;
                                   C = C + 1 ;    # PRINT PLUS SIGN # 
                              END  END
                         IF  B<ZL,1> W NE 0       # IF NEGATIVE # 
                         THEN BEGIN 
                              W = O"777777" - W ; # UN-COMPLEMENT # 
                              S [C] = S"MINUS" ;
                              C = C + 1 ;         # PRINT MINUS SIGN #
                              END 
                         CALL XCDDL (W, A, N) ;   # CONVERT VALUE # 
                         SPREAD (0, A, 0, ST, C) ; # TO DECIMAL # 
                         SQUEEZE (C, ST, 0, LINE, 4) ;
                         PRINT ;                  # PRINT THE LINE #
                         END
                    RETURN ;
  
           PSVFD:                  # 0041KKKKKK   K WORDS OF VFD N/Q...#
                    N = B<30, 6> INTW ;      # BITS PER FIELD # 
                    T = B<36,24> INTW ;      # TOTAL NUMBER OF FIELDS # 
                    M = WL / N ;             # N-BIT FIELDS PER WORD #
                    L = WL - M * N ;         # LAST FIELD IN WORD # 
                    CALL XCDDL (N, A, C) ;
                    B<  0 , CL> ND = CHARACTER"COMMA" ; 
                    B< CL ,  C> ND = B<0,C> A ;           # ND = *,N/* #
                    B<C+CL, CL> ND = CHARACTER"SLASH" ; 
                    CALL XCDDL (L, A, C) ;
                    B<  0 , CL> LD = CHARACTER"COMMA" ;   # LD = *,L/* #
                    B< CL ,  C> LD = B<0,C> A ; 
                    B<C+CL, CL> LD = CHARACTER"SLASH" ; 
                    K = K - 1 ;              # FOR EACH OF THE NEXT # 
                    FOR  I = 0 THRU K  DO     # (K) WORDS OF TXEQ  #
                         BEGIN
                         A = XCOD (ILOC + I) ;    # PRINT LOCN COUNTER #
                         LW [0] = C<2,8> A ;
                         W = XEQW [I] ;           # PRINT OCTAL WORD #
                         CALL OCT20 (W, LINE, 1) ;
                         C = 0 ;                  # PRINT OPCODE #
                         SPREAD (4, "VFD ", 0, ST, C) ; 
                         XD = ND ;
                         V = 0 ;
                         IF  I NE K               # IF NOT LAST WORD #
                         THEN T = T - M ;          # COUNT FIELDS # 
                         ELSE BEGIN 
                              M = T ;             # LAST WORD, ADJUST # 
                              L = WL - M * N ;     # LEFTOVER BITS #
                              CALL XCDDL (L, A, J) ;
                              B<  0 , CL> LD = CHARACTER"COMMA" ; 
                              B< CL ,  J> LD = B<0,J> A ; 
                              B<CL+J, CL> LD = CHARACTER"SLASH" ; 
                              END 
                         FOR  J = 1 THRU M  DO    # FOR EACH OF THE # 
                              BEGIN                # N-BIT FIELDS # 
                              F = B<V,N> W ;
                              V = V + N ;              # EXTRACT FIELD #
                              CALL PVF ;               # PRINT IT # 
                              END 
                         IF  L NE 0               # IF LEFTOVER BITS #
                         THEN BEGIN 
                              XD = LD ; 
                              F = B<V,L> W ;           # EXTRACT FIELD #
                              CALL PVF ;               # PRINT IT # 
                              END 
                         S [4] = S"SPACE" ;       # CLEAR FIRST COMMA # 
                         SQUEEZE (C, ST, 0, LINE, 4) ;
                         PRINT ;                  # PRINT THE LINE #
                         END
                    RETURN ;
  
  
#                   PVF  -  PRINT VFD FIELD.
* 
*                   ENTRY  (F)  = CONTENTS OF FIELD.
*                          (XD) = ",X/"  WHERE  X = FIELD WIDTH.
# 
  
                    PROC PVF ;
  
                         BEGIN
                         ITEM D, T ;
  
                         D = C ;                  # SAVE CHAR POSITION #
                         SPREAD (0, XD, 0, ST, C) ;    # PRINT ",X/" #
                         IF  F NE 0 
                         THEN BEGIN 
                              CALL XCDDL (F, A, T) ;   # CONVERT F #
                              SPREAD (0, A, 0, ST, C) ;  # PRINT IT # 
                              END 
                         IF  C GT 26              # IF LINE  #
                         THEN BEGIN               # OVERFLOW #
                              C = D ; 
                              S [4] = S"SPACE" ;  # CLEAR *,* # 
                              SQUEEZE (C, ST, 0, LINE, 4) ; 
                              PRINT ;             # PRINT LINE #
                              C = 0 ; 
                              SPREAD (5, "-    ", 0, ST, C) ;  # START #
                              SPREAD (0, XD, 0, ST, C) ;       #  NEW  #
                              IF  F NE 0                       # LINE  #
                              THEN SPREAD (0, A, 0, ST, C) ;
                              END 
                         RETURN ; 
                         END            # OF PROC PVF # 
  
                    END            # OF PS"P1" CASES #
  
#                             PROCESS REMAINING PSEUDO OPERATIONS.
# 
      PARG:                        # 00R2KKKKKK   APLIST WORD          #
               C = 0 ;
               SPREAD (5, "ARG  ", 0, ST, C) ;         # OPCODE # 
               RELF = I ; 
               IF  RELF EQ S"NO"             # IF NO RELOCATION, #
               THEN GO TO PCON1 ;             # TREAT AS *CON* #
  
               RELCH = "  " ;                # FORMAT VARIABLE FIELD #
               CALL PSA ;                    # PRINT SYMBOLIC ADDRESS # 
               SQUEEZE (C, ST, 0, LINE, 4) ; # PACK INTO LINE # 
               CALL OCT20 (INSW, LINE, 1) ;  # CONVERT WORD TO OCTAL #
               A = C<4,6> LW [2] ;           # SAVE BOTTOM 6 DIGITS # 
               C<4,6> LW [2] = "      " ;    # KEEP UPPER 14 DIGITS # 
               CALL PLC ;                    # PRINT LOCATION COUNTER # 
               PRINT ;                       # PRINT THE LINE # 
               C<4,6> LW [2] = A ;           # RECALL LOWER 6 DIGITS #
               LW [3] = RELCH ;              # AND RELOCATION CHAR #
               PRINT ;                       # PRINT SECOND LINE #
               RETURN ; 
  
      PEQU:                        # 00R3KKKKKK   EQUATE SYMBOL        #
               C = 0 ;
               SPREAD (5, "EQU  ", 0, ST, C) ;         # OPCODE # 
               RELF = I ; 
               RELCH = "  " ;                # FORMAT VARIABLE FIELD #
               CALL PSA ;                    # PRINT SYMBOLIC ADDRESS # 
               SQUEEZE (C, ST, 0, LINE, 4) ; # PACK INTO LINE # 
  
               SWITCH  RELOC: RT
                         PABS: NO,  PEXT: EXT,  PLIT: LIT,  PSYM: SYM ; 
               GO TO RELOC [I] ;             # RELOCATE (K) # 
                    BEGIN 
  
           PABS:    GO TO PEQU1 ;                 # ABS - LET IT BE # 
  
           PEXT:    K = 0 ;                       # EXT - MAKE IT ZERO #
                    GO TO PEQU1 ; 
  
           PLIT:    K = LITA [K] + LITB ;         # LITERAL ADDRESS # 
                    GO TO PEQU1 ; 
  
           PSYM:    K = SYMA [K] ;                # SYMBOL ADDRESS #
                    GO TO PEQU1 ; 
  
           PEQU1:   END            # OF RELOCATION CASES #
  
               A = XCOD (K) ;                # CONVERT (K) TO OCTAL # 
               C<0,6> LW [2] = C<4,6> A ; 
               C<6,4> LW [2] = RELCH ;       # RELOCATION CHARACTER # 
               PRINT ;                       # PRINT THE LINE # 
               RETURN ; 
  
               END            # OF PSEUDO OPERATION CASES # 
  
          END 
  
  
  
  
#***      PRINT - MOVE LINE TO PAGE, DUMP WHEN FULL.
# 
          PROC PRINT ;
  
#***
# 
          BEGIN 
  
          IF  LINECT EQ LINELIM * 2     # DUMP PAGE IF FULL # 
          THEN BEGIN
               FEED (0, 0) ;
               EJECT ;
               END
          LINECT = LINECT + 1 ;         # ADVANCE LINE COUNT #
          PAGELINE [LINECT] = LL [0] ;
          LL [0] = " " ;                # MOVE AND CLEAR LINE # 
          RETURN ;
  
          END 
  
  
  
  
#***      PSA  -  PRINT SYMBOLIC ADDRESS. 
# 
          PROC PSA ;
  
#         ENTRY  (K) = ADDRESS FIELD OF INSTRUCTION FROM TXEQ.
*                (RELF) = RELOCATION FLAG.
* 
*         STORES SYMBOLIC FORM OF ADDRESS INTO VARIABLE FIELD 
*         OF SOURCE INSTRUCTION FOR PRINTING. 
****
# 
          BEGIN 
  
          ITEM A C (WC) ; 
          ITEM L, N ; 
  
          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:     IF  ILIT NE 0            # NO RELOCATION IN LATEST # 
               THEN BEGIN                # PRECEDING PSEUDO OP #
                    IF  B<0,CL> ILIT EQ CHARACTER"MINUS"
                        AND  S [C-1] EQ S"PLUS"             # FIX UP #
                    THEN C = C - 1 ;                        #  SIGN  #
                    N = B<ZL,AL> ILIT ; 
                    SPREAD (N, ILIT, 0, ST, C) ;           #  COPY   #
                    ILIT = 0 ;                             # LITERAL #
                    END 
               ELSE BEGIN                    # NO IMMEDIATE LITERAL  #
                    IF B<ZL,1> K NE 0        # PS"IMMED" PRECEDING - #
                    THEN BEGIN               # CONVERT (K) TO OCTAL  #
                         K = -K ; 
                         K = B<ZL+1,AL-1> K ;     # UN-COMPLEMENT # 
                         IF  S [C-1] EQ S"PLUS" 
                         THEN C = C - 1 ;                   # FIX UP #
                         S [C] = S"MINUS" ;                 #  SIGN  #
                         C = C + 1 ;
                         END
                    CALL XCODL (K, A, L) ;                # PRINT  K #
                    SPREAD (0, A, 0, ST, C) ;             # IN OCTAL #
                    IF  K GT 7
                    THEN BEGIN                             # ADD *B* #
                         S [C] = S"B" ;                    # SUFFIX  #
                         C = C + 1 ;
                    END  END
               RETURN ; 
  
      EXT:     RELCH = " X" ;           # EXTERNAL REFERENCE #
               S [C] = S"EQUAL" ; 
               S [C+1] = S"X" ;              # PRINT *=X* # 
               C = C + 2 ;
               A = EXID [K] ;                # PRINT EXTERNAL IDENT # 
               SPREAD (0, A, 0, ST, C) ;
               RELF = S"NO" ; 
               RETURN ; 
  
      LIT:     RELCH = " +" ;           # LITERAL REFERENCE # 
               IF  LITC [K] LE 20 
               THEN BEGIN                    # IF IT FITS IN LINE # 
                    S [C] = S"EQUAL" ;
                    C = C + 1 ;                   # PRINT *=* # 
                    SPREAD (LITC [K], TLIT, K+1, ST, C) ;   # AND DATA #
                    END 
               ELSE BEGIN                    # IF LITERAL IS TOO LONG # 
                    S [C] = S"L" ;
                    C = C + 1 ;                   # FABRICATE NAME #
                    N = LITA [K] + LITB ;         #   *LNNNNNN*    #
                    A = OCTAL (N) ;               # AND PRINT THAT #
                    A = C<4,6> A ;
                    SPREAD (6, A, 0, ST, C) ; 
                    END 
               RELF = S"NO" ; 
               RETURN ; 
  
      SYM:     RELCH = " +" ;           # REFERENCE TO GENERATED #
               A = SYMN [K] ;            # STATEMENT LABEL #
               SPREAD (0, A, 0, ST, C) ;     # PRINT NAME # 
               RELF = S"NO" ; 
               RETURN ; 
  
               END       # OF RELOCATION CASES #
          END 
  
  
  
  
#***      SPACE - PRINT BLANK LINES.
# 
          PROC SPACE (N, M) ; 
  
          ITEM N ;            # NUMBER OF BLANK LINES # 
          ITEM M ;            # MIN LINES LEFT IN COLUMN #
  
#         *SPACE* IS USED FOR PRINTING BLANK LINES BETWEEN
*         SECTIONS OF THE OBJECT CODE LISTING.  THE MEANINGS
*         OF THE PARAMETERS ARE ANALOGOUS TO THE PARAMETERS 
*         OF THE *SPACE* PSEUDO OP IN COMPASS, Q.V. 
****
# 
          BEGIN 
  
          ITEM I ;                 # LOOP INDEX # 
          ITEM L ;                 # LINES LEFT IN CURRENT COLUMN # 
  
          IF LINECT EQ 0                # DO NOTHING IF AT #
              OR  LINECT EQ LINELIM      # TOP OF A COLUMN #
          THEN RETURN ; 
          L = LINELIM - LINECT ;        # COMPUTE LINES LEFT #
          IF  L LT 0                     # IN CURRENT COLUMN #
          THEN L = L + LINELIM ;
          IF  L GE (N + M)              # IF ENOUGH... #
          THEN BEGIN
               FOR  I = 1 THRU N  DO         # PRINT N BLANK LINES #
                    BEGIN 
                    LINECT = LINECT + 1 ; 
                    PAGELINE [LINECT] = " " ; 
               END  END 
          ELSE BEGIN                    # IF NOT ENOUGH... #
               IF  LINECT LT LINELIM
               THEN BEGIN                    # IF LEFT COLUMN # 
                    FOR  I = 1 THRU L  DO         # FILL IT WITH #
                         BEGIN                     # BLANK LINES #
                         LINECT = LINECT + 1 ;
                         PAGELINE [LINECT] = " " ;
                    END  END
               ELSE BEGIN                    # IF RIGHT COLUMN #
                    FEED (0, 0) ;                 # DUMP PAGE # 
                    EJECT ; 
               END  END 
          RETURN ;
  
          END 
  
     END  TERM
