Retro1.org codex

          IDENT  COPYC,FETS
          ABS
          ENTRY  COPYSBF
          ENTRY  COPYCF
          ENTRY  SCOPY
          ENTRY  COPYCR
          ENTRY  NPC=
          ENTRY  RFL=
          ENTRY  SSM=
          SYSCOM B1          DEFINE (B1) = 1
*COMMENT  COPYC - CODED FILE COPIES.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
          TITLE  COPYC - CODED FILE COPIES.
          SPACE  4
***       COPYC - CODED FILE COPIES.
*         G. R. MANSFIELD.  70/11/25.
          SPACE  4
***       DAYFILE MESSAGES.
*
*         * COPY COMPLETE.* = INFORMATIVE MESSAGE INDICATING COPY
*         COUNT WAS EXHAUSTED BEFORE EOI REACHED.
*
*         * EOI ENCOUNTERED.* = INFORMATIVE MESSAGE INDICATING END
*         OF INFORMATION WAS ENCOUNTED BEFORE THE COPY COUNT WAS
*         EXHAUSTED.
*
*         *INCORRECT CHARACTER NUMBER.* = INCORRECT FIRST/LAST
*         CHARACTER NUMBER SPECIFIED.
*
*         *INCORRECT COUNT.* = OPTIONAL RECORD/FILE COUNT INCORRECT
*         FORMAT.
*
*         * NO LINE TERMINATOR AT EOR(S).* = NO LINE TERMINATOR WAS
*         FOUND FOR THE LAST LINE OF A RECORD(S) (RECORD NOT Z-TYPE
*         DATA).  THE LINE TERMINATOR IS ADDED, AND THE JOB IS ABORTED
*         IF THE *NA* PARAMETER IS NOT SPECIFIED.
*
*         * NNNN LINE(S) TRUNCATED.* = INFORMATIVE MESSAGE INDICATING
*         NNNN LINES WERE TRUNCATED DURING COPYING.
*
*         *TOO MANY PARAMETERS.* = MORE THAN SIX PARAMETERS WERE
*         SPECIFIED ON A *COPYCF* OR *COPYCR* CALL, OR MORE THAN
*         ELEVEN ON AN *SCOPY* CALL.
*
*         *INCORRECT LINE NUMBER SPECIFICATION.* = INCORRECT
*         FIRST/LAST LINE NUMBER SPECIFIED.
*
*         *INCORRECT REWIND SPECIFICATION.* = REWIND PARAMETER
*         NOT *R* OR OMITTED.
*
*         *INCORRECT STRUCTURE SPECIFICATION.* = STRUCTURE
*         PARAMETER NOT *NS* OR OMITTED.
*
*         *INCORRECT CHARACTER SET SPECIFICATION.* = CHARACTER
*         SET PARAMETER NOT *D* OR OMITTED.
          SPACE  4
****      ASSEMBLY CONSTANTS.
 
 
 LINL     EQU    500D        WORKING BUFFER LENGTH (6-BIT CHARACTERS)
 BUFL     EQU    LINL+1      WORKING BUFFER LENGTH + 1
 IBUFL    EQU    2001B       IFILE BUFFER LENGTH
 OBUFL    EQU    2001B       OFILE BUFFER LENGTH
****
 
 
*         SPECIAL ENTRY POINTS.
 
 NPC=     EQU    0           FORCE OPERATING SYSTEM PARAMETER FORMAT
 
 SSM=     EQU    0           SUPPRESS DUMPS OF FIELD LENGTH
 
*CALL     COMCMAC
          TITLE  COMMON DATA
 DATA     SPACE  4
 
 
          ORG    120B
 FETS     BSS    0
 
 I        BSS    0
 INPUT    RFILEC IBUF,IBUFL,(FET=8)
 
 O        BSS    0
 OUTPUT   RFILEC OBUF,OBUFL,(FET=8)
 
 CT       CON    1           COUNT
 SK       CON    0           SKIP FLAG
 FC       CON    0           FIRST CHARACTER
 LC       CON    136         LAST CHARACTER
 LTC      CON    0           COUNT OF LINES TRUNCATED
 NA       CON    0           NO-ABORT FLAG
 NZ       CON    0           NON Z-TYPE DATA FLAG
 FL       CON    0           FIRST LINE NUMBER
 LL       CON    -1          LAST LINE NUMBER
 NS       CON    0           STRUCTURE REPORTING FLAG
 AS       CON    0           ASCII8 FLAG
 AF       CON    0           ASCII8 WITH FORMAT EFFECTORS FLAG
 LN       CON    0           LINE NUMBER ERROR MESSAGE FLAG
 SC       CON    0           *SCOPY* FLAG
 FCNT     CON    0           FILE COUNT
 RCNT     CON    0           RECORD COUNT
          TITLE  MAIN PROGRAMS.
 COPYCF   SPACE  4,25
