LIST80
          IDENT  LIST80,FETS
          ABS 
          SYSCOM B1          DEFINE (B1) = 1
          SPACE  4,10 
*COMMENT  LIST80 - COMPRESS COMPASS LISTINGS. 
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          SPACE  4,10 
          ENTRY  LIST80 
          ENTRY  RFL= 
          TITLE  LIST80 - COMPRESS COMPASS LISTINGS.
          TITLE 
***       LIST80 - COMPRESS COMPASS LISTINGS. 
*         G. R. MANSFIELD.
*         D. R. HILGREN.     79/04/25.  RESEQUENCED.
          SPACE  4,10 
***              *LIST80* READS A FILE CONTAINING LIST OUTPUT 
*         PRODUCED BY THE COMPASS COMPILER AND COMPRESSES IT TO 80
*         COLUMNS.
          SPACE  4,10 
***       CONTROL CARD CALL.
* 
*         LIST80(IFILE,OFILE,NR)
*                IFILE       FILE TO COPY FROM. 
*                OFILE       FILE TO COPY TO. 
*                NR          IF PRESENT, *IFILE* WILL NOT BE REWOUND. 
* 
*         ASSUMED PARAMETERS. 
*                IFILE = *LIST* 
*                OFILE = *OUTPUT* 
* 
*         PAGE SIZE AND PRINT DENSITY WILL BE BASED 
*         ON THE PRINT FILE TO BE PROCESSED.
* 
          SPACE  4,10 
***       DAYFILE MESSAGES. 
* 
*         * CONVERSION COMPLETE.* - *LIST80* COMPLETED. 
* 
*         * FILE NAME CONFLICT.* - *IFILE* AND *OFILE* HAVE THE SAME
*         NAME. 
* 
*         * FL TOO SHORT FOR LIST.* - NOT ENOUGH STORAGE FOR LIST.
          SPACE  4,10 
****      ASSEMBLY CONSTANTS. 
  
  
 IBUFL    EQU    2001B
 OBUFL    EQU    2001B
  
****
          SPACE  4,10 
*         COMMON DECKS. 
  
  
*CALL     COMCMAC 
*CALL     COMCCMD 
****
          TITLE  STORAGE ASSIGNMENT.
*         STORAGE ASSIGNMENT. 
  
  
          ORG    110B 
 FETS     BSS    0
  
 I        BSS    0           *IFILE*
 LIST     FILEC  IBUF,IBUFL 
  
 O        BSS    0           *OFILE*
 OUTPUT   FILEC  OBUF,OBUFL,(FET=6) 
  
 MBUF     BSS    136         WORKING READ BUFFER
 MBUFL    EQU    *-MBUF 
  
 SBUF     BSS    80          WORKING WRITE BUFFER 
 SBUFL    EQU    *-SBUF 
          BSS    10 
          SPACE  4,10 
*         PROGRAM CONSTANTS.
  
 PD       CON    1LS,0       PRINT DENSITY / CONTROL WORD 
 PL       CON    0           PAGE LENGTH
  
 BLANKS   BSS    0           BLANKS 
          DUP    10,1 
          CON    1R 
 LIST80   TITLE  LIST80 - MAIN PROGRAM. 
  
  
 LIST80   SB1    1           ENTRY
          RJ     ARG         PROCESS ARGUMENTS
 LST1     READ   I
          SX6    LSL         SET LINE LIST
          SA0    SRN         SET INITIAL LIST DISABLE 
          SA6    CKSAE+1
          EQ     LST3        READ FIRST LINE OF *IFILE* 
  
 LST2     WRITES O,SBUF,SBUFL 
 LST3     READS  I,MBUF,MBUFL 
          NG     X1,LST4     IF EOF 
          NZ     X1,LST1     IF EOR 
          SA1    MBUF 
          SX6    X1-1R1 
          ZR     X6,PEJ      IF PAGE EJECT
          SB2    A0 
          JP     B2          PROCESS LINE 
  
 LST4     WRITER O
          MESSAGE (=C* CONVERSION COMPLETE.*),3 
          ENDRUN
          TITLE  SUBROUTINES. 
 CKS      SPACE  4,10 
