*DECK     LIST
          IDENT  LIST 
 LIST     SECT   (LISTING ROUTINES -- PASS 1 = OBJECT CODE.),1
  
          SST    B,D,EXIT.
          NOREF  B,D,EXIT.
  
 B=LIST   RPVDEF             DEFINE ROUTINE FWA FOR REPRIEVE UTILITY
  
          ENTRY  FIN,PFD,PID,PIK,WCL
  
*         IN TABLES 
          EXT    LINEBUF,TS.SYM,TS.STN
          EXT    SFN
          EXT    LOCAL,COMSIZ,MOD 
*         IN FTN
          EXT    CO.ER,LOP=O
*         IN MAP
          EXT    LPS.PL 
*         IN ALLOC
          EXT    IDENT
  
*         IN PIG
          EXT    PIK=TAG,PIK=I,PIK=J,PIK=XJP,PIK=BL,PIK=PI,PIK=PS,PIKX
  
*         IN MAIN 
          EXT    WOF
  
 KIT      SPACE  4,8
**        KIT -  KONVERT INTERNAL TAG (TO DPC)
*         CONVERTS COMPILER-INVENTED TAGS (L, I, T, C, + F) TO HUMAN- 
*                READABLE FORM. 
*         ENTRY  X3 = TAG (R-JUST)
*         EXIT   X6 = DPC TAG (0L FORMAT) OF AT MOST 7 CHARACTERS 
*                            *T.NNNNN*
*                              *NNNNN* = DPC ORDINAL, LEADING ZERO SUPP 
*                            *T*       = TAG-TYPE LETTER
*                X0 = 7 
*         USES   A3  X1,X2
  
  
 KIT      SUBR               ENTRY/EXIT...
          MX1    -L.PWF 
          SX6    B0 
          BX1    -X1*X3      ISOLATE ORDINAL
          AX3    L.PWF         AND TYPE 
          SA3    X3+KITA-C.BASE/1S13
          SX0    7
 KIT1     BX2    X0*X1       ISOLATE LOWEST OCTAL DIGIT 
          AX1    3
          SX2    X2+1R0 
          BX6    X6+X2
          LX6    -6 
          NZ     X1,KIT1     IF NUMBER NOT FINISHED 
          BX6    X6+X3
          LX6    -2*6 
          EQ     EXIT.
  
 KITA     DATA   2RV.        20  VARIABLE 
          DATA   2RV=        22  VARIABLE (MORE)
          DATA   2RN.        24  STATEMENT LABEL
          DATA   2RL.        26  INVENTED LABEL 
          DATA   2RV.        30  VAR-DIM
          DATA   2RT.        32  TEMP/IND 
          DATA   2RC.        34  CONSTANT 
          DATA   2R*.        36  **** TEMP **** 
          DATA   2R*=        40  **** TEMP **** 
 KNT      SPACE  4,8
**        KNT -  KONVERT *N* TAG TO DPC 
*         ENTRY  X3 = N-TAG (R-JUST)
*         EXIT   X6 = DPC STATEMENT LABEL (0L FORMAT) WITH A PERIOD 
*                            ADDED AS THE FIRST CHARACTER.
*                            AT MOST 6 CHARACTERS.
*         USES   A1  X2  B7 
  
  
 KNT      SUBR               ENTRY/EXIT...
          SA1    TS.STN 
          SB7    X3-C.STAT-1
          SA1    X1+B7       FETCH TS.STAT ENTRY
          MX2    6
          AX1    P.STN       DISCARD LOW-ORDER GARBAGE
 KNT1     BX6    X2*X1       ISOLATE LEADING CHARACTER
          LX1    6
          ZR     X6,KNT1     IF NO SIGNIFICANT CHARACTER YET
          SX2    2R.*-1R* 
          BX6    X1+X2
          LX6    -2*6 
          EQ     EXIT.
 KTX      SPACE  4,8
**        KTX -  KONVERT TAG TO EXTERNAL FORMAT 
*         SIMILIAR TO *KIT*, BUT CONVERTS TO A PROGRAMMER SYMBOL WHERE
*                POSSIBLE.
*         ENTRY  (X3) = TAG (R-JUST, ZERO FILL) 
*         EXIT   (X6) = DPC CONVERSION (L-JUST, ZERO FILL, 9 CHAR MAX)
*                (X0) = 7.
*         USES   A1,A2,A3,A6  B2,B7  X0,X4,X6 
  
  
 KTX      SUBR               ENTRY/EXIT...
          LX3    -L.PWF 
          SX0    7
          SB7    X3-C.BASE/1S13 
          SX2    X3-C.END/1S13-1
          LX3    L.PWF       RESTORE X3 
          BX6    X3 
          MI     B7,KTXK     IF SHORT CONSTANT (POSITIVE) 
          PL     X2,KTXK     IF SHORT CONSTANT (NEGATIVE) 
  
          JP     B7+*+1 