***       COPYCF (IFILE,OFILE,N,FCHAR,LCHAR,NA)
*
*
*         COPYCF COPIES FILES FROM MEDIUM TO MEDIUM IN CODED MODE.
*         FILES ARE TREATED AS 6-BIT CHARACTER DATA WITH A MAXIMUM
*         LINE LENGTH DEFINED BY THE CONSTANT *LINL* (500) .
*
*                IFILE       INPUT FILE NAME.
*                OFILE       OUTPUT FILE NAME.
*                N           NUMBER OF FILES TO COPY.
*                FCHAR       FIRST CHARACTER TO COPY.
*                LCHAR       LAST CHARACTER TO COPY.
*                NA          DO NOT ABORT IF RECORD NOT Z-TYPE DATA.
*
*         IF IFILE = OFILE, FILES ON IFILE ARE SKIPPED.
*
*         ASSUMED PARAMETERS.
*                IFILE = *INPUT*
*                OFILE = *OUTPUT*
*                N = 1
*                FCHAR = 1
*                LCHAR = 136
*                NA  NOT SPECIFIED.
 
 
 COPYCF   BSS    0           ENTRY
          SB1    1           (B1) = 1
          RJ     PRS         PRESET PROGRAM
          RJ     SCC         SET CHARACTER COUNTS
          NZ     B7,ERR3     IF TOO MANY ARGUMENTS
          SX0    0           INITIALIZE LINE TRANSFER COUNT
 
 CCF1     READ   I           BEGIN READ
          RECALL O
          READS  I,BUF,-BUFL
          RJ     CPR         COPY RECORD
          NG     X1,ITM      IF EOI
          ZR     X1,CCF1     LOOP TO EOF
          SA2    CT          DECREMENT COUNT
          SX6    X2-1
          SA6    A2
          NZ     X6,CCF1     LOOP FOR ALL FILES
          EQ     ITM         TERMINATE PROGRAM
 COPYCR   SPACE  4,25
***       COPYCR (IFILE,OFILE,N,FCHAR,LCHAR,NA)
*
*
*         COPYCR COPIES RECORDS FROM MEDIUM TO MEDIUM IN CODED MODE.
*         FILES ARE TREATED AS 6-BIT CHARACTER DATA WITH A MAXIMUM
*         LINE LENGTH DEFINED BY THE CONSTANT *LINL* (500) .
*
*                IFILE       INPUT FILE NAME.
*                OFILE       OUTPUT FILE NAME.
*                N           NUMBER OF RECORDS TO COPY.
*                FCHAR       FIRST CHARACTER TO COPY.
*                LCHAR       LAST CHARACTER TO COPY.
*                NA          DO NOT ABORT IF RECORD NOT Z-TYPE DATA.
*
*         IF IFILE = OFILE, RECORDS ON IFILE ARE SKIPPED.
*
*         ASSUMED PARAMETERS.
*                IFILE = *INPUT*
*                OFILE = *OUTPUT*
*                N = 1
*                FCHAR = 1
*                LCHAR = 136
*                NA  NOT SPECIFIED.
 
 
 COPYCR   BSS    0           ENTRY
          SB1    1           (B1) = 1
          RJ     PRS         PRESET PROGRAM
          RJ     SCC         SET CHARACTER COUNTS
          NZ     B7,ERR3     IF TOO MANY ARGUMENTS
          SX0    0           INITIALIZE LINE TRANSFER COUNT
 
 CCR1     READ   I           BEGIN READ
          RECALL O
          READS  I,BUF,-BUFL
          RJ     CPR         COPY RECORD
          NG     X1,ITM      IF EOI
          SA2    CT          DECREMENT COUNT
          SX6    X2-1
          SA6    A2
          NZ     X6,CCR1     LOOP FOR ALL RECORDS
          EQ     ITM         TERMINATE PROGRAM
 COPYSBF  SPACE  4,20