**        CKS - CHECK SUBTITLE. 
* 
*         EXIT TO *LST2*. 
* 
*         USES   A - 0, 1, 2, 6.
*                X - 1, 2, 4, 6, 7. 
*                B - 2. 
* 
*         MACROS MOVE.
  
  
 CKS      SA1    MBUF+8      ASSEMBLE 10 CHARACTERS 
          MX4    1
          BX6    X6-X6
 CKS1     LX6    6
          BX6    X1+X6
          LX4    6
          SA1    A1+B1
          PL     X4,CKS1     IF NOT END OF WORD 
          SA6    CKSAE
          SA2    CKSA 
          SB2    B1+B1
 CKS2     BX7    X6-X2
          SA1    A2+B1
          SA2    A2+B2
          SA0    X1 
          NZ     X7,CKS2     IF NOT SUBTITLE
          SX6    1R 
          SA6    SBUF 
          SA6    A6+B1
          MOVE   46,MBUF+8,A6+B1  MOVE SUBTITLE 
          MOVE   31,MBUF+69,SBUF+48  MOVE SUB-SUBTITLE
          EQ     LST2        WRITE LINE 
  
 CKSA     BSS    0
          CON    10HSTORAGE AL,STA
          CON    10HSYMBOLIC R,REF
          CON    10HERROR DIRE,ERD
 CKSAE    CON    0,LSL
 ERD      SPACE  4,10 
**        ERD - LIST ERROR DIRECTORY. 
* 
*         EXIT TO *LST2*. 
* 
*         USES   A - 1, 6.
*                X - 1, 6.
*                B - 2, 3, 4. 
* 
*         MACROS MOVE.
  
  
 ERD      SA1    MBUF+16
          SX6    X1-1R
          ZR     X6,ERD1     IF NOT TYPE EXPLANATION
          MOVE   16,MBUF+12,SBUF
          MOVE   64,MBUF+40,SBUF+16 
          EQ     LST2        WRITE LINE 
  
 ERD1     MOVE   21,MBUF+19,SBUF
          SB2    9           NUMBER OF FIELDS TO MOVE 
          SB3    MBUF+44
          SB4    SBUF+21
 ERD2     MOVE   6,B3,B4     MOVE FIELD 
          SB3    B3+10
          SB4    B4+6 
          SB2    B2-1 
          NZ     B2,ERD2     IF NOT END OF LINE 
          MOVE   4,BLANKS,SBUF+75  CLEAR LAST PART OF LINE
          SX6    LSL
          SA6    CKSAE+1     RESET LINE LIST
          EQ     LST2        WRITE LINE 
 LSL      SPACE  4,10 