*                       2 2 2 2 3 3 3 3 4 
*                       0 2 4 6 0 2 4 6 0 
          ECHO   1,TYP=(V,V,N,L,A,T,C,Z,Z)
          EQ     KTX_TYP
  
*         CONVERT AN INTERNAL TAG 
  
 KTXZ     BSS    0           **** TEMP **** 
 KTXL     BSS    0           26 
 KTXC     BSS    0           34 
 KTXA     BSS    0           30 
          RJ     KIT         KONVERT INVENTED TAG 
          EQ     EXIT.       EXIT.. 
  
  
**        CONVERT INDIRECT/TEMP TAGS   (30) 
*                PREFIX THEM WITH *=S*. 
  
  
 KTXT     BSS    0           (30) 
          RJ     KIT         KONVERT INTERNAL TAG 
          SX4    2R=S 
          BX6    X6+X4
          LX6    -2*CHAR
          EQ     EXIT.       EXIT.. 
  
  
**        CONVERT VARIABLE TAG         (20, 22) 
*                WILL PREFIX TAG WITH *=X* IF *EXT* BIT IS SET IN THE 
*                SYMBOL TABLE ENTRY.
  
  
 KTXV     SA1    TS.SYM 
          SB2    X6-C.SYM-1  ORDINAL OF TAG 
          MX2    L.SYM
          SA3    X1+B2
          BX6    X2*X3      SYMBOL
          SA2    A3+B1       TAG
          IFBIT  X2,-EXT,EXIT.
          SA1    =XCO.TBK 
          IFBIT  X2,-BEF/EXT,KTXV1  IF NOT BEF
          MI     X1,KTXV1    IF TRACEBACK ON
          MX0    -L.JPADF 
          SBIT   X2,JPADF/BEF+1 
          BX2    -X0*X2 
          SB7    X2 
          SX1    1R"EXT"
          LX2    X1,B7
          BX6    X6+X2       APPEND SPECIAL CHARACTER 
 KTXV1    SX1    2R=X 
          BX6    X1+X6
          LX6    -2*CHAR     PREFIX EXTERNALS WITH *=X* 
          EQ     EXIT.       EXIT.. 
  
  
**        CONVERT STATEMENT LABEL TAG  (24).
  
  
 KTXN     RJ     KNT         KONVERT *N* TAG
          EQ     EXIT.       EXIT.. 
  
  
**        CONVERT SHORT CONSTANTS      (0-17,42-77) 
  
  
 KTXK     LX3    -18         SIGN EXTEND
          AX3    -18
          RJ     KTY         CONVERT SHORT CONSTANT 
          EQ     EXIT.
 KTY      SPACE  4,8
**        KTY -  CONVERT SHORT CONSTANTS FOR OBJECT LIST. 
* 
* 
*         ENTRY  (X3) = CONSTANT, RIGHT JUSTIFIED IN BITS (23-00).
*                       IF BIT (2**23) IS SET, CONSTANT IS ASSUMED TO BE
*                       NEGATIVE, AND CONVERSION WILL HAVE A LEADING
*                       MINUS SIGN. 
*                (X0) = 7.
* 
*         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. 
*                (X0) = 7.
* 
*         USES   X1-X3,X6 
  
  
 KTY      SUBR               ENTRY/EXIT...
          LX3    -L.LBIAS 
          AX3    -L.LBIAS    SIGN EXTEND
          BX2    X3 
          AX2    L.LBIAS     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    X0*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.
 PFD      SPACE  4,8
**        PFD    - PRINT FILE DESCRIPTION MACROS
* 
*         ENTRY  (A4) = TAG WORD
*         EXIT   (X6) = FILE NAME 
*                (X4) = BITS 18-36 OF TAG - RIGHT JUSTIFIED 
*                FILE DESCRIPTOR PRINTED
*         USES   ALL
 PFD      BSS    0
          MI     X4,PFD20    IF EQUIVALENCED FILE 
          SX3    X4 
          RJ     KTX         CONVERT FILE BUFFER LENGTH 
          SA6    PFDA+3 
          SA2    A4+B1       FETCH RECORD DESCRIPTOR
          MI     X2,PFD10    IF NO RECORD LENGTH SPECIFIED
          SX3    X2 
          RJ     KTX         CONVERT RECORD LENGTH
          SA6    PFDA+5 
          EQ     PFD30
  
 PFD10    MX6    0
          SA6    PFDA+5 
          EQ     PFD30
  
 PFD20    SA2    =XT.FILE 
          SB7    X4 
          SA1    X2+B7       FETCH EQUIVALENCED NAME
          MX7    0           NO RECORD LENGTH 
          SA7    PFDA+5 
          BX6    X1 
          RJ     =XFFN       MANUFACTURE FILE NAME. 
          SA6    PFDA+3 
 PFD30    LX4    -2*18
          SX3    X4 
          RJ     KIT         CONVERT BUFFER TAG 
          LX4    18 
          SX1    X4 
          SA6    PFDA+1 
          PIA    ,LINEBUF    CONVERT FILE ADDRESS 
          MX3    LG.VAR*CHAR
          BX6    X3*X5
          SB4    X4 
          RJ     =XFFN       MANUFACTURE FILE NAME. 
          BX1    X6 
          LX5    X6 
          RJ     SFN         SPACE FILL 
          SA2    PFDA 
          SA6    LINEBUF+1   STORE FILE NAME IN OUTPUT LINE 
          BX6    X2 
          SA2    A2+B1
          RJ     PVF         PRINT FILE DESCRIPTOR
          SX4    B4 
          BX6    X5 
          EQ     =XPFDX      EXIT TO HEADER 
  
 PFDA     DATA   7RFILE 
          BSS    1           FILE NAME
          DATA   1L,
          BSS    1           LENGTH OR EQUIVALENCE
          DATA   1L,
          BSS    1           RECORD LENGTH
          DATA   0
 PID      SPACE  4,8