***       COPYSBF (IFILE,OFILE,N,NA)
*
*
*         COPYSBF COPIES FILES FROM MEDIUM TO MEDIUM IN BINARY MODE,
*         SHIFTING EACH LINE IMAGE 1 CHARACTER TO THE RIGHT AND ADDING
*         A LEADING SPACE.  A PAGE EJECT IS WRITTEN AT THE BEGINNING
*         OF EACH RECORD.
*
*                IFILE       INPUT FILE NAME.
*                OFILE       OUTPUT FILE NAME.
*                N           NUMBER OF FILES TO COPY.
*                NA          DO NOT ABORT IF RECORD NOT Z-TYPE DATA.
*
*         ASSUMED PARAMETERS.
*                IFILE = *INPUT*
*                OFILE = *OUTPUT*
*                N = 1
*                NA  NOT SPECIFIED.
 
 
 COPYSBF  BSS    0           ENTRY
          SB1    1           (B1) = 1
          RJ     PRS         PRESET PROGRAM
          RJ     CNA         CHECK FOR *NO ABORT* PARAMETER
          NZ     B7,ERR3     IF TOO MANY PARAMETERS
          SX6    -1          SET CHARACTER -1
          SA6    FC
          SX7    LINL        SET MAXIMUM LINE LENGTH
          SA7    LC
          SA1    I           SET BINARY OPERATION
          SA2    O
          SX3    2
          BX6    X1+X3
          BX7    X2+X3
          SA6    A1
          SA7    A2
          SX0    0           INITIALIZE LINE TRANSFER COUNT
 
 CSF1     READ   I           BEGIN READ
          RECALL O
          READS  I,BUF,-BUFL
          NZ     X1,CSF3     IF EOR, EOF, OR EOI
          SA2    SK
          NZ     X2,CSF2     IF SKIP SET
          SB7    BUF+BUFL    LWA+1 OF BUFFER
          NE     B6,B7,CSF1.1  IF BUFFER NOT FULL
          SA1    LTC         INCREMENT TRUNCATION COUNT
          SX3    B1
          IX7    X1+X3
          SA7    A1          UPDATE COUNT
          SB6    B6-B1       DECREMENT CHARACTER COUNT
 CSF1.1   SX6    1R1         SET PAGE EJECT
          SB5    B6-BUF+1    GET NUMBER OF CHARACTERS IN BUFFER
          SA6    BUF-1
          WRITES O,BUF-1,B5  OUTPUT LINE
          SX6    1R          CLEAR EJECT
          SA6    BUF-1
          SX1    B1
          IX0    X0+X1       SHOW LINE WRITTEN OUT ALREADY
 CSF2     READS  I,BUF,-BUFL COPY REMAINDER OF RECORD
 CSF3     RJ     CPR
          NG     X1,ITM      IF EOI
          ZR     X1,CSF1     LOOP TO EOF
          SA2    CT          DECREMENT COUNT
          SX6    X2-1
          SA6    A2
          NZ     X6,CSF1     LOOP FOR ALL FILES
          EQ     ITM         TERMINATE PROGRAM
 SCOPY    SPACE  4,25
***       SCOPY(IFILE,OFILE,N,FCAR,LCAR,NA,R,FCS,FLINE,LLINE,NS)
*
*
*         *SCOPY* (STRUCTURE COPY) IS SIMILAR TO *COPYCF*, WITH EXTRA
*         PARAMETERS.  THE FIRST SIX PARAMETERS ARE EXPLAINED IN THE
*         *COPYCF* HEADER.  THE EXTRA PARAMETERS ARE AS FOLLOWS.
*
*         R      REWIND BOTH INPUT AND OUTPUT FILES.
*         FCS    FILE CHARACTER SET -
*                D, BLANK, OR OMITTED = 6/12 DISPLAY CODE.
*         FLINE  LINE NUMBER OF FIRST LINE TO COPY.
*         LLINE  LINE NUMBER OF LAST LINE TO COPY.
*         NS     NO STRUCTURE REPORTING.
*
*         DEFAULT VALUES (IF PARAMETER OMITTED) -
*
*                N           -1 (COPY TO EOI).
*                LCHAR       500 (250 6/12 CHARACTERS).
*                R           DO NOT REWIND FILES.
*                FCS         6/12 DISPLAY CODE.
*                FLINE       PRESENT POSITION, BOI IF REWIND SPECIFIED.
*                LLINE       EOI OR END OF FILE COUNT.
*                NS          REPORT FILE STRUCTURE.
 
 
 SCOPY    BSS    0           ENTRY
          SB1    1
          SX6    B1          SET *SCOPY* FLAG
          SX7    B1          SET STRUCTURE REPORTING
          SA6    SC
          SA7    NS
          SX6    500D        SET 250-CHARACTER LINE LENGTH
          SX7    -1          SET TO COPY TO EOI
          SA6    LC
          SA7    CT
          RJ     PRS         PRESET PROGRAM
          RJ     SCC         SET CHARACTER COUNTS
          RJ     SXP         SET EXTRA PARAMETERS
          EQ     CCF1        PROCESS FILE
          TITLE  SUBROUTINES.
 CPR      SPACE  4,20
