*DECK     LIST
          IDENT  LIST 
 LIST     SECT   (OBJECT CODE LISTING ROUTINES.)
 LIST     SPACE  4
*         IN ALLOC
          EXT    ALC
  
*         IN FAS
          EXT    APLA,FAPSUD,OL=BIN,OL=LBF,OL=PB,OL=RL,ORGSUB,RADC
          EXT    TAGSUB0
  
*         IN FTN
          EXT    CO.OPT,CO.PS,CO.PW 
  
*         IN PUC
          EXT    F.LBT,IDENT,LINEBUF,MOD,N.TABLE,O.STITL,PIA,PIK=LCM
          EXT    PIK=PI,PIK=PS,PIK=XJP
          EXT    SUM.LBT,S=CL,S=CON,S=LENP,S=LA,S=RD,T=API,T=APL,T=CLW
          EXT    T=DIM,T=DATS,T=FMT,T=IOA,T=LA,T=NLST,T=SCR,T.API,T.APL 
          EXT    T.CAC,T.CLW,T.CON,T.DIM,T.FMT,T.PTXTR,T.SCR,T.SYM,WOF
          EXT    T.CLWB,T.FPI,T.SUB 
  
*         IN UTILITY
          EXT    CDD,COD,DMT=,MVE=,SFN,SST,WOD,ZTB
 PS.      EJECT 
**        PS. -  SHIFTED PROGRAM TAG FORMAT FOR  AP  ENTRIES. 
* 
*         THIS FORMAT IS USED IN ROUTINE *WAP* TO SORT OUT
*         AP-LIST INDEX TABLE.
  
  
          DESCRIBE  PS.,60
 RA       DEFINE 18          RELATIVE ADDRESS 
 ORD      DEFINE 18          ORDINAL
          DEFINE 24 
  
*         CELLS 
  
 SAVFP    BSS    1           F.P. INDICATOR 
  
*         INSTRUCTION SKELETON TABLE (PARTIAL LIST) 
  
 PIK=TAG  BSSZ   4           TEMP HOLDING (DPC) TAG AND OFFSET. 
  
 PIK=BL   CON    1L +3R      THE WORD BEFORE *PIK=I* MUST BE NEGATIVE 
 PIK=I    CON    0           *I* REGISTER OF INSTRUCTION
 PIK=J    CON    0           *J* REGISTER OF INSTRUCTION
          DATA   0           *K* REGISTER OF INSTRUCTION
          DATA   -1          FLAG TO INDICATE 18-BIT *K* PORTION
          DATA   1R+         PLUS 
          DATA   1R-         MINUS
          DATA   1R*         STAR 
          DATA   1R/         SLASH
          DATA   1R,         COMMA
          DATA   1RA
          DATA   1RB
          DATA   -0          FLAG TO INDICATE CONDITIONAL *B* REGISTER
          DATA   1RX
          DATA   1R          BLANK
 KTY      SPACE  4,10 
**        KTY -  DETERMINE LENGTH OF CONSTANT TO CONVERT
* 
*         KTY    LENGTH      LENGTH OF CONSTANT (BITS)
*         KTY                DEFAULT IS 18 BITS 
  
  
 KTY      MACRO  LENGTH 
 A        MICRO 1,, 18
          IFC    NE,/LENGTH//,1 
 A        MICRO 1,, LENGTH
          SB2    60-"A" 
          RJ     KTY
 KTY      ENDM
          TITLE  PIK - OBJECT CODE LISTING MAIN ROUTINE 
 PIK      SPACE  0
**        PIK -  PRINT INSTRUCTION KONVERSION.
* 
*         CALLED BY FAS/POL IF OBJECT LISTING IS ENABLED. 
*         POL IS CALLED BY INSTRUCTION CONSTRUCTORS (NORMAL AND PSEUDO) 
*         IN FAS, RAD, AND REL TO CONVERT AND PRINT EACH OBJECT 
*         INSTRUCTION AS THEY ARE PROCESSED.
* 
*         ENTRY  RADC = + LONG,0 SHORT, - PSEUDO
*                (X5) = ADJUSTED INSTRUCTION IN (PB.) FORMAT. 
*                (OL=BIN) = BINARY. 
*                (OL=RL) = RELOCATION LISTING INDICATOR (SEE PLL).
*                (LINEBUF+0) = (ORIGIN) TO BE LISTED. 
*                            .MI. IF ALREADY FORMATTED. 
* 
*         EXIT   (OL=PB) = INSTRUCTION
  
  
 PIK      SUBR   =           ENTRY/EXIT...
          LX6    X5 
          SA2    RADC 
          BX7    0
          LX1    X5 
          SA7    SAVFP       (SAVFP) = 0
          SA6    OL=PB
          SA7    PIK=TAG+1   (PIK=TAG+1) = 0
          SA7    A7+B1       (PIK=TAG+2) = 0
          PL     X2,PIK20    IF NOT PSEUDO
          BX2    -X2         (X2) = PSEUDO NUMBER 
          SA3    X2+FAPSUD
          SB7    X3 
          JP     B7          JUMP TO LISTING PROCESSOR
  
  
**        PRINT NON-PSEUDO INSTRUCTIONS.
*         BREAK OUT THE *I*, *J*, AND *K* PORTIONS OF INSTRUCTION.
  
  
 PIK20    MX0    -PB.H2L
          BX6    X0*X5       CLEAR PB.H2 FIELD
          LX6    PB.GHL 
          SB5    X6          *GH* 
          SX0    7
.1        ECHO   ,P1=(I,J,K),REG=(3,6,6),LOC=(PIK=I,,),SC=(9,3,3) 
          LX1    SC 
          BX.REG X0*X1
          SX6    X.REG+1R0
          SA6    LOC  A6+B1  *P1* 
.1        ENDD
  
          SA3    B5+PIK=PS   FETCH INST SKELETON
          PL     X3,PIK60    IF SHORT INSTRUCTION (15 BIT)
  
*         PRE-PROCESS AND CONVERT TAGS. 
  
          MX4    -PB.TAGL 
          LX1    PB.TAGL-3
          BX3    -X4*X1      ISOLATE TAG
          =B3    B5 
  
 PIK40    BSS    0
          RJ     KTX         CONVERT TAG TO EXTERNAL FORM 
          SA6    PIK=TAG
          MX4    -PB.BIASL
          BX1    X5 
          LX1    -PB.BIASP
          MX0    -PB.H2L
          BX3    -X4*X1 
          LX1    PB.BIASP-PB.H2P
          BX4    -X0*X1      H2I = H2[INSTRUCTION]
          ZR     X3,PIK55    IF NO OFFSET 
          KTY                CONVERT OFFSET 
          MI     X3,PIK50    IF NEGATIVE OFFSET 
          SX1    1R+
          NE     B3,B1,PIK45 IF NOT RJ WITH TRACE 
          SX1    1R,
          SA3    SAVFP
          SA2    =2L,S
          ZR     X3,PIK45    IF NOT F.P.
          BX7    X2 
          SA7    PIK=TAG+2   ADD *,S* FOR SUB 
  
 PIK45    BX6    X6+X1
          LX6    -CHAR
  
 PIK50    SA6    PIK=TAG+1
  
*         LIST ADDRESS DECREMENT FROM H2[INSTRUCTION] FILED.
  
 PIK55    SX6    B3-3 
          ZR     X4,PIK60    IF NO ADDRESS DECREMENT
          ZR     X6,PIK60    IF INDEXED JUMP INSTRUCTION
          BX3    X4 
          RJ     KTX         CONVERT TAG
          SA3    =1L- 
          LX6    -CHAR
          BX6    X6+X3
          SA6    A6+B1
  
*         DO ACTUAL INSTRUCTION SKELETON CONVERSION.
  
 PIK60    SA1    =1H
          SX4    B5-3 
          BX6    X1 
          MX2    -2*CHAR
          SA1    OL=LBF 
          SA6    X1 
          SA3    B5+PIK=PS   SKELETON 
          SA1    PIK=I
          NZ     X4,PIK70    IF NOT X-JUMP
          SA3    X1-1R0+PIK=XJP  X-JUMP SKELETON
          EQ     PIK75
  
 PIK70    =X4    B5-01B 
          NZ     X4,PIK75    IF NOT LCM LOAD/STORE
          SA3    =XPIK=LCM+X1-1R4  LCM LOAD OR STORE SKEL 
  
 PIK75    BX4    -X2*X3 
          LX3    59-58
          PL     X3,PIK80    IF NO B-JUMP 
          SA1    PIK=J
          SX1    X1-1R0 
          NZ     X1,PIK80    IF *BJ* .NE. *B0*
          SA4    B5-4+PIK=XJP 
          BX4    -X2*X4 
  
 PIK80    LX4    4*CHAR 
          SA2    PIK=BL 
          LX3    4+2
          IX6    X4+X2
          MX0    -4 
          BX2    -X0*X3      ISOLATE FIRST DESCRIPTOR 
          LX3    4
          SA2    PIK=I-1+X2 
          LX2    4*CHAR 
          SB2    4*CHAR 
  
 PIK90    LX6    6
          SB2    B2-CHAR
          IX6    X6+X2
          NZ     B2,PIK100   IF ASSEMBLY NOT FULL 
          SA6    A6+B1
          SB2    10*CHAR
          BX6    0
  
 PIK100   BX1    -X0*X3 
          SA2    X1+PIK=I-1 
          LX3    4
          PL     X2,PIK90    IF NO CONDITIONAL ITEM 
          ZR     X1,PIK150   IF END OF SKELETON 
          NZ     X2,PIK110   IF 18-BIT  *K*  PORTION
          BX1    -X0*X3 
          =X2    1RB
          SX1    X1-1 
          ZR     X1,PIK90    PRESERVE BI [EVEN IF B0] 
          SA1    X1+PIK=I    FETCH CONDITIONAL REGISTER 
          SX1    X1-1R0 
          =X2    1RB
          NZ     X1,PIK90    IF NOT  *B0* 
          LX3    2*4         SKIP OVER REGISTER AND FOLLOWING SEP 
          EQ     PIK100 
  