**        PID    - PRINT IDENT CARD 
* 
*         ENTRY  NONE 
*         EXIT   IDENT CARD PRINTED 
*         USES   A1-3,A6 X1-3,X6
*         CALLS  PVF
  
 PID      BSS    0
          SA1    =1H
          SA3    =7RIDENT 
          BX6    X1 
          SA6    LINEBUF
          SA6    A6+B1
          BX6    X3 
          SA2    =XIDENT
          RJ     PVF         PRINT *IDENT* CARD 
          EQ     =XPIDX      EXIT TO HEADER 
 PIK      SPACE  4,10 
**        PIK -  PRINT INSTRUCTION KONVERSION 
*         CALLED BY *PIG* TO CONVERT AND PRINT EACH OBJECT INSTRUCTION
*                IF SUCH A LISTING WAS REQUESTED. 
* 
*         ENTRY  (X5) = INSTRUCTION.
*                (A5) = INSTRUCTION.
  
 PIK      BSS    0           ENTRY...  (EXIT INTO PIG)
          BX7    0
          BX1    X5 
          MX2    L.LGH
          BX6    X2*X1
          SA7    PIK=TAG+1
          NZ     X6,PIK2     IF NO PSEUDO-INST
          BX3    X1 
          AX1    P.LI12 
          SB7    X1 
          JP     B7+*+1 
          EQ     PIK1B       0  BSS 
          EQ     PIK1CL      1  CALL
          EQ     PIK1RJ      2  RJ
          EQ     PIK1JP      3  JP
          EQ     PIK1EQ      4  EQ   (UNCONDITIONAL)
  
**  =0    PROCESS *BSS* - DEFINE LOCATION SYMBOL
  
 PIK1B    SX1    X3-C.BASE
          SA2    =1H
          BX6    X2 
          MI     X1,PIK1B4   IF NO TAG
          SX3    X3 
          RJ     KTX         CONVERT TAG TO EXTERNAL REPRESENTATION 
          BX1    X6 
          RJ     SFN         SPACE FILL 
  
 PIK1B4   SA6    LINEBUF+1
          BX1    X5 
          AX1    P.LTAG 
          SX3    X1 
          RJ     KTX         CONVERT NUMBER OF BSS-ED WORDS 
          SA1    =7RBSS 
          SB2    3*CHAR 
          LX7    X6 
          BX6    X1 
          SA7    PIK=TAG
          EQ     PIK4 
  
  
**  =1    PROCESS *CALL* - RJ WITH TRACEBACK
  
 PIK1CL   MX4    -L.TAG 
          SX6    1RT
          AX3    P.LTAG 
          SB5    PIK=PS+1 
          SB5    B7-B5
          SB5    B5+PIK=PI
          BX3    -X4*X3      ISOLATE TAG
          SA6    PIK=I+2
          EQ     PIK25
  
  
**  =2    PROCESS *RJ*   - PLAIN RJ 
  
 PIK1RJ   EQU    PIK1CL 
  
**  =3    PROCESS *JP*   - INDEXED JUMP 
  
 PIK1JP   SX6    X3+1R0 
          SA6    PIK=I
          EQ     PIK1CL 
  
  
**  =4    PROCESS *EQ*   - UNCONDITIONAL JUMP 
  
 PIK1EQ   EQU    PIK1CL 
  
**        PIK1 - BREAK OUT THE *I*, *J* AND *K* DIGITS
  
 PIK2     LX6    L.LGH
          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
  
 .76      IFEQ   .CPU,76
  
          SX4    B5-B1
          NZ     X4,PIK22    IF NOT *01* OPCODE 
          SA3    PIK=I
          SX4    X3-1R4 
          MI     X4,PIK22    IF I-FIELD LESS THAN *4* 
          SX4    X3-1R6 
          PL     X4,PIK22    IF I-FIELD GREATER THAN *5*
  