**        CPR - COPY RECORD.
*
*         ENTRY  (X1) = FIRST BLOCK STATUS.
*                (X0) = NUMBER OF LINES COPIED.
*                (B6) = ADDRESS PLUS ONE OF LAST CHARACTER IN BUFFER.
*
*         EXIT   (X1) .LT. 0, IF EOI ENCOUNTERED.
*                (X1) .NE. 0, IF EOF ENCOUNTERED.
*                (X1) = 0, IF EOR ENCOUNTERED.
*
*         USES   X - 0, 1, 2, 3, 6, 7.
*                B - 5, 7.
*                A - 1, 2, 3, 7.
*
*         CALLS  SLR.
*
*         MACROS ABORT, READS, MESSAGE, WRITEF, WRITER, WRITEW.
 
 
 CPR      SUBR               ENTRY/EXIT
          BX7    X1
          SA7    CPRA        SAVE READ STATUS
          NZ     X1,CPR4     IF EOR, EOF, OR EOI
 CPR1     SA2    SK
          SX3    B1
          IX0    X0+X3       SHOW LINE COPIED
          NZ     X2,CPR3     IF SKIP SET
          SB7    BUF+BUFL    LWA+1 OF BUFFER
          NE     B6,B7,CPR1.1  IF BUFFER NOT FULL
          SA1    LTC         INCREMENT TRUNCATION COUNT
          IX7    X1+X3
          SA7    A1+         UPDATE COUNT
          SB6    B6-B1       DECREMENT CHARACTER COUNT
 CPR1.1   SA1    FC
          SA3    LC
          SB5    X1+BUF      ADDRESS OF FIRST CHARACTER TO BE OUTPUT
          GE     B5,B6,CPR9  IF FIRST CHARACTER TO COPY AFTER EOL
          SB5    X3+BUF      ADDRESS OF LAST CHARACTER TO BE OUTPUT
          LE     B5,B6,CPR2  IF LAST CHARACTER TO COPY BEFORE EOL
          SX3    B6-BUF      RESET LAST CHARACTER
 CPR2     IX6    X3-X1       NUMBER OF CHARACTERS TO BE OUTPUT
          RJ     SLR         SELECT LINE RANGE
          NG     X6,CPR3     IF LINE NOT TO BE PRINTED
          WRITES O,X1+BUF,X6
 CPR3     SA1    CPRA
          NZ     X1,CPR4.1   IF LAST READ STATUS WAS EOR/EOF/EOI
          READS  I,BUF,-BUFL
          BX7    X1
          SA7    CPRA        SAVE READ STATUS
          ZR     X1,CPR1     LOOP IF NO EOR/EOF
 CPR4     SB5    B6-BUF
          NZ     B5,CPR8     IF UNTERMINATED LINE
 CPR4.1   NG     X1,CPR6     IF EOF OR EOI
 
*         PROCESS EOR.
 
          SA2    NS          CHECK STRUCTURE PARAMETER
          ZR     X2,CPR4.2   IF STRUCTURE NOT REQUESTED
          WRITEW O,CPRB,2
 CPR4.2   SA2    SK
          NZ     X2,CPR5     IF SKIP SET
          WRITER O           END RECORD
 CPR5     SX1    B0          SET EOR STATUS
          SA3    RCNT        INCREMENT RECORD COUNT
          SX7    X3+B1
          SA7    A3
          EQ     CPRX        RETURN
 
*         PROCESS EOF AND EOI.
 
 CPR6     SA2    NS
          ZR     X2,CPR6.1   IF STRUCTURE NOT REQUESTED
          WRITEW O,CPRC,2
 CPR6.1   SA2    SK
          NZ     X2,CPR7     IF SKIP SET
          WRITEF O
 CPR7     SA2    I           CHECK FILE STATUS
          LX2    59-9
          SX1    B1          SET EOF
          SA3    FCNT        INCREMENT FILE COUNT
          SX6    X3+B1
          SA6    A3
          PL     X2,CPRX     IF NOT EOI
          SX1    -B1         SET EOI STATUS
          EQ     CPRX        RETURN
 
 CPR8     SX7    B1          SET NON Z-TYPE DATA FLAG
          SA7    NZ
          SA1    NA
          NZ     X1,CPR1     IF NO-ABORT SPECIFIED
          MESSAGE  ITMD,0    ISSUE NO LINE TERMINATOR MESSAGE
          ABORT
 
 CPR9     WRITEW O,(=1L ),B1 ISSUE NULL LINE
          EQ     CPR3        CONTINUE RECORD COPY
 
 
 CPRA     CON    0           LAST READ STATUS
 CPRB     DATA   C*--EOR--    *
 CPRC     DATA   C*--EOF--    *
 ITM      SPACE  4,15