**        LSL - LIST LINE.
* 
*         EXIT TO *LST2*. 
* 
*         USES   A - 0, 1, 2, 6, 7. 
*                X - 1, 2, 3, 4, 6, 7.
*                B - 2. 
* 
*         MACROS MOVE.
  
  
 LSL      MOVE   7,MBUF+7,SBUF+1  LOCATION FIELD
          MOVE   64,MBUF+40,SBUF+8  CARD IMAGE
          MOVE   6,MBUF+120,SBUF+72  SEQUENCE NUMBER
          SA1    MBUF+1      FIRST ERROR CODE (IF ANY)
          MX4    1
          BX6    X1 
          SA6    SBUF+1 
          SA1    MBUF+112    ASSEMBLE CARD NAME 
          SB2    X1-1R
          ZR     B2,LSL2     IF BLANK NAME
          BX6    X6-X6
          LX4    3*6
          SA2    LSLA 
 LSL1     LX6    6
          BX6    X6+X1
          LX4    6
          SA1    A1+B1
          PL     X4,LSL1     IF NOT END OF WORD 
          BX3    X2-X6
          ZR     X3,LSL2     IF SAME CARD NAME
          SA6    A2          SET NEW NAME 
          SX7    1R 
          SA7    SBUF+65
          MOVE   7,MBUF+112,SBUF+66 
 LSL2     SA1    MBUF+40     CHECK CARD TYPE
          SX6    X1-1R* 
          SB2    X1-1R, 
          ZR     X6,LST2     IF COMMENT 
          ZR     B2,LST2     IF CONTINUATION
          SA1    MBUF+50     ASSEMBLE OPCODE
          MX4    1
          BX6    X6-X6
          SA2    LSLB 
          LX4    3*6
 LSL3     LX6    6
          BX6    X6+X1
          LX4    6
          SA1    A1+B1
          PL     X4,LSL3     IF NOT END OF WORD 
          BX7    X2-X6
          ZR     X7,LSL5     IF *END* 
 LSL4     SA2    A2+B1
          BX7    X2-X6
          ZR     X2,LST2     IF EOL 
          NZ     X7,LSL4     IF NOT *EQU* TYPE
          MOVE   7,MBUF+29,SBUF 
          SX6    1R 
          SA6    SBUF 
          EQ     LST2        WRITE LINE 
  
*         PROCESS STATISTICS. 
  
 LSL5     SA0    LSL6        SET STATISTICS LIST
          SX6    A0+
          SA6    CKSAE+1
          EQ     LST2        WRITE LINE 
  
 LSL6     MX4    1           CHECK FOR NEW IDENT
          SA1    MBUF+50
          BX6    X6-X6
          LX4    3*6
          SA2    LSLC 
 LSL7     LX6    6
          BX6    X1+X6
          LX4    6
          SA1    A1+B1
          PL     X4,LSL7     IF NOT YET 7 CHARACTERS
          SX7    LSL
          BX6    X6-X2
          NZ     X6,LSL8     IF NOT *IDENT* 
          SA0    X7 
          SA7    CKSAE+1
          EQ     LSL         PROCESS IDENT
  
 LSL8     MOVE   75,MBUF+27,SBUF
          MOVE   5,BLANKS,SBUF+75 
          EQ     LST2        WRITE LINE 
  
 LSLA     CON    1H 
  
 LSLB     BSS    0
          CON    7REND
 LSLC     CON    7RIDENT
          CON    7REQU
          CON    7RSET
          CON    7RDUP
          CON    7RMAX
          CON    7RMIN
          CON    7RCOL
          CON    7RBASE 
          CON    0
 PEJ      SPACE  4,10 
**        PEJ - PROCESS EJECT.
* 
*         EXIT   (A0) = LINE PROCESSOR. 
*                EXIT TO *LST2*.
* 
*         USES   A - 0, 1, 6, 7.
*                X - 1, 6, 7. 
* 
*         MACROS MOVE.
  
  
 PEJ      SA0    CKS         SET SUBTITLE CHECK 
          SX6    1R1         SET EJECT
          SX7    1R 
          SA6    SBUF 
          SA7    A6+1 
          MOVE   46,MBUF+8,A7+B1  TITLE 
          MOVE   21,MBUF+89,SBUF+47  DATE/TIME
          MOVE   5,MBUF+115,SBUF+68  * PAGE*
          MOVE   7,MBUF+121,SBUF+73  PAGE NUMBER
          SA1    =1H         CLEAR CARD NAME
          BX6    X1 
          SA6    LSLA 
          SA1    PD+1        GET *PD* CONTROL WORD
          BX6    X6-X6       DISABLE USE OF *PD*
          SA6    A1 
          WRITEW O,PD,X1     WRITE PRINT DENSITY FORMAT CONTROL 
          EQ     LST2        WRITE LINE 
 REF      SPACE  4,10 