*         HERE IF R/W LCM 
  
          SA3    X3+=XPIK=LCM-1R4  FETCH INST SKELETON
          EQ     PIK23
  
 PIK22    BSS    0
  
 .76      ENDIF 
  
          SA3    B5+PIK=PS   FETCH INST SKELETON
 PIK23    PL     X3,PIK3     IF SHORT INSTRUCTION (15 BIT)
  
*         PRE-PROCESS AND CONVERT TAGS
  
          MX4    -L.TAG 
          LX1    L.TAG-3
          BX3    -X4*X1      ISOLATE TAG
 PIK25    SB3    B7          SAVE OP-CODE 
          RJ     KTX         CONVERT TAG TO EXTERNAL FORM 
          SA6    PIK=TAG
          MX4    -L.LBIAS 
          AX5    P.LBIAS
          BX3    -X4*X5 
          ZR     X3,PIK3     IF NO OFFSET 
          EQ1    B3,PIK3     IF RJ WITH TRACEBACK IN BIAS FIELD 
          RJ     KTY         CONVERT OFFSET 
          MI     X3,PIK27    IF NEGATIVE OFFSET 
          SX1    1R+
          BX6    X6+X1
          LX6    -CHAR
 PIK27    SA6    PIK=TAG+1
  
  
**        PIK3 - DO ACTUAL INSTRUCTION SKELETION CONVERSION 
  
 PIK3     SA1    =1H
          SA3    PIK=I
  
 .76      IFEQ   .CPU,76
  
          SX4    B5-B1
          NZ     X4,PIK3B    IF NOT *01* OPCODE 
          SX4    X3-1R4 
          MI     X4,PIK3B    IF I-FIELD LESS THAN *4* 
          SX4    X3-1R6 
          PL     X4,PIK3B    IF I-FIELD GREATER THAN *5*
  
*         HERE IF R/W LCM 
  
          SB5    PIK=PS+1R4 
          SB5    -B5
          SB5    X3+B5
          SB5    B5+=XPIK=LCM 
  
 PIK3B    BSS    0
  
 .76      ENDIF 
  
          SX4    B5-3 
          BX6    X1 
          MX2    -2*CHAR
          SA6    LINEBUF+1
          NZ     X4,PIK3D    IF NO X-JUMP 
          SB5    PIK=PS+1R0 
          SB5    -B5
          SB5    X3+B5
          SB5    B5+PIK=XJP 
 PIK3D    SA3    B5+PIK=PS   FETCH SKELETON 
          BX4    -X2*X3      X4 = 2R<OP-MNEMONIC> 
          LX3    59-58
          PL     X3,PIK3G    IF NO B-JUMP 
          SA1    PIK=J
          SX1    X1-1R0 
          NZ     X1,PIK3G    IF *BJ* .NE. *B0*
          SA4    B5-4+PIK=XJP 
          BX4    -X2*X4 
 PIK3G    LX4    4*6
          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*6
          SB2    4*6
 PIK3L    LX6    6
          SB2    B2-6 
          IX6    X6+X2
          NZ     B2,PIK3P    IF ASSEMBLY NOT FULL 
          SA6    A6+B1
          SB2    10*6 
          BX6    0
 PIK3P    BX1    -X0*X3 
          SA2    X1+PIK=I-1 
          LX3    4
          PL     X2,PIK3L    IF NO CONDITIONAL ITEM 
          ZR     X1,PIK5     IF END OF SKELETON 
          NZ     X2,PIK4     IF 18-BIT *K* PORTION
          BX1    -X0*X3 
          SA1    X1+PIK=I-1  FETCH CONDIT-REGISTER
          SX1    X1-1R0 
          =X2    1RB
          NZ     X1,PIK3L    IF NOT *B0*
          LX3    2*4         SKIP OVER REGISTER AND FOLLOWING SEP 
          EQ     PIK3P
  
  
**        PIK4 - 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. 
  
 PIK4     SA2    PIK=TAG
          MX0    -CHAR
 PIK4A    LX2    CHAR 
          SB0    0
          BX1    -X0*X2 
 PIK4L    LX6    CHAR 
          SB2    B2-CHAR
          LX2    CHAR 
          IX6    X6+X1
          BX1    -X0*X2 
          NZ     B2,PIK4P    IF ASSEMBLY NOT FULL 
          SA6    A6+B1
          SB2    10*CHAR
          BX6    0
 PIK4P    NZ     X1,PIK4L    IF MORE CHARACTERS 
          SA2    A2+B1
          NZ     X2,PIK4A    IF OFFSET EXISTS 
 PIK5     LX6    X6,B2       LEFT JUSTIFY ASSEMBLY
          SA6    A6+B1
          BX6    0
          SA6    A6+B1       INSURE AN END OF LINE
 PIK6     SB3    LINEBUF-1
          PLINE  LINEBUF,A6-B3
          EQ     PIKX        EXIT.. 
 PVF      SPACE  4,8