**        ITM - ISSUE TERMINATION MESSAGES.
*
*         ENTRY  (LTC) = NUMBER OF LINES TRUNCATED.
*                (X1) = -1 IF EOI ENCOUNTERED.
*                     = 0 IF EOR ENCOUNTERED.
*                     = 1 IF EOF ENCOUNTERED.
*
*         EXIT   APPROPRIATE MESSAGES ISSUED TO DAYFILE.
*
*         USES   X - 1, 2, 5, 7.
*                A - 1, 2, 7.
*                B - 2, 5.
*
*         CALLS  CDD, SNM.
*
*         MACROS ENDRUN, MESSAGE.
 
 
 ITM      BSS    0           ENTRY
          SX7    X1+         SAVE TERMINATION TYPE
          SA7    ITME
          SA1    X1+ITMG+1   TERMINATION TYPE
          SB5    ITMF
          SB2    1R/
          RJ     SNM         SET TERMINATION TYPE INTO MESSAGE
          SA1    LTC         GET TRUNCATION COUNT
          ZR     X1,ITM1     IF NO LINES TRUNCATED
          RJ     CDD         CONVERT TO DECIMAL DISPLAY CODE
          MX1    1           ENTER COUNT IN MESSAGE
          SB2    B2-B1
          AX1    B2
          BX1    X1*X4
          SB2    1RX
          SB5    ITMA
          RJ     SNM
          MESSAGE  ITMA,3    ISSUE LINES TRUNCATED MESSAGE
 ITM1     SA1    NZ
          ZR     X1,ITM2     IF Z-TYPE DATA
          MESSAGE  ITMD,0    ISSUE NO LINE TERMINATOR MESSAGE
 ITM2     SX1    ITMB        * EOI ENCOUNTERED.*
          SA2    ITME
          NG     X2,ITM3     IF EOI ENCOUNTERED
          SX1    ITMC        * COPY COMPLETE.*
 ITM3     MESSAGE  X1,0      ISSUE COMPLETION MESSAGE
          SA1    FCNT        FILE COUNT
          RJ     CDD         CONVERT TO DISPLAY
          SB2    B2-B1
          MX5    1
          AX1    X5,B2
          BX1    X1*X4       ZERO FILL
          SB5    ITMF
          SB2    1R+
          RJ     SNM         SET FILE COUNT INTO MESSAGE
          SA1    FCNT
          SX1    X1-1
          ZR     X1,ITM3.1   IF JUST ONE FILE
          SA1    =1LS
 ITM3.1   SB2    1R#
          RJ     SNM         SET PLURAL INTO MESSAGE
          SA1    RCNT        RECORD COUNT
          RJ     CDD         CONVERT TO DISPLAY
          SB2    B2-B1
          AX1    X5,B2
          BX1    X1*X4       ZERO FILL
          SB2    1R-
          RJ     SNM         SET RECORD COUNT INTO MESSAGE
          SA1    RCNT
          SX1    X1-1
          ZR     X1,ITM3.2   IF JUST ONE RECORD
          SA1    =1LS
 ITM3.2   SB2    1R$
          RJ     SNM         SET PLURAL INTO MESSAGE
          BX1    X0          LINE COUNT
          RJ     CDD         CONVERT TO DISPLAY
          SB2    B2-B1
          AX1    X5,B2
          BX1    X1*X4       ZERO FILL
          SB2    1R,
          RJ     SNM         SET LINE COUNT INTO MESSAGE
          SX1    B1
          IX1    X0-X1
          ZR     X1,ITM3.3   IF JUST ONE LINE
          SA1    =1LS
 ITM3.3   SB2    1R=
          RJ     SNM         SET PLURAL INTO MESSAGE
          MESSAGE ITMF
          SA2    SC          CHECK CALL
          ZR     X2,ITM4     IF NOT *SCOPY*
          MESSAGE  =0,1      CLEAR *MS1W* FOR INTERACTIVE USERS
 ITM4     ENDRUN
 
 
 ITMA     DATA   C* XXXXXXXXXX LINE(S) TRUNCATED.*
 ITMB     DATA   C* EOI ENCOUNTERED.*
 ITMC     DATA   C* COPY COMPLETE.*
 ITMD     DATA   C* NO LINE TERMINATOR AT EOR(S).*
 ITME     BSS    1           TERMINATION TYPE
 ITMF     DATA   C* ///. ++++++++++ FILE#; ---------- RECORD$; ,,,,,,,,,
