COPYC 
          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 