**        PVF -  PACK VARIABLE FIELD FOR LISTING. 
*         ENTRY  X2 = (A2) = (FWA OF ITEMS TO BE PACKED)
*                A6 _ FWA+1 TO WRITE FROM 
*                X6 = 7R]OP-FIELD 
*                ITEMS ARE IN 0L FORMAT, TERMINATED BY A ZERO WORD
*         USES   A1-A4,A6,A7  B2-B5,B6,B7 
  
  
 PVF      SUBR               ENTRY/EXIT...
          SB2    3*CHAR 
          MX4    -CHAR
          SB7    A6-B1
 PVF2     LX2    CHAR 
          SB0    0
          BX1    -X4*X2 
 PVF4     LX6    CHAR 
          SB2    B2-CHAR
          LX2    CHAR 
          IX6    X6+X1
          BX1    -X4*X2      ISOLATE NEXT CHARACTER 
          NZ     B2,PVF6     IF ASSEMBLY NOT FULL 
          SA6    A6+B1
          SB2    10*CHAR
          BX6    0
 PVF6     NZ     X1,PVF4     IF MORE CHARACTERS 
          SA2    A2+B1
          NZ     X2,PVF2     IF MORE ITEMS
          LX6    X6,B2
          SA6    A6+B1
          BX6    0
          SA6    A6+B1
          SB3    B7-B1
          PLINE  B7,A6-B3 
          EQ     EXIT.
 WCL      EJECT 
**        WCL -  WRITE (PSEUDO) COMPASS LISTING.
*         CALLED DURING *END* PROCESSING TO LIST EVERYTHING THAT GOES 
*         INTO THE BINARY THAT HASNT BEEN LISTED. 
  
  
 WCL      BSS    0           ENTRY... 
 WCC      SPACE  4,8
**        WCC -  LIST CONSTANT ASSIGNMENTS. 
  
  
          SA3    =XTS.CON 
          =B4    0           (B4) = ORDINAL IN CON TABLE
          SA2    =XTS=CON 
          SA5    X3          FETCH FIRST CONSTANT 
          SA0    X2          A0 = LENGTH OF TABLE 
          SA3    =XCP.PW
          SX7    8
          ZR     X3,WCC1     IF NOT IN PW MODE
          SX7    6
          SX6    1RB
          LX6    9*CHAR 
          SA6    WCCA2A 
 WCC1     SA7    =XWVBD 
          ZR     X2,WCCX     IF NOT CONSTANTS 
          PLINE  ,,1
  
 WCC2     SX3    B4+C.CON 
          RJ     KIT         KONVERT TO EXTERNAL FORMAT 
          BX1    X6 
          RJ     SFN         SPACE FILL NAME. 
          LX1    X5 
          SA6    WCCA1       +1 = TAG 
          BX6    X5 
          SB5    A5+B1
          SA6    WCCA3       +6 = DPC ECHO OF CON 
          RJ     =XWOD       CONVERT CONST TO DPC 
          SA5    B5 
          SA4    =XBA.CON 
          SA6    WCCA2       +3 = ABCDEFGHIJ
          SA7    A6+B1       +4 = KLMNOPQRST
          SX1    B4+X4
          SB4    B4+B1
          PIA    ,WCCA       CONVERT ADDRESS TO DPC 
          SA2    =XWVBD 
          PLINE  A6,X2
          SB3    A0 
          LT     B4,B3,WCC2  IF MORE CONSTANTS
 WCCX     BSS    0           EXIT.. 
 WCF      SPACE  4,8
**        WCF -  LIST *FORMATS*.
  
  
          SA3    =XTP.FMT 
          SA2    =XTP=FMT 
          SA5    X3          FETCH 1ST FORMAT 
          SA0    X2          A0 = LENGTH OF TABLE.
          SB4    B0 
          ZR     X2,WCFX     IF NO FORMATS
          PLINE  ,,1
  
**        PROCESS 1ST WORD - STATEMENT NUMBER.
  
 WCF2     SA2    WCFC 
          MX0    L.STN
          BX1    X0*X5
          LX1    9*CHAR 
          BX6    X2+X1
          SA6    WCCA1       +1 = TAG 
  
