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