,, LINE=.*
 ITMG     DATA   L*EOI*
          DATA   L*EOR*
          DATA   L*EOF*
 SLR      SPACE  4,15
**        SLR - SELECT LINE RANGE.
*
*         ENTRY  (X1) = OFFSET INTO BUF OF FIRST CHARACTER OF LINE.
*                (X6) = NUMBER OF CHARACTERS IN LINE.
*
*         EXIT   (X1) = UNCHANGED.
*                (X6) = UNCHANGED IF LINE TO BE COPIED.
*                     = -1 IF LINE TO BE SKIPPED.
*
*         USES   X - 1, 2, 3, 4, 5, 6.
*                A - 1, 2, 3, 4, 6.
*                B - 6, 7.
*
*         CALLS  DXB.
 
 
 SLR      SUBR               ENTRY/EXIT
          SA2    FL          CHECK LINE RANGE
          SA3    LL
          IX2    X2+X3
          NG     X2,SLRX     IF NO LINE RANGE SPECIFIED
          SB7    X6          SET CHARACTER COUNT
          SA6    SLRB        SAVE ENTRY CONDITION
          BX6    X1
          SA6    A6-B1
          SA1    X1+BUF      GET FIRST CHARACTER
          BX5    X5-X5       CLEAR ASSEMBLY WORD
          SB6    60
 
*         PROCESS DISPLAY CODE FILE.
 
 SLR1     SX2    X1-1R0      CHECK CHARACTER
          NG     X2,SLR2     IF NOT NUMERIC
          SX2    X1-1R+
          PL     X2,SLR2     IF NOT NUMERIC
          SB6    B6-6
          LX1    X1,B6
          BX5    X1+X5       MERGE DIGIT
          ZR     B6,SLR2     IF TEN DIGITS PROCESSED
          SB7    B7-B1
          SA1    A1+B1
          ZR     B7,SLR2     IF END OF LINE
          EQ     SLR1        CONTINUE PROCESSING
 
 SLR2     ZR     X5,SLR3     IF NO DIGITS FOUND
          RJ     DXB         TRANSLATE LINE NUMBER
          SA2    SLRB
          SA3    FL
          SA4    LL
          IX5    X6-X3
          SA1    SLRA
          IX3    X4-X6
          NG     X5,SLR3     IF LINE NOT IN RANGE
          BX6    X2
          NG     X4,SLRX     IF NO END OF RANGE SPECIFIEC
          PL     X3,SLRX     IF IN RANGE
 SLR3     SX6    -1
          EQ     SLRX        EXIT
 
 
 SLRA     CON    0           SAVE (X1)
 SLRB     CON    0           SAVE (X6)
          SPACE  4
*         COMMON DECKS.
 
 
*CALL     COMCCDD
*CALL     COMCCIO
*CALL     COMCDXB
*CALL     COMCRDS
*CALL     COMCRDW
*CALL     COMCSNM
*CALL     COMCSYS
*CALL     COMCWTS
*CALL     COMCWTW
          SPACE  4
**        BUFFERS.
 
 
 BUFFERS  BSS    0
          USE    //
          SEG
          BSS    1
 BUF      BSS    BUFL
 IBUF     BSS    IBUFL
 OBUF     BSS    OBUFL
 RFL=     BSS    0
 PRS      TITLE  PRESET.
**        PRS - PRESET PROGRAM.
*
*         EXIT   (B7) = REMAINDER ARGUMENT COUNT.
*                (A5) = LAST ARGUMENT ADDRESS.
 
 
          ORG    BUF
 PRS      SUBR               ENTRY/EXIT
          SX6    IBUF        ENTER POINTER TO INPUT BUFFER
          SA6    0
          SA1    ACTR        CHECK ARGUMENT COUNT
          MX4    42
          SB7    X1
          ZR     B7,PRSX     IF NO ARGUMENTS
 