**        PROCESS CONTENTS OF FORMAT. 
  
 WCF5     BX6    X5 
          SB5    A5 
          SA6    WCCA3       +6 = DPC ECHO OF CON 
          BX1    X5 
          RJ     =XWOD       CONVERT CONTENTS 
          SA5    B5+B1
          SA4    =XBA.FMT 
          SA6    WCCA2       +3 = ABCDEFGHIJ
          SA7    A6+B1       +4 = KLMNOPQRST
          SX1    B4+X4
          PIA    ,WCCA       CONVERT ADDRESS TO DPC 
          SA2    =XWVBD 
          PLINE  A6,X2
          SA1    =1H
          MX0    8*CHAR 
          BX6    X1 
          BX3    -X0*X5 
          SA6    WCCA1       +1 = CLEAR TAG.
          SB4    B4+B1
          SB3    A0 
          EQ     B4,B3,WCFX  IF NO MORE FORMATS 
          NZ     X3,WCF5     IF MORE IN CURRENT FORMAT. 
          EQ     WCF2        CONTINUE 
 WCFX     BSS    0
 WCT      SPACE  4,8
**        WCT -  LIST OUT NUMBER OF TEMPORARIES.
  
  
          SA1    =XTEM.MAX
          SA4    =XBA.TEM 
          SA5    =8L
          SX0    7
          SX3    X1-C.TEM 
          SA1    =H*BSSD* 
          BX6    X1 
          SA6    LINEBUF+2
          ZR     X3,WCT2     IF NO TEMPS
  
          RJ     KTY         CONVERT NUMBER OF TEMPS
          SA2    KITA-C.BASE/1S13+C.TEM/1S13
          SA6    LINEBUF+3
          BX7    X2+X5
          SX1    X4 
          LX7    -2*CHAR
          =A7    LINEBUF+1
          PIA                CONVERT OCTAL DIGITS TO DPC
          =A6    A7-1 
          PLINE  A6,4,1 
          SA1    =XTEM.MAX
          SA4    =XBA.TEM 
          SX3    X1-C.TEM 
  
 WCT2     SA1    =XTG.VDIM
          SX1    X1-C.VDIM
          ZR     X1,WCTX     IF NO VAR-DIM CELLS
          IX4    X4+X3
          BX3    X1 
          RJ     KTY         CONVERT NUMBER OF VAR-DIM CELLS
          SA2    KITA-C.BASE/1S13+C.VDIM/1S13 
          BX7    X2+X5
          SA6    LINEBUF+3
          LX7    -2*CHAR
          BX1    X4 
          SA7    LINEBUF+1
          PIA                CONVERT OCTAL DIGITS TO DPC
          =A6    A7-1 
          PLINE  A6,4,1 
 WCTX     BSS    0
 WCA      SPACE  4,8