**        REF - LIST CROSS REFERENCE TABLE. 
* 
*         EXIT TO *LST2*. 
* 
*         USES   A - 1, 6.
*                X - 1, 6.
*                B - 2, 3, 4. 
* 
*         MACROS MOVE.
  
  
 REF      SA1    MBUF+67
          SX6    X1-1R= 
          NZ     X6,REF1     IF NOT QUALIFIER LINE
          MOVE   30,MBUF+50,SBUF+18 
          EQ     LST2        WRITE LINE 
  
 REF1     MOVE   9,MBUF+7,SBUF  SYMBOL NAME 
          MOVE   7,MBUF+17,SBUF+9  SYMBOL VALUE 
          SB3    MBUF+42
          SB2    8           NUMBER OF FIELDS TO MOVE 
          SB4    SBUF+16
 REF2     MOVE   8,B3,B4     MOVE FIELD  *PPP/LL F* 
          SB3    B3+10
          SB4    B4+8 
          SB2    B2-1 
          NZ     B2,REF2     IF NOT END OF LINE 
          SX6    LSL         RESET LINE LIST
          SA6    CKSAE+1
          EQ     LST2        WRITE LINE 
 SRN      SPACE  4,10 
**        SRN - SET RECORD NAME.
* 
*         EXIT TO *LST3*. 
* 
*         USES   A - 1, 6.
*                B - 3. 
*                X - 1, 4, 6. 
* 
*         MACROS MESSAGE. 
  
  
 SRN      SA1    MBUF 
          SB3    X1-1RS 
          ZR     B3,SRN2     IF 6 LPI PRINT DENSITY IMAGE 
          EQ     B3,B1,SRN2  IF 8 LPI PRINT DENSITY IMAGE 
          SX6    B0 
          MX4    10 
 SRN1     LX6    6
          BX6    X6+X1
          LX4    1
          SA1    A1+B1
          NG     X4,SRN1     IF NOT 7 CHARACTERS CHECKED
          LX6    -6 
          SA6    SRNA+1 
          MESSAGE  A6-B1,1
          EQ     LST3        READ NEXT LINE 
  
 SRN2     SX6    X1 
          LX6    -6 
          SA6    PD 
          EQ     LST3        READ NEXT LINE 
  
 SRNA     DATA   10HCONVERTING
          DATA   0,0
 STA      SPACE  4,10 
**        STA - LIST STORAGE ALLOCATION.
* 
*         EXIT TO *LST2*. 
* 
*         USES   A - 1. 
*                X - 1, 6.
* 
*         MACROS MOVE.
  
  
 STA      SA1    MBUF+26     CHECK LINE TYPE
          SX6    X1-1R
          ZR     X6,STA1     IF NOT ALLOCATION
          MOVE   76,MBUF+18,SBUF
          EQ     LST2        WRITE LINE 
  
 STA1     MOVE   76,MBUF+38,SBUF
          EQ     LST2        WRITE LINE 
          SPACE  4,10 
**        COMMON DECKS. 
  
  
*CALL     COMCCIO 
*CALL     COMCMVE 
*CALL     COMCRDS 
*CALL     COMCRDW 
*CALL     COMCSYS 
*CALL     COMCWTS 
*CALL     COMCWTW 
 BUFFERS  SPACE  4,10 
**        BUFFERS.
  
  
 ENDS     BSS    0
          USE    // 
 IBUF     BSS    IBUFL
 OBUF     BSS    OBUFL
 END      BSS    0
 RFL=     BSS    0
          USE    *
 ARG      SPACE  4,10 