*         MERGE K-ADDRESS PORTION INTO ASSEMBLY.
*         ENTRY  (X6) = PARTIAL OUTPUT WORD (RIGHT JUST, ZERO FILL) 
*                (B2) = 6 * (NUMBER OF EMPTY CHARS LEFT IN X6)
*                (A6) _ LAST OUTPUT LINE STORE ADDRESS. 
*                (B3) = INDEX TO INSTRUCTION SKELTON
  
 PIK110   SA2    PIK=TAG
          MX0    -CHAR
  
 PIK120   LX2    CHAR 
          SB0    0
          BX1    -X0*X2 
  
 PIK130   LX6    CHAR 
          SB2    B2-CHAR
          LX2    CHAR 
          IX6    X6+X1
          BX1    -X0*X2 
          NZ     B2,PIK140   IF ASSEMBLY NOT FULL 
          SA6    A6+B1
          SB2    10*CHAR
          BX6    0
  
 PIK140   NZ     X1,PIK130   IF MORE CHARACTERS 
          SA2    A2+B1
          NZ     X2,PIK120   IF OFFSET EXISTS 
  
 PIK150   SA3    =1H
          SB4    B2-B1
          MX7    1
          AX7    X7,B4
          BX3    X3*X7       GET DESIRED NO. OF BLANKS
          BX6    X6+X3       BLANK FILL 
          LX6    X6,B2       LEFT JUSTIFY ASSEMBLY
          SA6    A6+B1
          SX0    B3-B1       SAVE (B3-1)
          SB3    LINEBUF-1
          PLINE  LINEBUF,A6-B3
          SA1    TAGSUB0
          SA4    =7RSUB0
          LX1    PB.TAGP
          ZR     X0,EXIT.    IF RJ WITH TRACE 
          NZ     X1,SUBI.10  IF SUB0
          SA4    PIK=TAG+1
          RJ     WSM         WRITE SUB MACRO
          EQ     EXIT.
 LI=XXX   SPACE  4,10 