**        WCA -  LIST AP-LISTS ACTUALLY COMPILED. 
  
  
          SA1    =XTP=APL 
          SA3    =XBA.APL 
          ZR     X1,WCAX     IF NO AP-LISTS 
          SA0    X3 
          PLINE  ,,1
  
          SA2    =XTG.APL 
          SHRINK =XTT=SCR 
          ALLOC  =XTT.SCR,X2-C.PRO+1
          SA3    =XTA.PRO 
          =B6    0
          SB2    X2 
          =A4    X3-1        INITIALIZE TAG FETCH REGISTER
          SA2    =XTP.APL 
          SB3    60-18
          SA5    X2 
  
 WCA22    =A4    A4+1 
          LE     B2,WCA24    IF NO MORE TAGS
          =B2    B2-1 
          PL     X4,WCA22    IF NOT AN AP-TAG 
          LX0    X4,B1
          PL     X0,WCA22    IF NOT AN AP-TAG 
          LX6    X4,B3
          SA6    X1+B6
          =B6    B6+1        COUNT UP AP-TAGS 
          EQ     WCA22       LOOP.. 
  
 WCA24    SA3    =XTP=APL 
          LX3    -18
          BX7    X3 
          =X6    B6+1 
          SA7    X1+B6
          SHRINK =XTT=SCR,X6
          RJ     =XSRT       SORT AP-TAGS IN ADDRESS ORDER
  
 WCA3     SA1    =XTT.SCR 
          SA2    =XTT=SCR 
          MX0    -1 
          SA3    X1          FETCH AP-TAG 
          =X6    X1+1 
          LX3    18 
          IX7    X2+X0       DECREMENT LENGTH 
          SA6    A1 
          SB2    X3          ADDRESS OF THIS TAG
          SA7    A2 
          LX3    18 
          ZR     X7,WCAX     IF NO MORE AP-TAGS 
          =A4    A3+1 
          LX4    18 
          SB7    X4          ADDRESS OF NEXT TAG
          SB4    B7-B2       LENGTH OF NEXT APLIST
          SX3    X3-4S15
          RJ     KTX         KONVERT TAG TO XTERNAL FORM
          BX1    X6 
          RJ     SFN         SPACE FILL NAME (OF TAG) 
          SA2    =8LBSS    0
          SA6    LINEBUF+1
          NZ     B4,WCA4     IF NEXT TAG NOT AT SAME PLACE
          BX7    X2 
          SX1    A0 
          =A7    A6+1 
          PIA                CONVERT ADDRESS TO DPC 
          =A6    A6-1 
          SB3    LINEBUF-1
          PLINE  A6,A7-B3    * L.TAG  BSS  0* 
          EQ     WCA3 
  
 WCA4     MX0    -L.ABIAS 
          BX1    X5 
          NZ     X5,WCA42    IF NOT AN END-OF-AP-LIST ENTRY 
          SX1    A0 
          PIA                CONVERT ADDRESS TO DPC 
          SX1    2R-0-2R0 
          SX2    2R0
          BX3    X5*X1
          IX7    X2+X3
          SA6    LINEBUF
          LX7    -2*CHAR
          SX1    A6 
          SA7    LINEBUF+2
          =A5    A5+1 
          PLINE  X1,3 
          =B4    B4-1 
          =A0    A0+1 
          EQ     WCA9 
  
 WCA42    AX1    P.ABIAS
          BX7    -X0*X1      ISOLATE BIAS 
          MX0    -L.ATAG
          AX1    P.ATAG-P.ABIAS 
          BX3    -X0*X1      ISOLATE TAG
          RJ     KTX         CONVERT TAG
          SA6    WCAB 
          BX3    X7 
          RJ     KTY         CONVERT BIAS 
          MI     X3,WCA5     IF BIAS IS NEGATIVE
          SX1    1R+
          BX6    X6+X1
          LX6    -CHAR
 WCA5     SX1    X5 
          BX7    0
          SA6    A6+B1
          SA7    A6+B1
          ZR     X1,WCA8     IF NORMAL (NOT I/O) ITEM 
          BX1    X5 
          SX7    1R,
          LX1    P.IOLCM-P.ALCM   ISOLATE LCM BIT 
          LX7    -CHAR
          SA7    A7 
          SX6    1R0
          PL     X1,WCA6     IF NO LCM BIT
          SX6    1R1
 WCA6     LX6    -CHAR
          SA6    A7+B1       PUT A LCM INDICATOR IN   WCAB+3
       BX1    X5
          MX0    -L.ATYP
          AX1    P.ATYP 
          BX3    -X0*X1      ISOLATE ATYP 
          RJ     KTX         CONVERT ATYP 
          SA6    WCAC        PUT ATYP IN    WCAB+5
          MX0    -L.ASIZ
          BX3    -X0*X5 
          RJ     KTX         CONVERT SIZE 
          SA6    WCAD 
 WCA8     SX1    A0 
          SA0    A0+B1       ADVANCE ADDRESS
          PIA                CONVERT ADDRESS TO DPC 
          SA2    LINEBUF+1
          SA3    =7RAPL 
          SB4    B4-B1
          =A6    A2-1 
          BX6    X2 
          SA6    A2 
          BX6    X3 
          SA2    WCAB 
          SA5    A5+B1
          RJ     PVF         PACK VARIABLE FIELD
  
 WCA9     SA2    =1H
          BX7    X2 
          SA7    LINEBUF+1
          NZ     B4,WCA4     IF MORE ITEMS IN THIS AP-LIST
          EQ     WCA3 
 WCAX     BSS    0           EXIT.. 
 WCB      SPACE  4,8
**        WCB -  LIST I/O BUFFER ASSIGNMENTS. 
  
  
          SA1    =XMOD
          SA2    =XNARGS
          IFBIT  X1,-PPRO,WCBX
          ZR     X2,WCBX     IF NO BUFFERS
          SB4    X2 
          PLINE  ,,1
          SA1    =XTA.PRO 
          SA3    =XT.FILE 
          SA0    X1 
          SA5    X3 
  
 WCB2     SA4    A5+B1
          SB4    B4-B1
          MX0    LG.VAR*CHAR
          BX1    X0*X5
          SA5    A4+2        A5 = A5+3
          MI     X4,WCB6     IF EQUIVALENCED FILE, AVOID..
          RJ     SFN
          SA6    WCBC3       FILE NAME
          SX1    X4 
          PIA 
          SB2    B7-9*CHAR
          AX6    B2 
          SA6    WCBC2       LEFT JUSTIFIED BUFFER LENGTH 
          AX4    2*18 
          SX3    X4 
          RJ     KTX
          BX1    X6 
          RJ     SFN
          SA6    WCBC1       L-TAG
          SB7    X4-C.PRO 
          SA2    B7+A0
          SX1    X2 
          PIA    ,WCBC
          PLINE A6,6
  
 WCB6     NZ     B4,WCB2     IF MORE FILES
 WCBX     BSS    0           EXIT.. 
 WCE      SPACE  4,8