**        ARG - PROCESS ARGUMENTS.
* 
*         USES   A - 1, 2, 6, 7.
*                X - 0, 1, 2, 3, 4, 6, 7. 
*                B - 2, 7.
* 
*         CALLS  IPP. 
* 
*         MACROS ABORT, MESSAGE, REWIND.
  
  
          ORG    IBUF 
          SEG 
  
 ARG5     NZ     X0,ARG6     IF NO REWIND 
          REWIND I
 ARG6     RJ     IPP         INITIALIZE PAGE PARAMETERS 
  
 ARG      SUBR               ENTRY/EXIT 
          SX7    A0-END      CHECK FL 
          PL     X7,ARG1     IF ENOUGH FIELD LENGTH 
          MESSAGE  ARGA      * FL TOO SHORT FOR LIST, NEED XXXXB.*
          ABORT              ABORT
  
 ARG1     SB2    IBUF        SPLIT FL BETWEEN BUFFERS 
          BX0    X0-X0       CLEAR NO REWIND
          SX1    A0-B2
          AX1    1
          SX6    X1+B2       LIMIT FOR I = FIRST FOR O
          SX7    A0+         LIMIT FOR O = FL 
          SA6    I+4
          SA7    O+4
          SA6    A7-B1
          SA6    A6-B1
          SX7    B1 
          LX7    18 
          BX6    X6+X7       SET FET SIZE TO 1+MINIMUM
          SA6    A6-B1
          SX7    B2          (0) = POINTER TO I BUFFER
          SA7    B0 
          SA1    ACTR        CHECK ARGUMENT COUNT 
          MX4    42 
  
*         PROCESS *IFILE* NAME. 
  
          SB7    X1 
          ZR     B7,ARG5     IF NO ARGUMENTS
          SA1    B1+B1       SET *IFILE* NAME 
          SA2    I
          BX7    X4*X1
          SX3    X2 
          ZR     X7,ARG2     IF BLANK ARGUMENT
          IX7    X7+X3
          SA7    A2 
  
*         PROCESS *OFILE* NAME. 
  
 ARG2     SB7    B7-B1
          ZR     B7,ARG4     IF 1 ARGUMENT
          SA1    A1+B1       SET *OFILE* NAME 
          SA2    O
          BX7    X4*X1
          ZR     X7,ARG3     IF BLANK ARGUMENT
          IX7    X7+X3
          SA7    A2 
  
*         CHECK FOR NO REWIND.
  
 ARG3     SX0    B7-B1
  
*         CHECK FILE NAMES. 
  
 ARG4     SA1    I           CHECK FILE NAMES 
          SA2    O
          BX7    X1-X2
          AX7    18 
          NZ     X7,ARG5     IF *IFILE* NE. *OFILE* 
          MESSAGE  ARGB      * FILE NAME CONFLICT.* 
          ABORT              ABORT
  
 .1       OCTMIC ENDS+END-IBUF+20 
 ARGA     DATA   C* FL TOO SHORT FOR LIST, NEED ".1"B.* 
  
 ARGB     DATA   C* FILE NAME CONFLICT.*
IPP       SPACE  4,15 
**        IPP - INITIALIZE PAGE PARAMETERS. 
* 
*         ENTRY  NONE.
* 
*         EXIT   PRINT DENSITY SET UP IF NOT TTY. 
* 
*         USES   A - 6. 
*                B - NONE.
*                X - 2, 6.
* 
*         CALLS  STF. 
* 
*         MACROS GETPP. 
  
  
 IPP      SUBR               ENTRY/EXIT 
          SX2    O           FET ADDRESS OF PRINT FILE
          RJ     STF
          ZR     X6,IPPX     IF TTY PRINT FILE
          GETPP  IPPA,PL,PD 
          SX6    B1+
          SA6    PD+1        SET CONTROL WORD TO USE *PD* 
          EQ     IPPX        RETURN 
  
 IPPA     BSSZ   2           GETPAGE RESPONSE BLOCK 
          SPACE  4,5
*         COMMON DECKS FOR PRESET.
  
*CALL     COMCCPM 
*CALL     COMCSTF 
  
          END 