*         PROCESS IFILE NAME.
 
          SA5    ARGR        SET IFILE NAME
          SA2    I
          BX7    X4*X5
          SX3    X2
          ZR     X7,PRS1     IF BLANK ARGUMENT
          IX7    X7+X3
          SA7    A2
 
*         PROCESS OFILE NAME.
 
 PRS1     SB7    B7-B1
          ZR     B7,PRS2     IF 1 ARGUMENT
          SA5    A5+B1       SET OFILE NAME
          SA2    O
          BX7    X4*X5
          SB7    B7-B1
          ZR     X7,PRS2     IF BLANK ARGUMENT
          IX7    X7+X3
          SA7    A2
 
*         CHECK FILE NAMES.
 
 PRS2     SA1    I           CHECK FILE NAMES
          SA2    O
          IX7    X1-X2
          NZ     X7,PRS3     IF IFILE .NE. OFILE
          SX6    B1          SET SKIP FLAG
          SA6    SK
 
*         PROCESS COUNT.
 
 PRS3     ZR     B7,PRSX     IF NO ADDITIONAL ARGUMENTS
          SA5    A5+1
          ZR     X5,PRS4     IF BLANK ARGUMENT
          RJ     DXB         CONVERT NUMBER
          NZ     X4,ERR1     IF INCORRECT COUNT
          ZR     X6,ERR1     IF COUNT = 0
          SA6    CT
 PRS4     SB7    B7-1
          EQ     PRSX        RETURN
          SPACE  4,15
**        SCC - SET CHARACTER COUNTS.
*
*         ENTRY  (A5) = ADDRESS OF LAST ARGUMENT PROCESSED.
*                (B7) = REMAINING ARGUMENT COUNT.
*
*         EXIT   (A5) = ADDRESS-1 OF NEXT ARGUMENT.
*                (B7) = REMAINING ARGUMENT COUNT.
*                (NA) = 1 IF NO-ABORT SPECIFIED.
*
*         USES   X - 1, 2, 5, 6.
*                A - 1, 2, 5, 6.
*                B - 2, 7.
*
*         CALLS  CNA, DXB.
 
 
 SCC      SUBR               ENTRY/EXIT
          ZR     B7,SCCX     IF NO REMAINING ARGUMENTS
          SA5    A5+B1       CHECK START CHARACTER
          ZR     X5,SCC2     IF BLANK
          RJ     DXB
          NZ     X4,ERR2     IF INCORRECT COUNT
          ZR     X6,ERR2     IF FIRST CHARACTER COUNT = ZERO
          SB2    X6-BUFL-1
          PL     B2,ERR2     IF FIRST OUT OF RANGE
          SX6    X6-1
          SA6    FC
 SCC2     SB7    B7-B1
          ZR     B7,SCC3     IF NO ADDITIONAL COUNTS
          SA5    A5+B1       CHECK TERMINAL CHARACTER
          ZR     X5,SCC2.1   IF BLANK
          RJ     DXB
          NZ     X4,ERR2     IF INCORRECT COUNT
          SB2    X6-BUFL-1
          PL     B2,ERR2     IF LAST OUT OF RANGE
          SA6    LC
 SCC2.1   SB7    B7-B1       DECREMENT ARGUMENT COUNT
 SCC3     SA1    FC          CHECK CHARACTER LIMITS
          SA2    LC
          IX6    X2-X1
          NG     X6,ERR2     IF FIRST .GT. LAST
          RJ     CNA         CHECK FOR *NA* PARAMETER
          EQ     SCCX        RETURN
 CNA      SPACE  4,10
**        CNA - CHECK FOR *NA* PARAMETER (NO ABORT).
*
*         ENTRY  (A5) = ADDRESS OF LAST ARGUMENT PROCESSED.
*                (B7) = REMAINING ARGUMENT COUNT.
*
*         EXIT   (NA) = 1 IF NO-ABORT SPECIFIED.
*                (B7) = REMAINING ARGUMENT COUNT.
*
*         USES   X - 5, 6.
*                A - 5, 6.
*                B - 7.
 
 
 CNA      SUBR               ENTRY/EXIT
          ZR     B7,CNAX     IF NO REMAINING ARGUMENTS
          SA5    A5+B1       CHECK *NA* PARAMETER
          SB7    B7-B1
          ZR     X5,CNAX     IF BLANK
          SX6    B1
          SA6    NA          SET *NA* FLAG
          EQ     CNAX        RETURN
 SXP      SPACE  4,15