**        WCE    - LIST END LINE. 
  
  
          SA1    =XLOCAL
          SA2    =XCOMSIZ 
          IX1    X1+X2
          PIA    ,=XLPS.PL
          SA6    LINEBUF
          SA3    LOP=O
          PL     X3,WCE1     IF NO OBJECT LISTING 
          SA2    CO.ER
          ZR     X2,WCE1     IF ER=0
          SA1    =10L LEN.
          BX6    X1 
          SB2    A6 
          SA6    A6+B1
          SA1    =7RBSS      PUT A  * LEN.  BSS   0 *  BEFORE  * END *
          LX1    CHAR 
          SA3    =1R0 
          IX7    X1+X3
          LX7    2*CHAR 
          SA7    A6+B1
          BX6    0
          SA6    A7+B1
          PLINE  B2,3        B2 = FWA OF LINE TO PRINT
          SA3    LPS.PL 
          BX6    X3 
          SA6    LINEBUF
 WCE1     SA3    MOD
          SA2    =XIDENT
          SA1    =7REND 
          SBIT   X3,PPRO
          SA4    =1H
          AX3    -0 
          BX6    X4 
          BX2    X2*X3
          SA6    A6+B1
          BX6    X1 
          RJ     PVF         PRINT *END* LINE 
 WCS      SPACE  4,8
**        WCS - LIST BLOCK STATISTICS.
  
  
          SA1    =XFAILSFT
          NZ     X1,EXIT.    IF TABLES ARE CRUMBLES UP, BLOCKS ARE WRONG
  
**        PREPARE STATISTICS
  
          SA3    =XLCNT 
          SA4     =XLCP.PS
          IX3    X3-X4
          SB2    X3+12
          LE     B2,WCS1     IF SUFFICIENT ROOM LEFT ON THIS PAGE 
          SX7    X4+B1
          SA7    A3 
 WCS1     BX6    X6-X6
          SA4    =XCP.PW
          SA0    LINEBUF+2
          SA6    LINEBUF+5   STORE ZERO BYTE TERMINATOR 
          SX1    WCSA 
          SX2    3
          NZ     X4,WCS2     IF IN PW MODE
          SA3    =10H 
          SA2    X1          SHIFT TABLE HEADER FOR PW=0 FORMAT 
          SA4    X1+B1
          SA0    LINEBUF
          BX7    X3 
          SA5    A4+B1
          SA7    A0 
          BX6    X2 
          SA7    A7+B1
          SX1    A0 
          SA6    A7+B1
          BX7    X4 
          BX6    X5 
          SX2    6
          SA7    A6+B1
          SA6    A7+B1
 WCS2     PLINE  X1,X2,2     PRINT TABLE HEADER 
  
          SB4    =XN.BLK
          =X6 
          SB4    -B4
 WCS3     SA5    =XBA.PRO+8+B4 FORMAT AND PRINT TABLE 
          BX1    X5 
          PIA    ,LINEBUF+3  CONVERT BLOCK ADDRESS TO DPC 
          SA4    A5+B1
          IX1    X4-X5
          PIA    ,LINEBUF+4  CONVERT BLOCK LENGTH TO DPC
          SA2    WCSB+8+B4
          BX7    X2 
          SA7    LINEBUF+2
          SX2    A0-B1
          SX3    LINEBUF+5
          SB4    B4+B1
          IX2    X3-X2
          PLINE  A0,X2
          MI     B4,WCS3     IF MORE BLOCKS 
          EQ     =XWCLX      EXIT.. 
  
  
 WCCA     DATA   10H 123456        ADDRESS
 WCCA1    DATA   10H C.01234       TAG
          DIS    1,CON
 WCCA2    DATA   10H1234567890     VALUE, UPPER HALF
          DATA   10H1234567890     VALUE, LOWER HALF
 WCCA2A   DATA   10HB 
 WCCA3    DATA   10HABCDEFGHIJ     VALUE, EXPRESSED IN DPC
          DATA   0
  
 WCFC     VFD    CHAR/1R.,L.STN/0,24/4R 
  
 WCAB     DATA   0LTAG
          DATA   0LBIAS 
          DATA   1L,
          DATA   1L0         LCM BIT.... 0 MEANS NO LCM 
          DATA   1L,
 WCAC     DATA   1L0         TYP
          DATA   1L,
 WCAD     DATA   1L0         SIZ
          DATA   0           END OF LIST
  
 WCBC     DIS    1, 123456         ADDRESS
 WCBC1    DIS    1, L.N            L-TAG
          DIS    1,BSS
 WCBC2    DIS    1,NNNNB           LENGTH 
 WCBC3    DIS    1, LFN 
          CON    0
  
 WCSA     DATA   28C  BLOCK    ADDRESS    LENGTH
 WCSB     DIS    1,  CODE    /
          DIS    1,  LITERAL /
          DIS    1,  FORMAT  /
          DIS    1,  TEMP    /
          DIS    1,  ARG     /
          DIS    1,  NAMELIST/
          DIS    1,  VARIABLE/
          DIS    1,  BUFFER  /
          LIST   D
 FIN      END    FTN10       END OF (1,0) OVERLAY WHEN OBJECT LIST IS ON