**        PRINT PSEUDO INSTRUCTIONS.
* 
*         (X1)=(X5)=INSTRUCTION 
  
  
 LI=BMI   BSSENT 0
 LI=BCI   BSSENT 0
 LI=OTR   BSSENT 0
 LI=EMI   BSSENT 0
 LI=ECI   BSSENT 0
 LI=LOO   BSSENT 0
          EQ     EXIT.       NO ACTION
 LI=ADDR  SPACE  3,10 
 LI=ADDR  BSSENT 0
          SA5    =7RADDR
          SA2    T.SYM
          LX1    -PB.TAGP 
          SX3    X1          ISOLATE T.SYM INDEX
          ERRNZ  PB.TAGL-18 
          LX1    PB.TAGP-PB.BIASP 
          SX4    X1          ISOLATE BIAS 
          ERRNZ  PB.BIASL-18
          RJ     KTX
          SA6    PIK=TAG
          SX6    1R,
          LX6    -CHAR
          =A6    A6+1 
          BX3    X4 
          KTY                CONVERT BIAS 
          =A6    A6+1 
          =A2    A6-2 
          SA1    =10H 
          BX3    X5 
          BX6    X1 
          RJ     PVF         PRINT  *       ADDR   NAME,VERSION  *
          EQ     EXIT.
 LI=APL   SPACE  4,10 
 LI=APL   BSSENT 0           LIST AP-LISTS
          SB6    B0          INDICATE REGULAR AP-LISTS
          SA1    WCA.RJ 
          SA2    APLA        LENGTH OF T.APL BEFORE APPENDING T.LCA 
          RJ     WAP
          RJ     WLP         LIST LCM POINTER CELLS 
          EQ     EXIT.
 LI=BOS   SPACE  4,4
 LI=BOS   BSSENT 0           LIST LINE NUMBER 
          MX0    -PB.BIASL
          AX1    PB.BIASP 
          BX1    -X0*X1      LINE NUM = BIAS [INSTRUCTION]
          CALL   CDD         CONVERT LINE NUMBER TO DISPLAY CODE
          SA1    =H/*/
          SA2    =H/ /
          BX6    X1 
          SA3    OL=LBF 
          LX7    X2 
          SA6    X3          +4 = Z 1-10      NOMINALLY 
          SA3    =5ALINE
          SA7    A6+B1       +5 = Z11-20
          BX6    X3 
          LX7    X4 
          SA6    A7+B1       +6 = Z21-30
          SA7    A6+B1       +7 = Z31-40
          SB3    A7+B1
          SB6    LINEBUF
          PLINE  B6,B3-B6 
          EQ     EXIT.
 LI=BSS   SPACE  4,4
 LI=BSS   BSSENT 0           *BSS*,  DEFINE LOCATION SYMBOL 
          RJ     PBS         PRINT * TAG   BSS   N* 
          EQ     EXIT.
 LI=CON   SPACE  4,10 
 LI=CON   BSSENT 0           PRINT CONSTANT ASSIGNMENTS 
          SA3    CO.PW
          SX7    9
          SX3    X3-126 
          SX6    CC0
          PL     X3,CON.10   IF NOT IN PW MODE
          SX7    5
          SX6    CC3
 CON.10   SA7    WCCB        (WCCB) = LENGTH OF PRINT LINE
          SA6    A7+1        (WCCB+1) = START OF LINE BUFFER
          SA1    S=CON
          SA5    T.CON
          RJ     WCC         WRITE (T.CON)
          EQ     EXIT.
 LI=CPL   SPACE  4,10 
 LI=CPL   BSSENT 0           PRINT *CPL* TAG WORD 
          MX0    -PB.TAGL 
          LX1    -PB.TAGP 
          BX3    -X0*X1      TAGI = TAG[INSTRUCTION]
          BX4    X3 
          RJ     KTX         CONVERT TAGI 
          SA6    PIK=TAG     (PIK=TAG) = TAG
  
*         LIST   *CP         TAG,L* 
*                WHERE L = WC.CLEN IFF WC.CTYP .EQ. 0, ELSE  L = 0. 
  
          LX0    X4,B1
          IX2    X4+X0       STIND = 3 * TAGI 
          ERRNZ  3-Z=SYM
          SA3    T.SYM
          =B7    X3+WC.W
          SA1    X2+B7       WCI = T.SYM(STIND) + WC.W
          BX2    X1 
          HX1    WC.CLEN
          AX1    -WC.CLENL   CLENI = CLEN[WCI]
          HX2    WC.CTYP
          AX2    59 
          BX3    -X2*X1      L = CLENI IFF WC.CTYP .EQ. 0 
          KTY                CONVERT LENGTH 
          SA2    =1R, 
          BX6    X2+X6
          LX6    -CHAR
          SA6    A6+B1       (PIK=TAG+1) = ,L 
          SA2    A6-B1
          SA1    =10H 
          SA3    =7RCP
          BX6    X1 
          RJ     PVF         PRINT *  CP    TAG,L*
          EQ     EXIT.
 LI=DATA  SPACE  4,10 
 LI=DATA  BSSENT 0           PRINT DATA INITIALIZATION TABLES 
          SA2    T=DATS 
          ZR     X2,EXIT.    IF NO DATA INITIALIZATION
 .T       IFEQ   TEST,ON
          DUMPT  DATS 
 .T       ENDIF 
          EQ     EXIT.
 LI=END   SPACE  4,10 
 LI=END   BSSENT 0           PRINT END LINE 
          MX7    0
          SA7    PIK=TAG+1
          SA4    MOD
          SA2    IDENT
          SBIT   X4,MO.PROP 
          SA1    =1H
          AX4    -0 
          BX6    X1 
          BX7    X2*X4
          SA3    =7REND 
          SA7    A7-B1       (PIK=TAG) = PROGRAM NAME  OR 0 
          SA2    A7 
          RJ     PVF         PRINT *END    PROGNAM* 
          EQ     EXIT.
 LI=EQUN  SPACE  4,10 
 LI=EQUN  BSSENT 0           PRINT *EQUN* 
          SA1    SUM.LBT
          PIA    ,LINEBUF    PREPARE INSTRUCTION ADDRESS
          SA3    S=LENP      ORDINAL INTO T.SYM ENTRY FOR LENP. 
          LX0    X3,B1
          IX3    X3+X0       = 3 * ORDINAL = INDEX INTO T.SYM 
          SA2    T.SYM
          IX1    X2+X3
          MX0    WA.SYML
          SA3    X1+WA.W     FETCH LABEL
          BX1    X0*X3       KEEP NAME
          CALL   SFN         SPACE FILL NAME
          LX6    -CHAR
          SA3    =10HEQUN 
 EQUN.10  SA1    OL=LBF 
          SA6    X1 
          BX6    X3 
          =A6    A6+1 
          SB7    LINEBUF-1
          PLINE  LINEBUF,A6-B7     PRINT  *LENP.  EQUN   *
          EQ     EXIT.
 LI=FEQU  SPACE  4,4
 LI=FMT   SPACE  4,10 
 LI=FMT   BSSENT 0           PRINT FORMAT ASSIGNMENTS 
          RJ     WCF
          SA3    CO.OPT 
          SA2    T=LA 
          NZ     X3,EXIT.    IF NOT QCG 
          SA1    S=LA 
          ZR     X2,EXIT.    IF NO LABELS ASSIGN-ED 
          LX1    PB.TAGP
          RJ     PBS         PRINT BSS (LA.)
          SX6    1R 
          SA6    OL=RL       SET TO INCLUDE OCTAL 
          EQ     EXIT.
 LI=FLA   SPACE  4,10 
 LI=FLA   BSSENT 0           FORMAT LABEL ASSIGN-ED 
          SA4    =7LLABS
          BX6    X4 
          BX3    X1 
          SA6    LINEBUF+5
          RJ     KTX         CONVERT LABEL TAG
          SA6    A6+B1
          SA2    OL=BIN 
          AX2    -1 
          SA4    =L/,FMT/ 
          BX7    -X2*X4      FLAG AS FORMAT IFF SIGN OFF
          MX6    0
          SA7    A6+B1
          SB5    LINEBUF+5
          SA6    A7+B1
          RJ     PLL         PUBLISH LISTING LINE 
          EQ     EXIT.
 LI=FVEC  SPACE  4,4
 LI=FVEC  BSSENT 0           PRINT FILE DESCRIPTOR
          SA5    =7RFVEC
          SA2    T.SYM
          LX1    -PB.TAGP 
          SB7    X1          ISOLATE T.SYM *WB* INDEX 
          SA4    =10H 
          ZR     B7,FVEC.10  IF NO LFN
          SB7    B7-WB.W+WA.W 
          ERRNZ  PB.TAGL-18 
          SA2    X2+B7
          MX0    -WA.SYML 
          LX2    -WA.SYMP 
          BX4    -X0*X2      ISOLATE NAME OF FILE 
          LX4    -WA.SYML    LEFT JUSTIFY 
          MX2    1
          BX4    X4-X2       TURN OFF BIT 59
  
 FVEC.10  LX1    PB.TAGP-PB.BIASP 
          SX3    X1          ISOLATE BUFL (OR MRL)
          ERRNZ  PB.BIASL-18
          KTY                CONVERT BUFL (OR MRL)
  
 FVEC.20  SA6    PIK=TAG
          BX1    X4 
          CALL   SFN         SPACE FILL THE NAME
          LX6    -CHAR
          BX3    X5 
          SA2    PIK=TAG
          RJ     PVF         PRINT  *LFN     FVEC  BUFL   * 
          EQ     EXIT.
  
 LI=PLIM  BSSENT 0           PRINT LIMIT
          SA1    =XCO.LL     PRINT LIMIT
          CALL   CDD         CONVERT TO DECIMAL 
          MX5    1
          SB2    B2-B1
          AX5    B2 
          BX6    X5*X4       ZERO FILL LIMIT
          SA5    =7RPLIM
          SA4    =10H 
          EQ     FVEC.20
 LI=IDNT  SPACE  4,4
 LI=IDNT  BSSENT 0
          RJ     WCS         LIST BLOCK STATISTICS
          SA1    IDENT       FETCH PROGRAM NAME 
          SA3    =7RIDENT 
          SA4    =10H 
          MX6    0           SUPPRESS OCTAL AND RELOC 
          BX7    X1 
          SA6    OL=RL
          LX6    X4 
          SA7    PIK=TAG     (PIK=TAG) = PROGRAM NAME 
          SA2    A7+
          RJ     PVF         PRINT  *    IDENT  PROGNAM * 
          EQ     EXIT.
 LI=IOM   SPACE  4,10 
 LI=IOM   BSSENT 0           LIST IO AP-LISTS 
          SA1    =10H 
          SA3    =7RIOM 
          BX6    X1 
          BX7    X3 
          SA7    WIO.10 
          SA6    LINEBUF+1
          =A6    A6+1 
          SB6    B1          INDICATE IO AP-LIST
          SA1    WIO.RJ 
          SA2    T=IOA
          RJ     WAP         LIST I/O AP-LISTS
          SA3    =7RCLW 
          BX6    X3 
          SA6    WIO.10 
          RJ     WCL         LIST CHARACTER LENGTH ARRAYS 
          EQ     EXIT.
 LI=JPI   SPACE  4,4
 LI=JPI   BSSENT 0           PRINT *JP   BI+Q* INSTRUCTION
          SB3    3           INDEX TO INSTRUCTION SKELETON
          MX4    -PB.IL 
          LX5    -PB.IP 
          BX6    -X4*X5      EXTRACT *I*
          LX5    PB.IP
          SX6    X6+1R0 
          SA6    PIK=I       SET FOR JP INTRUCTION
          EQ     RJ6.10 
 LI=LCC   SPACE  4,10 
**        DUE TO THE DIFICULTIES INVOLVED IN PRINTING LOADER
*         DIRECTIVES IN THE PROPER PLACE, WE WILL NOT DO SO.
  
  
 LI=LCC   BSSENT 0           PRINT USER LOADER DIRECTIVE
          EQ     EXIT.
 LI=LD0   SPACE  4,10 
 LI=LD0   BSSENT 0
 LI=ST0   BSSENT 0
          EQ     "BLOWUP"    SHOULD NOT COME HERE 
 LI=NLST  SPACE  4,10 
 LI=NLST  BSSENT 0           PRINT NAMELIST GROUP TABLE 
          SA2    T=DIM
** FV     WHAT ABOUT RUN-TIME DIM TABLE ??
          SA2    T=NLST 
          ZR     X2,EXIT.    IF NO NAMELIST GROUPS
 .T       IFEQ   TEST,ON
          DUMPT  NLST 
 .T       ENDIF 
          EQ     EXIT.
 LI=RJ3   SPACE  4,4
 LI=RJ3   BSSENT 0           PRINT *RJ     XXX* INSTRUCTION 
          SB3    2           INDEX TO INSTRUCTION SKELETON
          EQ     RJ6.10 
 LI=RJ6   SPACE  4,4
 LI=RJ6   BSSENT 0           PRINT RETURN JUMP WITH TRACE 
          SB3    1           INDEX TO INSTRUCTION SKELETON
 RJ6.10   MX4    -PB.TAGL 
          SX6    1RT
          LX1    -PB.TAGP 
          SB5    PIK=PS+1 
          SB5    B3-B5
          SB5    B5+PIK=PI
          BX3    -X4*X1      ISOLATE TAG
          SA6    PIK=I+2
          EQ     PIK40
 LI=SB0I  SPACE  4,10 
 LI=SB0I  BSSENT 0           OUTPUT SUB0 INDEX
          SA4    =7RSB0I
          EQ     SUBI.10
 LI=SUBI  SPACE  4,10 
 LI=SUBI  BSSENT 0           OUTPUT SUB INDEX 
          SA4    =7RSUBI
 SUBI.10  BSS    0
          MX0    -PB.TAGL 
          AX1    PB.TAGP
          BX3    -X0*X1      TAGI = TAG[INSTRUCTION]
          RJ     KTX         CONVERT TAG
          SA6    PIK=TAG     (PIK=TAG) = TAG
          SA1    =10H 
          BX3    X4 
          BX6    X1 
          SA2    A6 
          RJ     PVF         PRINT * SUBI  TAG* 
          EQ     EXIT.
 LI=UJP   SPACE  4,4
 LI=UJP   BSSENT 0           PRINT *EQ     XXX* INSTRUCTION 
          SB3    4           INDEX TO INSTRUCTION SKELETON
          EQ     RJ6.10 
 LI=USE   SPACE  4,4
 LI=USE   BSSENT 0           PRINT *USE BLOCK*
          HX1    PB.BIAS
          AX1    -PB.BIASL
          SA1    X1+TLBN     FETCH BLOCK NAME 
          SX6    55B
          SA4    =10H 
          SA3    =7RUSE 
          IX7    X1-X6       LEAVE A 0 AT BOTTOM OF NAME
          SA7    PIK=TAG     (PIK=TAG) = BLOCK NAME 
          SA2    A7 
          BX6    X4 
          RJ     PVF         PRINT * USE  BLKNAM* 
          EQ     EXIT.
  
 USE.10   DIS    1, 
          DIS    1, 
          DATA   10H USE  BLOC
          BSS    1           K NAME 
 LI=TRAC  SPACE  4,4
 LI=TRAC  BSSENT 0           PRINT *NAME    TRACE*
          SA1    IDENT
          CALL   ZTB         ZERO CHARS TO BLANKS 
          LX6    -6 
          SX7    1R+         INDICATE PROGRAM RELOCATION
          SA6    LINEBUF+4
          SB5    TRAC.A 
          SA7    OL=RL
          RJ     PLL         PUBLISH LISTING LINE 
          EQ     EXIT.
  
 TRAC.A   DATA   L/TRACE./
          DATA   0
 LI=PLIM  SPACE  4,4
 LI=ZERO  SPACE  4,10 
 LI=ZERO  BSSENT 0           PRINT A ZERO WORD
          SA3    =10H 
          BX1    0
          RJ     ZWI         OUTPUT A ZERO WORD 
          EQ     EXIT.
  
          TITLE  OBJECT LISTING SUPPORTING ROUTINES.
 KTX      SPACE  4,10 
**        KTX -  KONVERT TAG TO EXTERNAL FORMAT 
* 
*         ENTRY  (X3) = TAG (R-JUST, ZERO FILL) 
*         EXIT   (X6) = DPC CONVERSION (L-JUST, ZERO FILL, 9 CHAR MAX)
*                (SAVFP) .EQ. 1 IF FP 
*         USES   A1,A2,A3,A7   B2,B7   X1,X2,X3,X6,X7 
  
  
 KTX      SUBR               ENTRY/EXIT...
          ZR     X3,KTX60    IF TAG .EQ. 0
          MX1    -PB.ORDL 
          BX2    X1*X3       PFXI = PFX[TAGI] 
          ZR     X2,KTX20    IF PFXI .EQ. 0 (IF SYMBOL TABLE ORDINAL) 
  
*         CONVERT AN INTERNAL TAG.
*         X3 = TAGI (R-JUST)
  
          SX6    B0 
          BX1    -X1*X3      ORDI = ORD[TAGI] 
          AX2    P=PFX
          SB2    X2 
 .TEST    IFEQ   TEST,ON
          SX3    X2-K=END 
          PL     X3,"BLOWUP" IF PFXI .GE. K=END 
 .TEST    ENDIF 
          SX3    7
 KTX10    BX2    X3*X1       ISOLATE LOWEST OCTAL DIGIT 
          AX1    3
          SX2    X2+1R0 
          BX6    X6+X2
          LX6    -CHAR
          NZ     X1,KTX10    IF NUMBER NOT FINISHED 
          SA3    B2+KTXN     FETCH TAG PREFIX 
          BX6    X6+X3
          LX6    -3*CHAR
          EQ     EXIT.
  
*         CONVERT VARIABLE TAG. 
*         TESTS FOR STATEMENT LABEL (*LAB*) AND PROCESSES.
*         PREFIX TAG WITH *=X* IF *EXT* BIT IS SET IN THE SYMBOL
*         TABLE ENTRY.
*         (X3) = ORDI        (SYMBOL TABLE ORDINAL) 
  
  
 KTX20    SA1    T.SYM
          LX6    X3,B1
          IX6    X6+X3       STIND =  3 * ORDI
          ERRNZ  3-Z=SYM
          IX1    X1+X6
          SA2    X1+WB.W     WBI = T.SYM(STIND) 
          BX7    X2 
          SBIT   X2,WB.LABP 
          MI     X2,KTX40    IF STATEMENT LABEL 
          MX6    WA.SYML
          SA3    A2-WB.W+WA.W      WAI = T.SYM(STIND) 
          BX6    X6*X3      SYMBOL
          LX2    WB.LABP-WB.EXTP
          =B2    0
          SBIT   X7,WB.FPP
          PL     X7,KTX30    IF NOT FP
          MX1    -WB.FPNOL
          LX7    1+WB.FPP-WB.FPNOP
          BX1    -X1*X7 
          SB2    X1 
 KTX30    SX7    B2+         FPNO (OR ZERO) 
          SA7    SAVFP       (SAVFP) = FPNO[WBI]
          SA7    SAVFP       (SAVFP) = FP[WBI]
          PL     X2,EXIT.    IF NOT AN EXTERNAL 
          SX1    2R=X 
          BX6    X1+X6
          LX6    -2*CHAR     PREFIX EXTERNALS WITH *=X* 
          EQ     EXIT.       EXIT.. 
  
*         CONVERT STATEMENT LABEL TAG.
*         (A2) = WBI
  
 KTX40    =A1    A2-WB.W+WA.W      WAI = WORD A ENTRY OF SYMBOL 
          MX2    CHAR 
          AX1    WA.STLP     EXTRACT THE LABEL
 KTX50    BX6    X2*X1       ISOLATE LEADING CHARACTER
          LX1    CHAR 
          ZR     X6,KTX50    IF NO SIGNIFICANT CHARACTER YET
          SX2    2R.*-1R* 
          BX6    X1+X2
          LX6    -2*CHAR
          EQ     EXIT.
  
 KTX60    KTY                CONVERT 0
          EQ     EXIT.
  
*         VECTOR OF PREFIXES FOR AUXILLIARY TABLE TAGS. 
  
 KTXN     BSS    0
          LOC    0
 K=SYM    DATA   3RSY.       K.SYM       (SHOULD NEVER SEE THIS)
 K=GL     DATA   3RGL.       K.GL        GENERATED LABEL
 K=AP     DATA   3RAP.       K.AP        AP-LIST INDEX
 K=IO     DATA   3RIO.       K.IO        I/O APL INDEX
 K=LC     DATA   3RLP.       K.LC        LCM POINTER WORD INDEX 
 K=END    BSS    0           INSURE VECTOR SYNCHRONIZATION
          LOC    *O 
 KTY      SPACE  4,10 
**        KTY -  CONVERT SHORT CONSTANTS FOR OBJECT LIST. 
* 
*         ENTRY  (B2) = SHIFT COUNT FOR SIGN EXTENSION
*                (X3) = CONSTANT, RIGHT JUSTIFIED.  HIGH ORDER BIT IS 
*                       ASSUMED TO BE SIGN BIT (WHICH BIT IS HIGH ORDER 
*                       IS DETERMINED BY (B2)).  MINUS SIGN WILL PREFIX 
*                       AS NECESSARY. 
* 
*         EXIT   (X6) = DPC CONVERSION (0L FORMAT).  WILL HAVE A
*                       TRAILING *B* SUFFIX IF ABSOLUTE VALUE OF
*                       THE CONSTANT IS .GT. EIGHT. 
*                (X3) .LT.0 IF CONSTANT WAS NEGATIVE. 
* 
*         USES   X1-X3,X6,X7
  
  
 KTY      SUBR               ENTRY/EXIT...
          SX7    7
          LX3    B2,X3
          BX2    X3 
          AX3    B2,X3       SIGN EXTEND
          AX2    59          MASK = (+0 IF POS), (-0 IF NEG)
          BX6    X2-X3       X6 = ABS (X3)
          LX1    X6 
          AX6    3
          ZR     X6,KTY6     IF ABS(X3) .LT. 8
          =X6    1RB
  
 KTY6     BX2    X7*X1       ISOLATE LOWEST OCTAL DIGIT 
          AX1    3
          SX2    X2+1R0 
          LX6    -CHAR
          BX6    X2+X6
          NZ     X1,KTY6     IF NUMBER NOT EXHAUSTED
  
          LX6    -CHAR
          PL     X3,EXIT.    IF POSITIVE CONSTANT 
          SX1    1R-
          BX6    X1+X6
          LX6    -CHAR
          EQ     EXIT.
 KUB      SPACE  4,10 
**        KUB -  KONVERT UPPER BITS TO DISPLAY CODE.
*                CONVERT UPPER 12 BITS OF A WORD TO DISPLAY CODE, 
*                ZERO NOT SUPPRESSED. 
* 
*         ENTRY  (X1) = WORD TO BE CONVERTED
*         EXIT   (X7) = WORD CONTAINING LEFT JUSTIFIED 4 CHARACTERS 
*                       CONVERTED TO DPC
*         USES   X -  1,3,4,6,7 
*                B -  2,4 
  
  
 KUB      SUBR   0           ENTRY/EXIT.
          =X3    1R0
          MX6    -3 
          MX7    0
          SB4    3
          SB2    4*3         N = 4
 KUB10    LX1    B4 
          BX4    -X6*X1 
          IX4    X4+X3       CONVERT TO DPC 
          LX7    CHAR 
          BX7    X7+X4
          SB2    B2-B4       N = N - 1
          NZ     B2,KUB10    IF N .NE. 0
          LX7    -4*CHAR
          EQ     EXIT.
 PBS      SPACE  4,10 
**        PBS -  PRINT BSS INSTRUCTION. 
* 
*         ENTRY  (X1) = PB INSTRUCTION FORMAT , WHERE 
*                PB.TAG      TAG OF BSS 
*                PB.BIAS     NUMBER OF BSS
*         CALLS  KTX,KTY,PVF
*         USES   ALL BUT X0,A5,X5,A0
  
  
 PBS      SUBR               ENTRY/EXIT...
          MX7    -PB.BIASL
          MX6    -PB.TAGL 
          LX1    -PB.BIASP
          BX3    -X7*X1      BSS COUNT = BIAS [INSTRUCTION] 
          LX1    PB.BIASP-PB.TAGP 
          BX4    -X6*X1      BSS TAG = TAG [INSTRUCTION]
          KTY                CONVERT BSS COUNT
          SA6    PBSA+1 
          SA2    =1H
          BX6    X2 
          LX3    X4 
          ZR     X4,PBS10    IF TAGI .EQ. 0    (NO TAG) 
          RJ     KTX         CONVERT TAG TO EXTERNAL REPRESENTATION 
          BX1    X6 
          CALL   SFN         SPACE FILL 
 PBS10    LX6    -6 
          BX7    0           INDICATE NO OCTAL
          SB5    A6-B1
          SA7    OL=RL
          SA6    LINEBUF+4
          RJ     PLL         PUBLISH LISTING LINE 
          EQ     EXIT.
  
 PBSA     DATA   7LBSS
          DATA   1L0
          DATA   0
 PVF      SPACE  4,10 
**        PVF -  PACK VARIABLE FIELD FOR LISTING. 
*         ENTRY  X2 = (A2) = (FWA OF ITEMS TO BE PACKED)
*                X6 = LABEL FIELD TO BE WRITTEN 
*                X3 = 7R]OP-FIELD 
*                ITEMS ARE IN 0L FORMAT, TERMINATED BY A ZERO WORD
*         USES   ALL BUT A0,A5,X5,X0
  
  
 PVF      SUBR               ENTRY/EXIT...
          SA1    OL=LBF 
          SA6    X1          STORE LABEL FIELD
          BX6    X3 
          SB2    3*CHAR 
          MX4    -CHAR
          SB7    A6-B1
          ZR     X2,PFV40    IF NOTHING TO PACK 
 PVF10    LX2    CHAR 
          SB0    0
          BX1    -X4*X2 
 PVF20    LX6    CHAR 
          SB2    B2-CHAR
          LX2    CHAR 
          IX6    X6+X1
          BX1    -X4*X2      ISOLATE NEXT CHARACTER 
          NZ     B2,PVF30    IF ASSEMBLY NOT FULL 
          SA6    A6+B1
          SB2    10*CHAR
          BX6    0
 PVF30    NZ     X1,PVF20    IF MORE CHARACTERS 
          SA2    A2+B1
          SA3    =1H
          NZ     X2,PVF10    IF MORE ITEMS
          SB3    B2-B1
          MX7    1
          AX7    X7,B3
          BX3    X3*X7       GET DESIRED NO. OF BLANKS
          BX6    X6+X3       FILL IN BLANKS 
 PFV40    LX6    X6,B2
          SA6    A6+B1
          SB3    LINEBUF-1
          PLINE  LINEBUF,A6-B3
          EQ     EXIT.
 PLL      SPACE  4,10 
**        PLL - PUBLISH LISTING LINE. 
* 
*         ENTRY  (B5) -> FIRST ITEM TO ASSEMBLE.
*                            USUALLY -> LINEBUF+5 = 7L_OPCODE.
*                (LINEBUF+0) = ORIGIN COUNTER.
*                            .MI. IF ALREADY FORMATTED. 
*                (LINEBUF+4) = LABEL FIELD, FORMATTED ALREADY.
*                (OL=LBF) = ADDRESS IN LINEBUF OF LABEL FIELD (FOR PW). 
*                (OL=BIN) = FULLWORD BINARY FOR LISTING.
*                (OL=RL) = RELOCATION LISTING INDICATOR --
*                            .ZR. = SUPPRESS OCTAL, BLANK RL. 
*                            .NZ. = 1R_F, F = RELOC CHARACTER.
* 
*         USES   ALL BUT  A0,X0,  A5,X5.
*         CALLS  COD, PLINE, PVS, WOD.
  
  
 PLL      SUBR   0           ENTRY/EXIT...
          SA3    OL=RL
          SA4    =H/  / 
          BX6    X4 
          SB6    A5          SAVE (A5)
          LX7    X4 
          ZR     X3,PLL5     IF NO OCTAL TRANSLATION
          SA1    OL=BIN 
          CALL   WOD
 PLL5     SA3    OL=RL
          SA6    LINEBUF+1   (LINEBUF+1, +2) = OCTAL
          SA7    A6+B1
          SX6    1R 
          SA5    B6          RESTORE (A5) 
          SA6    A3 
          ZR     X3,PLL6     IF NO RELOCATION 
          SX6    X3+
 PLL6     SA4    =9L
          SA3    LINEBUF+4
          IX7    X4+X6       (LINEBUF+3) = RELOCATION 
          SA1    OL=LBF 
          SA2    B5 
          LX7    -2*6 
          BX6    X3          SET STORE AT (LINEBUF+4) 
          SA7    A7+B1
          SA6    X1 
          RJ     PVS         PACK VARIABLE STRINGS
          SA1    LINEBUF
          SB3    A6+B1       (B3) = LWA+1 OF PACKED LINE
          SB6    A1 
          MI     X1,PLL8     IF ORIGIN ALREADY FORMATTED
          CALL   COD
          LX6    2*6
          SA6    A1          SET (ORIGIN) IN LINEBUF+0
 PLL8     PLINE  B6,B3-B6 
          EQ     EXIT.
 PVS      SPACE  4,10 
**        PVS - PACK VARIABLE STRINGS.
* 
*         ENTRY  (A2,X2) = FIRST ITEM.
*                (A6) -> LAST WORD STORED.
*                ITEMS ARE IN 0L FORMAT, TERMINATED BY A ZERO WORD
* 
*         EXIT   (A6) -> LAST WORD STORED (BLANK FILLED). 
*         USES   ALL BUT A0,A5,X5,X0
  
  
 PVS      SUBR               ENTRY/EXIT...
          SB2    10*6        INDICATE ACCUMULATOR EMPTY 
          MX4    -CHAR
          BX6    0
          ZR     X2,EXIT.    IF NOTHING TO PACK 
 PVS10    LX2    CHAR 
          SB0    +
          BX1    -X4*X2 
 PVS20    LX6    6
          BX2    X2-X1       REMOVE CHAR FROM SOURCE
          SB2    B2-6 
          LX2    6
          IX6    X6+X1
          BX1    -X4*X2      ISOLATE NEXT CHARACTER 
          NZ     B2,PVS30    IF ASSEMBLY NOT FULL 
          SA6    A6+B1
          SB2    10*6 
          BX6    0
 PVS30    NZ     X2,PVS20    IF SOURCE NOT EMPTY
          MI     X2,PVS20    IF SOURCE WORD ALL SEMICOLONS
          SA2    A2+B1
          SB3    B2-B1
          NZ     X2,PVS10    IF MORE ITEMS
          MX7    1
          SA3    =1H
          AX7    X7,B3
          BX3    X3*X7       GET DESIRED NO. OF BLANKS
          BX6    X6+X3       FILL IN BLANKS 
          LX6    X6,B2
          SA6    A6+B1
          EQ     EXIT.
 VFD      SPACE  4,10 
**        VFD - VARIABLE FIELD DEFINITION.
* 
* 
*                CONVERTS A SPECIFIED FIELD IN A BINARY WORD TO OCTAL 
*         DISPLAY CODE WITH APPROPRIATE SPACING AND BLANK FILL. 
*         THE FIELD TO BE CONVERTED CAN BE REPRESENTED IN *COMPASS* BY--
* 
*         POS    (B4)   IN (X1) 
*         VFD    (B5)/FIELD   WHERE *FIELD* HAS BEEN EXTRACTED FROM (X1)
* 
*         E.G.   (B4) = 45   POSITION COUNTER 
*                (B5) = 30   NR OF BITS 
* 
*                BINARY      76211031100015620310 
*                DPC RSULT   .....0311000156.....    (.=BLANK(55B)) 
* 
*         ENTRY  (X1)  =  BINARY WORD TO BE CONVERTED 
*                (B4)  =  POSITION COUNTER
*                (B5)  =  NR OF BITS IN FIELD 
* 
*         EXIT   (X6)  =  CONVERTED UPPER 30 BITS OF (X1) -- DPC RESULT 
*                (X7)  =  CONVERTED LOWER 30 BITS OF (X1) -- DPC RESULT 
*                (X0)  =  .ZR. IF BAD POS OR BIT COUNT ON ENTRY,
*                            ELSE .NZ.
* 
*         USES   X - 0,1,2,3,4,6,7
*                A - NONE 
*                B - 6
* 
*         CALLS  NONE 
  
  
 VFD      SUBR   =           ** ENTRY/EXIT ** 
          MX3    0
          BX0    X0-X0
          SB6    B5-1 
          LT     B4,B0,EXIT. IF POS COUNT IS BAD
          LT     B5,B0,EXIT. IF BIT COUNT IS BAD
          MX0    -3 
          ZR     B5,VFD2     IF NOT CONVERTING ANY BITS 
          MX3    1
          AX3    X3,B6
          NO
          LX3    X3,B4       (X3) = EXTRACT MASK FOR BITS TO CONVERT
          BX1    X3*X1
  
 VFD2     MX6    0
          BX7    X7-X7
          SB6    60 
  
*         ASSEMBLE APPROPRIATE DIGITS.
  
 VFD3     LX1    3
          BX2    -X0*X1 
          LX3    3
          BX4    -X0*X3 
          SX2    X2+1R0 
          SB6    B6-6 
          NZ     X4,VFD4     IF ASSEMBLING THESE DIGITS 
          SX2    1R 
  
 VFD4     LX2    X2,B6
          BX7    X7+X2
          GT     B6,B0,VFD3  IF PACKING REG (X7) NOT FULL 
  
*         HERE IF PACKING REGISTER (X7) IS FULL.
  
          SB6    60 
          NZ     X6,EXIT.    IF FINISHED ASSEMBLING ENTIRE WORD 
          BX6    X7 
          MX7    0
          EQ     VFD3 
 WAP      SPACE  4,10 
**        WAP -  LIST AP-LISTS ACTUALLY COMPILED. 
*                CALLED FROM *LI=APL* AND *LI=IOM*. 
* 
*         ENTRY  (B6) = APL/ IOAP INDICATOR, .EQ. 0 IF APL, .EQ. 1
*                       IF IO AP-LISTS. 
*                (X1) = RJ  WCA/ WIO , ROUTINE TO LIST ONE AP-LIST ITEM 
*                (X2) = LENGTH OF AP-LIST TABLE TO PRINT
*                T.PTXTR HAS BINARY EQUIVALENT OF AP-LISTS. 
* 
*         CALLS  ALLOC,SST,KTX,SFN,PLINE,ZWI,PIA,WCA,WIO,WOD
*         CELLS  WAPA,WAPB
* 
*         (NOTE) CODE ASSUMES T.APL IMMEDIATELY PRECEDES T.IOA, 
*                T.API IMMEDIATELY PRECEDES T.IOI.
  
  
 WAP      SUBR   0           ENTRY/EXIT...
          SB3    BN=APL+B6
          SA3    B3+F.LBT 
          LX3    -LB.ORGP 
          SA0    X3          ORGA = ORG[T.LBT(BN=APL)]
          ERRNZ  18-LB.ORGL 
          BX6    X1 
          ZR     X2,EXIT.    IF NO AP-LISTS TO PRINT
          AX4    X2,B6
          ERRNZ  2-Z=IOA
          SA6    WAP.RJ 
          SB5    X4 
          SA2    T=API+B6 
          SHRINK T=SCR
          ALLOC  T.SCR,X2 
          SA3    T.API+B6 
          =B4    1           APLIND = 1 
          SB2    X2-1        LEN = (T=API) - 1
          SA4    X3          APA = FWA(T.API) 
          SX6    A0+B5       LWAAPL = ORG + (T=APL) 
          LX6    PS.RAP 
          SA2    T.APL+B6 
          MX7    -WC.RAL
          SA6    X1          FWA(T.SCR) = LWAAPL
          SA5    X2          ORGAPI = FWA(T.APL)
  
*         FORM TEMPORARY AP TAG TABLE AS PS. AND STORE IN T.SCR.
*         FOR I = 1,(T=API/T=IOI) 
*                RA[PS.] = RA[API],  ORD[PS.] = I.
  
 WAP10    =A4    A4+1        APA = APA + 1, API = (APA) 
          SX3    B4 
          LE     B2,WAP20    IF LEN .LE. 0
          =B2    B2-1        LEN = LEN - 1
          LX4    -WC.RAP
          BX6    -X7*X4      RAI = RA[API]
          LX6    PS.RAP 
          LX3    PS.ORDP
          BX6    X6+X3
          SA6    X1+B4       T.SCR(APIND) = (RAI,APIND) [PS.] 
          =B4    B4+1        APIND = APIND + 1
          EQ     WAP10       LOOP.. 
  
*         SORT T.SCR IN ASCENDING ORDER OF RA[PS.]. 
  
 WAP20    SB7    X1          (B7) = FWA(T.SCR) FOR SORT 
          SX1    B4          (X1) = LENGTH FOR SORT 
          CALL   SST         SORT T.SCR 
  
*         BEGIN LISTING NEXT GROUP OF APL'S.
*         (A5,X5) = ORGAPI
*         (B6) = APL/ IO-APL INDICATOR
*         (A0) = ORGA 
  
 WAP30    SA1    T.SCR
          SA2    T=SCR
          SA3    X1          APA = FWA(T.SCR), API = (APA)
          =X6    X1+1        (T.SCR) = (T.SCR) + 1
          LX3    -PS.RAP     RIGHT JUSTIFY RA FIELD 
          SX7    X2-1        (T=SCR) = (T=SCR) - 1
          SA7    A2 
          ZR     X7,EXIT.    IF END OF LIST 
          SA6    A1 
          SB4    X3          RAI = RA[API]
          ERRMI  18-PS.RAL
          LX3    PS.RAP-PS.ORDP 
          SX3    X3          TAGI = TAG[API]
          ERRMI  18-PS.ORDL 
          SA2    APTAG+B6    (X2) = K.AP/ K.IO
          =A4    A3+1        APJ = API + 1
          LX4    -PS.RAP
          SB3    X4          RAJ = RA[APJ]
          ERRNZ  18-PS.RAL
          IX4    X3+X2       ADD PREFIX TO TAG
          SX0    B3-B4       LENAPI = RAJ - RAI 
          SX1    A0 
          PIA    ,LINEBUF 
          BX1    X4 
          LX1    PB.TAGP
          SX6    B6 
          SA6    WAPA        (WAPA) = (B6)
          RJ     PBS         PRINT *  TAG  BSS  0*
          SA1    WAPA 
          SB6    X1+         RESTORE (B6) 
          ZR     X0,WAP30    IF LENAPI.EQ.0 (NEXT TAG AT SAME PLACE)
  
*         LIST NEXT APL ITEM IN THIS GROUP. 
*         (X0) = LENAPI 
  
 WAP40    SA3    T.PTXTR
          =X6    X3+1 
          SA1    X3 
          SA6    A3          FWA(T.PTXTR) = FWA(T.PTXTR) + 1
          SB5    X0          SAVE (B5) = (X0) 
          SB2    A5          SAVE (B2) = (A5) 
          CALL   WOD         CONVERT BINARY TO DPC
          SA6    LINEBUF+1
          SA7    LINEBUF+2
          SX1    A0 
          PIA    ,A6-B1 
          SA5    B2          RESTORE (A5) 
          SA1    A5 
          SX0    B5          RESTORE (X0) 
          NZ     X1,WAP50    IF NOT +/- 0 
          SA3    =10H 
          RJ     ZWI         PRINT ZERO WORD ITEM 
          EQ     WAP90
  
 WAP50    BSS    0
 WAP.RJ   RJ     **          CALL  WCA/ WIO TO LIST ONE AP-LIST 
  
 WAP90    SA1    WAPA 
          SA2    =10H 
          SB6    X1          RESTORE (B6) 
          SB3    B6+B1
          BX6    X2 
          SETMEM LINEBUF+1,4,X6    BLANK FILL 
          ERRNZ  2-Z=IOA
          SA5    A5+B3       ORGAPI = ORGAPI + Z=APL /Z=IOA 
          SA0    A0+B1       ORGA = ORGA + 1
          SX0    X0-1        LENAPI = LENAPI - 1
          NZ     X0,WAP40    IF MORE ITEMS IN THIS AP-LIST
          EQ     WAP30
  
 WAPA     BSS    1
 WCA.RJ   RJ     WCA
 WIO.RJ   RJ     WIO
 WCA      SPACE  4,10 
**        WCA - LIST ONE AP-LIST. 
*                LIST SUB MACRO ALSO IF FP[WBI] .EQ. 1. 
* 
*         LISTS: AP.N        APL   TAG+BIAS,BCP,CLEN (IF LCM[WBI].EQ.0) 
*                LC.N        LAP   TAG+BIAS,BCP,CLEN (IF LCM[WBI].EQ.1) 
*         ENTRY  (X1) = T.APL ENTRY 
*         USES   ALL BUT A5,X0,B6 
*         CALLS  KTX,KTY,PVF,WSM
  
  
 WCA      SUBR               ENTRY/EXIT.
          BX5    X1 
          MX6    0
          SA6    WCA.10+4    (WCA.10+4) = 0 
          MX7    -IA.TAGL 
          HX1    IA.CRH 
          LX5    -IA.TAGP 
          SB5    B0          PSNAM = *APL*
          BX3    -X7*X5      TAGI = TAG[API]
          BX4    X3 
          MI     X1,WCA90    IF CHARACTER RELATIONAL HEADER 
          RJ     KTX         CONVERT TAGI TO EXTERNAL FORM
          MX2    -IA.MODEL
          SA6    WCA.10+2    (WCA.10+2) = TAG 
          LX5    IA.TAGP-IA.MODEP 
          BX7    -X2*X5      TYPE = MODE[API] 
          LX7    OA.TYPP
          MX1    0           INDICATE NON LCM AND NON FP
          MX6    -PB.ORDL 
          BX6    X6*X4       PFXI = PFX[TAGI] 
          NZ     X6,WCA15    IF PFXI .NE. K=SYM 
          ERRNZ  K=SYM
          SA3    T.SYM
          =B2    X3+WB.W
          LX6    X4,B1
          IX6    X4+X6       STIND = 3 * TAGI 
          ERRNZ  3-Z=SYM
          SX1    B1 
          SA2    X6+B2       WBI = T.SYM(STIND)+WB.W
          LX2    -WB.LCMP 
          BX1    X1*X2       LCMI = LCM[WBI]
          SB5    X1          REMEMBER (B5) = LCMI 
          LX1    OA.LCMP
          LX2    WB.LCMP-1-WB.FPP 
 WCA15    BX6    X7+X1
          SA6    WCA.10      (WCA.10) = (LCM,MODEI) [OA.] 
  
          BX3    X5 
          LX5    IA.MODEP-1-IA.STP
          LX3    IA.MODEP-IA.BIASP
          MI     X5,WCA95    IF ST[API] .EQ. 1
          MX7    -IA.BIASL
          BX3    -X7*X3      BIASI = BIAS[API]
          LX5    IA.STP-IA.CHARP
          MI     X5,WCA20    IF CHARACTER 
  
*         IF TAGI IS (S=RD), REPLACE BIAS BY ITS DIMENSION
*         HEADER RA.
*         (X4) = TAGI 
  
          SA2    S=RD 
          SA1    T.DIM
          IX7    X2-X4
          SB2    X1          +DH.W
          NZ     X7,WCA40    IF TAGI .NE. S=RD
          SA3    X3+B2       DHI = T.DIM(BIASI) + DH.W
          HX3    DH.RA
          AX3    -DH.RAL     BIASI = RA[DHI]
          EQ     WCA40
  
*         HANDLE CHARACTER APLIST HERE. 
  
 WCA20    PL     X2,WCA35    IF NOT F.P.
          MX7    0
          SA7    SAVFP       DISABLE *SUB*
          SA4    WCA.10 
          MX6    1
          BX6    X6*X2       FPI = FP[WBI]
          LX6    1+OA.FPP 
          BX6    X6+X4
          SA6    A4          FP[WCA.10] = FPI 
          MX7    -WB.FPNOL
          LX2    1+WB.FPP-WB.FPNOP
          BX4    -X7*X2      FPNOI = FPNO[WBI]
          KTY                CONVERT FPNO 
          SA6    WCA.10+2    (WCA.10+2) = BIASI 
          =X3    X4-1        FPNOI = FPNOI - 1
          EQ     WCA40
  
 WCA35    SA2    T.CAC
          MX7    -WC.CLENL
          MX1    -WC.BCPL 
          SB2    X2 
          SA3    X3+B2       CACI = T.CAC(BIASI)
          BX5    X3 
          LX5    -WC.BCPP 
          BX3    -X1*X5      BCPI = BCP[CACI] 
          LX5    WC.BCPP-WC.CLENP 
          BX4    -X7*X5      CLENI = CLEN[CACI] 
          KTY                CONVERT BCPI 
          SA1    =1L, 
          BX7    X1 
          SA6    WCA.10+5    (WCA.10+5) = BCP 
          SA7    A6-B1       (WCA.10+4) = SLASH 
          BX3    X4 
          KTY                CONVERT CLEN 
          MX1    -IA.BIASL
          LX5    WC.CLENP-WC.RAP
          BX3    -X1*X5      BIASI = RA[CACI], TRUNCATED TO IA.BIASL
          SA6    WCA.10+7    (WCA.10+7) = CLEN
  
*         NON CHARACTER APLIST. 
*         (X3) = BIASI
  
 WCA40    KTY    24          CONVERT BIAS 
          MI     X3,WCA60    IF BIAS IS NEGATIVE
          SX1    1R+         PREFIX A PLUS
          BX6    X6+X1
          LX6    -CHAR
 WCA60    SA6    WCA.10+3    (WCA.10+3) = BIAS
  
 WCA80    SA1    WCA.10 
          RJ     KUB         CONVERT UPPER 12 BITS
          SA7    A1 
          SA2    =10H 
          SA3    B5+APLAB    7RAPL OR 7RLAP 
          BX6    X2 
          SA2    WCA.10 
          RJ     PVF         PACK VARIABLE FIELD
          SA4    WCA.10+3 
          RJ     WSM         WRITE SUB MACRO
          EQ     EXIT.
  
*         LIST CHARACTER RELATIONAL HEADER. 
  
 WCA90    KTY                CONVERT LEFT TAGI
          ERRNZ  IA.LEFTP-IA.TAGP 
 .T       IFEQ   TEST,ON,1
          MI     X3,"BLOWUP" LEFT SHOULD NEVER BE .LT. 0
          SA6    WCA.10+2    (WCA.10+2) = LEFT
          MX1    -IA.RITEL
          LX5    IA.TAGP-IA.BIASP 
          BX3    -X1*X5      RITEI = BIAS[API]
          ERRNZ  IA.RITEP-IA.BIASP
          KTY    24          CONVERT RITE (BIASI) 
 .T       IFEQ   TEST,ON,1
          MI     X3,"BLOWUP" RITE SHOULD NEVER BE .LT. 0
          SX1    1R,
          BX6    X6+X1
          LX6    -CHAR
          SA6    A6+B1       (WCA.10+3) = , BIASI 
          SA2    =2LRH
          BX7    X2 
          SA7    WCA.10      (WCA.10) = 'RH'
          EQ     WCA80
  
 WCA95    SA1    =1L, 
          MX6    0
          BX7    X1 
          SA7    WCA.10+3    (WCA.10+3) = COMMA 
          SA6    SAVFP       (SAVFP) = 0
          EQ     WCA80
  
 APLAB    DATA   7RAPL
          DATA   7RLAP
  
 WCA.10   BSS    1           +0    (LCM,FP,MODE)
          DATA   1L,
          BSS    2           +2    TAG+BIAS 
          DATA   1L,
          DATA   0           +5    BCP
          DATA   1L,
          BSS    1           +7    CLEN 
          DATA   0
          DATA   7RLAP
 WCC      SPACE  4,10 
**        WCC -  LIST CONSTANT ASSIGNMENTS. 
*                CALLED FROM *LI=CON*.
* 
*         LISTS  TAG         CON   CONSTANT IN OCTAL DPC
* 
*         ENTRY  (X1) = SYMORD OF LABEL FOR BLOCK.
*                (WC.RA[SYMORD]) = OBJECT ORIGIN OF FIRST WORD. 
*                (A5, X5) = FWA BINARY CONSTANTS. 
* 
*         USES   ALL. 
* 
*         CALLS  MVE=, PIA, WOD, WOF, ZTB 
  
  
 WCC      SUBR   0           ENTRY/EXIT...
          SA3    A5+N.TABLE 
          SA2    T.SYM
          ZR     X3,EXIT.    IF (TABLE) EMPTY 
          LX6    X1,B1
          SA5    X5          (CI, VI) = FIRST CONSTANT
          SA0    X3          LENT = LENGTH OF TABLE 
          IX1    X6+X1       STIND = 3 * SYMORD 
          ERRNZ  3-Z=SYM
          IX1    X1+X2
          MX7    WA.SYML
          =A3    X1+WA.W     WAI = T.SYM(STIND) 
          =A4    X1+WC.W
          HX3    WA.SYM 
          BX1    X7*X3       NAMEI = SYM[WAI] 
          CALL   ZTB         ZEROES TO BLANKS 
          LX4    -WC.RAP
          MX2    -WC.RAL
          BX7    -X2*X4      (WCCF) = ORGA = OBJECT ORIGIN
          SX1    A0 
          SA7    WCCF 
          IX7    X1+X7       ORGLAST = ORGA + LENT
          SA7    A7+B1
  
 WCC20    LX6    -CHAR
          SA6    CC3         (CC3) = LABEL
          SA1    WCCF 
          SX7    X1+B1       ORGA = ORGA + 1
          SA7    A1 
          PIA    ,LINEBUF    CONVERT ADDRESS TO DISPLAY 
          BX1    X5 
          SA6    A6-B1
          SB5    A5+B1
 .T       IFEQ   TEST,OFF,1 
          SA5    =H/ /
          BX7    X5 
          SA7    CC8
          CALL   WOD         CONVERT CONST TO DPC 
          SA5    B5 
          SA6    CC5         (CC5)  = ABCDEFGHIJ
          =A7    A6+1        (CC5+1) = KLMNOPQRST 
          SA6    CC0
          =A7    A6+1 
          SA1    WCCB        LENGTH OF PRINT LINE 
          =A2    A1+1        FWA OF PRINT BUFFER
          MOVE   X1,X2,LINEBUF+1
          SA2    WCCB 
          PLINE  LINEBUF,X2+B1     PRINT THE LINE 
          SA2    WCCF 
          SA3    A2+B1
          SA1    =H/ /
          IX7    X2-X3       MORE = ORGA .LT. ORGLAST 
          BX6    X1 
          MI     X7,WCC20    IF MORE CONSTANTS
          EQ     EXIT.
  
 CC0      DIS    3, 
 CC3      DIS    1, LABEL.
          DIS    1,CON
 CC5      DIS    3,12345678901234567890B
 CC8      DIS    1, DPC VAL 
  
 WCCB     BSS    2           LENGTH OF PRINT LINE (PW VS NONPW) AND FWA 
 WCCF     BSS    2           ORGA, ORGLAST
 WCE      SPACE  4,10 
 WCF      SPACE  4,10 
**        WCF -  LIST FORMATS.
* 
*         CALLS  PIA,WOD,PLINE
  
  
 WCF      SUBR               ENTRY/EXIT...
          SA2    T=FMT
          ZR     X2,EXIT.    IF END OF T.FMT
          SA3    T.FMT
          SA5    X3          FETCH 1ST FORMAT 
          SA0    X2          A0 = LENGTH OF TABLE.
          SB4    B0 
  
*         PROCESS 1ST WORD - STATEMENT NUMBER.
  
 WCF10    SA2    WCFC 
          MX0    WA.STLL
          BX1    X0*X5
          LX1    9*CHAR 
          BX6    X2+X1
          SA6    CC3         (CC3) = TAG
  
*         PROCESS CONTENTS OF FORMAT. 
  
 WCF20    BX6    X5 
          SB5    A5 
          SA6    CC8         +6 = DPC ECHO OF CON 
          BX1    X5 
          CALL   WOD         CONVERT CONTENTS OF WORD TO OCTAL
          SA5    B5+B1
          SA4    BN=FMT+F.LBT 
          SA6    CC5         (CC5)  = ABCDEFGHIJ
          SA7    A6+B1       (CC5+1) = KLMNOPQRST 
          SA6    CC0
          SA7    A6+B1
          SX1    B4+X4
          PIA    ,LINEBUF    CONVERT ADDRESS TO DPC 
          SA1    WCCB        LENGTH OF PRINT LINE 
          SA2    A1+B1       FWA OF BUFFER
          MOVE   X1,X2,LINEBUF+1
          SA2    WCCB 
          PLINE  LINEBUF,X2+B1
          SA1    =1H
          MX0    8*CHAR 
          BX6    X1 
          BX3    -X0*X5 
          SA6    CC3         CLEAR TAG WORD 
          SB4    B4+B1
          SB3    A0 
          EQ     B4,B3,EXIT. IF NO MORE FORMATS 
          NZ     X3,WCF20    IF MORE IN CURRENT FORMAT. 
          EQ     WCF10       CONTINUE 
  
 WCFC     VFD    CHAR/1R.,WA.STLL/0,24/4R 
 WCL      SPACE  4,10 
**        WCL -  WRITE CHARACTER LENGTH ARRAYS. 
* 
*                CL.         BSS   0
*                            CLW   TAG1+BIAS1,TAG2+BIAS2
* 
*         ENTRY  (A0) = ORIGIN OF (CL.)S. 
*                T.CLWB HAS BINARY REPRESENTATION 
* 
*         CALLS  WIO,PIA,WOD
  
  
 WCL      SUBR   0           ENTRY/EXIT...
          SX1    A0 
          PIA    ,LINEBUF 
          SA1    S=CL 
          LX1    PB.TAGP
          RJ     PBS         PRINT  * CL.  BSS    0*
          SA1    T.CLW
          SA2    T=CLW
          SX0    X2 
          SA5    X1-Z=IOA    CLI = FWA(T.CLW) - Z=IOA 
  
*         PROCESS NEXT ENTRY OF T.CLW.
  
 WCL10    ZR     X0,EXIT.    IF END OF T.CLW
          SA4    T.CLWB 
          =X6    X4+1 
          SX1    A0 
          SA6    A4          FWA(T.SCR) = FWA(T.SCR) + 1
          PIA    ,LINEBUF    CONVERT ORGA 
          SA1    X4 
          SB3    A5          SAVE (B3) = A5 
          SB4    X0          SAVE (B4) = (X0) 
          CALL   WOD         CONVERT BINARY TO DPC
          SA6    LINEBUF+1
          =A7    A6+1 
          SX0    B4          RESTORE (X0) 
          SA5    B3+Z=IOA    CLI = CLI + (Z=IOA)
          RJ     WIO         PRINT THE LIST 
          =A0    A0+1        ORGA = ORGA + 1
          SX0    X0-Z=IOA    LEN = LEN - Z=IOA
          EQ     WCL10
 WCS      SPACE  4,10 
**        WCS - LIST BLOCK STATISTICS.
* 
*         CALLS  PLINE,PIA
  
  
 WCS      SUBR               ENTRY/EXIT...
          SA1    CO.PS       FETCH PAGE SIZE
          SX4    3
          SX6    WCSB 
          LX4    30 
          BX7    X4+X6       SET SUBTITLE = 'OBJECT LISTING'
          =X3    X1-1        TO AVOID A DOUBLE EJECT
          SA7    O.STITL
          PLINE  WCSA,4,X3   PRINT TABLE HEADING
          SA1    =10H 
          BX6    X1 
          SA0    B0          BLKI = 0 
          SA6    LINEBUF
 WCS30    SA5    A0+F.LBT    FETCH BLOCK ORIGIN 
          LX5    -LB.ORGP 
          SX1    X5          TRUNCATE ORG TO 18 BITS
          PIA    ,LINEBUF+2  (LINEBUF+2) = BLOCK ADDRESS
          LX5    LB.ORGP-LB.BLENP 
          SX1    X5          TRUNCATE BLEN TO 18 BITS 
          PIA    ,A6+B1      (LINEBUF+3) = BLOCK LENGTH 
          SA2    A0+TLBN     FETCH BLOCK NAME 
          BX7    X2 
          SA7    LINEBUF+1
          SA0    A0+B1       BLKI = BLKI + 1
          PLINE  A7-B1,4
          SB2    A0-Z.LBT 
          MI     B2,WCS30    IF MORE BLOCKS TO PRINT
          SA1    =10H 
          BX6    X1 
          SETMEM LINEBUF+1,4,X6    BLANK FILL LINEBUF 4 WORDS 
          PLINE  B0,B0,1     SPACE 1
          EQ     EXIT.
  
 WCSA     DIS    4,          BLOCK      ADDRESS    LENGTH 
 WCSB     DIS    3,             OBJECT LISTING. 
 WIO      SPACE  4,10 
**        WIO - LIST ONE I/O AP-LISTS.
*                CALLED FROM WAP AND WCL TO LIST ONE I/O APLIST.
* 
*         LISTS  IO.N        IOM   TAG+BIAS,BCP,TAG+BIAS
* 
*         ENTRY  (A5,X5) = IOM
* 
*         USES   ALL EXCEPT A0,X0,A5,B6 
* 
*         CALLS  KTX,KTY,RVF
* 
*                **WARNING** DO NOT EVER TRY TO USE 
*                            REGISTERS A0,X0,A5,B6 IN THIS
*                            ROUTINE, TERRIBLE THINGS WILL HAPPEN!
*                            (LIKE AN INFINITE LOOP?) 
  
  
 WIO      SUBR   0           ENTRY/EXIT.
          =X7    0
          SA7    WIO.10+9    CLEAR BCP FIELD
          MX4    -IA.MODEL
          MX7    -IA.TAGL 
          LX5    -IA.TAGP 
          BX3    -X7*X5      TAGI = TAG[IO1]
          SB4    X3          REMEBER (B4) = TAGI
          RJ     KTX         CONVERT TAG TO DPC 
          SA6    WIO.10+3    (WIO.10+3) = TAG 
          =X1    1
          LX5    IA.TAGP-IA.MODEP 
          BX6    -X4*X5      MODEI = MODE[IO1]
          LX5    IA.MODEP-IA.IOCP 
          BX1    X1*X5       LST = IOC[IO1] 
          LX1    OA.LSTP
          NZ     X1,WIO10    IF CONTROL ITEM
          SA2    =XFCLMOD 
          LX6    2
          MX7    -4 
          SB7    X6 
          AX2    B7 
          BX6    -X7*X2 
  
 WIO10    LX6    OA.TYPP
          BX6    X6+X1
          ZR     B4,WIO15    IF TAGI .EQ. 0 
          ZR     X1,WIO11    IF NOT CONTROL ITEM
          BX2    X6 
          MX3    -OA.TYPL 
          HX2    OA.TYP 
          LX2    OA.TYPL
          BX2    -X3*X2      EXTRACT CONTROL CODE 
          SX3    X2-IC.UNT
          ZR     X3,WIO12    IF UNIT
          SX3    X2-IC.REC
          ZR     X3,WIO12    IF RECORD LENGTH 
          SX3    X2-IC.IOS
          ZR     X3,WIO12    IF I/O STATUS
          EQ     WIO15       NO OTHER CONTROL ITEM GETS OA.VAR
  
 WIO11    BX2    X5 
          LX2    IA.IOCP-IA.VARP-IA.VARL
          MI     X2,WIO15    IF IA.VAR (LOOP INDICATOR) 
  
 WIO12    CLAS=  X2,OA,(VAR)
          BX6    X6+X2       ADD IN VAR BIT 
  
 WIO15    MX7    -PB.ORDL 
          SX2    B4 
          BX3    X7*X2       PFXI = PFX[TAGI] 
          NZ     X3,WIO20    IF PFXI .NE. 0 
          ERRNZ  K=SYM
          SX2    X2+B4
          SB4    X2+B4       STIND = 3 * TAGI 
          ERRNZ  3-Z=SYM
          SA2    T.SYM
          =X2    X2+WB.W
          SA2    X2+B4       WBI = T.SYM(STIND) + WB.W
          CLAS=  X3,WB,(LCM)
          MX7    1
          BX3    X3*X2       LCMI = LCM[WBI]
          HX2    WB.FP
          LX3    OA.LCMP-WB.LCMP
          BX6    X6+X3       ADD IN LCM BIT 
  
 WIO20    SA6    WIO.10+1    (WIO.10+1) = (LCM,LST,TYPE)[OA.] 
          LX5    IA.IOCP-1-IA.STP 
          PL     X5,WIO25    IF NOT ST
          SA1    =1L, 
          BX6    X1 
          BX5    -X5         SET (X5) = 0 SO THAT (WIO.10+5) = 0
          EQ     WIO50       WILL BE SET ALSO 
  
 WIO25    MX7    -IA.BIASL
          LX5    1+IA.STP-IA.BIASP
          BX3    -X7*X5      BIASI = BIAS[IO1]
          LX5    IA.BIASP-1-IA.CHARP
          MI     X5,WIO30    IF CHARACTER 
          PL     X2,WIO40    IF NOT F.P.
  
*         FOR NON CHARACTER F.P. ITEM, OUTPUT:  
*                IOM         0000, BIASI, WB.FPNO-1 
  
          SA1    WIO.10+1 
          MX4    1
          BX4    X4*X2       FPI = FP[WBI]
          LX4    1+OA.FPP 
          BX6    X1+X4
          SA6    A1          FP[WIO.10+1] = FPI 
          MX7    -WB.FPNOL
          LX2    1+WB.FPP-WB.FPNOP
          BX4    -X7*X2      FPNOI = FPNO[WBI]
          KTY    24          CONVERT BIAS 
          SA6    WIO.10+3    (WIO.10+3) = BIASI 
          =X3    X4-1        FPNOI = FPNOI - 1
          EQ     WIO40
  
*         HANDLE CHARACTER APLIST.
*         (X2) = WBI HIGH SHIFTED TO WB.FP
  
 WIO30    MI     X2,"BLOWUP" CHARACTER F.P. NOT ALLOWED 
          SA1    T.CAC
          SB5    X1 
          MX7    -WC.BCPL 
          SA4    B5+X3       CACI = T.CAC(BIASI)
          LX4    -WC.BCPP 
          BX3    -X7*X4      BCPI = BCP[IO1]
          KTY                CONVERT BCPI 
          LX4    WC.BCPP-WC.CLENP 
          MX7    -WC.CLENL
          BX3    -X7*X4      CLENI = CLEN[IO1]
          SA6    WIO.10+9    (WIO.10+9) = BCP 
          LX4    WC.CLENP-WC.RAP
          KTY                CONVERT CLEN 
          SA1    =1R+ 
          SX7    1R0
          BX6    X6+X1
          LX6    -CHAR
          LX7    -CHAR
          SA6    WIO.10+7    (WIO.10+7) = CLEN
          SA7    A6-B1       (WIO.10+6) = DPC(0)
          MX1    -IA.BIASL
          BX3    -X1*X4      BIASI = RA[CACI], TRUNCATED TO IA.BIASL
  
 WIO40    KTY    24          CONVERT BIAS 
          MI     X3,WIO50    IF NEGATIVE BIAS 
          SA1    =1R+ 
          IX6    X6+X1
          LX6    -CHAR
  
*         PROCESS IO2.
  
 WIO50    SA6    WIO.10+4    (WIO.10+4) = BIASI 
          MX7    0
          =A4    A5+1        IO2 = IO1 + 1
          MI     X5,WIO55    IF CHARACTER 
          SA7    A6+B1       (WIO.10+5) = 0 TERMINATOR
  
 WIO55    ZR     X4,WIO70    IF IO2 .EQ. 0
          MX7    -IA.TAGL 
          LX4    -IA.TAGP 
          BX3    -X7*X4      TAG2I = TAG[IO2] 
          SA1    WIO.10+1 
          CLAS=  X2,OA,(IND)
          ZR     X3,WIO58    IF TAG2I .EQ. 0
          BX6    X1+X2       ADD IN IND BIT 
          SA6    A1          IND[WIO.10+1] = 1
 WIO58    LX4    IA.TAGP-IA.BIASP 
          RJ     KTX         CONVERT LENGTH TAG 
          SA6    WIO.10+6    (WIO.10+6) = TAG2I 
          MX5    -IA.BIASL
          BX3    -X5*X4      BIAS2I = BIAS[IO2] 
          KTY    24          CONVERT LENGTH BIAS
          MI     X3,WIO60    IF BIAS IS NEGATIVE
          SA1    =1R+ 
          BX6    X6+X1
          LX6    -CHAR
  
 WIO60    SA6    A6+B1       (WIO.10+7) = BIASI 
          SA1    =1L, 
          BX7    X1 
          SA7    WIO.10+5    (WIO.10+5) = COMMA 
  
 WIO70    SA1    WIO.10+1 
          RJ     KUB         CONVERT UPPER 12 BITS
          SA7    A1 
          SA1    =10H 
          SA3    WIO.10 
          BX6    X1 
          SA2    A3+B1
          RJ     PVF         PRINT THE LINE 
          SA1    =1L, 
          BX6    X1 
          SA6    WIO.10+5    (WIO.10+5) = COMMA 
          EQ     EXIT.
  
 WIO.10   DATA   7RIOM
          BSS    1           +1    MODE 
          DATA   1L,
          BSS    2           +3    TAG1 + BIAS1 
          DATA   1L,
          BSS    2           +6    TAG2 + BIAS2 
          DATA   1L,
          DATA   0           +9    BCP
          DATA   0
  
 APTAG    CON    K.AP 
          CON    K.IO 
 WLP      SPACE  4,10 
**        WLP - LIST LCM POINTER CELLS. 
*               LIST *SUB* MACRO IF FP[WBI] .EQ. 1. 
* 
*         LISTS: LC.N        LAP   TAG+BIAS 
*         ENTRY  (A0) = ORGA, ORGIN COUNTER OF LISTING AP-LISTS 
*                (APLA) = LEN OF T.APL BEFORE APPENDING T.LCA 
*         USES   ALL
  
  
 WLP      SUBR               ENTRY/EXIT.
          SA5    T.APL
          SA2    APLA 
          SA3    T=APL
          MX7    0
          IX2    X5+X2
          IX6    X5+X3
          SA7    X6          LWA+1(T.APL) = 0  (MARK TERMINATOR)
          ERRMI  1-FUDGE
          =X0    0           LCIND = 0
          SA5    X2          LCAD = FWA(T.APL) + (APLA) 
  
*         LIST NEXT LCM POINTER CELL. 
*         FOR N= 1, (T=LCA-1),
*         LIST:    * LC.N    LAP    (T.LCA(N+1)) *
*         (A0) = ORGA 
*         (X0) = LCIND
*         (A5) = LCAD 
  
 WLP10    ZR     X5,EXIT.    IF END OF T.LCA
          SX0    X0+B1       LCIND = LCIND + 1
          MX6    -IA.TAGL 
          MX7    -IA.BIASL
          LX5    -IA.BIASP
          BX4    -X7*X5      BIASI = BIAS[LCI]
          LX5    IA.BIASP-IA.TAGP 
          BX3    -X6*X5      TAGI = TAG[LCI]
          RJ     KTX         CONVERT TAG
          SA6    PIK=TAG
          BX3    X4 
          KTY    24          CONVERT BIAS 
          MI     X3,WLP20    IF BIAS .LT. 0 
          SX1    1R+
          BX6    X6+X1
          LX6    -CHAR
 WLP20    SA6    A6+B1
          SX1    A0 
          PIA    ,LINEBUF    CONVERT ORGA TO DPC
          =A0    A0+1        ORGA = ORGA + 1
          MX7    -PB.TAGL 
          =X3    X0+K.LC
          BX3    -X7*X3      GET RID OF SIGN EXTENSION
          RJ     KTX         CONVERT LCIND TO A LC.N TAG
          BX1    X6 
          CALL   SFN         SPACE FILL 
          LX6    -CHAR
          SA3    B1+APLAB    *LAP*
          =A5    A5+1        LCAD = LCAD + 1,  LCI = (LCAD) 
          SA2    PIK=TAG
          RJ     PVF         PRINT  * LAP   TAG+BIAS* 
          SA4    PIK=TAG+1
          RJ     WSM         WRITE SUB MACRO
          EQ     WLP10
 WSM      SPACE  4,10 
**        WSM - WRITE SUB MACRO.
* 
*         ENTRY: A4-1, A4 _ TAG, BIAS FIELD OF INSTRUCTION, 0_L FORMAT
*                (ORGSUB) = ORIGIN COUNTER OF SUB BLOCK 
* 
*         EXIT:  SUB    TAG,BIAS   LISTED 
*                (SAVFP) = 0
* 
*         USES:  ALL BUT A5,X5
* 
*         CALLS  PIA, PVF, VFD
  
  
 WSM      SUBR   0           ENTRY/EXIT.
          SA1    SAVFP
          SA3    =1L, 
          ZR     X1,EXIT.    IF *SUB* NOT NECESSARY 
          LX4    -CHAR
          IX7    X4+X3       PREFIX WITH (,)
          SA7    A4 
          SB2    X1-1        FPNO-1 = T.FPI INDEX 
          SA1    T.FPI
          SA2    X1+B2       FETCH FPI ENTRY
          SA1    ORGSUB 
          MX7    -FP.SUBL 
          LX2    -FP.SUBP 
          BX2    -X7*X2      EXTRACT THE SUB INDEX
          SB2    X2-1 
          SX1    X1+B2
          PIA    ,LINEBUF    CONVERT SUBORG TO DPC
          SA2    T.SUB
          SA1    X2+B2       FETCH SUB ENTRY
          SB4    60 
          SB5    60 
          RJ     VFD         FORM SUB CALL DPC
          SA3    =1H+        TO INDICATE RELOCATION 
          SA6    LINEBUF+1
          LX6    X3 
          =A7    A6+1 
          =A6    A7+1 
          SA1    =10H 
          BX6    X1 
          =A2    A4-1 
          SA3    =7RSUB 
          RJ     PVF         PRINT  *    SUB    TAG,BIAS* 
          BX7    0
          SA7    SAVFP       (SAVFP) = 0
          EQ     EXIT.
 DATA     SPACE  4,10 
 ZWI      SPACE  4,10 
**        ZWI - ZERO WORD ITEM. 
* 
*         LISTS A ZERO WORD ITEM, E.G., FOR APLISTS.
* 
*         ENTRY  (X3) = LABEL FIELD.
*                (LINEBUF+0) = SET AS DESIRED (USUALLY ORIGIN). 
*                (X1) = +/- ZERO
* 
*         USES   A1-A4,A6,A7  X1-X4,X6,X7  B2-B7. 
  
  
 ZWI      SUBR   0           ENTRY/EXIT...
          IFEQ   TEST,ON,1
          NZ     X1,"BLOWUP"
          BX7    X3 
          SX6    2R0 &2R-0
          SA2    OL=LBF 
          BX3    X1*X6       ERASE ALTER-MASK IF POSITIVE ZERO
          SA7    X2 
          LX3    -2*CHAR
          SA2    =H/0 / 
          BX6    X2-X3       H/-0/  OR   H/0/ 
          SA6    A7+B1
          SB7    LINEBUF-1
          PLINE  LINEBUF,A6-B7
          EQ     EXIT.
 TLBN     SPACE  4,10 
**        TLBN - TABLE OF LOCAL BLOCK NAMES.
  
  
          MACRO  LBLK,NR,NAM
 NR  DIS    1,NAM 
          ENDM
  
  
 TLBN     BSS 
          LOC    0
          LIST   -X,G        COMSLBT IS LISTED IN REC 
*CALL     COMSLBT            DEFINE LOCAL BLOCK NAMES 
          LIST   *
 Z.LBT    BSS                NUMBER OF BLOCKS 
          LOC    *O 
 END      SPACE  4,10 
          LIST   D
          ENTRY  FIN.OL 
 FIN.OL   END                END OF (1,0) OVERLAY WHEN OLIST ON 