**        SXP - SET EXTRA PARAMETERS.
*
*         ENTRY  (A5) = ADDRESS OF LAST ARGUMENT PROCESSED.
*                (B7) = ARGUMENT COUNT.
*
*         USES   X - 0, 1, 2, 4, 5, 6.
*                A - 1, 2, 5, 6.
*                B - 7.
*
*         CALLS  CCS, DXB, ERR.
*
*         MACROS REWIND.
 
 
 SXP      SUBR               ENTRY/EXIT
          ZR     B7,SXPX     IF NO REMAINING ARGUMENTS
 
*         PROCESS REWIND PARAMETER.
 
          SA5    A5+B1
          ZR     X5,SXP1     IF NULL PARAMETER
          AX5    54
          SX6    X5-1RR
          NZ     X6,ERR4     IF INCORRECT PARAMETER
          REWIND I
          REWIND O
 SXP1     SB7    B7-B1
          RJ     CCS         CHECK CHARACTER SET
          ZR     B7,SXPX     IF NO MORE PARAMETERS
 
*         PROCESS LINE NUMBER PARAMETERS.
 
          SA5    A5+B1       GET FIRST LINE NUMBER
          ZR     X5,SXP2     IF NULL PARAMETER
          RJ     DXB         TRANSLATE PARAMETER
          NZ     X4,ERR5     IF ERROR DETECTED
          SA6    FL
 SXP2     SB7    B7-B1
          ZR     B7,SXPX     IF NO MORE PARAMETERS
          SA5    A5+B1
          ZR     X5,SXP3     IF NULL PARAMETER
          RJ     DXB         TRANSLATE PARAMETER
          NZ     X4,ERR5     IF ERROR DETECTED
          SA6    LL
          ZR     X6,SXP3     IF EOI SPECIFIED
          SA1    FL
          IX6    X6-X1
          NG     X6,ERR5     IF FIRST .GT. LAST
 SXP3     SB7    B7-B1
          ZR     B7,SXPX     IF NO MORE PARAMETERS
 
*         PROCESS STRUCTURE PARAMETER.
 
          SA5    A5+B1
          ZR     X5,SXP4     IF NULL PARAMETER
          AX5    48
          BX6    X6-X6
          SX5    X5-2RNS
          NZ     X5,ERR6     IF NOT *NS*
          SA6    NS
 SXP4     SB7    B7-B1
          NZ     B7,ERR3     IF TOO MANY PARAMETERS
          EQ     SXPX        EXIT
 CCS      SPACE  4,15
**        CCS - CHECK CHARACTER SET.
*
*         ENTRY  (A5) = ADDRESS OF LAST ARGUMENT PROCESSED.
*                (B7) = NUMBER OF PARAMETERS LEFT TO PROCESS.
*
*         EXIT   (A5) = UPDATED.
*                (B7) = UPDATED.
*
*         USES   X - 1, 2, 5.
*                A - 5.
*                B - 7.
*
*         CALLS  ERR.
 
 
 CCS      SUBR               ENTRY/EXIT
          ZR     B7,CCSX     IF NO REMAINING ARGUMENTS
          SA5    A5+B1
          SB7    B7-B1
          ZR     X5,CCSX     IF NULL PARAMETER
          MX2    48
          BX5    X2*X5
          LX5    6
          SX1    X5-1RD
          NZ     X1,ERR7     IF NOT 6/12 DISPLAY CODE
          EQ     CCSX        EXIT
 ERR      SPACE  4
**        ERR - PROCESS ERRORS.
 
 
 ERR1     SX0    ERRA
          EQ     ERR
 
 ERR2     SX0    ERRB
          EQ     ERR         EXIT
 
 ERR3     SX0    ERRC
          EQ     ERR         EXIT
 
 ERR4     SX0    ERRD
          EQ     ERR         EXIT
 
 ERR5     SX0    ERRE
          EQ     ERR         EXIT
 
 ERR6     SX0    ERRF
          EQ     ERR         EXIT
 
 ERR7     SX0    ERRG
 
 ERR      MESSAGE X0
          ABORT
 
 ERRA     DATA   C*INCORRECT COUNT.*
 ERRB     DATA   C*INCORRECT CHARACTER NUMBER.*
 ERRC     DATA   C*TOO MANY PARAMETERS.*
 ERRD     DATA   C*INCORRECT REWIND SPECIFICATION.*
 ERRE     DATA   C*INCORRECT LINE NUMBER SPECIFICATION.*
 ERRF     DATA   C*INCORRECT STRUCTURE SPECIFICATION.*
 ERRG     DATA   C*INCORRECT CHARACTER SET SPECIFICATION.*
          SPACE  4
          END