Retro1.org codex

          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