COPYB 
          IDENT  COPYB,FETS 
          ABS 
          ENTRY  COPY 
          ENTRY  COPYBF 
          ENTRY  COPYEI 
          ENTRY  COPYBR 
          ENTRY  COPYX
          ENTRY  TCOPY
          ENTRY  NPC= 
          ENTRY  RFL= 
          ENTRY  SSM= 
          SYSCOM B1          DEFINE (B1) = 1
          TITLE  COPYB - BINARY FILE COPIES.
*COMMENT  COPYB - BINARY FILES COPIES.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          SPACE  4,10 
*****     COPYB - BINARY FILE COPIES. 
* 
*         G. R. MANSFIELD.   70/12/20.
* 
*         J. C. BOHNHOFF.    73/03/01.
*         R. E. TATE.        73/04/03.
*         J. L. LARSON.      77/03/16.
* 
*         THE COPYB DECK CONTAINS THE BINARY FILE AND RECORD COPY 
*         UTILITIES, INCLUDING COPY, COPYBF, COPYEI, TCOPY, COPYBR, 
*         AND COPYX.
          SPACE  4,10 
***       THE COPY UTILITY COPIES DATA FROM ONE FILE TO ANOTHER UNTIL 
*         THE SPECIFIED TERMINATION CONDITION IS MET.  THE FOLLOWING
*         TABLE DESCRIBES THE CAPABILITIES OF THE COPY UTILITY -
* 
*                            OUTPUT MEDIA FORMAT
*                +------+------+------+------+------+------+------+ 
*                +  MS  +  I   +  SI  +  S   +  L   +  F   +  LI  + 
*         +------+------+------+------+------+------+------+------+ 
*         +  MS  + YES* + YES* + YES* + YES  + YES  + NO   + YES* + 
*         +------+------+------+------+------+------+------+------+ 
*         +  I   + YES* + YES* + YES* + YES  + YES  + NO   + YES* + 
*  INPUT  +------+------+------+------+------+------+------+------+ 
*         +  SI  + YES* + YES* + YES* + YES  + YES  + NO   + YES* + 
*  MEDIA  +------+------+------+------+------+------+------+------+ 
*         +  S   + YES  + YES  + YES  + YES* + YES  + NO   + YES  + 
*  FORMAT +------+------+------+------+------+------+------+------+ 
*         +  L   + YES  + YES  + YES  + NO   + YES* + NO   + YES  + 
*         +------+------+------+------+------+------+------+------+ 
*         +  F   + YES  + YES  + YES  + NO   + NO   + YES* + YES  + 
*         +------+------+------+------+------+------+------+------+ 
*         +  LI  + YES* + YES* + YES* + YES  + YES  + NO   + YES* + 
*         +------+------+------+------+------+------+------+------+ 
* 
*                MS REFERS TO MASS STORAGE, TERMINAL, OPTICAL DISK OR 
*                UNIT RECORD EQUIPMENT.  I, SI, S, L, F AND LI REFER
*                TO TAPE FORMATS.  COPIES MARKED WITH (*) INDICATE
*                VERIFY IS MEANINGFUL, SINCE LOGICAL STRUCTURE OF 
*                FILES IS COMPATIBLE. 
* 
* 
*         COPY ( LFN1, LFN2, X, C, TC, COPYCNT, BSIZE, CHARCNT, 
*                ERLIMIT, PO, LFN3, NSC ) 
* 
*         COPY ( I=LFN1, O=LFN2, V=X, M=C, TC=TC, N=COPYCNT, BS=BSIZE,
*                CC=CHARCNT, EL=ERLIMIT, PO=PO, L=LFN3, NS=NSC )
* 
*         LFN1     FILE TO COPY FROM.  DEFAULT = INPUT. 
* 
*         LFN2     FILE TO COPY TO.  DEFAULT = OUTPUT.
*                  IF LFN1 = LFN2, FILES ARE SKIPPED. 
* 
*         X        IF SPECIFIED (1 TO 7 ALPHANUMERIC CHARACTERS), FILES 
*                  ARE REWOUND BEFORE COPY, AND REWOUND, VERIFIED, AND
*                  REWOUND AGAIN AFTER COPY.  DEFAULT = NO VERIFY.
*                  IF LFN1 = LFN2, FILE WILL BE REWOUND BEFORE
*                  SKIPPING, BUT VERIFY WILL NOT BE DONE. 
* 
*         C        CODED FILE MODE SELECTION -
*                  C1 = INPUT FILE ONLY, C2 = OUTPUT FILE ONLY, 
*                  OTHER (1 TO 7 ALPHANUMERIC CHARACTERS) = BOTH FILES. 
*                  APPLIES TO S, L, AND SI FORMAT TAPES.
*                  DEFAULT = BINARY MODE SELECTED ON BOTH FILES.
* 
*         TC       COPY TERMINATION CONDITION.  DEFINES MEANING OF
*                  COPYCNT PARAMETER -
*                  F OR EOF = COPYCNT DEFINES NUMBER OF FILES TO COPY.
*                  I OR EOI = COPY TO EOI.  COPYCNT MEANINGLESS.
*                  D OR EOD = COPYCNT DEFINES NUMBER OF DOUBLE EOF,S
*                             TO COPY TO. 
*                  DEFAULT = EOD. 
* 
*         COPYCNT  COPY COUNT, AS FURTHER DEFINED BY TC PARAMETER.
*                  DEFAULT = 1. 
* 
*         BSIZE    MAXIMUM BLOCK SIZE IN CM WORDS FOR S OR L TAPE.
*                  BSIZE CANNOT BE SPECIFIED TOGETHER WITH CHARCNT
*                  PARAMETER.  DEFAULT = 1000B FOR S TAPE, 2000B
*                  FOR L TAPE.
* 
*         CHARCNT  MAXIMUM NUMBER OF CHARACTERS IN BLOCK FOR S OR L 
*                  TAPE.  PRU SIZE AND UNUSED BIT COUNT ARE CALCULATED
*                  FROM CHARCNT, HOWEVER, UNUSED BIT COUNT IS USED
*                  ONLY WHEN WRITING A FULL BLOCK DURING GENERATION 
*                  OF AN S OR L TAPE FROM A MASS STORAGE, I, LI OR
*                  SI-BINARY FILE.  CHARCNT CANNOT BE SPECIFIED 
*                  TOGETHER WITH BSIZE PARAMETER.  NO DEFAULT 
*                  (BSIZE DEFAULT USED).
* 
*         ERLIMIT  ERROR LIMIT.  MAXIMUM NUMBER OF NON-FATAL TAPE 
*                  ERRORS TO ALLOW BEFORE ABORT.  INCLUDES *PARITY* 
*                  AND *BLOCK TOO LARGE* ERRORS, AS RETURNED BY THE 
*                  SYSTEM AFTER RECOVERY ATTEMPTS FAILED. 
*                  IF EL=U IS SPECIFIED, UNLIMITED ERROR PROCESSING 
*                  IS ALLOWED.  ERROR LIMIT DOES NOT APPLY (IGNORED)
*                  IF CONTROL WORDS ARE NOT SUPPORTED ON THE INPUT
*                  DEVICE TYPE (TERMINAL AND UNIT RECORD EQUIPMENT),
*                  IN WHICH CASE, ANY ERROR WILL ABORT THE JOB. 
*                  DEFAULT = 0. 
* 
*         PO       ONE OR MORE OF THE FOLLOWING PROCESSING OPTIONS -
* 
*                  E   INPUT BLOCKS WITH *PARITY* OR *BLOCK TOO 
*                      LARGE* ERRORS ARE TO BE PROCESSED.  DEFAULT =
*                      ERROR BLOCKS ARE SKIPPED.
* 
*                  D   NOISE BLOCKS GENERATED DURING MASS STORAGE, I, 
*                      LI OR SI COPY TO S OR L TAPE ARE DELETED.
*                      DEFAULT = NOISE BLOCKS ARE PADDED TO NOISE SIZE
*                      WITH BINARY ZEROS IF BINARY S OR L TAPE OR WITH
*                      BLANKS IF CODED MODE.  PO=D ALLOWED ONLY ON
*                      COPY FROM MASS STORAGE, I, LI OR SI-BINARY TAPE
*                      TO S OR L TAPE.
* 
*                  R   RECORD SPLITTING ALLOWED DURING GENERATION OF S
*                      OR L TAPE FROM MASS STORAGE, I, LI OR SI-BINARY
*                      FILE.  INPUT RECORDS GREATER THAN OUTPUT FILE
*                      PRU SIZE WILL BE SPLIT INTO MULTIPLE BLOCKS ON 
*                      OUTPUT.  DEFAULT = NO RECORD SPLITTING ALLOWED,
*                      ABORT IF RECORD TOO LARGE ENCOUNTERED.  ALLOWED
*                      ONLY ON COPY FROM MASS STORAGE, I, LI OR 
*                      SI-BINARY TAPE TO S OR L TAPE. 
* 
*                  M   COPY FILES AS SPECIFIED BY COPY TERMINATION
*                      CONDITION, ELIMINATING EOF ON OUTPUT.  PRIMARILY 
*                      PROVIDED FOR USE WITH LABELED S AND L OUTPUT 
*                      TAPES, SINCE TAPE MARK HAS DOUBLE MEANING
*                      (EOF AND LABEL GROUP DELIMITER). 
*                      DEFAULT = FILES ARE COPIED WITH EOF SEPARATORS.
* 
*         LFN3     ALTERNATE OUTPUT FILE TO RECEIVE PARITY ERROR
*                  MESSAGES WHEN NON-ZERO ERLIMIT SPECIFIED,  IN
*                  WHICH CASE, FILE NAME LFN3 CANNOT BE THE SAME AS 
*                  LFN1 OR LFN2.  DEFAULT = OUTPUT. 
* 
*         NSC      NOISE SIZE. ANY INPUT BLOCK CONTAINING FEWER THAN
*                  NSC CHARACTERS IS CONSIDERED NOISE AND IS DISCARDED. 
*                  ALLOWED ONLY WHEN INPUT TAPE IS S, L, OR F FORMAT. 
*                  MAXIMUM VALUE IS 41 CHARACTERS. IF NS=0 IS SPECIFIED,
*                  THE DEFAULT OF 18 CHARACTERS IS USED.
* 
* 
*         THE PARAMETERS ON THE COPY COMMAND ARE BOTH POSITIONAL
*         AND EQUIVALENCED.  ANY COMBINATION OF POSITIONAL AND
*         EQUIVALENCED ARGUMENTS MAY BE SPECIFIED, HOWEVER, POSITIONAL
*         ARGUMENTS ARE INTERPRETTED SOLELY ON THE NUMBER OF PRECEDING
*         PARAMETERS.  ALL PARAMETERS ARE OPTIONAL.  UNLESS EXPLICITLY
*         STATED OTHERWISE IN THE PARAMETER DESCRIPTION, SPECIFICATION
*         OF NON-APPLICABLE PARAMETERS FOR A PARTICULAR TYPE OF COPY
*         IS INCORRECT. 
* 
*         FOR IDENTICAL COPIES (MASS STORAGE TO MASS STORAGE, I TO I, 
*         SI TO SI, S TO S, L TO L, F TO F, AND LI TO LI TAPE COPIES) 
*         AND FOR INTERCHANGEABLE COPIES (I TO SI-BINARY, SI-BINARY TO
*         I, AND S TO L), WHERE DATA MANIPULATION IS NOT REQUIRED, A
*         SINGLE BUFFER COPY IS USED.  ALL OTHER TYPES OF COPIES
*         REQUIRE TWO I/O BUFFERS AND A WORKING STORAGE BUFFER.  COPY 
*         WILL RFL UP FOR ADDITIONAL FIELD LENGTH NEEDED TO PROCESS L 
*         AND F TAPE COPIES.
* 
*         THE DATA COPY BEGINS AT THE CURRENT POSITION OF LFN1 AND
*         LFN2, UNLESS THE VERIFY OPTION IS SPECIFIED, AND CONTINUES
*         UNTIL THE COPY TERMINATION CONDITION IS MET OR EOI IS 
*         ENCOUNTERED.  IF LFN1 = LFN2, FILES ARE SKIPPED.  IF PO=M 
*         OPTION IS SELECTED, CORRESPONDING EOF,S ARE NOT GENERATED 
*         ON LFN2.  WHEN THE COPY IS TERMINATED BY A DOUBLE EOF (FOR
*         TC=EOD OPTION), THE SECOND EOF IS NOT TRANSFERRED TO LFN2.
*         FOR A COPY WITH A FILE COUNT SPECIFIED (TC=EOF), IF EOI IS
*         ENCOUNTERED ON LFN1 BEFORE THE FILE COUNT IS SATISFIED, AN
*         ADDITIONAL EOF WILL BE GENERATED ON LFN2 IF DATA OR RECORDS 
*         HAVE BEEN TRANSFERRED SINCE THE PREVIOUS EOF WAS WRITTEN. 
          SPACE  4,10 
***       THE COPYBF UTILITY COPIES A SPECIFIED NUMBER OF FILES FROM
*         ONE FILE TO ANOTHER.
* 
* 
*         COPYBF ( LFN1, LFN2, N, C ) 
* 
*         LFN1     FILE TO COPY FROM.  DEFAULT = INPUT. 
* 
*         LFN2     FILE TO COPY TO.  DEFAULT = OUTPUT.
*                  IF LFN1 = LFN2, FILES ARE SKIPPED. 
* 
*         N        NUMBER OF FILES TO COPY.  DEFAULT = 1. 
* 
*         C        IF SPECIFIED (1 TO 7 ALPHANUMERIC CHARACTERS), 
*                  CODED MODE SET ON BOTH FILES.
*                  APPLIES TO S, L, AND SI FORMAT TAPES.
*                  DEFAULT = BINARY MODE SELECTED ON BOTH FILES.
* 
*         THE DATA COPY BEGINS AT THE CURRENT POSITION OF LFN1 AND LFN2 
*         AND CONTINUES UNTIL THE SPECIFIED NUMBER OF FILES ARE COPIED
*         OR EOI IS ENCOUNTERED.  IF LFN1 = LFN2, FILES ARE SKIPPED.
*         IF EOI IS ENCOUNTERED ON LFN1 BEFORE THE FILE COUNT IS
*         SATISFIED, AN ADDITIONAL EOF WILL BE GENERATED ON LFN2 IF 
*         DATA OR RECORDS HAVE BEEN TRANSFERRED SINCE THE PREVIOUS
*         EOF WAS WRITTEN.
          SPACE  4,10 
***       THE COPYEI UTILITY COPIES ONE FILE TO ANOTHER UNTIL END 
*         OF INFORMATION IS ENCOUNTERED.
* 
* 
*         COPYEI ( LFN1, LFN2, V, C ) 
* 
*         LFN1     FILE TO COPY FROM.  DEFAULT = INPUT. 
* 
*         LFN2     FILE TO COPY TO.  DEFAULT = OUTPUT.
*                  IF LFN1 = LFN2, THE FILE IS SKIPPED TO EOI.
* 
*         V        IF SPECIFIED (1 TO 7 ALPHANUMERIC CHARACTERS), FILES 
*                  ARE REWOUND BEFORE COPY, AND REWOUND, VERIFIED, AND
*                  REWOUND AGAIN AFTER COPY.  DEFAULT = NO VERIFY.
*                  IF LFN1 = LFN2, FILE WILL BE REWOUND BEFORE
*                  SKIPPING, BUT VERIFY WILL NOT BE DONE. 
* 
*         C        IF SPECIFIED (1 TO 7 ALPHANUMERIC CHARACTERS), 
*                  CODED MODE SET ON BOTH FILES.
*                  APPLIES TO S, L, AND SI FORMAT TAPES.
*                  DEFAULT = BINARY MODE SELECTED ON BOTH FILES.
* 
*         THE DATA COPY BEGINS AT THE CURRENT POSITION OF LFN1 AND
*         LFN2, UNLESS THE VERIFY OPTION IS SELECTED, AND CONTINUES 
*         UNTIL EOI IS ENCOUNTERED.  IF LFN1 = LFN2, THE FILE IS
*         SKIPPED TO EOI. 
          SPACE  4,10 
***       THE COPYBR UTILITY COPIES A SPECIFIED NUMBER OF RECORDS FROM
*         ONE FILE TO ANOTHER.
* 
* 
*         COPYBR ( LFN1, LFN2, N, C ) 
* 
*         LFN1     FILE TO COPY FROM.  DEFAULT = INPUT. 
* 
*         LFN2     FILE TO COPY TO.  DEFAULT = OUTPUT.
*                  IF LFN1 = LFN2, RECORDS ARE SKIPPED. 
* 
*         N        NUMBER OF RECORDS TO COPY.  DEFAULT = 1. 
*                  EACH EOF IS COUNTED AS AN ADDITIONAL RECORD. 
* 
*         C        IF SPECIFIED (1 TO 7 ALPHANUMERIC CHARACTERS), 
*                  CODED MODE SET ON BOTH FILES.
*                  APPLIES TO S, L, AND SI FORMAT TAPES.
*                  DEFAULT = BINARY MODE SELECTED ON BOTH FILES.
* 
*         THE DATA COPY BEGINS AT THE CURRENT POSITION OF LFN1 AND LFN2 
*         AND CONTINUES UNTIL THE SPECIFIED NUMBER OF RECORDS ARE 
*         COPIED OR EOI IS ENCOUNTERED.  IF LFN1 = LFN2, RECORDS ARE
*         SKIPPED.  IF EOI IS ENCOUNTERED ON LFN1 BEFORE THE RECORD 
*         COUNT IS SATISFIED, AN ADDITIONAL EOR WILL BE GENERATED 
*         ON LFN2 IF ANY DATA HAS BEEN TRANSFERRED SINCE THE PREVIOUS 
*         EOR/EOF WAS WRITTEN.
          SPACE  4,10 
***       THE COPYX UTILITY COPIES LOGICAL RECORDS FROM ONE FILE TO 
*         ANOTHER UNTIL THE SPECIFIED TERMINATION CONDITION IS MET. 
* 
* 
*         COPYX ( LFN1, LFN2, TERM, BKSP, C ) 
* 
*         COPYX ( LFN1, LFN2, TYPE / NAME, BKSP, C )
* 
*         LFN1     FILE TO COPY FROM.  DEFAULT = INPUT. 
* 
*         LFN2     FILE TO COPY TO.  DEFAULT = OUTPUT.
*                  IF LFN1 = LFN2, RECORDS ARE SKIPPED. 
* 
*         TERM     TERMINATION CONDITION.  DEFAULT = 1. 
*                  *00* = COPY TO ZERO RECORD.
*                  N = NUMBER OF RECORDS TO COPY. 
*                  NAME = NAME OF LAST RECORD TO COPY.
* 
*         TYPE     MNEMONIC FOR RECORD TYPE.
*                  *ABS* = MULTIPLE ENTRY POINT OVERLAY 
*                  *CAP* = FAST DYNAMIC LOAD CAPSULE
*                  *OPL* = MODIFY OLD PROGRAM LIBRARY DECK
*                  *OPLC* = MODIFY OLD PROGRAM LIBRARY COMMON DECK
*                  *OPLD* = MODIFY OLD PROGRAM LIBRARY DIRECTORY
*                  *OVL* = CENTRAL PROCESSOR OVERLAY
*                  *PP* = 6000 SERIES PERIPHERAL PROCESSOR PROGRAM
*                  *PPL* = 16-BIT PERIPHERAL PROCESSOR PROGRAM
*                  *PPU* = 7600 PERIPHERAL PROCESSOR PROGRAM
*                  *PROC* = PROCEDURE TYPE RECORD 
*                  *REL* = RELOCATABLE CENTRAL PROCESSOR PROGRAM
*                  *TEXT* = UNRECOGNIZABLE AS A PROGRAM 
*                  *ULIB* = USER LIBRARY PROGRAM
* 
*         NAME     RECORD NAME. 
* 
*         BKSP     BACKSPACE CONTROL.  DEFAULT = 0. 
*                  *0* = NO BACKSPACE 
*                  *1* = BACKSPACE LFN1 ONLY
*                  *2* = BACKSPACE LFN2 ONLY
*                  *3* = BACKSPACE BOTH FILES 
* 
*         C        IF SPECIFIED (1 TO 7 ALPHANUMERIC CHARACTERS), 
*                  CODED MODE SET ON BOTH FILES.
*                  APPLIES TO S, L, AND SI FORMAT TAPES.
*                  DEFAULT = BINARY MODE SELECTED ON BOTH FILES.
* 
*         THE DATA COPY BEGINS AT THE CURRENT POSITION OF LFN1 AND LFN2 
*         AND CONTINUES UNTIL THE SPECIFIED TERMINATION CONDITION IS
*         MET OR EOF OR EOI IS ENCOUNTERED.  IF LFN1 = LFN2, RECORDS
*         ARE SKIPPED.  IF EOI IS ENCOUNTERED ON LFN1 BEFORE THE
*         TERMINATION CONDITION IS SATISFIED, AN ADDITIONAL EOR WILL
*         BE GENERATED ON LFN2 IF ANY DATA HAS BEEN TRANSFERRED SINCE 
*         THE PREVIOUS EOR WAS WRITTEN. 
          SPACE  4,10 
***       THE TCOPY UTILITY PROVIDES CONVERSION SUPPORT FOR E, B, 
*         X, AND SI-CODED FORMAT TAPES.  TAPES WRITTEN IN THESE 
*         FORMATS SHOULD BE ASSIGNED IN S (STRANGER TAPE) FORMAT. 
*         TCOPY WILL CONVERT THE DATA RECEIVED FROM THE S FORMAT
*         DRIVER AS NECESSARY TO MATCH THE SPECIFIED FORMAT 
*         (PARAMETER ON TCOPY COMMAND) AND COPY IT TO A MASS
*         STORAGE FILE OR ITS EQUIVALENT (I, LI OR SI-BINARY TAPE). 
*         TCOPY ALSO PROVIDES THE CAPABILITY OF GENERATING E AND B
*         TAPES, VIA S FORMAT, FROM A MASS STORAGE, I, LI OR SI-BINARY
*         FILE. 
* 
* 
*         TCOPY ( LFN1, LFN2, FORMAT, TC, COPYCNT, CHARCNT, ERLIMIT,
*                PO, LFN3, NSC )
* 
*         TCOPY ( I=LFN1, O=LFN2, F=FORMAT, TC=TC, N=COPYCNT, 
*                CC=CHARCNT, EL=ERLIMIT, PO=PO, L=LFN3, NS=NSC )
* 
*         LFN1     FILE TO COPY FROM.  DEFAULT = INPUT. 
* 
*         LFN2     FILE TO COPY TO.  DEFAULT = OUTPUT.
*                  IF LFN1 = LFN2, FILES ARE SKIPPED. 
* 
*         FORMAT   OBSOLETE TAPE FORMAT SPECIFYING THE TYPE OF
*                  CONVERSION FOR THE COPY.  DEFAULT = X. 
* 
*                  E   COPY E FORMAT TAPE TO MASS STORAGE, I, LI OR 
*                      SI-BINARY FILE, OR GENERATE NEW E TAPE FROM
*                      MASS STORAGE, I, LI OR SI-BINARY FILE.  THE E
*                      TAPE MUST BE UNLABELED AND ASSIGNED AS S FORMAT. 
* 
*                  B   COPY B FORMAT TAPE TO MASS STORAGE, I, LI OR 
*                      SI-BINARY FILE OR GENERATE A NEW B TAPE FROM 
*                      A MASS STORAGE, I, LI OR SI-BINARY FILE. 
*                      THE B TAPE MUST BE UNLABELED AND ASSIGNED AS 
*                      S FORMAT.
* 
*                  X   COPY X FORMAT TAPE TO MASS STORAGE, I, LI OR 
*                      SI-BINARY FILE.  THE X TAPE MUST BE UNLABELED
*                      AND ASSIGNED AS S FORMAT.
* 
*                  SI  COPY SI-CODED FORMAT TAPE TO MASS STORAGE, 
*                      I, LI OR SI-BINARY FILE.  THE SI-CODED TAPE MUST 
*                      BE ASSIGNED AS S FORMAT AND MAY BE LABELED OR
*                      UNLABELED. 
*                      NOTE - IF FILE COUNT WAS SPECIFIED, THE POSITION 
*                      OF THE INPUT TAPE AFTER THE COPY IS INDETERMI- 
*                      NATE SINCE CONTROL WORDS ARE USED ON THE SI- 
*                      CODED FILE READ VIA S FORMAT (EOF ON SI-CODED
*                      TAPE IS LEVEL 17B BLOCK TERMINATOR BUT EOF ON
*                      S TAPE IS A TAPE MARK).
* 
*                  I   COPY I FORMAT TAPE TO MASS STORAGE, I, LI OR 
*                      SI-BINARY FILE.  THE I FORMAT TAPE MUST BE 
*                      ASSIGNED AS L FORMAT AND MAY BE LABELED OR 
*                      UNLABELED.  I FORMAT IS NOT AN OBSOLETE FORMAT.
*                      THIS OPTION HAS BEEN INCLUDED TO SIMPLIFY THE
*                      RECOVERY OF DATA FROM OVERWRITTEN TAPES. 
*                      NOTE - IF THE TERMINATING CONDITION IS OTHER 
*                      THAN *EOI*, THEN THE POSITION OF THE INPUT TAPE
*                      AFTER THE COPY IS INDETERMINATE, SINCE CONTROL 
*                      WORD READS ARE USED ON THE I FORMAT TAPE READ
*                      VIA L FORMAT (EOF ON AN I FORMAT TAPE IS A 
*                      LEVEL 17B BLOCK TERMINATOR BUT EOF ON AN L 
*                      TAPE IS A TAPE MARK).
* 
*         TC       COPY TERMINATION CONDITION.  DEFINES MEANING OF
*                  COPYCNT PARAMETER -
*                  F OR EOF = COPYCNT DEFINES NUMBER OF FILES TO COPY.
*                  I OR EOI = COPY TO EOI.  COPYCNT MEANINGLESS.
*                  D OR EOD = COPYCNT DEFINES NUMBER OF DOUBLE EOF,S
*                             TO COPY TO. 
*                  DEFAULT = EOD. 
* 
*         COPYCNT  COPY COUNT, AS FURTHER DEFINED BY TC PARAMETER.
*                  DEFAULT = 1. 
* 
*         CHARCNT  CHARACTER COUNT.  DETERMINES MAXIMUM BLOCK SIZE
*                  (LINE LENGTH) IN CHARACTERS TO BE READ OR WRITTEN
*                  AND PRU SIZE.  APPLIES ONLY TO E AND B TAPE COPIES.
*                  DEFAULT = 136 CHARACTERS FOR E TAPE, 150 CHARACTERS
*                  FOR B TAPE.
* 
*         ERLIMIT  ERROR LIMIT.  MAXIMUM NUMBER OF NON-FATAL TAPE 
*                  ERRORS TO ALLOW BEFORE ABORT.  INCLUDES *PARITY* 
*                  AND *BLOCK TOO LARGE* ERRORS, AS RETURNED BY THE 
*                  SYSTEM AFTER RECOVERY ATTEMPTS FAILED.  FOR X, SI- 
*                  CODED AND I TAPES IT ALSO INCLUDES *INCORRECT BLOCK
*                  FORMAT* ERRORS (INCORRECT BYTE COUNT AND/OR UNUSED 
*                  BIT COUNT FOR THIS FORMAT).  IF EL=U IS SPECIFIED, 
*                  UNLIMITED ERROR PROCESSING IS ALLOWED.  ERROR LIMIT
*                  DOES NOT APPLY (IGNORED) WHEN GENERATING AN E OR B 
*                  TAPE FROM A MASS STORAGE, I, LI OR SI-BINARY FILE
*                  (SINCE CONTROL WORDS ARE NOT USED) OR IF CONTROL 
*                  WORDS ARE NOT SUPPORTED ON THE INPUT FILE DEVICE 
*                  TYPE (TERMINAL OR UNIT RECORD EQUIPMENT), IN WHICH 
*                  CASE, ANY ERROR WILL ABORT THE JOB.  DEFAULT = 0.
* 
*         PO       PROCESSING OPTION -
* 
*                  E   INPUT BLOCKS WITH *PARITY* OR *BLOCK TOO 
*                      LARGE* ERRORS ARE TO BE PROCESSED.  DEFAULT =
*                      ERROR BLOCKS ARE SKIPPED.
* 
*                  T   WHEN GENERATING AN E OR B FORMAT TAPE, TRUNCATE
*                      DATA IN LINE BEYOND THE MAXIMUM E/B TAPE LINE
*                      SIZE (AS DEFINED BY CC= PARAMETER OR DEFAULT). 
*                      LEGAL ONLY WHEN GENERATING AN E OR B TAPE FROM 
*                      A MASS STORAGE, I, LI OR SI-BINARY TAPE FILE.
* 
*         LFN3     ALTERNATE OUTPUT FILE TO RECEIVE PARITY ERROR
*                  MESSAGES WHEN NON-ZERO ERLIMIT SPECIFIED, IN 
*                  WHICH CASE, FILE NAME LFN3 CANNOT BE THE SAME AS 
*                  LFN1 OR LFN2.  DEFAULT = OUTPUT. 
* 
*         NSC      NOISE SIZE. ANY BLOCK CONTAINING FEWER THAN NSC
*                  CHARACTERS IS CONSIDERED NOISE AND IS DISCARDED. 
*                  ALLOWED ONLY FOR E/B FORMAT CONVERSION.
*                  IF NS=0 IS SPECIFIED, THE DEFAULT OF 18
*                  CHARACTERS IS USED.
* 
* 
*         THE PARAMETERS ON THE TCOPY COMMAND ARE BOTH POSITIONAL 
*         AND EQUIVALENCED.  ANY COMBINATION OF POSITIONAL AND
*         EQUIVALENCED ARGUMENTS MAY BE SPECIFIED, HOWEVER, POSITIONAL
*         ARGUMENTS ARE INTERPRETTED SOLELY ON THE NUMBER OF PRECEDING
*         PARAMETERS.  ALL PARAMETERS ARE OPTIONAL.  UNLESS EXPLICITLY
*         STATED OTHERWISE IN THE PARAMETER DESCRIPTION, SPECIFICATION
*         OF NON-APPLICABLE PARAMETERS FOR A PARTICULAR TYPE OF COPY
*         IS INCORRECT. 
* 
*         WHEN GENERATING A NEW B TAPE FROM A MASS STORAGE, I, LI OR
*         SI-BINARY FILE, LINES MAY BE ENCOUNTERED THAT ARE TOO SMALL 
*         TO BE COPIED DIRECTLY TO THE TAPE.  SMALL BLOCKS MAY ALSO 
*         RESULT WHEN A LINE IS ENCOUNTERED THAT EXCEEDS THE MAXIMUM
*         LINE SIZE FOR THE B TAPE, SINCE IT IS SPLIT INTO MULTIPLE 
*         LINES.  IF THE LINE LENGTH IS LESS THAN THE B TAPE NOISE
*         SIZE, IT WILL BE BLANK FILLED TO THE NOISE SIZE.
*         IF THE *PO=T* OPTION IS SPECIFIED, LINES THAT WOULD 
*         NORMALLY BE SPLIT INTO MULTIPLE LINES WILL BE TRUNCATED 
*         AT THE MAXIMUM LINE SIZE. 
* 
*         WHEN GENERATING A NEW E TAPE FROM A MASS STORAGE, I, LI OR
*         SI-BINARY TAPE FILE, LINES THAT EXCEED THE MAXIMUM LINE 
*         SIZE WILL BE SPLIT INTO MULTIPLE LINES.  A CONTINUATION 
*         LINE CONSISTING OF AN EOL ONLY WILL BE DISCARDED (WILL NOT
*         GENERATE EXTRANEOUS BLANK BLOCK).  IF THE *PO=T* OPTION 
*         IS SPECIFIED, LINES ARE TRUNCATED AT THE MAXIMUM LINE SIZE
*         (ALL CONTINUATION LINES ARE DISCARDED). 
* 
*         THE DATA COPY BEGINS AT THE CURRENT POSITION OF LFN1 AND LFN2 
*         AND CONTINUES UNTIL THE COPY TERMINATION CONDITION IS MET OR
*         EOI IS ENCOUNTERED.  IF LFN1 = LFN2, FILES ARE SKIPPED. 
*         WHEN THE COPY IS TERMINATED BY A DOUBLE EOF (FOR TC=EOD 
*         OPTION), THE SECOND EOF IS NOT TRANSFERRED TO LFN2. 
*         FOR A COPY WITH A FILE COUNT SPECIFIED (TC=EOF), IF EOI IS
*         ENCOUNTERED ON LFN1 BEFORE THE FILE COUNT IS SATISFIED, AN
*         ADDITIONAL EOF WILL BE GENERATED ON LFN2 IF ANY DATA OR 
*         RECORDS HAVE BEEN TRANSFERRED SINCE THE PREVIOUS EOF WAS
*         WRITTEN.
          SPACE  4,10 
***       DAYFILE ERROR MESSAGES. 
* 
* 
*         * ARGUMENT ERROR.* - COMMAND CONTAINS INCORRECT OR
*         NON-APPLICABLE PARAMETERS.
* 
*         * BLOCK SIZE NOT APPLICABLE.* - SPECIFICATION OF *CC* OR
*         *BS* PARAMETER ON *COPY* IS ALLOWED ONLY WHEN COPYING 
*         TO OR FROM AN S OR L FORMAT TAPE.  SPECIFICATION OF 
*         *CC* PARAMETER ON *TCOPY* LEGAL ONLY WHEN CONVERTING
*         OR GENERATING AN E OR B FORMAT TAPE.
* 
*         * BLOCK SIZE TOO LARGE ON LFN.* - FOR *COPY*, BLOCK SIZE FOR
*         S COPY EXCEEDS MAXIMUM FOR THAT FORMAT (1000B WORDS). 
*         FOR *TCOPY*, CHARACTER COUNT FOR E OR B TAPE COPY EXCEEDS 
*         MAXIMUM FOR THAT FORMAT (5120 CHARACTERS).
*         FOR *COPYBF* AND *COPYEI*, F TAPE BLOCK SIZE EXCEEDS WORKING
*         BUFFER LENGTH (ONLY *COPY* SUPPORTS S, L, AND F TAPES). 
* 
*         * BLOCK SIZE TOO SMALL ON LFN.* - FOR *COPY*, ON F TO F TAPE
*         COPY, MAXIMUM FRAME COUNT FOR THE FIRST FILE (AS SPECIFIED
*         DURING TAPE ASSIGNMENT) EXCEEDS THAT SPECIFIED FOR THE SECOND 
*         FILE.  ON S AND L TAPE COPIES, BLOCK SIZE (AS SPECIFIED BY
*         *BS* PARAMETER OR CALCULATED FROM *CC* PARAMETER) IS LESS 
*         THAN NOISE SIZE.  FOR *TCOPY*, ON E AND B TAPE COPIES, BLOCK
*         SIZE (AS CALCULATED FROM *CC* PARAMETER) IS LESS THAN THE 
*         CORRESPONDING S TAPE NOISE SIZE.
* 
*         * COPY FL ABOVE USER LIMIT.* - FOR *COPY*, FIELD LENGTH 
*         REQUIRED FOR F OR L TAPE COPY EXCEEDS THE USER,S CURRENT
*         MAXIMUM FL. 
* 
*         * ERROR LIMIT EXCEEDED.* - FOR *COPY* AND *TCOPY*, NUMBER 
*         OF *PARITY*, *BLOCK TOO LARGE* AND *INCORRECT BLOCK FORMAT* 
*         ERRORS DETECTED ON THE INPUT FILE EXCEEDS THE ERROR LIMIT 
*         (AS SPECIFIED BY EL PARAMETER). 
* 
*         * FILE NAME CONFLICT.* - FOR *COPY* AND *TCOPY*, WITH 
*         EXTENDED ERROR PROCESSING IN EFFECT (NONZERO *EL* SPECIFIED), 
*         ALTERNATE OUTPUT FILE NAME IS SAME AS INPUT OR OUTPUT FILE
*         NAME. 
* 
*         * INCORRECT COPY.* - FOR *COPY*, THE FILE TYPES (TAPE FORMAT
*         OR DEVICE TYPE) DO NOT MEET COPY REQUIREMENTS (REFER TO 
*         CAPABILITY TABLE IN *COPY* DOCUMENTATION).  FOR *TCOPY*,
*         THE CONVERSION TYPE (E, B, X, SI) AND THE FILE TYPES
*         (TAPE FORMAT OR DEVICE TYPE) DO NOT MEET COPY REQUIRE-
*         MENTS (REFER TO *TCOPY* CAPABILITY DOCUMENTATION).
* 
*         * INCORRECT NOISE SIZE ON LFN.* - FOR *COPY*, ON S TO S, L TO 
*         L, AND F TO F TAPE COPIES, THE NOISE SIZE FOR THE SECOND FILE 
*         (AS SPECIFIED DURING TAPE ASSIGNMENT) EXCEEDS THAT DEFINED
*         FOR THE FIRST FILE.  FOR *TCOPY*, ON X AND SI-CODED TAPE
*         COPIES, INCORRECT NOISE SIZE HAS BEEN SPECIFIED WHEN THE S
*         FORMAT TAPE WAS ASSIGNED (REQUIRED NOISE SIZE IS 8 FRAMES FOR 
*         7-TRACK, 6 FRAMES FOR 9-TRACK). 
* 
*         * PROCESSING OPTION NOT APPLICABLE.* - *PO=R* OR *PO=D* 
*         SPECIFICATION ALLOWED ONLY ON *COPY* FROM MASS STORAGE, I,
*         LI OR SI-BINARY FILE TO S OR L TAPE.  *PO=T* SPECIFICATION
*         ALLOWED ON *TCOPY* ONLY WHEN GENERATING AN E OR B TAPE. 
* 
*         * RECORD TOO LARGE ON LFN.* - FOR *COPY* WHEN RECORD
*         SPLITTING PROCESSING OPTION NOT SPECIFIED, *COPYBF*, AND
*         *COPYEI*, DURING GENERATION OF S OR L TAPE FROM MASS
*         STORAGE, I, LI OR SI-BINARY FILE, AN INPUT RECORD WAS 
*         ENCOUNTERED THAT WAS LARGER THAN THE OUTPUT FILE PRU SIZE.
* 
*         * UNLABELED TAPE REQUIRED - LFN.* - FOR *TCOPY*, THE
*         S FORMAT TAPE FOR AN E, B, OR X COPY MUST BE UNLABELED. 
* 
*         * UNRECOVERABLE ERROR ON LFN.* - FOR *COPY* AND *TCOPY*, AN 
*         UNRECOVERABLE ERROR WAS DETECTED ON THE INPUT FILE (WRONG 
*         PARITY, DENSITY CHANGE, READY DROP, ETC.).
* 
*         * UNRECOGNIZED TERMINATION CONDITION.* - THE *COPYX*
*         TERMINATION RECORD COUNT OR RECORD TYPE WAS NOT RECOGNIZED. 
* 
*         * UNRECOGNIZED BACKSPACE CODE.* - THE BACKSPACE CODE
*         SPECIFIED TO *COPYX* WAS NOT 0, 1, 2, OR 3. 
          SPACE  4,10 
***       DAYFILE INFORMATIVE MESSAGES. 
* 
* 
*         * CHECK DAYFILE FOR ERRORS.* - ALERTS TERMINAL USER THAT SOME 
*         ERROR SUMMARY OR WARNING MESSAGES WERE ISSUED TO THE DAYFILE. 
* 
*         * COPY COMPLETE.* - COPY COUNT WAS EXHAUSTED BEFORE EOI 
*         ENCOUNTERED.
* 
*         * COPY INDETERMINATE.* - WARNING MESSAGE ISSUED BY *COPYBF*,
*         *COPYEI*, *COPYBR*, AND *COPYX* WHEN COPY INVOLVES AN S, L, 
*         OR F FORMAT TAPE (ONLY *COPY* UTILITY PROVIDES SUPPORT
*         FOR THESE FORMAT TAPES).
* 
*         * EOF ENCOUNTERED.* - END OF FILE WAS ENCOUNTERED BEFORE
*         *COPYX* TERMINATION CONDITION SATISFIED.
* 
*         * EOI ENCOUNTERED.* - END OF INFORMATION WAS ENCOUNTERED
*         BEFORE THE COPY COUNT WAS EXHAUSTED.
* 
*         * FILE NOT FOUND - LFN.* - INPUT FILE DID NOT EXIST PRIOR 
*         TO COPY.
* 
*         * N BAD FORMAT BLOCKS.* - *TCOPY* ERROR SUMMARY MESSAGE 
*         ISSUED BEFORE ENDING OR ABORTING.  ALTERNATE OUTPUT FILE
*         CONTAINS DETAILED ERROR MESSAGES. 
* 
*         * N NOISE BLOCKS DELETED.* - DURING S OR L TAPE *COPY* FROM 
*         MASS STORAGE, I, LI OR SI-BINARY FILE, N OUTPUT FILE BLOCKS 
*         WERE DELETED SINCE THEY WERE LESS THAN NOISE SIZE.
*         DURING *TCOPY* WITH S FORMAT INPUT TAPE FOR E/B FORMAT
*         CONVERSION OR FOR *COPY* FROM S/L/F FORMAT INPUT TAPE,
*         N INPUT BLOCKS WERE DELETED (NOT WRITTEN TO OUTPUT) 
*         SINCE THEY WERE LESS THAN NOISE SIZE. 
* 
*         * NOISE BLOCK PROCESSING IN EFFECT.* - IN *COPY* WHEN 
*         USER DOES NOT SPECIFY *NS* PARAMETER FOR S TO S/L, L TO L,
*         OR F TO F TAPE COPY, NOISE PROCESSING IS AUTOMATICALLY
*         SELECTED WHEN THE OUTPUT TAPE NOISE SIZE EXCEEDS THE INPUT
*         TAPE NOISE SIZE. THIS WILL SLOW PROCESSING, SINCE DOUBLE
*         BUFFER DATA MANIPULATION MUST THEN BE USED TO REMOVE INPUT
*         NOISE BLOCKS. 
* 
*         * INSUFFICIENT NOISE SIZE, AUTOMATICALLY INCREASED.* -
*         WARNING MESSAGE ISSUED IN *COPY* IF *NS* PARAMETER IS 
*         SPECIFIED BUT NOT LARGE ENOUGH FOR S TO S/L, L TO L, OR F TO
*         F TAPE COPY (THE NOISE SIZE USED FOR THE INPUT TAPE MUST BE 
*         GREATER THAN OR EQUAL TO THAT OF THE OUTPUT TAPE).
* 
*         * N NOISE BLOCKS PADDED.* - DURING S OR L TAPE *COPY* FROM
*         MASS STORAGE, I, LI OR SI-BINARY FILE, N OUTPUT FILE BLOCKS 
*         HAD TO BE PADDED SINCE THEY WERE LESS THAN NOISE SIZE.
* 
*         * N PARITY/BLOCK TOO LARGE ERRORS.* - *COPY* AND *TCOPY*
*         ERROR SUMMARY MESSAGE ISSUED BEFORE ENDING OR ABORTING. 
*         ALTERNATE OUTPUT FILE CONTAINS DETAILED ERROR MESSAGES. 
* 
*         * N RECORD SPLITS OCCURRED.* - DURING S OR L TAPE *COPY* FROM 
*         MASS STORAGE, I, LI OR SI-BINARY FILE, MULTIPLE BLOCKS PER
*         RECORD WERE WRITTEN FOR N INPUT RECORDS.
          SPACE  4,10 
***       ALTERNATE OUTPUT FILE MESSAGES. 
* 
*         * INCORRECT FORMAT IN BLOCK N.* - FOR *TCOPY* WITH EXTENDED 
*         ERROR PROCESSING IN EFFECT, AN *INCORRECT BLOCK FORMAT* ERROR 
*         (INCORRECT BYTE COUNT AND/OR UNUSED BIT COUNT IN THIS FORMAT) 
*         WAS DETECTED IN THIS BLOCK WITHOUT THE *PARITY* ERROR 
*         INDICATOR SET.  N SPECIFIES BLOCK COUNT OF BLOCK IN 
*         ERROR, AND IS INITIALLY SET TO 0 (FIRST BLOCK FROM INITIAL
*         POSITION OF INPUT FILE).
* 
*         * PARITY/BLOCK TOO LARGE ERROR IN BLOCK N.* - FOR *COPY*
*         AND *TCOPY*, WITH EXTENDED ERROR PROCESSING IN EFFECT,
*         A *PARITY* OR *BLOCK TOO LARGE* ERROR WAS DETECTED ON THIS
*         BLOCK (ERROR INDICATOR SET IN CONTROL WORD HEADER). 
*         N SPECIFIES BLOCK COUNT OF BLOCK IN ERROR, AND IS INITIALLY 
*         SET TO 0 (FIRST BLOCK FROM INITIAL POSITION OF INPUT FILE). 
          SPACE  4,10 
****      ASSEMBLY CONSTANTS. 
  
  
 DPRS     EQU    1003B       DEFAULT PRU SIZE WITH CONTROL WORDS
 BUFL     EQU    DPRS        DEFAULT WORKING STORAGE BUFFER LENGTH
 FBUFL    EQU    DPRS*30B    DEFAULT CIO BUFFER LENGTH
 LBUFL    EQU    102B        ALTERNATE OUTPUT CIO BUFFER LENGTH 
 RBFL     EQU    1000B       RECORD COPY WORKING BUFFER LENGTH
 SBUFL    EQU    FBUFL*2     SINGLE BUFFER COPY DEFAULT BUFFER LENGTH 
  
 FETL     EQU    9           FET LENGTH 
 FETODL   EQU    16          OPTICAL DISK FET EXTENSION LENGTH
  
 DFNS     EQU    18          DEFAULT NOISE SIZE 
 MNSZ     EQU    41          MAXIMUM NS PARAMETER IN CHARACTERS 
 DSPS     EQU    1000B       DEFAULT S TAPE PRU SIZE FOR *COPY* 
 DLPS     EQU    2000B       DEFAULT L TAPE PRU SIZE FOR *COPY* 
 MCBS     EQU    5120        MAXIMUM BLOCK SIZE (IN CHARACTERS) 
  
 MFLF     EQU    73000B-2    MAXIMUM FIELD LENGTH FACTOR
 LOFL     EQU    43000B-2    LOWER OPTIMUM FL FOR L AND F TAPE COPIES 
****
          SPACE  4,10 
*         SPECIAL ENTRY POINTS. 
  
 NPC=     EQU    0           FORCE OPERATING SYSTEM PARAMETER FORMAT
 SSM=     EQU    0           SUPPRESS DUMPS OF FIELD LENGTH 
          TITLE  MACRO DEFINITIONS. 
 CWRW     SPACE  4,15 
**        CWRW - CONTROL WORD READ WORDS TO WORKING BUFFER. 
* 
*         CWRW   FILE,BUF,N 
* 
*                FILE        FWA FET.  PARAMETER PROVIDED ONLY FOR
*                            COMPATIBILITY WITH READW MACRO.  INPUT 
*                            FET IS ALWAYS USED BY CWR ROUTINE. 
*                BUF         FWA WORKING BUFFER.  PARAMETER PROVIDED
*                            ONLY FOR COMPATIBILITY WITH READW MACRO. 
*                            (FWWB) IS ALWAYS USED BY CWR ROUTINE.
*                N           NUMBER OF WORDS TO TRANSFER. 
* 
*         CALLS  CWR. 
  
  
 CWRW     MACRO  F,S,N
          R=     X7,N 
          RJ     CWR
          ENDM
 CWWW     SPACE  4,15 
**        CWWW - CONTROL WORD WRITE WORDS FROM WORKING BUFFER.
* 
*         CWWW   FILE,BUF,N 
* 
*                FILE        FWA FET. 
*                BUF         FWA WORKING BUFFER.
*                N           NUMBER OF WORDS TO TRANSFER. 
* 
*         CALLS  CWW. 
  
  
 CWWW     MACRO  F,S,N
          R=     B7,N 
          R=     B6,S 
          R=     X2,F 
          RJ     CWW
          ENDM
          SPACE  4,10 
*CALL     COMCMAC 
*CALL     COMSLFM 
          QUAL   MTX
*CALL     COMSMTX 
          QUAL   *
*CALL     COMSSRT 
          TITLE  FETS.
          ORG    120B 
 FETS     BSS    0
  
  
 I        BSS    0           INPUT FILE 
 INPUT    FILEB  IBUF,FBUFL,FET=FETL
          BSSZ   FETODL      OPTICAL DISK FET EXTENSION 
 CWF      EQU    *-I         CONTROL WORD FLAG
          CON    0           NONZERO IF CONTROL WORDS ENABLED ON INPUT
 SLF      EQU    *-I         FORMAT FLAG
          CON    0           1= S TAPE, 2= L TAPE, -1= F TAPE, 0= OTHER 
 TCF      EQU    *-I         TCOPY CONVERSION FORMAT
          CON    0           -3=I,-2=SI,-1=X,1=E,2=B,0=NO CONVERSION
 PRU      EQU    *-I         PRU SIZE (IN CM WORDS) 
          CON    -1 
 NSZ      EQU    *-I         NOISE SIZE (24/BITS, 18/UBC, 18/LENGTH)
          CON    0
 TRK      EQU    *-I         TRACK BITS, TAPE TYPE AND LABEL TYPE 
          CON    0           1/NT,1/MT,2/TAPE TYPE,50/0,6/LABEL TYPE
 ODF      EQU    *-I         FORMAT FLAG (OD SIMILAR TO L)
          CON    0
  
  
 O        BSS    0           OUTPUT FILE
 OUTPUT   FILEB  OBUF,FBUFL,FET=FETL
          BSSZ   FETODL      OPTICAL DISK FET EXTENSION 
          CON    0           NONZERO IF CONTROL WORDS ENABLED ON OUTPUT 
          CON    0           1= S TAPE, 2= L TAPE, -1= F TAPE, 0= OTHER 
          CON    0           1=E, 2=B, 0=NO CONVERSION
          CON    -1          PRU SIZE (IN CM WORDS) 
          CON    0           NOISE SIZE (24/BITS, 18/UBC, 18/LENGTH)
          CON    0           1/NT,1/MT,2/TAPE TYPE,50/0,6/LABEL TYPE
          CON    0           FORMAT FLAG (OD SIMILAR TO L)
  
  
 L        FILEB  LBUF,LBUFL  ALTERNATE OUTPUT FILE
          ORG    L
          VFD    42/0LOUTPUT,17/1,1/1 
          ORG    L+FETL 
          TITLE  DATA STORAGE.
**        DATA STORAGE. 
  
  
 BTSK     CON    0           BLOCK TERMINATOR/SKIP WORD INDICATOR 
 CWBC     CON    0           READCW BYTE COUNT
 CRI      CON    -2          CALLING ROUTINE INDICATOR
 CT       CON    1           COPY COUNT 
 EL       CON    0           ERROR LIMIT
 EORF     CON    1           CURRENT BLOCK EOR FLAG 
 ERRF     CON    0           CURRENT BLOCK ERROR FLAG 
 FUBC     CON    0           FULL BLOCK UNUSED BIT COUNT (S, L TAPES) 
 FWWB     CON    BUF1+1      FWA WORKING BUFFER 
 LVL      CON    0           EOR LEVEL NUMBER 
 LWDB     CON    0           LWA+1 DATA TRANSFERRED TO WORKING BUFFER 
 NS       CON    0           NOISE SIZE 
 NSFG     CON    0           NOISE SIZE FORCED UP FLAG
 RWCB     VFD    1/1,59/0    REMAINING WORDS IN CURRENT BLOCK 
 RWTT     CON    0           REMAINING WORDS TO TRANSFER
 SBT      CON    -1          SINGLE BUFFER READ/WRITE THRESHOLD 
 SK       CON    0           SKIP FLAG
 TC       CON    1           TERMINATION CONDITION (-1=EOI,0=EOD,1=EOF) 
 UBC      CON    0           UNUSED BIT COUNT FOR CURRENT WRITE 
 UBCB     CON    0           UNUSED BIT COUNT FOR CURRENT BLOCK 
 VF       CON    0           VERIFY FLAG
  
 BC       CON    -1          BLOCK COUNT
 RC       CON    0           RECORD COUNT 
  
 ESPI     CON    0           ERROR BLOCKS SKIPPED/PROCESSED INDICATOR 
 NPDI     CON    0           NOISE BLOCKS PADDED/DELETED INDICATOR
 RSAI     CON    0           RECORD SPLIT ALLOWED INDICATOR 
 SEWI     CON    0           SKIP EOF WRITE INDICATOR 
 TLLI     CON    0           TRUNCATE LONG LINES INDICATOR
  
 BFCT     CON    0           BAD FORMAT BLOCK COUNT 
 NZCT     CON    0           NOISE BLOCK COUNT
 PBCT     CON    0           PARITY/BLOCK TOO LARGE ERROR COUNT 
 RSCT     CON    0           RECORD SPLIT COUNT 
  
 FCPY     CON    0           FILE COPY COUNT
 RCPY     CON    0           RECORD COPY COUNT
 WCPY     CON    0           WORD COPY COUNT
          SPACE  4,10 
**        TECA - TABLE OF ERROR COUNT ADDRESSES.
* 
*T        6/ EF, 18/ DMSA, 18/ OMSA, 18/ ERCA 
* 
*         EF     ERROR FLAG VALUE.
*         DMSA   DAYFILE ERROR SUMMARY MESSAGE ADDRESS. 
*         OMSA   ALTERNATE OUTPUT FILE ERROR MESSAGE ADDRESS. 
*         ERCA   ERROR COUNT ADDRESS. 
  
  
 TECA     BSS    0
          VFD    6/-1,18/IESA,18/PDED,18/PBCT  PARITY/BLOCK TOO LARGE 
          VFD    6/1,18/IESC,18/PDEF,18/BFCT   BAD FORMAT BLOCK ERROR 
 TECAL1   EQU    *-TECA 
          VFD    6/0,18/IESD,18/0,18/NZCT      NOISE BLOCKS PROCESSED 
          VFD    6/0,18/IESE,18/0,18/RSCT      RECORD SPLITS PROCESSED
 TECAL2   EQU    *-TECA 
          TITLE  COPY/COPYBF/COPYEI.
 COPY     SPACE  4,10 
**        COPY - COPY ONE FILE TO ANOTHER UNTIL SPECIFIED TERMINATION 
*         CONDITION IS MET. 
* 
*         EXIT   TO *CPY*.
  
  
 COPY     SX6    -1          INDICATE *COPY* CALL 
          RJ     CTP         COPY/TCOPY PRESET PROGRAM
          EQ     CPY         PROCESS FILE COPY
 COPYBF   SPACE  4,10 
**        COPYBF - COPY SPECIFIED NUMBER OF FILES FROM ONE FILE TO
*         ANOTHER.
* 
*         EXIT   TO *CPY*.
  
  
 COPYBF   SX6    1           INDICATE *COPYBF* CALL 
          RJ     PRS         PRESET PROGRAM 
          EQ     CPY         PROCESS FILE COPY
 COPYEI   SPACE  4,10 
**        COPYEI - COPY ONE FILE TO ANOTHER UNTIL END OF INFORMATION
*         IS ENCOUNTERED. 
* 
*         EXIT   TO *CPY*.
  
  
 COPYEI   SX7    -1          SET TERMINATION CONDITION
          SX6    2           INDICATE *COPYEI* CALL 
          SA7    TC 
          RJ     PRS         PRESET PROGRAM 
*         EQ     CPY         PROCESS COPY TO EOI
 CPY      SPACE  4,10 
**        CPY - COPY FILES. 
* 
*         EXIT   TO *SBC*, IF SINGLE BUFFER COPY. 
*                TO *END*, IF COPY COMPLETE.
*                TO *END5*, IF EOI ENCOUNTERED. 
* 
*         USES   A - 0, 1, 2. 
*                X - 1, 2.
* 
*         CALLS  CPF, WNB=. 
  
  
 CPY      SA2    SBT         GET SINGLE BUFFER COPY INDICATOR 
          PL     X2,SBC      IF NO DATA MANIPULATION REQUIRED 
          SA1    O+CWF
          SA0    BUFL-3      DEFAULT WORKING BUFFER LENGTH
          ZR     X1,CPY1     IF CONTROL WORD WRITE DISABLED 
          RECALL O
          WRITECW O,*        PRESET CONTROL WORD WRITE FUNCTION 
          SA2    O+PRU       GET OUTPUT PRU SIZE
          SA0    X2+
 CPY1     RJ     CPF         COPY FILE
          SA1    CT 
          NG     X0,END5     IF EOI ENCOUNTERED 
          ZR     X1,END      IF COPY COMPLETE 
          EQ     CPY1        CONTINUE COPY
 SBC      SPACE  4,10 
**        SBC - SINGLE BUFFER COPY. 
* 
*         EXIT   TO *END*, IF COPY COMPLETE.
*                TO *END5*, IF EOI ENCOUNTERED. 
* 
*         USES   A - 0, 1, 2, 3, 4, 6, 7. 
*                B - 3, 6, 7. 
*                X - ALL. 
* 
*         CALLS  ABP, CIO=, DRN, PDE, PEF, SYS=, WNB=.
* 
*         PROGRAMMER,S NOTE - WHEN CHECKING FOR FET COMPLETE AND
*         DATA IN THE BUFFER, THE FET STATUS MUST BE PICKED UP
*         BEFORE THE BUFFER POINTER.
  
  
 SBC      RECALL O
          WRITECW O,*        PRESET CONTROL WORD WRITE
          SA2    I+3
          BX5    X5-X5       INDICATE NO DATA TRANSFERRED 
          SA0    X2+         INITIALIZE INPUT PSEUDO OUT POINTER
          BX0    X0-X0       INDICATE NO BLOCKS AVAILABLE OR COMPLETE 
          EQ     SBC13       INITIATE CONTROL WORD READ 
  
*         CHECK FOR INPUT BLOCK AVAILABLE.
  
 SBC1     SA2    I           CHECK INPUT FILE STATUS
          SA3    I+2         CHECK INPUT IN = PSEUDO OUT POINTER
          BX0    X0-X0       INDICATE NO BLOCKS AVAILABLE OR COMPLETE 
          SX1    A0 
          IX1    X3-X1
          LX2    59-0 
          NZ     X1,SBC3     IF INPUT BLOCK AVAILABLE 
          PL     X2,SBC7     IF BUFFER BUSY 
          LX2    59-11-59+0 
          NG     X2,SBC17    IF PARITY ERROR STATUS IN FET
          LX2    59-3-59+11 
          PL     X2,SBC7     IF NOT EOF 
          LX2    59-9-59+3
          PL     X2,SBC2     IF NOT EOI 
          SX0    -1          INDICATE EOI ENCOUNTERED 
  
*         PROCESS EOF OR EOI. 
  
 SBC2     RJ     PEF         PROCESS EOF
          SA1    CT 
          NG     X0,END5     IF EOI ENCOUNTERED 
          ZR     X1,END      IF COPY COMPLETE 
          SA2    O+2         UPDATE INPUT IN = OUTPUT IN
          LX6    X2 
          BX5    X5-X5       INDICATE NO DATA TRANSFERRED 
          SA6    I+2
          SA0    X2          UPDATE INPUT PSEUDO OUT POINTER
          SX0    B1          FORCE CHECK ON OUTPUT
          SA3    SBT
          NZ     X3,SBC13    IF NOT LARGE L OR F TAPE COPY
          SA2    SK 
          NZ     X2,SBC13    IF SKIP SET
          SA6    A6+B1       UPDATE INPUT OUT = OUTPUT IN 
          WRITECW O,R        FORCE WRITE ON LARGE L OR F TAPE 
          EQ     SBC13       REINITIATE CONTROL WORD READ 
  
*         PROCESS INPUT BLOCK.
  
 SBC3     SX0    B1          INDICATE INPUT BLOCK TRANSFERRED 
          SA3    BC          INCREMENT BLOCK COUNT
          SX5    B1          INDICATE DATA TRANSFERRED
          IX6    X3+X5
          SA4    A0          CRACK CONTROL WORD HEADER
          MX7    -24
          SA6    A3 
          BX7    -X7*X4      BYTE COUNT 
          SX2    4           CALCULATE WORD COUNT 
          IX7    X7+X2
          SX2    X2+B1
          IX7    X7/X2
          AX4    36 
          SB6    X7 
          SA2    EORF        CHECK FOR PREVIOUS EOR 
          SB7    X4          PRU SIZE 
          ZR     X2,SBC4     IF PREVIOUS BLOCK NOT EOR
          SA2    I+4         GET FWA DATA IN BLOCK
          SX3    B1 
          SX1    A0 
          RJ     ABP
          BX2    -X6         INDICATE BLOCK IN CIO BUFFER 
          SX1    X6+B6
          RJ     DRN         DISPLAY RECORD NAME
 SBC4     SA4    I+SLF
          SA2    I+4
          SX6    -B1         INDICATE EOR STATUS FOR S, L, F TAPE 
          NZ     X4,SBC5     IF S, L, OR F INPUT TAPE 
          SX6    B6-B7       NO EOR IF FULL BLOCK 
 SBC5     SA1    WCPY 
          SA6    EORF        SAVE EOR FLAG
          SX7    B6 
          IX7    X1+X7       INCREMENT WORD COPY COUNT
          SA7    A1 
          SX1    A0 
          ZR     X6,SCB5.1   IF NOT EOR/EOF 
          SX3    B6+1 
          RJ     ABP         FIND POSITION TRAILER CONTROL WORD 
          SA1    RCPY 
          SA2    I+4
          SA4    X6          TRAILER CONTROL WORD 
          MX7    -12
          LX4    12 
          SX6    X1+B1       INCREMENT RECORD COPY COUNT
          SA6    A1 
          SA1    FCPY 
          BX7    -X7*X4 
          SX7    X7-17B      CHECK FOR EOF
          NZ     X7,SCB5.1   IF NOT EOF 
          SX6    X1+1        INCREMENT FILE COUNT 
          SA6    A1+
 SCB5.1   SX3    B6+2        ADVANCE OVER BLOCK AND CONTROL WORDS 
          SX1    A0 
          RJ     ABP
          SA1    A0+         GET CONTROL WORD HEADER
          NG     X1,SBC16    IF ERROR OCCURRED ON THIS BLOCK
  
*         TRANSFER BLOCK TO OUTPUT. 
  
 SBC6     SA6    O+2         ADVANCE OUTPUT IN POINTER
          SA1    SK 
          SA0    X6          ADVANCE INPUT PSEUDO OUT POINTER 
          ZR     X1,SBC7     IF SKIP NOT SET
          SA6    A6+B1       ADVANCE OUTPUT OUT POINTER 
          SA6    I+3         ADVANCE INPUT OUT POINTER
          EQ     SBC11       CONTINUE CONTROL WORD READ 
  
*         CHECK FOR REINITIATE CONTROL WORD WRITE.
  
 SBC7     SA1    SK 
          NZ     X1,SBC11    IF SKIP SET
          SA2    O           CHECK OUTPUT FILE STATUS 
          SA1    O+2
          LX2    59-0 
          PL     X2,SBC10    IF BUFFER BUSY 
          SA2    A1+B1       CHECK BUFFER THRESHOLD 
          SA3    SBT
          IX1    X1-X2       (IN-OUT) 
          IX2    X1-X3       (IN-OUT) - 1/3(BUFFER SIZE)
          ZR     X1,SBC10    IF BUFFER EMPTY
          ZR     X3,SBC9     IF FORCE WRITE ON LARGE L OR F TAPE
          PL     X1,SBC8     IF IN .GT. OUT 
          LX3    1
          IX2    X3+X1       2/3(BUFFER SIZE) - (OUT-IN)
 SBC8     NG     X2,SBC10    IF BUFFER THRESHOLD NOT REACHED
 SBC9     WRITECW O          REINITIATE CONTROL WORD WRITE
  
*         CHECK FOR OUTPUT BLOCK WRITTEN. 
  
 SBC10    SA1    O+3         CHECK OUTPUT OUT = INPUT OUT 
          SA2    I+3
          IX3    X1-X2
          ZR     X3,SBC11    IF BLOCK NOT WRITTEN 
          BX6    X1 
          SX0    X0+B1       INDICATE OUTPUT BLOCK COMPLETE 
          SA6    A2          UPDATE INPUT OUT = OUTPUT OUT
  
*         CHECK FOR REINITIATE CONTROL WORD READ. 
  
 SBC11    SA4    I           CHECK INPUT FILE STATUS
          LX4    59-0 
          PL     X4,SBC15    IF BUFFER BUSY 
          SA1    I+2
          LX4    59-11-59+0 
          NG     X4,SBC15    IF PARITY ERROR STATUS IN FET
          LX4    59-3-59+11 
          NG     X4,SBC15    IF EOF/EOI ENCOUNTERED 
          SA3    SBT         CHECK BUFFER THRESHOLD 
          SA2    A1+B1
          IX1    X1-X2       (IN-OUT) 
          IX2    X3+X1       1/3(BUFFER SIZE) + (IN-OUT)
          ZR     X1,SBC13    IF BUFFER EMPTY
          ZR     X3,SBC15    IF WAIT FOR WRITE ON LARGE L OR F TAPE 
          NG     X1,SBC12    IF OUT .GT. IN 
          LX3    1
          IX2    X1-X3       (IN-OUT) - 2/3(BUFFER SIZE)
 SBC12    PL     X2,SBC15    IF BUFFER THRESHOLD NOT REACHED
 SBC13    SA1    TC          CHECK TERMINATION CONDITION
          PL     X1,SBC14    IF NOT COPY TO EOI 
          SA2    SEWI        CHECK SKIP EOF WRITE INDICATOR 
          NZ     X2,SBC14    IF PO=M OPTION SELECTED
          READCW I,0         INITIATE CONTROL WORD READ TO EOI
          EQ     SBC15       CHECK FOR RECALL 
  
 SBC14    READCW I,17B       INITIATE CONTROL WORD READ TO EOF
  
*         CHECK FOR RECALL. 
  
 SBC15    NZ     X0,SBC1     IF INPUT AND/OR OUTPUT BLOCKS TRANSFERRED
          RECALL             WAIT FOR DATA TRANSFER 
          EQ     SBC1        CHECK FOR INPUT BLOCKS 
  
*         PROCESS PARITY OR BLOCK TOO LARGE ERROR.
  
 SBC16    BX5    X6          SAVE ADVANCED POINTER VALUE
          SB3    B0          INDICATE PARITY/BLOCK TOO LARGE ERROR
          RJ     PDE         PROCESS ERROR
          BX6    X5 
          SA2    ESPI        CHECK ERROR BLOCKS SKIPPED OR PROCESSED
          SX7    A0 
          NZ     X2,SBC6     IF BLOCK TO BE PROCESSED 
          SA7    I+2         BACKUP INPUT IN POINTER
          RECALL I           WAIT FOR ERROR STATUS COMPLETION 
 SBC17    SX2    I
          RJ     CUE         CHECK FOR UNRECOVERABLE ERROR
          SX0    B1+         FORCE CHECK ON OUTPUT
          SA3    SBT
          NZ     X3,SBC13    IF NOT LARGE L OR F TAPE COPY
          RECALL O           WAIT FOR WRITE TO COMPLETE 
          EQ     SBC13       REINITIATE CONTROL WORD READ 
          TITLE  COMMON COPY ROUTINES.
 ABP      SPACE  4,15 
**        ABP - ADVANCE BUFFER POINTER. 
* 
*         EXIT   (A2) = ADDRESS OF LIMIT POINTER. 
*                (X1) = IN OR OUT POINTER TO BE UPDATED.
*                (X2) = LIMIT POINTER.
*                (X3) = NUMBER OF WORDS TO ADVANCE. 
* 
*         EXIT   (X6) = ADVANCED IN OR OUT POINTER VALUE. 
* 
*         USES   A - 2. 
*                X - 1, 2, 3, 6.
  
  
 ABP      SUBR               ENTRY/EXIT 
          SX2    X2+
          IX2    X2-X1
          IX6    X3-X2
          NG     X6,ABP1     IF NO WRAP AROUND
          SA2    A2-3        FIRST
          BX3    X6 
          SX1    X2 
 ABP1     IX6    X1+X3
          EQ     ABPX        RETURN 
 ABT      SPACE  4,15 
**        ABT - ABORT ROUTINE.
* 
*         FLUSHES OUTPUT FILE BUFFER.  FLUSHES ALTERNATE OUTPUT FILE
*         BUFFER, IF NECESSARY.  ISSUES DAYFILE MESSAGES. 
* 
*         ENTRY  (B5) = FWA MESSAGE, IF ENTRY AT *ABT4*.
* 
*         USES   A - 1, 2, 6. 
*                B - 2. 
*                X - 1, 2, 6. 
* 
*         CALLS  CIO=, IES, MSG=, SNM, SYS=.
  
  
 ABT4     SX6    B5+         SAVE ABORT MESSAGE ADDRESS 
          SA1    I           SET NAME IN MESSAGE
          MX2    42 
          SA6    ABTA 
          BX1    X2*X1
          SB2    1RX
          RJ     SNM
*         EQ     ABT
  
 ABT      SA1    SK 
          NZ     X1,ABT2     IF SKIP SET
          SA1    O+CWF
          ZR     X1,ABT1     IF CONTROL WORDS DISABLED ON OUTPUT
          WRITECW O          FLUSH OUTPUT BUFFER
          EQ     ABT2        ABORT
  
 ABT1     WRITER O           FLUSH OUTPUT BUFFER
  
 ABT2     SA1    EL 
          ZR     X1,ABT3     IF EXTENDED ERROR PROCESSING NOT IN EFFECT 
          WRITER L           FLUSH ALTERNATE OUTPUT FILE BUFFER 
 ABT3     RECALL I           FORCE 1MT ERROR MESSAGES TO DAYFILE FIRST
          RJ     IES         ISSUE ERROR SUMMARY MESSAGES 
          SA2    ABTA        ISSUE ABORT MESSAGE
          MESSAGE X2,0
          ABORT 
  
  
 ABTA     CON    ABTB        ABORT MESSAGE ADDRESS
  
 ABTB     DATA   C* ERROR LIMIT EXCEEDED.*
 ABTC     DATA   C* RECORD TOO LARGE ON XXXXXXX.* 
 ABTD     DATA   C* UNRECOVERABLE ERROR ON XXXXXXX.*
 BFL      SPACE  4,15 
**        BFL - BLANK FILL LINE.
* 
*         ENTRY  (B6) = LWA+1 CODED LINE. 
*                (B7) = LENGTH OF FULL LINE.
*                (FWWB) = FWA WORKING BUFFER. 
* 
*         EXIT   (B6) = LWA+1 BLANK FILLED LINE.
* 
*         USES   A - 1, 2, 6. 
*                B - 4, 6.
*                X - 1, 2, 3, 6.
* 
*         CALLS  SFN. 
  
  
 BFL      SUBR               ENTRY/EXIT 
          SA2    FWWB        FWA WORKING BUFFER 
          SA1    B6-B1       GET LAST WORD OF LINE
          SB4    X2+B7
          NZ     X1,BFL1     IF LAST WORD NOT ZERO
          SB6    B6-B1       GET PREVIOUS WORD OF LINE
          SA1    B6-B1
 BFL1     RJ     SFN         BLANK FILL LAST DATA WORD
          SA6    A1 
          SA2    =10H 
          BX6    X2 
 BFL2     GE     B6,B4,BFLX  IF AT LINE LIMIT 
          SA6    B6          BLANK FILL TO LINE LIMIT 
          SB6    B6+B1
          EQ     BFL2        CONTINUE BLANK FILL
 CPF      SPACE  4,15 
**        CPF - COPY FILE.
* 
*         ENTRY  (A0) = WORD COUNT FOR READ.
*                (FWWB) = FWA WORKING BUFFER. 
* 
*         EXIT   (X0) .LT. 0, IF EOI ENCOUNTERED. 
*                (CT) = 0, IF COPY COMPLETE.
* 
*         USES   A - 1, 2, 4. 
*                B - 2, 3, 4, 5, 6, 7.
*                X - 0, 1, 2, 4, 5. 
* 
*         CALLS  CIO=, CWR, CWW, DRN, PEF, RDW=, SSL, WNB=, WTW=. 
  
  
 CPF9     SX0    X1+B1       PROCESS END OF FILE
          RJ     PEF
  
 CPF      SUBR               ENTRY/EXIT 
          BX5    X5-X5       INDICATE NO DATA TRANSFERRED 
          SA1    I+CWF
          SX0    B1          INDICATE READ TO BE REINITIATED
          ZR     X1,CPF1     IF CONTROL WORD READ DISABLED
          SA2    I+TCF
          SB3    -B1
          SB2    X2 
          LT     B2,B3,CPF1  IF I OR SI-C TAPE READ VIA S/L FORMAT
          READCW I,17B       INITIATE CONTROL WORD READ 
 CPF1     SA1    O+CWF
          NZ     X1,CPF2     IF CONTROL WORD WRITE ENABLED
          RECALL O
          WRITE  O,*         PRESET STANDARD WRITE
 CPF2     SA1    I+CWF
          ZR     X1,CPF3     IF CONTROL WORD READ DISABLED
          CWRW   I,(FWWB),A0
          EQ     CPF5        CHECK READ STATUS
  
 CPF3     ZR     X0,CPF4     IF PREVIOUS READ STATUS NOT EOR
          READ   I           INITIATE STANDARD READ 
 CPF4     SA4    FWWB        FWA WORKING BUFFER 
          READW  I,X4,A0
 CPF5     NG     X1,CPF9     IF EOF/EOI ENCOUNTERED 
          SX5    B1+         INDICATE DATA TRANSFERRED
          SB4    X0          SAVE PREVIOUS READ STATUS
          SB5    X1          SAVE CURRENT READ STATUS 
          ZR     X0,CPF6     IF PREVIOUS READ STATUS NOT EOR
          RJ     VNS         VERIFY NOISE SIZE BLOCK
          SX0    B5          RESTORE CURRENT READ STATUS
          NG     X4,CPF2     IF NOISE BLOCK 
          SA2    FWWB        DISPLAY RECORD NAME
          RJ     DRN
 CPF6     SA1    FWWB        FWA WORKING BUFFER 
          SA2    SK 
          SX0    B5          RESTORE CURRENT READ STATUS
          SB3    X1 
          SA3    WCPY 
          NZ     X2,CPF10    IF SKIP SET
          SA2    O+SLF
          SA1    O+CWF
          SB7    B6-B3
          SB2    X2 
          SX4    B7 
          IX6    X4+X3       ADD CURRENT WORD COPY COUNT
          SA6    A3+
          ZR     X1,CPF8     IF CONTROL WORD WRITE DISABLED 
          LE     B2,CPF7     IF NOT S OR L OUTPUT TAPE
          RJ     SSL         SPECIAL PROCESSING FOR S OR L OUTPUT TAPE
 CPF7     CWWW   O,B3,B7
          EQ     CPF2        CONTINUE COPY
  
 CPF8     WRITEW O,B3,B7
          ZR     X0,CPF2     IF CURRENT READ STATUS NOT EOR 
          WRITER O
          SA1    RCPY        INCREMENT RECORD COUNT 
          SX6    X1+B1
          SA6    A1 
          EQ     CPF1        PRESET STANDARD WRITE
  
 CPF10    SX4    B6-B3
          IX6    X4+X3       ADD WORDS COPIED 
          SA6    A3+
          ZR     X0,CPF2     IF NOT EOR 
          SA1    RCPY        INCREMENT RECORD COUNT 
          SX6    X1+B1
          SA6    A1 
          EQ     CPF2        CONTINUE COPY
 CUE      SPACE  4,15 
**        CUE - CHECK UNRECOVERABLE ERROR.
* 
*         CLEARS ERROR STATUS FROM FET AND CLEARS BLOCK ERROR FLAG. 
*         ABORTS IF UNRECOVERABLE ERROR IS DETECTED (IF LAST BLOCK
*         PROCESSED DID NOT HAVE A PARITY OR BLOCK TOO LARGE ERROR).
* 
*         ENTRY  (X2) = FWA FET.
*                (ERRF) = ERROR FLAG FOR LAST BLOCK PROCESSED.
* 
*         EXIT   TO *ABT4*, IF UNRECOVERABLE ERROR DETECTED.
* 
*         USES   A - 1, 3, 6, 7.
*                B - 5. 
*                X - 1, 3, 6, 7.
  
  
 CUE      SUBR               ENTRY/EXIT 
          SA3    ERRF        LAST BLOCK ERROR FLAG
          SB5    ABTD        * UNRECOVERABLE ERROR ON LFN.* 
          SA1    X2 
          PL     X3,ABT4     IF NO PARITY ERROR ON LAST BLOCK 
          MX6    4           CLEAR ERROR STATUS FROM FET+0 BITS 10 - 13 
          LX6    14 
          SX7    B0          CLEAR BLOCK ERROR FLAG 
          BX6    -X6*X1 
          SA7    A3 
          SA6    A1 
          EQ     CUEX        RETURN 
 CWR      SPACE  4,20 
**        CWR - CONTROL WORD READ WORDS.
* 
*         ENTRY  (FWWB) = FWA WORKING BUFFER. 
*                (X7) = NUMBER OF WORDS TO TRANSFER.
* 
*         EXIT   (X1) = -1, IF EOF ENCOUNTERED. 
*                     = -2, IF EOI ENCOUNTERED. 
*                     = 0, IF TRANSFER COMPLETE AND NO EOR DETECTED.
*                     = (B6), IF EOR WAS DETECTED ON INPUT BEFORE OR
*                     IMMEDIATELY AFTER TRANSFER WAS COMPLETED. 
*                (B6) = LWA+1 DATA TRANSFERRED. 
*                (LVL) = EOR LEVEL NUMBER.
*                (UBC) = UNUSED BIT COUNT FOR LAST WORD TRANSFERRED.
* 
*         USES   A - 1, 2, 3, 4, 6, 7.
*                B - 2, 3, 6, 7.
*                X - 1, 2, 3, 4, 6, 7.
* 
*         CALLS  CEL, INB, RDW=.
  
  
 CWR      SUBR               ENTRY/EXIT 
          SA1    FWWB        FWA WORKING BUFFER 
          SA7    RWTT        SAVE NUMBER OF WORDS TO TRANSFER 
          BX6    X6-X6
          LX7    X1 
          SA2    RWCB 
          SA7    LWDB 
          SA6    LVL         CLEAR EOR LEVEL NUMBER 
          SA6    UBC         CLEAR UNUSED BIT COUNT 
          PL     X2,CWR1     IF WORDS REMAINING IN CURRENT BLOCK
          RJ     INB         INITIALIZE NEW BLOCK 
          NG     X1,CWRX     IF EOF/EOI ENCOUNTERED 
 CWR1     SA1    RWCB        REMAINING WORDS IN CURRENT BLOCK 
          SA2    RWTT        REMAINING WORDS TO TRANSFER
          IX6    X2-X1
          SA4    BTSK        BLOCK TERMINATOR/SKIP WORD INDICATOR 
          BX3    X2 
          SB7    X2 
          NG     X6,CWR2     IF MORE THAN ENOUGH DATA TO FILL BUFFER
          BX3    X1 
          SB7    X1+B1       ALSO TRANSFER CONTROL WORD TRAILER 
          ZR     X4,CWR2     IF NO BLOCK TERMINATOR OR EXTRA WORD 
          SB7    B7+B1       ALSO TRANSFER BLOCK TERMINATOR/EXTRA WORD
 CWR2     SA4    LWDB        LWA+1 DATA IN WORKING BUFFER 
          ZR     B7,CWR3     IF NO DATA REQUESTED 
          IX6    X1-X3       DECREMENT NUMBER OF WORDS IN CURRENT BLOCK 
          SA6    A1 
          IX7    X2-X3       DECREMENT NUMBER OF WORDS TO TRANSFER
          SA7    A2 
          IX6    X4+X3       INCREMENT WORKING BUFFER ADDRESS 
          SA6    A4 
          READW  I,X4,B7
 CWR3     SA4    RWCB 
          NZ     X4,CWR7     IF TRANSFER COMPLETE AND NO EOR
          SA3    LWDB        PROCESS TRAILER CONTROL WORD 
          SA4    BTSK        CHECK FOR BLOCK TERMINATOR OR EXTRA WORD 
          SA1    X3          GET TRAILER CONTROL WORD 
          ZR     X4,CWR4     IF NO BLOCK TERMINATOR OR EXTRA WORD 
          SA1    A1+B1
 CWR4     LX7    X1 
          SA2    UBCB        SET UNUSED BIT COUNT FOR BLOCK 
          AX7    48 
          BX6    X2 
          SA7    LVL
          MX7    1           SET INITIALIZE NEW BLOCK FLAG
          SA6    UBC
          SA7    RWCB 
          ZR     X2,CWR5     IF NO UNUSED BIT COUNT 
          SB3    59          CLEAR EXTRANEOUS DATA FROM LAST DATA WORD
          SB2    X2 
          MX2    1
          SA1    X3-1 
          SB2    B3-B2
          AX2    B2 
          BX6    X2*X1
          SA6    A1 
 CWR5     SB2    X4 
          LE     B2,CWR6     IF NOT I OR SI-C BLOCK TERMINATOR
          SA1    I+TCF
          SB2    B1+B1
          SB2    -B2
          SB3    X1 
          NE     B2,B3,CWR5.1  IF NOT SI-CODED TAPE 
          SA2    X3          PROCESS SI-CODED BLOCK TERMINATOR
          RJ     SIT
          PL     X1,CWR6     IF NOT SI-CODED EOF
          EQ     CWRX        RETURN 
  
 CWR5.1   SB2    B2-B1
          NE     B2,B3,CWR6  IF NOT I FORMAT VIA L FORMAT 
          SA2    X3          PROCESS I BLOCK TERMINATOR 
          RJ     IBT
          NG     X1,CWRX     IF I FORMAT EOF ENCOUNTERED
 CWR6     SA2    RWTT 
          ZR     X2,CWR7     IF TRANSFER COMPLETE 
          SA3    EORF 
          NZ     X3,CWR7     IF EOR ON CURRENT BLOCK
          RJ     INB         INITIALIZE NEW BLOCK 
          PL     X1,CWR1     IF EOF/EOI NOT ENCOUNTERED 
 CWR7     SA1    I+TCF
          SB2    B1+B1
          SB2    -B2
          SB3    X1 
          NE     B2,B3,CWR8  IF NOT SI-CODED TAPE 
          RJ     CEL         CONVERT END OF LINES 
 CWR8     SA3    LWDB        LWA+1 DATA TRANSFERRED 
          SA4    RWCB        REMAINING WORDS IN CURRENT BLOCK 
          SB6    X3 
          BX1    X1-X1
          SA2    EORF        EOR FLAG 
          PL     X4,CWRX     IF CURRENT BLOCK NOT DEPLETED
          ZR     X2,CWRX     IF NO EOR ON CURRENT BLOCK 
          SX1    B6 
          EQ     CWRX        RETURN 
 CWW      SPACE  4,20 
**        CWW - CONTROL WORD WRITE WORDS. 
* 
*         ENTRY  (X0) .NE. 0, IF EOR TO BE GUARANTEED IF MS/I/LI/SI-B 
*                     OUTPUT. 
*                (X2) = FWA FET.
*                (B6) = FWA WORKING BUFFER. 
*                (B7) = NUMBER OF WORDS TO TRANSFER.
*                IF (B7) = 0, EOR ONLY WILL BE WRITTEN IF MS/I/LI/SI-B
*                     OUTPUT. 
*                (UBC) = UNUSED BIT COUNT FOR BLOCK.
*                (LVL) = EOR LEVEL NUMBER.
* 
*         EXIT   (X2) = FWA FET.
* 
*         USES   A - 1, 3, 4, 6, 7. 
*                B - 5, 6, 7. 
*                X - 1, 3, 4, 6, 7. 
* 
*         CALLS  WTW=.
  
  
 CWW3     SA1    RCPY        EOR VIA NON-FULL PRU 
          SX6    X1+B1
          SA6    A1 
  
 CWW      SUBR               ENTRY/EXIT 
          ZR     B7,CWW2     IF WORKING BUFFER EMPTY
          SX6    B7          SAVE NUMBER OF WORDS 
          SB5    B7 
          SA6    CWWA 
          SX3    5           BUILD CONTROL WORD HEADER
          SA4    X2+ODF 
          SA1    UBC         GET UNUSED BIT COUNT FOR BLOCK 
          IX6    X6*X3       CALCULATE NUMBER OF BYTES
          ZR     X4,CWW1     IF MS/I/LI/SI-B OUTPUT 
          BX3    X1 
          ZR     X1,CWW1     IF NO UNUSED BIT COUNT 
          SX4    12          CALCULATE UNUSED BIT COUNT FOR BYTE
          LX7    X4 
          IX3    X3/X4
          IX6    X6-X3
          IX3    X3*X7
          IX1    X1-X3
          LX1    24 
          BX6    X1+X6       MERGE UNUSED BIT COUNT AND BLOCK LENGTH
 CWW1     SB6    B6-B1       RESET FWA WORKING BUFFER 
          SA3    LVL         GET EOR LEVEL NUMBER 
          SA6    B6          STORE HEADER CONTROL WORD
          BX7    X3 
          SB7    B5+B1       INCREMENT LENGTH OF WORKING BUFFER 
          LX7    -12
          SA7    B6+B7       STORE TRAILER CONTROL WORD 
          SB7    B7+B1
          WRITEW X2,B6,B7    WRITE CONTROL WORD BLOCK 
          SA3    CWWA        CHECK IF FULL PRU WRITTEN
          SA1    X2+PRU 
          IX1    X1-X3
          NZ     X1,CWW3     IF LAST BLOCK NOT FULL PRU 
 CWW2     SA3    LVL         BUILD TRAILER CONTROL WORD 
          SA1    X2+SLF 
          BX7    X3 
          ZR     X0,CWWX     IF NOT EOR STATUS
          SA3    RCPY        INCREMENT RECORD COUNT 
          SX6    X3+B1
          SA6    A3 
          LX7    -12
          SB6    CWWB 
          NZ     X1,CWWX     IF NOT MS/OD/I/LI/SI-B OUTPUT
          SA7    B6+B1
          WRITEW X2,B6,B1+B1 WRITE EOR ONLY 
          EQ     CWWX        RETURN 
  
  
 CWWA     CON    0           BLOCK SIZE IN WORDS
  
 CWWB     CON    0           CONTROL WORD EOR 
          CON    0
 DRN      SPACE  4,15 
**        DRN - DISPLAY RECORD NAME.
* 
*         ENTRY  (X2) = FWA RECORD.  IF (X2) .LT. 0, IT IS THE
*                     COMPLEMENT OF FWA RECORD IN INPUT CIO BUFFER. 
*                (X1) = FWA RECORD, IF ZERO LENGTH RECORD.
* 
*         EXIT   (RC) = UPDATED RECORD COUNT. 
* 
*         USES   A - 1, 2, 3, 6, 7. 
*                X - 1, 2, 3, 6, 7. 
* 
*         CALLS  MSG=.
  
  
 DRN      SUBR               ENTRY/EXIT 
          SA3    RC          INCREMENT RECORD COUNT 
          SX7    B1 
          IX6    X3+X7
          PL     X2,DRN1     IF NOT DISPLAY FROM CIO BUFFER 
          IX7    X2-X7
          BX2    -X2
 DRN1     IX1    X1-X2
          SA6    A3 
          ZR     X1,DRN2     IF ZERO LENGTH RECORD
          SA1    X2          GET RECORD NAME
          MX6    12 
          BX6    X6*X1
          LX6    12 
          SX6    X6-7700B 
          NZ     X6,DRN2     IF NOT 77 TABLE
          SA3    I+4
          SA1    A1+B1
          SX3    X3 
          PL     X7,DRN2     IF NOT DISPLAY FROM CIO BUFFER 
          SA2    I+1
          IX6    X3+X7       CHECK FOR WRAP AROUND
          NZ     X6,DRN2     IF NO WRAP AROUND
          SA1    X2 
 DRN2     MX7    42 
          BX7    X7*X1
          SA7    DRNA+1      ENTER NAME IN MESSAGE
          MESSAGE A7-B1,1    DISPLAY RECORD NAME
          EQ     DRNX        RETURN 
  
  
 DRNA     DATA   10H  COPYING 
          CON    0,0
 END      SPACE  4,15 
**        END - END ROUTINE.
* 
*         FLUSHES OUTPUT BUFFER, IF NECESSARY.  FLUSHES ALTERNATE 
*         OUTPUT FILE BUFFER, IF NECESSARY.  ISSUES DAYFILE MESSAGES. 
* 
*         ENTRY  AT *END5*, IF EOI ENCOUNTERED BEFORE COPY COMPLETE.
* 
*         EXIT   TO *VFY*, IF VERIFY REQUESTED. 
* 
*         USES   A - 1, 2, 6. 
*                X - 1, 2, 6. 
* 
*         CALLS  CIO=, IES, MSG=, SYS=. 
  
  
 END5     SX6    ENDC        *EOI ENCOUNTERED* OR *FILE NOT FOUND*
          SA1    ENDG 
          NZ     X1,END3.4   IF *FILE NOT FOUND*
          SA6    ENDA 
*         EQ     END
  
 END      SA1    SK 
          NZ     X1,END2     IF SKIP SET
          RECALL O
          SA1    O+2         CHECK *IN* = *OUT* 
          SA2    A1+B1
          IX1    X1-X2
          ZR     X1,END2     IF OUTPUT BUFFER EMPTY 
          SA2    O+CWF
          ZR     X2,END1     IF CONTROL WORD WRITE DISABLED 
          WRITECW O          FLUSH OUTPUT BUFFER
          EQ     END2        ISSUE COMPLETION MESSAGE 
  
 END1     WRITE  O           FLUSH OUTPUT BUFFER
 END2     SA1    EL 
          ZR     X1,END3     IF EXTENDED ERROR PROCESSING NOT IN EFFECT 
          WRITER L           FLUSH ALTERNATE OUTPUT FILE BUFFER 
 END3     RECALL I           FORCE 1MT ERROR MESSAGES TO DAYFILE FIRST
          RECALL O
          RECALL L
          SA2    ENDA        ISSUE ENDING MESSAGE 
          MESSAGE X2,0
          SA2    ENDA 
          SA1    X2+2        COPY STATUS
          SB2    1R/
          SB5    ENDF 
          RJ     SNM         SET TERMINATION TYPE INTO MESSAGE
          SA1    FCPY        FILE COUNT 
          RJ     CDD         CONVERT TO DISPLAY 
          SB2    B2-B1
          MX0    1
          AX1    X0,B2
          BX1    X1*X4       ZERO FILL
          SB2    1R+
          RJ     SNM         SET FILE COUNT INTO MESSAGE
          SA1    FCPY 
          SX1    X1-1 
          ZR     X1,END3.1   IF JUST ONE FILE 
          SA1    =1LS 
 END3.1   SB2    1R#
          RJ     SNM         SET PLURAL INTO MESSAGE
          SA1    RCPY        RECORD COUNT 
          RJ     CDD         CONVERT TO DISPLAY 
          SB2    B2-B1
          AX1    X0,B2
          BX1    X1*X4       ZERO FILL
          SB2    1R-
          RJ     SNM         SET FILE COUNT INTO MESSAGE
          SA1    RCPY 
          SX1    X1-1 
          ZR     X1,END3.2   IF JUST ONE RECORD 
          SA1    =1LS 
 END3.2   SB2    1R$
          RJ     SNM         SET PLURAL INTO MESSAGE
          SA1    WCPY        WORD COUNT 
          RJ     CDD         CONVERT TO DISPLAY 
          SB2    B2-B1
          AX1    X0,B2
          BX1    X1*X4       ZERO FILL
          SB2    1R,
          RJ     SNM         SET WORD COUNT INTO MESSAGE
          SA1    WCPY 
          SX1    X1-1 
          ZR     X1,END3.3   IF JUST ONE WORD 
          SA1    =1LS 
 END3.3   SB2    1R=
          RJ     SNM         SET PLURAL INTO MESSAGE
 END3.4   MESSAGE ENDF
          RJ     IES         ISSUE ERROR SUMMARY MESSAGES 
          SA1    VF 
          NZ     X1,VFY      IF VERIFY REQUESTED
          ZR     X0,END4     IF NO WARNING MESSAGES ISSUED
          MESSAGE ENDE,3     * CHECK DAYFILE FOR ERRORS.* 
 END4     ENDRUN
  
  
 ENDA     CON    ENDB        ENDING MESSAGE ADDRESS 
  
 ENDB     DATA   C* COPY COMPLETE.* 
          DATA   L*END* 
 ENDC     DATA   C* EOI ENCOUNTERED.* 
          DATA   L*EOI* 
 ENDD     DATA   C* EOF ENCOUNTERED.* 
          DATA   L*EOF* 
 ENDE     DATA   C* CHECK DAYFILE FOR ERRORS.*
 ENDF     DATA   C* ///. ++++++++++ FILE#; ---------- RECORD$; ,,,,,,,,,
,, WORD=.*
 ENDG     CON    0           FILE NOT FOUND FLAG
 ERP$     SPACE  4,35 
**        ERP$ - ERROR PROCESSING ROUTINE.
* 
*         WHEN A NON-FATAL ERROR (ERROR STATUS 02 IN BITS 10-13 OF
*         FET+0) IS DETECTED, CIO= EXITS TO ERP$.  SINCE ERROR
*         PROCESSING MUST BE ENABLED IN ORDER TO GET CONTROL BACK AFTER 
*         A NON-FATAL ERROR HAS OCCURRED, AND EP BIT IS SET ONLY WHEN 
*         CONTROL WORD READ IS ENABLED, THE ERROR PROCESSING ROUTINE
*         IS ENTERED AT ERP$ ONLY VIA CWR ROUTINE (CWR CALLS RDW= 
*         WHICH CALLS CIO= WHEN BUFFER IS EMPTY OR THRESHOLD IS 
*         REACHED, WHICH EXITS TO ERP$ UPON DETECTING 02 ERROR STATUS). 
* 
*         WHEN A PARITY OR BLOCK TOO LARGE ERROR OCCURS, BIT 59 OF THE
*         HEADER CONTROL WORD OF THE BLOCK IN ERROR IS SET IN ADDITION
*         TO THE ERROR STATUS IN THE FET, AND THE CONTROL WORD READ 
*         OPERATION TERMINATES SO THAT THE LAST BLOCK IN THE CIO BUFFER 
*         IS THE ONE IN ERROR.  WHEN SOME OTHER NON-FATAL ERROR SUCH AS 
*         WRONG PARITY, DENSITY CHANGE, OR READY DROP OCCURS, ONLY THE
*         ERROR STATUS IS SET IN THE FET.  THEREFORE, AFTER THE CIO 
*         BUFFER IS EMPTIED, THE JOB MUST BE ABORTED WITH 
*         *UNRECOVERABLE ERROR ON LFN.* IF THE LAST BLOCK PROCESSED 
*         DID NOT HAVE A PARITY OR BLOCK TOO LARGE ERROR. 
* 
*         ENTRY  (X2) = FWA FET.
*                (ERRF) = ERROR FLAG FOR LAST BLOCK PROCESSED.
* 
*         EXIT   (X7) = 0, IF EXIT TO *CIO=*. 
*                (X7) = PREVIOUS READ FUNCTION CODE, IF EXIT
*                     TO *CIO=+1*.
*                TO *CIO=*, IF CIO BUFFER NOT EMPTY (RETURN TO RDW= 
*                     WITHOUT REISSUING CIO FUNCTION).
*                TO *ERPX$* WHEN A RECOVERABLE ERROR OCCURS.
* 
*         USES   A - 1, 3.
*                X - 1, 3, 7. 
* 
*         CALLS  CUE. 
  
  
 ERP$     SA1    X2+2        IN POINTER 
          SA3    A1+B1       OUT POINTER
          IX1    X1-X3
          BX7    X7-X7       CLEAR CIO ERROR STATUS 
          NZ     X1,CIO=     IF BUFFER NOT EMPTY
          RJ     CUE         CHECK UNRECOVERABLE ERROR
          EQ     ERPX$       RESUME *CIO* FUNCTION
 IES      SPACE  4,10 
**        IES - ISSUE ERROR SUMMARY MESSAGES. 
* 
*         EXIT   (X0) = NUMBER OF ERROR SUMMARY MESSAGES ISSUED.
* 
*         USES   A - 1, 2, 6. 
*                B - 5, 6, 7. 
*                X - 0, 1, 2, 6.
* 
*         CALLS  INM, MSG=. 
  
  
 IES      SUBR               ENTRY/EXIT 
          SB6    B0 
          BX0    X0-X0
          SB7    TECAL2 
 IES1     GE     B6,B7,IESX  IF END OF ERROR COUNTS 
          SA2    TECA+B6
          SB6    B6+B1
          SA1    X2 
          ZR     X1,IES1     IF NO ERRORS OF THIS TYPE OCCURRED 
          AX2    36 
          SX0    X0+B1
          SB5    X2+
          RJ     INM         INSERT NUMBER IN MESSAGE 
          MESSAGE B5,3       ISSUE MESSAGE TO USERS DAYFILE 
          EQ     IES1        CONTINUE ERROR SUMMARY PROCESSING
  
  
 IESA     DATA   C* XXXXXXXXXX PARITY/BLOCK TOO LARGE ERRORS.*
 IESC     DATA   C* XXXXXXXXXX BAD FORMAT BLOCKS.*
 IESD     DATA   C* XXXXXXXXXXXXXXX NOISE BLOCKS PADDED.* 
 IESE     DATA   C* XXXXXXXXXX RECORD SPLITS OCCURRED.* 
 INB      SPACE  4,15 
**        INB - INITIALIZE NEW BLOCK. 
* 
*         EXIT   CONTROL WORD HEADER CRACKED AND FLAGS/COUNTS SET.
*                (X1) = 0, IF INITIALIZATION COMPLETE.
*                     = -1, IF EOF ENCOUNTERED. 
*                     = -2, IF EOI ENCOUNTERED. 
* 
*         USES   A - 1, 2, 3, 4, 6, 7.
*                X - 1, 2, 3, 4, 6, 7.
* 
*         CALLS  ABP, ISI, IXB, PDE, RDW=.
  
  
 INB8     SA2    I+TCF
          SX2    X2+1 
          PL     X2,INBX     IF NOT I OR SI-C VIA S/L FORMAT
          SX1    -2          RETURN EOI IF TAPE MARK ENCOUNTERED
  
 INB      SUBR               ENTRY/EXIT 
 INB1     READW  I,INBA,B1   READ HEADER CONTROL WORD 
          NG     X1,INB8     IF EOF/EOI ENCOUNTERED 
          SA2    BC          INCREMENT BLOCK COUNT
          SX6    B1 
          BX7    X7-X7       CLEAR BLOCK ERROR FLAG 
          IX6    X2+X6
          SA6    A2 
          SA7    ERRF 
          SA4    INBA        GET CONTROL WORD HEADER
          SA7    BTSK        CLEAR BLOCK TERMINATOR/SKIP WORD INDICATOR 
          MX3    -24         CRACK CONTROL WORD HEADER
          BX7    -X3*X4      BYTE COUNT 
          SA7    CWBC        READCW BYTE COUNT
          AX4    24 
          MX2    -6 
          LX3    X7 
          BX6    -X2*X4      UNUSED BIT COUNT FOR BYTE
          SX1    4
          IX7    X7+X1       ROUND UP BYTE COUNT
          SX1    X1+B1
          BX2    X1 
          IX7    X7/X1       CALCULATE WORD COUNT 
          AX4    12 
          IX2    X7*X2       CALCULATE UNUSED BIT COUNT FOR WORD
          SX1    12 
          IX2    X2-X3
          ZR     X2,INB2     IF NO EXTRA DATA BYTES 
          IX2    X2*X1
          IX6    X2+X6
 INB2     SA6    UBCB        SAVE UNUSED BIT COUNT FOR BLOCK
          SA7    RWCB        SAVE WORD COUNT FOR BLOCK
          SA1    I+SLF
          SX6    -1          INDICATE EOR STATUS FOR S, L, F TAPE 
          SX3    X4          PRU SIZE 
          NZ     X1,INB3     IF S, L, OR F TAPE 
          IX6    X7-X3       NO EOR IF FULL BLOCK 
 INB3     SA6    EORF        SAVE EOR FLAG
          NG     X4,INB6     IF ERROR OCCURRED ON THIS BLOCK
 INB4     SA2    I+TCF
          BX1    X1-X1
          SX3    X2+B1
          PL     X2,INBX     IF NOT TCOPY X, SI-CODED TO I INPUT TAPE 
          NZ     X3,INB5     IF NOT X BLOCK 
          RJ     IXB         INITIALIZE X FORMAT TAPE BLOCK 
          BX1    X1-X1       INDICATE INITIALIZATION COMPLETE 
          EQ     INBX        RETURN 
  
 INB5     SX3    X3+1 
          NZ     X3,INB5.1   IF NOT SI-CODED BLOCK
          RJ     ISI         INITIALIZE SI-CODED TAPE BLOCK 
          BX1    X1-X1       INDICATE INITIALIZATION COMPLETE 
          EQ     INBX        RETURN 
  
 INB5.1   RJ     IIB         INITIALIZE I FORMAT TAPE BLOCK 
          BX1    X1-X1       INDICATE INITIALIZATION COMPLETE 
          EQ     INBX        RETURN 
  
*         PROCESS PARITY OR BLOCK TOO LARGE ERROR.
  
 INB6     SB3    B0          INDICATE PARITY/BLOCK TOO LARGE ERROR
          RJ     PDE         PROCESS ERROR
          SA1    ESPI        ERROR BLOCKS SKIPPED/PROCESSED INDICATOR 
          NZ     X1,INB4     IF ERROR BLOCKS TO BE PROCESSED
          SA1    I+3         REMOVE BLOCK FROM BUFFER 
          SA3    RWCB        GET BLOCK WORD COUNT 
          SX3    X3+B1       REMOVE BLOCK AND TRAILER CONROL WORD 
          SA2    A1+B1       LIMIT
          RJ     ABP         ADVANCE INPUT OUT POINTER
          MX7    1           SET INITIALIZE NEW BLOCK FLAG
          SA6    A1 
          SA7    A3+
          EQ     INB1        PROCESS NEXT BLOCK 
  
  
 INBA     CON    0           CONTROL WORD HEADER
 INM      SPACE  4,15 
**        INM - INSERT NUMBER IN MESSAGE. 
* 
*         ENTRY  (B5) = FWA MESSAGE TO BE ISSUED. 
*                (X1) = NUMBER TO BE CONVERTED FOR MESSAGE. 
* 
*         EXIT   NUMBER CONVERTED TO DECIMAL DISPLAY AND ENTERED INTO 
*                     MESSAGE.
* 
*         USES   B - 2. 
*                X - 1. 
* 
*         CALLS  CDD, SNM.
  
  
 INM      SUBR               ENTRY/EXIT 
          RJ     CDD         CONVERT NUMBER TO DECIMAL DISPLAY
          SB2    B2-B1       CLEAR BLANK FILL 
          MX1    1
          AX1    B2 
          BX1    X1*X4
          SB2    1RX
          RJ     SNM         ENTER NUMBER IN MESSAGE
          EQ     INMX        RETURN 
 PDE      SPACE  4,15 
**        PDE - PROCESS DATA BLOCK ERROR. 
* 
*         ENTRY  (B3) = 0, IF PARITY OR BLOCK TOO LARGE ERROR.
*                     = 1, IF DATA ERROR. 
* 
*         EXIT   IF BLOCK ERROR FLAG NOT ALREADY SET, PARITY/BLOCK
*                     TOO LARGE, OR DATA ERROR COUNT INCREMENTED, AND 
*                     IF ERROR LIMIT NONZERO, ERROR MESSAGE ISSUED TO 
*                     ALTERNATE OUTPUT FILE.
*                TO *ABT*, IF ERROR LIMIT EXCEEDED. 
* 
*         USES   A - 1, 2, 3, 4, 6, 7.
*                B - 2, 3, 5, 7.
*                X - 1, 2, 3, 4, 6, 7.
* 
*         CALLS  INM, SNM, SYS=, WTC=, WTW=.
  
  
 PDE      SUBR               ENTRY/EXIT 
          SA1    ERRF 
          SA2    TECA+B3
          NZ     X1,PDEX     IF BLOCK ERROR FLAG ALREADY SET
          SA3    X2          INCREMENT CORRESPONDING ERROR COUNT
          SX6    B1 
          IX7    X3+X6
          SA4    EL 
          AX2    18 
          SA7    A3 
          ZR     X4,ABT      IF ZERO ERROR LIMIT
          SX7    X2          SAVE ERROR MESSAGE ADDRESS 
          AX2    36 
          SA7    PDEA 
          BX6    X2 
          SA6    A1          SET BLOCK ERROR FLAG 
          SB2    TECAL1-1 
          SX6    -B1
 PDE1     SA1    TECA+B2     CALCULATE TOTAL ERROR COUNT
          SA2    X1 
          SB2    B2-B1
          IX6    X6+X2
          GE     B2,PDE1     IF MORE ERROR COUNTS 
          BX7    X4 
          NG     X4,PDE2     IF UNLIMITED ERROR PROCESSING
          IX7    X6-X4
 PDE2     SA7    A7+B1       SAVE ABORT INDICATOR 
          NZ     X6,PDE3     IF NOT FIRST ERROR 
          WRITE  L,*         PRESET STANDARD WRITE
          WRITEW L,PDEC,B1+B1  WRITE HEADER LINE
          WRITEW X2,CCDR,8
          DATE   PDEC 
          CLOCK  PDEC+1 
          WRITEW X2,PDEC,5
 PDE3     SA2    PDEA        GET ERROR MESSAGE ADDRESS
          SB3    B0 
          SB2    X2 
          SB7    PDECL
          SB5    PDEC 
 PDE4     SA2    B2+B3       MOVE MESSAGE TO BUFFER 
          BX6    X2 
          SA6    B5+B3
          SB3    B3+B1
          LT     B3,B7,PDE4  IF MORE WORDS IN MESSAGE 
          SA1    BC          BLOCK COUNT
          RJ     INM         INSERT NUMBER IN MESSAGE 
          WRITEC L,B5 
          SA1    PDEB        GET ABORT INDICATOR
          NG     X1,PDEX     IF ERROR LIMIT NOT REACHED 
          EQ     ABT         ABORT
  
  
 PDEA     CON    0           ERROR MESSAGE ADDRESS
 PDEB     CON    0           ABORT INDICATOR
  
 PDECL    EQU    6
 PDEC     BSS    0           HEADER LINE AND MESSAGE BUFFER 
          CON    10H1- ERROR S
          CON    10HUMMARY -
          BSSZ   PDECL-2
  
 PDED     DATA   C* PARITY/BLOCK TOO LARGE ERROR IN BLOCK XXXXXXXXXX.*
 PDEF     DATA   C* INCORRECT FORMAT IN BLOCK XXXXXXXXXX.*
 PEF      SPACE  4,20 
**        PEF - PROCESS END OF FILE.
* 
*         GENERATES AN EOF ON OUTPUT WITH OR WITHOUT CONTROL WORDS
*         UNLESS ONE OF THE FOLLOWING CONDITIONS EXIST -
*                1.  SKIP FLAG IS SET.
*                2.  PO=M OPTION (SKIP EOF WRITE) IS SELECTED.
*                3.  LAST DOUBLE EOF (FOR TC=EOD COPY) IS ENCOUNTERED.
*                4.  FOR A COPY WITH A FILE COUNT SPECIFIED (COPYBF 
*                    OR COPY/TCOPY WITH TC=EOF PARAMETER), WHEN EOI 
*                    IS ENCOUNTERED ON INPUT AND NO DATA TRANSFER HAS 
*                    OCCURRED SINCE PREVIOUS EOF. 
*         THE COPY COUNT IS DECREMENTED WHEN APPLICABLE.
* 
*         ENTRY  (X0) .LT. 0, IF EOI ENCOUNTERED. 
*                (X5) = 0, IF EMPTY FILE ENCOUNTERED. 
* 
*         EXIT   (X0) .LT. 0, IF EOI ENCOUNTERED. 
*                (CT) = 0, IF COPY COMPLETE.
* 
*         USES   A - 1, 2, 3, 4, 6. 
*                B - 2. 
*                X - 0, 1, 2, 3, 4, 6.
* 
*         CALLS  CIO=, MSG=, WTW=.
  
  
 PEF3     WRITEF O           GENERATE EOF AND FLUSH BUFFER
 PEF4     SA1    TC          GET TERMINATION CONDITION
          NG     X0,PEFX     IF EOI ENCOUNTERED 
          NG     X1,PEFX     IF COPY TO EOI 
          SB2    X0+
          NZ     X1,PEF5     IF COPY TO FILE COUNT
          EQ     B2,B1,PEFX  IF EMPTY FILE NOT ENCOUNTERED
 PEF5     SX1    B1          DECREMENT COPY COUNT 
          SA2    CT 
          IX6    X2-X1
          SA6    A2+
  
 PEF      SUBR               ENTRY/EXIT 
          SA2    TC 
          SA4    SK 
          SA1    BC          INCREMENT BLOCK COUNT
          SA3    CT 
          SB2    X2 
          NG     X0,PEF2     IF EOI ENCOUNTERED 
          SX0    B1 
          IX6    X1+X0
          SA6    A1 
          NZ     X5,PEF1     IF DATA TRANSFERRED
          NZ     B2,PEF1     IF NOT COPY TO DOUBLE EOF
          SA2    RC 
          IX1    X3-X0
          ZR     X2,PEF1     IF NO RECORDS COPIED 
          SX0    B1+B1
          NZ     X1,PEF1     IF NOT LAST DOUBLE EOF 
          SA1    =10H SKIPPING   SKIP LAST EOF
          BX0    X0-X0
          LX6    X1 
          SA6    PEFB 
 PEF1     SA1    RC          ADVANCE RECORD COUNT 
          SX6    B1 
          IX6    X1+X6
          SA6    A1+
          MESSAGE  PEFB,1    DISPLAY EOF MESSAGE
          ZR     X0,PEF5     IF LAST DOUBLE EOF ENCOUNTERED 
          SA3    SEWI        SKIP EOF WRITE INDICATOR 
          NZ     X3,PEF4     IF PO=M OPTION SELECTED
          SA1    FCPY        INCREMENT FILE COUNT 
          SX6    X1+B1
          SA6    A1 
          SA2    O+CWF
          NZ     X4,PEF4     IF SKIP SET
          ZR     X2,PEF3     IF CONTROL WORD WRITE DISABLED 
          WRITEW O,PEFA,B1+B1 WRITE CONTROL WORD EOF
          EQ     PEF4        DECREMENT COPY COUNT 
  
 PEF2     NZ     X4,PEFX     IF SKIP SET
          LE     B2,PEFX     IF NOT COPY TO FILE COUNT
          ZR     X5,PEFX     IF NO DATA TRANSFERRED 
          EQ     PEF1        WRITE EOF
  
  
 PEFA     VFD    60/0        CONTROL WORD EOF 
          VFD    12/17B,48/0
  
 PEFB     DATA   C*  COPYING EOF.*
 SSL      SPACE  4,20 
**        SSL - SPECIAL PROCESSOR FOR S AND L OUTPUT TAPES. 
* 
*         ENTRY  (B4) = PREVIOUS READ STATUS. 
*                (B6) = LWA+1 DATA IN WORKING BUFFER. 
*                (B7) = NUMBER OF WORDS IN WORKING BUFFER.
*                (FWWB) = FWA WORKING BUFFER. 
* 
*         EXIT   (B6) = UPDATED LWA+1 DATA IN WORKING BUFFER. 
*                (B7) = UPDATED NUMBER OF WORDS IN WORKING BUFFER.
*                TO *ABT4*, IF RECORD TOO LARGE ENCOUNTERED AND RECORD
*                     SPLIT NOT ALLOWED.
* 
*         USES   A - 1, 2, 3, 4, 6. 
*                B - 5, 6, 7. 
*                X - 1, 2, 3, 4, 6. 
* 
*         CALLS  BFL. 
  
  
 SSL3     SA6    B6          ZERO FILL BLOCK TO NOISE SIZE
          SB6    B6+B1
          LT     B6,B5,SSL3  IF MORE WORDS TO ZERO
 SSL4     SA1    O+PRU       GET OUTPUT PRU SIZE
          SA3    UBC
          SX2    B7 
          SA4    FUBC 
          IX1    X1-X2
          BX6    X4 
          IX3    X3-X4
          NZ     X1,SSLX     IF NOT FULL BLOCK
          PL     X3,SSLX     IF LARGER UNUSED BIT COUNT ALREADY SET 
          SA6    A3+
  
 SSL      SUBR               ENTRY/EXIT 
          ZR     B7,SSLX     IF EOR ONLY
          NZ     B4,SSL1     IF PREVIOUS READ STATUS EOR
          SA1    RSAI        RECORD SPLIT ALLOWED INDICATOR 
          SB5    ABTC        * RECORD TOO LARGE ON LFN.*
          SA2    RSCT        INCREMENT RECORD SPLIT COUNT 
          ZR     X1,ABT4     IF RECORD SPLIT NOT ALLOWED
          SX6    X2+B1
          SA6    A2 
 SSL1     SA2    CRI
          SA1    O+NSZ       GET OUTPUT NOISE SIZE
          PL     X2,SSLX     IF NOT *COPY*
          SA3    FWWB        FWA WORKING BUFFER 
          SB5    X3 
          SB5    B5+X1       LWA+1 MINIMUM SIZE BLOCK 
          SA2    NZCT 
          SX6    X2+B1       INCREMENT NOISE BLOCK COUNT
          GE     B6,B5,SSL4  IF BLOCK AT LEAST MINIMUM SIZE 
          SA6    A2 
          SA3    NPDI        NOISE BLOCKS PADDED/DELETED INDICATOR
          ZR     X3,SSL2     IF NOISE BLOCK TO BE PADDED
          SB7    B0          DELETE BLOCK 
          EQ     SSLX        RETURN 
  
 SSL2     SA2    O           CHECK OUTPUT MODE
          BX6    X6-X6
          LX2    59-1 
          SB7    X1+
          NG     X2,SSL3     IF BINARY MODE 
          RJ     BFL         BLANK FILL LINE TO NOISE SIZE
          EQ     SSL4        CHECK FOR FULL BLOCK 
 VFY      SPACE  4,10 
**        VFY - VERIFY FILES. 
* 
*         LOADS AND EXECUTES VERIFY UTILITY.
* 
*         USES   A - 1, 2, 6, 7.
*                X - 0, 1, 2, 6, 7. 
* 
*         CALLS  MSG=, SYS=, WNB=.
  
  
 VFY      BSS    0
          RECALL I
          RECALL O
          MX0    42          TRANSFER VERIFY ARGUMENTS TO RA+2
          SA1    I
          BX7    X0*X1
          SA2    O
          R=     A7,ARGR
          BX6    X0*X2
          SA1    VFYA-1 
          SA6    A7+B1
          SX7    B1          ARGUMENT COUNT - 1 
 VFY1     SA1    A1+B1
          BX6    X1 
          SX7    X7+B1       INCREMENT ARGUMENT COUNT 
          SA6    A6+B1
          NZ     X1,VFY1     IF MORE ARGUMENTS
          SA7    ACTR 
          MESSAGE VFYC,3,R   ISSUE VERIFY COMMAND TO DAYFILE
          SYSTEM LDR,R,VFYB  LOAD AND EXECUTE VERIFY UTILITY
          PS     0
  
  
 VFYA     CON    0LA         ABORT ON ERROR 
          CON    0LR         REWIND 
          CON    1LL+1R=     ALTERNATE OUTPUT FILE
          CON    0
          CON    1LN+1R=     FILE COUNT 
          CON    0
          CON    0           CODED PARAMETER
          CON    0           BLOCK SIZE PARAMETER FOR S AND L TAPES 
          CON    0
          CON    0           END OF ARGUMENTS 
  
 VFYB     CON    0LVERIFY 
          CON    140BS36
  
 VFYC     DATA   C-*  VERIFY,XXXXXXX,+++++++,A,R,L=///////,N(((((((($$$)
,)))))))))).- 
  
  
 VNS      SPACE  4,15 
**        VNS - VERIFY NOISE SIZE BLOCK FOR *COPY* OR *TCOPY*.
* 
*         ENTRY  (B6) = LWA+1 DATA IN WORKING BUFFER. 
*                (FWWB) = FWA WORKING BUFFER. 
*                (I+NSZ) = INPUT TAPE NOISE SIZE. 
*                (NZCT) = NOISE BLOCK DELETED COUNT.
*                (BTSK) = ZERO IF NO BLOCK TERMINATOR OR EXTRA WORD 
* 
*         EXIT   (X4) = BLOCK SIZE - NOISE SIZE.
* 
*         USES   A - 1, 2, 4, 6.
*                B - 3. 
*                X - 0, 1, 2, 4, 6. 
  
  
 VNS      SUBR               ENTRY/EXIT 
          SA4    I+NSZ
          SA1    NSFG 
          ZR     X1,VNSX     IF NO SPECIAL NOISE PROCESSING IN EFFECT 
          SA2    FWWB        FWA WORKING BUFFER 
          SB3    X2 
          SX1    B6-B3       NUMBER OF DATA WORDS IN LINE 
          SA2    BTSK 
          ZR     X2,VNS1     IF NO BLOCK TERMINATOR OR EXTRA WORD 
          SX1    X1+1 
 VNS1     SX2    60 
          IX1    X2*X1       NUMBER OF DATA BITS IN LINE
          SA2    UBC         UNUSED BIT COUNT FOR LAST WORD TRANSFERED
          IX1    X1-X2       BLOCK SIZE 
          MX0    24 
          BX4    X0*X4       NOISE SIZE 
          LX4    24 
          IX4    X1-X4
          PL     X4,VNSX     IF NOT NOISE BLOCK 
          SA1    NZCT        INCREMENT NOISE BLOCK DELETED COUNT
          SX6    B1 
          IX6    X6+X1
          SA6    A1 
          EQ     VNSX        RETURN 
          SPACE  4,10 
**        COMMON DECKS. 
  
  
*CALL     COMCCDD 
 WRIF$    EQU    1           SELECT *RE-ISSUE CURRENT WRITE*
*CALL     COMCCIO 
*CALL     COMCRDW 
*CALL     COMCSFN 
*CALL     COMCSNM 
*CALL     COMCSYS 
*CALL     COMCWTC 
*CALL     COMCWTW 
          SPACE  4,10 
**        COPY/COPYBF/COPYEI BUFFERS. 
  
  
          USE    BUFFERS
 LBUF     BSS    0           ALTERNATE OUTPUT FILE CIO BUFFER 
  
*         SINGLE BUFFER COPY ALLOCATIONS. 
  
 SBUF     EQU    LBUF+LBUFL  SINGLE CIO BUFFER
 SRFL     EQU    SBUF+SBUFL  FL FOR SINGLE BUFFER COPY
  
*         DOUBLE BUFFER COPY ALLOCATIONS. 
  
 BUF1     EQU    LBUF+LBUFL  WORKING STORAGE BUFFER 
 IBUF1    EQU    BUF1+BUFL   INPUT FILE CIO BUFFER
 OBUF1    EQU    IBUF1+FBUFL OUTPUT FILE CIO BUFFER 
 RFL1     EQU    OBUF1+FBUFL FL FOR DOUBLE BUFFER COPY
          ERRNG  TCOPY-BUF1  IF LBUF OVERFLOWS INTO TCOPY 
          TITLE  COPYBR/COPYX.
 COPYBR   SPACE  4,10 
**        COPYBR - COPY SPECIFIED NUMBER OF RECORDS FROM ONE FILE TO
*         ANOTHER.
* 
*         EXIT   TO *END*, IF COPY COMPLETE.
*                TO *END5*, IF EOI ENCOUNTERED. 
  
  
 COPYBR   SX6    B0          INDICATE *COPYBR* CALL 
          RJ     PRS         PRESET PROGRAM 
  
 CBR1     READ   I           BEGIN READ 
          RECALL O
          WRITE  O,*         PRESET WRITE FUNCTION
          READW  I,BUF,RBFL 
          RJ     CPR         COPY RECORD
          NG     X0,END5     IF EOI ENCOUNTERED 
          SA2    CT          DECREMENT COUNT
          SX6    X2-1 
          SA6    A2 
          NZ     X6,CBR1     LOOP FOR ALL RECORDS 
          EQ     END         TERMINATE PROGRAM
 COPYX    SPACE  4,10 
**        COPYX - COPY LOGICAL RECORDS FROM ONE FILE TO ANOTHER UNTIL 
*         SPECIFIED TERMINATION CONDITION IS MET. 
* 
*         EXIT   TO *END*, IF COPY COMPLETE.
*                TO *END5*, IF EOI ENCOUNTERED. 
  
  
 COPYX    SX6    -1          INDICATE *COPYX* CALL
          RJ     PRS         PRESET PROGRAM 
  
 CPX1     READ   I           BEGIN READ 
          RECALL O
          WRITE  O,*         PRESET WRITE FUNCTION
          READW  I,BUF,RBFL 
          PL     X1,CPX2     IF NOT EOF OR EOI
          RJ     CPR         PROCESS EOF/EOI
 CPX1.1   NG     X0,END5     IF EOI ENCOUNTERED 
          SX6    ENDD        SET *EOF ENCOUNTERED.* ENDING MESSAGE
          SA6    ENDA 
          EQ     END         ISSUE DAYFILE MESSAGE AND ENDRUN 
  
 CPX2     BX5    X1          SAVE EOR STATUS
          SA2    TM          CHECK TERMINATION CONDITION
  
*         PROCESS ZERO RECORD.
  
          NZ     X2,CPX3     IF NOT ZERO RECORD REQUEST 
          SX2    X1-BUF 
          ZR     X2,CPX4     IF ZERO RECORD 
          EQ     CPX5        COPY RECORD
  
*         PROCESS RECORD NAME.
  
 CPX3     NG     X2,CPX5     IF NOT RECORD NAME 
          SX2    BUF
          SX1    B6          LWA+1 OF DATA READ 
          RJ     SRT         SET RECORD TYPE
          SA1    RN          CHECK RECORD NAME
          BX2    X7-X1
          SA3    A1+B1
          NZ     X2,CPX5     IF NO MATCH
          NG     X3,CPX4     IF NO TYPE REQUESTED 
          SX2    X6          CHECK TYPE 
          BX7    X2-X3
          NZ     X7,CPX5     IF NO MATCH
 CPX4     SX6    B1+         SET TERMINATION
          SA6    CT 
  
*         COPY RECORD.
  
 CPX5     BX1    X5          RESTORE EOR STATUS 
          RJ     CPR         COPY RECORD
          NZ     X0,CPX1.1   IF EOF OR EOI ENCOUNTERED
          SA1    CT          DECREMENT COUNT
          SX6    X1-1 
          SA6    A1+
          NZ     X6,CPX1     LOOP FOR ALL RECORDS 
          SA1    BK1
          ZR     X1,CPX6     IF NO BACKSPACE FOR FILE 1 
          BKSP   I
 CPX6     SA2    SK 
          SA1    BK2
          NZ     X2,END      IF SKIPPING RECORDS
          ZR     X1,END      IF NO BACKSPACE FOR FILE 2 
          BKSP   O
          EQ     END
  
  
 TM       CON    1S59        COPYX TERMINATION
 RN       CON    0           RECORD NAME
          CON    1S59        RECORD TYPE
 BK1      CON    0           FILE 1 BACKSPACE 
 BK2      CON    0           FILE 2 BACKSPACE 
          TITLE  RECORD COPY ROUTINES.
 CPR      SPACE  4,15 
**        CPR - COPY RECORD.
* 
*         ENTRY  (X1) = FIRST BLOCK READ STATUS.
*                (B6) = LWA+1 DATA TRANSFERRED TO WORKING BUFFER. 
* 
*         EXIT   (X0) .LT. 0, IF EOI. 
*                (X0) = 0, IF EOR.
*                (X0) .GT. 0, IF EOF. 
* 
*         USES   A - 1, 2.
*                X - 0, 1, 2, 5.
* 
*         CALLS  CIO=, DRN, MSG=, RDW=, WTW=. 
  
  
 CPR4     MESSAGE PEFB,1     DISPLAY EOF MESSAGE
          SA1    FCPY 
          SA2    WCPY 
          SX6    X1+B1       INCREMENT FILE COPY COUNT
          IX7    X2+X5
          SA6    A1 
          SA7    A2          INCREMENT WORD COPY COUNT
          SA1    RC          ADVANCE RECORD COUNT 
          SX0    B1+         SET EOF STATUS 
          SA2    SK 
          IX6    X1+X0
          SA6    A1 
          NZ     X2,CPRX     IF SKIP SET
          WRITEF O           GENERATE EOF 
  
 CPR      SUBR               ENTRY/EXIT 
          SX0    X1+B1
          SA0    X1 
          SX5    0           CLEAR WORD COUNT 
          PL     X1,CPR0     IF NOT EOF OR EOI
          SX2    B6-BUF 
          NZ     X2,CPR1     IF DATA IN BUFFER
          NG     X0,CPRX     IF EOI ENCOUNTERED 
          EQ     CPR4        EOF ENCOUNTERED
  
 CPR0     SX2    BUF
          RJ     DRN         DISPLAY RECORD NAME
 CPR1     SA2    SK 
          SB7    B6-BUF 
          SX1    B7 
          IX5    X5+X1       SHOW WORDS COPIED
          NZ     X2,CPR2     IF SKIP SET
          WRITEW O,BUF,B7 
 CPR2     SX0    B0          CLEAR EOR STATUS 
          SX2    A0 
          NZ     X2,CPR3     IF EOR 
          READW  I,BUF,RBFL 
          SX0    X1+B1
          SA0    X1 
          PL     X1,CPR1     IF NOT EOF OR EOI
          SX2    B6-BUF 
          NZ     X2,CPR1     IF DATA IN BUFFER
          PL     X0,CPR4     IF EOF 
 CPR3     SA1    RCPY 
          SA2    WCPY 
          SA3    SK 
          SX6    X1+B1
          IX7    X2+X5       ADD WORDS COPIED TO COUNT
          SA6    A1 
          SA7    A2 
          NZ     X3,CPRX     IF SKIP SET
          WRITER O           END RECORD 
          EQ     CPRX        RETURN WITH EOR OR EOI STATUS
          SPACE  4,10 
**        COMMON DECKS. 
  
  
*CALL     COMCSRT 
          SPACE  4,10 
**        COPYBR/COPYX BUFFERS. 
  
  
 BUF      BSS    0           WORKING STORAGE BUFFER 
 IBUF     EQU    BUF+RBFL    INPUT FILE CIO BUFFER
 OBUF     EQU    IBUF+FBUFL  OUTPUT FILE CIO BUFFER 
 RFL=     EQU    OBUF+FBUFL  FIELD LENGTH FOR COPYBR AND COPYX
          TITLE  TCOPY. 
 TCOPY    SPACE  4,10 
**        TCOPY - COPY E, B, X, SI-CODED OR I TAPE VIA S/L FORMAT TO
*         MASS STORAGE, I, LI, OR SI-BINARY FILE, OR GENERATE E OR B
*         TAPE VIA S/L FORMAT FROM MASS STORAGE, I, LI, OR SI-BINARY
*         FILE. 
* 
*         EXIT   TO *CPY*, IF X, SI-C, OR I TO MS/I/LI/SI-B COPY. 
*                TO *CEB*, IF E OR B TO MS/I/LI/SI-B COPY.
*                TO *GEB*, IF MS/I/LI/SI-B TO E OR B COPY.
  
  
 TCOPY    SX6    B0          INDICATE *TCOPY* CALL
          RJ     CTP         COPY/TCOPY PRESET PROGRAM
          SA1    I+TCF
          SB3    -B1
          SB2    X1 
          GE     B2,B1,CEB   IF E OR B TO MS/I/LI/SI-B COPY 
          ZR     B2,GEB      IF MS/I/LI/SI-B TO E OR B COPY 
          EQ     B2,B3,CPY   IF X TO MS/I/LI/SI-B COPY
          READCW I,17B       INITIATE CONTROL WORD READ 
          EQ     CPY         SI-C OR I TO MS/I/LI/SI-B COPY 
 CEB      SPACE  4,10 
**        CEB - COPY E OR B TAPE TO MASS STORAGE, I, LI OR SI-B TAPE. 
* 
*         EXIT   TO *END*, IF COPY COMPLETE.
*                TO *END5*, IF EOI ENCOUNTERED. 
* 
*         USES   A - 0, 1, 2, 3, 4, 6.
*                B - 2, 6, 7. 
*                X - 0, 1, 2, 3, 4, 5, 6. 
* 
*         CALLS  CIO=, CWR, DRN, PEF, WTC=, WTH=. 
  
  
 CEB      BSS    0
          SA1    I+PRU       GET E OR B TAPE PRU SIZE 
          SA0    X1+
 CEB1     BX5    X5-X5       INDICATE NO DATA TRANSFERRED 
          READCW I,17B       INITIATE CONTROL WORD READ 
          RECALL O
          WRITE  O,*         PRESET STANDARD WRITE FUNCTION 
 CEB2     CWRW   I,(FWWB),A0
          NG     X1,CEB5     IF EOF/EOI ENCOUNTERED 
          NZ     X5,CEB3     IF PREVIOUS READ STATUS NOT EOF
          RJ     VNS         VERIFY NOISE SIZE BLOCK
          NG     X4,CEB2     IF NOISE BLOCK 
          SA2    FWWB        FWA WORKING BUFFER 
          RJ     DRN         DISPLAY FILE NAME
 CEB3     SA1    I+TCF
          SA2    SK 
          SX5    B1          INDICATE DATA TRANSFERRED
          SB2    X1 
          NZ     X2,CEB2     IF SKIP SET
          SA4    FWWB        FWA WORKING BUFFER 
          GT     B2,B1,CEB4  IF B TO MS/I/LI/SI-B COPY
          SB7    X4 
          SB7    B6-B7       LENGTH OF LINE 
          SA1    B6-B1
          RJ     SFN         BLANK FILL LAST WORD 
          SA6    A1 
          RJ     CWH         COUNT WORDS
          WRITEH O,X4,B7
          EQ     CEB2        CONTINUE COPY
  
 CEB4     BX6    X6-X6       GUARANTEE END OF LINE
          SA6    B6+
          RJ     CWC         COUNT WORDS
          WRITEC O,X4 
          EQ     CEB2        CONTINUE COPY
  
 CEB5     SX0    X1+B1       SET TERMINATION CONDITION
          RJ     PEF         PROCESS END OF FILE
          SA2    RCPY        INCREMENT RECORD COUNT 
          SX6    X2+B1
          SA6    A2 
          SA1    CT 
          NG     X0,END5     IF EOI ENCOUNTERED 
          ZR     X1,END      IF COPY COMPLETE 
          EQ     CEB1        REINITIATE CONTROL WORD READ 
 GEB      SPACE  4,15 
**        GEB - GENERATE E OR B TAPE FROM MASS STORAGE, I, LI OR SI-B 
*         TAPE. 
* 
*         EXIT   TO *END*, IF COPY COMPLETE.
*                TO *END5*, IF EOI ENCOUNTERED. 
* 
*         USES   A - 0, 1, 2, 3, 4, 6.
*                B - 2, 3, 5, 6, 7. 
*                X - 0, 1, 2, 3, 4, 5, 6. 
* 
*         CALLS  BFL, CIO=, CUB, CWW, DRN, PEF, RDC=. 
  
  
 GEB      BSS    0
          WRITECW O,*        PRESET CONTROL WORD WRITE
          SA1    O+PRU       GET E OR B TAPE PRU SIZE 
          BX5    X5-X5       INDICATE NO DATA TRANSFERRED 
          SA0    X1 
 GEB1     SX0    B1+         INDICATE READ REINITIATED
          READ   I           INITIATE STANDARD READ 
 GEB2     SA4    FWWB        FWA WORKING BUFFER 
          READC  I,X4,A0
          NG     X1,GEB7     IF EOF/EOI ENCOUNTERED 
          BX5    X4          SAVE LAST DATA WORD
          SB5    X1          SAVE CURRENT READ STATUS 
          ZR     X0,GEB3     IF PREVIOUS READ STATUS NOT EOR
          SX6    B0+
          SA2    FWWB        FWA WORKING BUFFER 
          SA6    GEBA        INDICATE NOT CONTINUATION LINE 
          RJ     DRN         DISPLAY RECORD NAME
 GEB3     SA3    FWWB        FWA WORKING BUFFER 
          SX0    B5          RESTORE CURRENT READ STATUS
          BX4    X5 
          IX6    X0-X3
          SX5    B1          INDICATE DATA TRANSFERRED
          ZR     X0,GEB4     IF TRANSFER COMPLETE 
          SA1    RCPY        INCREMENT RECORD COUNT 
          SX6    X1+B1
          SA6    A1 
          ZR     X6,GEB1     IF EOR ONLY
          SA4    B6-1 
 GEB4     BX6    X4          RESTORE CONTENTS OF LAST DATA WORD 
          SA2    O+TCF
          SA6    B6-B1
          SB2    X2 
          MX4    -12
          SA1    GEBA        CHECK PREVIOUS LINE EOL STATUS 
          BX6   -X4*X6       SET CURRENT LINE EOL INDICATOR 
          SA3    X3 
          SA6    A1 
          SB7    A0 
          SA4    FUBC        GET FULL BLOCK UNUSED BIT COUNT
          ZR     X1,GEB4.1   IF NOT CONTINUATION LINE 
          SA2    TLLI        CHECK FOR *PO=T* OPTION
          NZ     X2,GEB6.1   IF DISCARD CONTINUATION LINE 
          GT     B2,B1,GEB5  IF GENERATING B TAPE 
          ZR     X3,GEB6.1   IF EOL ONLY (E TAPE) 
 GEB4.1   GT     B2,B1,GEB5  IF GENERATING B TAPE 
          RJ     BFL         BLANK FILL LINE FOR E TAPE 
          BX6    X4 
          EQ     GEB6        WRITE ONE LINE PER BLOCK 
  
 GEB5     RJ     CUB         CALCULATE B TAPE UNUSED BIT COUNT
 GEB6     SA3    FWWB        FWA WORKING BUFFER 
          SA6    UBC         SET UNUSED BIT COUNT FOR WRITE 
          SB3    X3 
          SB7    B6-B3       NUMBER OF WORDS IN BUFFER
          SB6    B3+
          SA1    WCPY        ADD TO WORD COUNT
          SX3    B7 
          IX6    X1+X3
          SA6    A1 
          CWWW   O,B6,B7
 GEB6.1   ZR     X0,GEB2     IF NOT EOR 
          EQ     GEB1        REINITIATE READ
  
 GEB7     SX0    X1+B1       PROCESS END OF FILE
          RJ     PEF
          SA1    CT 
          NG     X0,END5     IF EOI ENCOUNTERED 
          ZR     X1,END      IF COPY COMPLETE 
          BX5    X5-X5       INDICATE NO DATA TRANSFERRED 
          EQ     GEB1        CONTINUE COPY
  
  
 GEBA     CON    0           PREVIOUS LINE EOL STATUS 
          TITLE  E, B, X, SI-C, I CONVERSION ROUTINES.
 CCW      SPACE  4,10 
**        CCW - COUNT CHARACTERS IN WORD. 
* 
*         ENTRY  (X1) = DATA WORD, LEFT JUSTIFIED, ZERO FILLED. 
* 
*         EXIT   (B5) = NUMBER OF CHARACTERS IN WORD. 
* 
*         USES   B - 5. 
*                X - 2, 6.
  
  
 CCW      SUBR               ENTRY/EXIT 
          SB5    B0 
          ZR     X1,CCWX     IF ZERO WORD 
          MX6    -54
 CCW1     BX2    -X6*X1 
          SB5    B5+1        INCREMENT CHARACTER COUNT
          AX6    6
          NZ     X2,CCW1     IF MORE CHARACTERS IN WORD 
          EQ     CCWX        RETURN 
 CEL      SPACE  4,15 
**        CEL - CONVERT SI-CODED END OF LINES.
* 
*         FOR 7-TRACK *SI*-CODED TAPE, END-OF-LINES REPRESENTED BY
*         16...1632B EXTERNAL BCD ARE CONVERTED INTO 63...6362B 
*         64-CHARACTER SET DISPLAY CODE (WITH 6362B IN LOWER BYTE OF
*         CM WORD) OR 00...0062B 63-CHARACTER SET DISPLAY CODE
*         (WITH 0062B IN LOWER BYTE OF CM WORD).
*         THESE REPRESENTATIONS ARE CONVERTED INTO BINARY ZERO
*         END-OF-LINES IN THE WORKING BUFFER. 
* 
*         ENTRY  (FWWB) = FWA WORKING BUFFER. 
*                (LWDB) = LWA+1 DATA IN WORKING BUFFER. 
* 
*         USES   A - 1, 2, 7. 
*                B - 2, 6.
*                X - 1, 2, 3, 4, 6, 7.
  
  
 CEL      SUBR               ENTRY/EXIT 
          SA1    FWWB        FWA WORKING BUFFER 
          SA2    I+TRK       GET TRACK BITS 
          SB2    X1 
          LX2    59-58
          PL     X2,CELX     IF NOT 7-TRACK SI-CODED TAPE 
          SA2    LWDB        LWA+1 DATA IN WORKING BUFFER 
          MX6    -12
          SB6    X2 
 CEL0     SA2    CELA        GET 63/64 CHARACTER SET EOL CONVERSION 
          BX3    X2 
          AX3    6
 CEL1     SB6    B6-B1       CONVERT 63...62B/00...0062B TO EOL 
          LT     B6,B2,CELX  IF CONVERSION COMPLETE 
          SA1    B6 
          BX4    -X6*X1 
          BX4    X4-X2
          NZ     X4,CEL1     IF NOT 6362B/0062B IN LOWER BYTE 
          MX6    54          CLEAR 62B CHARACTER FROM WORD
          BX7    X6*X1
          ZR     X3,CEL3     IF 63-CHARACTER SET CONVERSION 
 CEL2     LX6    6           CLEAR CONSECUTIVE 63B CHARACTERS FROM WORD 
          BX4    -X6*X7 
          LX3    6
          BX4    X4-X3
          NZ     X4,CEL3     IF NOT 63B CHARACTER 
          BX7    X6*X7
          NZ     X7,CEL2     IF MORE CHARACTERS IN WORD 
 CEL3     SA7    A1 
          MX6    -12
          EQ     CEL0        CONTINUE CONVERSION
  
  
 CELA     CON    6362B       64-CHARACTER SET EOL CONVERSION
 CUB      SPACE  4,20 
**        CUB - CALCULATE UNUSED BIT COUNT FOR B TAPE LINE. 
* 
*         LINE IS BLANK FILLED TO NOISE SIZE, IF NECESSARY. 
*         IF LINE HAS ODD NUMBER OF CHARACTERS, AN EXTRA BLANK IS 
*         APPENDED.  UNUSED BIT COUNT OF LAST DATA WORD IS CALCULATED 
*         FROM THE ADJUSTED LINE. 
* 
*         ENTRY  (B6) = LWA+1 CODED LINE. 
*                (FWWB) = FWA CODED LINE. 
* 
*         EXIT   (B6) = LWA+1 READJUSTED LINE.
*                (X6) = UNUSED BIT COUNT FOR LAST DATA WORD IN LINE.
* 
*         USES   A - 1, 2, 4, 6.
*                B - 2, 3, 5, 6, 7. 
*                X - 1, 2, 3, 4, 6. 
* 
*         CALLS  BFL, CCW.
  
  
 CUB      SUBR               ENTRY/EXIT 
          SA1    B6-B1
          SX4    1R 
          MX6    -6 
          NZ     X1,CUB1     IF LAST DATA WORD NOT ZERO 
          SA2    A1-B1
          BX3    -X6*X2 
          NZ     X3,CUB1     IF PREVIOUS WORD NOT PART OF EOL 
          BX6    X2+X4       BLANK FILL PREVIOUS WORD 
          SA6    A2 
 CUB1     SA2    FWWB        FWA WORKING BUFFER 
          SA4    O+NSZ
          SB3    X2 
          SB3    B6-B3       NUMBER OF DATA WORDS IN LINE 
          SB7    X4          MINIMUM NUMBER OF WORDS FOR NOISE SIZE 
          AX4    18 
          GT     B3,B7,CUB4  IF LINE LENGTH .GT. NOISE SIZE 
          RJ     CCW         COUNT CHARACTERS IN LAST DATA WORD 
          RJ     BFL         BLANK FILL LINE TO NOISE SIZE
          EQ     B3,B7,CUB2  IF LAST WORD BORDERS ON NOISE SIZE 
          SB5    B0 
 CUB2     SB2    X4 
          GE     B5,B2,CUB3  IF DATA CHARACTERS EXCEED NOISE SIZE 
          SB5    B2 
          SA1    NZCT        INCREMENT NOISE BLOCK COUNT
          SX6    X1+B1
          SA6    A1 
 CUB3     SB5    B5+B5       CLEAR BLANK FILL BEYOND NOISE SIZE 
          SB2    B5+B5
          SA1    B6-B1
          SB2    B2+B5
          MX6    1
          SB2    B2-B1
          AX6    B2 
          BX6    X6*X1
          SA6    A1 
 CUB4     SA1    B6-B1
          NZ     X1,CUB5     IF LAST DATA WORD NOT ZERO 
          SB6    B6-B1
          SA1    B6-1 
 CUB5     RJ     CCW         COUNT CHARACTERS IN LAST DATA WORD 
          SX2    B5 
          LX2    59-0 
          PL     X2,CUB7     IF EVEN NUMBER OF CHARACTERS 
          SX4    1R          APPEND BLANK CHARACTER 
          SB2    B5+1 
 CUB6     LX4    -6 
          SB2    B2-B1
          NZ     B2,CUB6     IF BLANK NOT IN POSITION 
          BX6    X1+X4
          SA6    A1+
          SB5    B5+B1       INCREMENT NUMBER OF CHARACTERS 
 CUB7     SB2    10          CALCULATE UNUSED BIT COUNT FOR LAST WORD 
          SX2    6
          SX6    B2-B5
          IX6    X2*X6
          EQ     CUBX        RETURN 
 CWC      SPACE  4,10 
**        CWC - COUNT WORDS - *C* FORMAT. 
* 
*         ENTRY  (X4) = BUFFER ADDRESS. 
* 
*         EXIT   (WCPY) = (WCPY)+WORD COUNT 
* 
*         USES   A - 1. 
*                X - 1, 2, 3, 6.
  
  
 CWC2     SA1    WCPY        ADD TO TOTAL WORD COUNT
          IX6    X3+X1
          SA6    A1 
  
 CWC      SUBR
          SA1    X4          FWA OF BUFFER
          MX2    -12         EOL MASK 
          SX3    1           CLEAR WORD COUNT 
 CWC1     BX6    -X2*X1 
          ZR     X6,CWC2     IF EOL 
          SX3    X3+B1
          SA1    A1+1 
          EQ     CWC1        CONTINUE COUNTING
 CWH      SPACE  4,10 
**        CWH - COUNT WORDS - *H* FORMAT. 
* 
*         ENTRY  (X4) = BUFFER ADDRESS
*                (B7) = BUFFER LENGTH 
* 
*         EXIT   (WCPY) = (WCPY)+WORD COUNT 
* 
*         USES   A - 1, 2.
*                X - 1, 2, 3, 6.
*                B - 2. 
  
  
 CWH      SUBR
          SB2    B7-B1
          SA1    X4+B2       LWA BUFFER 
          SA2    CWHA        BLANK
 CWH1     IX3    X1-X2       CHECK BLANK WORD 
          NZ     X3,CWH2     IF NON-BLANK 
          SA1    X4+B2
          SB2    B2-B1
          NZ     B2,CWH1     IF NOT FIRST WORD
 CWH2     SA1    WCPY 
          SX2    B2+B1       WORDS LEFT 
          IX6    X1+X2
          SA6    A1+
          EQ     CWHX        RETURN 
  
  
 CWHA     DATA   10H
 IBT      SPACE  4,20 
**        IBT - PROCESS I TAPE BLOCK TERMINATOR.
* 
*         ENTRY  (X2) = DATA WORD CONTAINING 48-BIT BLOCK TERMINATOR. 
*                (BTSK) = UNUSED BIT COUNT FOR BLOCK TERMINATOR WORD. 
*                (CWBC) = READCW BYTE COUNT.
* 
*         EXIT   (X1) = -1, IF LEVEL 17B BLOCK TERMINATOR (EOF) 
*                           ENCOUNTERED IN I BLOCK TERMINATOR.
*                (LVL) = EOR LEVEL FROM BLOCK TERMINATOR. 
*                (EORF) = ZERO IF NOT FULL I BLOCK. 
* 
*         USES   A - 1, 2, 6, 7.
*                B - 2, 3.
*                X - 1, 2, 3, 4, 6, 7.
* 
*         CALLS  PDE. 
  
  
 IBT3     SA2    CWBC 
          SX6    X2-5004B    BYTES IN NON-EOR BLOCK 
          SA6    EORF 
          SA7    LVL
          SX2    X7-17B 
          BX1    X1-X1
          NZ     X2,IBTX     IF NOT LEVEL 17B (EOF) 
          SX1    -B1
  
 IBT      SUBR               ENTRY/EXIT 
          SA1    I+TRK
          SX4    B0+         NO EXTRA BYTE BIAS 
          LX1    59-58
          NG     X1,IBT1     IF 7-TRACK TAPE
          SA1    CWBC 
          SX3    X1+4 
          SX1    5
          IX3    X3/X1
          LX3    -1 
          NG     X3,IBT1     IF ODD WORD COUNT WITH 48 BIT TERMINATOR 
          SX4    -1          BIAS TO REMOVE EXTRA BYTE
 IBT1     SA1    BTSK        CLEAR EXTRANEOUS DATA
          SB3    59 
          SB2    X1-1        CORRECT FOR ALWAYS HAVE TERMINATOR FLAG
          MX1    1
          SB2    B3-B2
          AX1    B2 
          BX2    X1*X2
          AX2    12          EXTRACT LEVEL NUMBER FROM BLOCK TERMINATOR 
          MX1    -6 
          BX7    -X1*X2      LEVEL NUMBER 
          AX2    12 
          MX1    -24
          BX6    -X1*X2      BLOCK NUMBER 
          AX2    24 
          MX3    -12
          SA1    CWBC        READCW BYTE COUNT
          IX1    X1+X4       9-TRACK ODD BYTE NUMBER CORRECTION 
          BX4    -X3*X2      BYTE COUNT 
          IX3    X4-X1
          NZ     X3,IBT2     IF ERROR IN NUMBER OF BYTES
          SA1    IBTA        PREVIOUS BLOCK NUMBER
          SX3    B1 
          IX2    X1+X3       INCREMENT
          IX3    X6-X2
          SA6    A1          REPLACE PREVIOUS BLOCK NUMBER
          NZ     X3,IBT2     IF BLOCK SEQUENCE NUMBER ERROR 
          SX1    X7-20B 
          NG     X1,IBT3     IF LEGAL LEVEL NUMBER
 IBT2     SB3    B1          PROCESS DATA ERROR 
          RJ     PDE
          BX7    X7-X7
          EQ     IBT3        CLEAR LEVEL NUMBER 
  
  
 IBTA     CON    -1          PREVIOUS BLOCK NUMBER
 IIB      SPACE  4,15 
**        IIB - INITIALIZE I FORMAT TAPE BLOCK. 
* 
*         ENTRY  (RWCB) = WORD COUNT OF BLOCK.
*                (UBCB) = UNUSED BIT COUNT FOR BLOCK. 
* 
*         EXIT   WORD COUNT AND UNUSED BIT COUNT UPDATED AS NECESSARY.
*                EOR FLAG AND BLOCK TERMINATOR SET. 
* 
*         USES   A - 1, 2, 4, 6, 7. 
*                B - 3. 
*                X - 1, 2, 4, 6, 7. 
* 
*         CALLS  PDE. 
  
  
 IIB1     NG     X1,IIB2     IF ODD WORD COUNT
          SX2    X2+12
 IIB2     SA6    A1          UPDATE BLOCK WORD COUNT
          BX7    X7-X7       CLEAR UNUSED BIT COUNT 
          SX6    B1 
          SA7    A2 
          SA6    EORF 
          ZR     X2,IIBX     IF NO DATA ERROR 
          SB3    B1          PROCESS DATA ERROR 
          RJ     PDE
  
 IIB      SUBR               ENTRY/EXIT 
          SA1    RWCB        GET BLOCK WORD COUNT 
          SA2    UBCB        GET UNUSED BIT COUNT 
          BX6    X1 
          LX1    -1 
          BX7    X2          SET BLOCK TERMINATOR = UNUSED BIT COUNT
          SX7    X7+B1       ALWAYS HAVE TERMINATOR 
          SA7    BTSK        SET BLOCK TERMINATOR INDICATOR 
          SX6    X6-1        DECREMENT BLOCK WORD COUNT 
          SA4    I+TRK       GET TRACK BITS 
          SX2    X2-12
          LX4    59-58
          NG     X4,IIB2     IF 7-TRACK TAPE
          EQ     IIB1        CHECK FOR ODD WORD COUNT 
 ISI      SPACE  4,15 
**        ISI - INITIALIZE SI-CODED FORMAT TAPE BLOCK.
* 
*         ENTRY  (RWCB) = WORD COUNT OF BLOCK.
*                (UBCB) = UNUSED BIT COUNT FOR BLOCK. 
* 
*         EXIT   WORD COUNT AND UNUSED BIT COUNT UPDATED AS NECESSARY.
*                     EOR FLAG AND BLOCK TERMINATOR INDICATOR SET 
*                     APPROPRIATELY.
* 
*         USES   A - 1, 2, 3, 4, 6, 7.
*                B - 3. 
*                X - 1, 2, 3, 4, 6, 7.
* 
*         CALLS  PDE. 
  
  
 ISI3     NG     X1,ISI4     IF ODD WORD COUNT
          SX2    X2+12-8
 ISI4     SA6    A1          UPDATE BLOCK WORD COUNT
          BX7    X7-X7       CLEAR UNUSED BIT COUNT 
          IX6    X3-X6       SET EOR FLAG IF NOT FULL BLOCK 
          SA7    A2 
          SA6    EORF 
          ZR     X2,ISIX     IF NO DATA ERROR 
          SB3    B1          PROCESS DATA ERROR 
          RJ     PDE
  
 ISI      SUBR               ENTRY/EXIT 
          SA1    RWCB        GET BLOCK WORD COUNT 
          SA2    UBCB        GET UNUSED BIT COUNT 
          SA3    I+PRU       GET INPUT PRU SIZE 
          LX6    X1 
          IX4    X3-X1
          NZ     X4,ISI1     IF WORD COUNT .NE. PRU SIZE
          ZR     X2,ISI4     IF FULL BLOCK
 ISI1     SA4    I+TRK       GET TRACK BITS 
          LX1    -1 
          BX7    X2          SET BLOCK TERMINATOR = UNUSED BIT COUNT
          NZ     X2,ISI2     IF NONZERO UNUSED BIT COUNT
          SX7    B1+         SET TERMINATOR INDICATOR WHEN DATA ERROR 
 ISI2     SX6    X6-1        DECREMENT BLOCK WORD COUNT 
          SA7    BTSK        SET BLOCK TERMINATOR INDICATOR 
          SX2    X2-12
          NG     X4,ISI3     IF 9-TRACK SI-CODED TAPE 
          EQ     ISI4        UPDATE FLAGS/COUNTS
 IXB      SPACE  4,15 
**        IXB - INITIALIZE X FORMAT TAPE BLOCK. 
* 
*         ENTRY  (RWCB) = WORD COUNT OF BLOCK.
*                (UBCB) = UNUSED BIT COUNT FOR BLOCK. 
* 
*         EXIT   WORD COUNT AND UNUSED BIT COUNT UPDATED AS 
*                     NECESSARY.  EOR FLAG AND SKIP WORD INDICATOR
*                     SET APPROPRIATELY.
* 
*         USES   A - 1, 2, 3, 6, 7. 
*                B - 3. 
*                X - 1, 2, 3, 6, 7. 
* 
*         CALLS  PDE. 
  
  
 IXB1     SA3    I+TRK       GET TRACK BITS 
          BX6    X1 
          LX3    59-58
          NG     X3,IXB3     IF 7-TRACK X TAPE
          BX3    X2 
          LX1    -1 
          SX2    B1 
          NG     X1,IXB2     IF ODD WORD COUNT (BAD BLOCK)
          BX2    X3 
          ZR     X2,IXB3     IF NO UNUSED BIT COUNT 
          SX2    X2-48       ELIMINATE EXCESS BYTE
 IXB2     SX7    -B1         SET SKIP WORD INDICATOR
          IX6    X6+X7       DECREMENT BLOCK WORD COUNT 
          SA7    BTSK 
 IXB3     SA3    I+PRU       GET INPUT PRU SIZE 
          SA6    A1          UPDATE BLOCK WORD COUNT
          BX7    X7-X7       CLEAR UNUSED BIT COUNT 
          IX6    X3-X6       SET EOR FLAG IF NOT FULL BLOCK 
          SA7    A2 
          SA6    EORF 
          ZR     X2,IXBX     IF NO DATA ERROR 
          SB3    B1          PROCESS DATA ERROR 
          RJ     PDE
  
 IXB      SUBR               ENTRY/EXIT 
          SA1    RWCB        GET BLOCK WORD COUNT 
          SA2    UBCB        GET UNUSED BIT COUNT 
          SX3    X1-1 
          NZ     X3,IXB1     IF NOT TERMINATOR ONLY 
          ZR     X2,IXB1     IF NO UNUSED BIT COUNT 
          SX2    X2-12
          BX6    X1 
          EQ     IXB2        SET SKIP WORD INDICATOR
 SIT      SPACE  4,15 
**        SIT - PROCESS SI-CODED TAPE BLOCK TERMINATOR. 
* 
*         ENTRY  (X2) = DATA WORD CONTAINING 48-BIT BLOCK TERMINATOR. 
*                (BTSK) = UNUSED BIT COUNT FOR BLOCK TERMINATOR WORD. 
* 
*         EXIT   (X1) = -1, IF LEVEL 17B BLOCK TERMINATOR (EOF) 
*                     ENCOUNTERED ON SI-CODED TAPE. 
* 
*         USES   A - 1, 3, 7. 
*                B - 2, 3.
*                X - 1, 2, 3, 6, 7. 
* 
*         CALLS  PDE. 
  
  
 SIT2     SX7    X7+B1
          SA1    TELN+X7     CONVERT DISPLAY LEVEL NUMBER TO BCD
          BX3    X1-X2
          ZR     X1,SIT1     IF END OF TABLE
          NZ     X3,SIT2     IF NOT MATCH 
 SIT3     SA7    LVL
          SX2    X7-17B 
          BX1    X1-X1
          NZ     X2,SITX     IF NOT LEVEL 17B (EOF) 
          SX1    -B1
  
 SIT      SUBR               ENTRY/EXIT 
          SA1    BTSK        CLEAR EXTRANEOUS DATA
          SB3    59 
          SB2    X1+
          SA3    I+TRK       GET TRACK BITS 
          MX1    1
          SB2    B3-B2
          AX1    B2 
          BX2    X1*X2
          AX2    12          EXTRACT LEVEL NUMBER FROM BLOCK TERMINATOR 
          MX1    -6 
          SX7    -1 
          BX2    -X1*X2 
          PL     X3,SIT2     IF 7-TRACK SI-CODED TAPE 
          BX7    X2 
          SX1    X2-20B 
          NG     X1,SIT3     IF LEGAL LEVEL NUMBER
 SIT1     SB3    B1          PROCESS DATA ERROR 
          RJ     PDE
          BX7    X7-X7
          EQ     SIT3        CLEAR LEVEL NUMBER 
 TDBC     SPACE  4,10 
**        TELN - TABLE OF EOR LEVEL NUMBERS.  BLANK REPRESENTS
*         LEVEL 0.  LEVELS 1 - 17B IN EXTERNAL BCD WERE CONVERTED 
*         TO DISPLAY CODE DURING READ, AND MUST BE RE-TRANSLATED. 
  
  
 TELN     BSS    0
          LOC    0
          CON    55B         LEVEL 0 EOR
          CON    34B         LEVEL 1 EOR
          CON    35B         LEVEL 2 EOR
          CON    36B         LEVEL 3 EOR
          CON    37B         LEVEL 4 EOR
          CON    40B         LEVEL 5 EOR
          CON    41B         LEVEL 6 EOR
          CON    42B         LEVEL 7 EOR
          CON    43B         LEVEL 10B EOR
          CON    44B         LEVEL 11B EOR
          CON    33B         LEVEL 12B EOR
          CON    54B         LEVEL 13B EOR
          CON    64B         LEVEL 14B EOR
          CON    74B         LEVEL 15B EOR
          CON    63B         LEVEL 16B EOR
          CON    61B         LEVEL 17B EOF
          CON    0           END OF TABLE 
          LOC    *O 
          SPACE  4,10 
**        COMMON DECKS. 
  
  
*CALL     COMCRDC 
*CALL     COMCWTH 
          SPACE  4,10 
**        TCOPY BUFFERS.
  
  
 BUF2     BSS    0           WORKING STORAGE BUFFER 
 IBUF2    EQU    BUF2+BUFL   INPUT FILE CIO BUFFER
 OBUF2    EQU    IBUF2+FBUFL OUTPUT FILE CIO BUFFER 
 RFL2     EQU    OBUF2+FBUFL FIELD LENGTH FOR TCOPY 
          TITLE  PRESET.
 CTP      SPACE  4,10 
**        CTP - COPY AND TCOPY PRESET PROGRAM.
* 
*         ENTRY  (X6) = -1, IF *COPY* CALL. 
*                     = 0, IF *TCOPY* CALL. 
* 
*         EXIT   (B1) = 1.
* 
*         USES   A - 0, 1, 2, 4, 6, 7.
*                X - 0, 1, 2, 4, 6, 7.
* 
*         CALLS  BVR, CCP, CDT, CFN, CPV, GPS, RBL, RBP, SPS, VCY, VTY. 
  
  
 CTP2     RJ     VCY         VALIDATE COPY
 CTP3     SA0    I           SET PRU SIZE ON S OR L INPUT TAPE
          RJ     SPS
          RJ     GPS         GET INPUT PRU SIZE 
          SA0    O           SET PRU SIZE ON S OR L OUTPUT TAPE 
          RJ     SPS
          RJ     GPS         GET OUTPUT PRU SIZE
          RJ     RBL         RESET BUFFER LENGTHS FOR L AND F TAPES 
          RJ     RBP         RESET BUFFER POINTERS
          RJ     AEM         ADJUST ERROR MESSAGES
          RJ     BVR         BUILD VERIFY REQUEST 
          SA1    I+CWF
          ZR     X1,CTPX     IF CONTROL WORDS DISABLED
          MX1    1           SET EP BIT OF INPUT FILE FET 
          SA2    I+1
          LX1    44-59
          BX6    X1+X2
          SA6    A2 
  
 CTP      SUBR               ENTRY/EXIT 
          SB1    1           (B1) = 1 
          SA6    CRI         SAVE CALLING ROUTINE INDICATOR 
          SX7    1RD         SET DEFAULT TERMINATION CONDITION
          SA0    TCYA        COPY ARGUMENT TABLE
          LX7    -6 
          SX0    TCYAL       COPY ARGUMENT TABLE LENGTH 
          SA7    TC 
          NG     X6,CTP1     IF NOT *TCOPY* CALL
          SX7    1RX         SET DEFAULT X FORMAT CONVERSION
          LX7    -6 
          SA7    CF 
          SX6    BUF2+1      FWA TCOPY WORKING BUFFER 
          SA0    TTYA        TCOPY ARGUMENT TABLE 
          SA6    FWWB 
          SX0    TTYAL       TCOPY ARGUMENT TABLE LENGTH
 CTP1     RJ     CCP         CRACK COMMAND PARAMETERS 
          RJ     CPV         CONVERT PARAMETER VALUES 
          SA0    I           CHECK IF CONTROL WORDS ALLOWED ON INPUT
          RJ     CDT
          SA0    O           CHECK IF CONTROL WORDS ALLOWED ON OUTPUT 
          RJ     CDT
          RJ     CFN         CHECK FILE NAMES 
          SA1    CRI         GET CALLING ROUTINE INDICATOR
          NG     X1,CTP2     IF *COPY* CALL 
          RJ     VTY         VALIDATE TCOPY 
          SA1    CSMR        GET CHARACTER SET MODE 
          NG     X1,CTP3     IF 64-CHARACTER SET
          SX6    0062B       SET *SI*-CODED EOL FOR 63-CHARACTER SET
          SA6    CELA 
          EQ     CTP3        CONTINUE PRESET
 TCYA     SPACE  4,10 
**        TCYA - TABLE OF COPY COMMAND ARGUMENTS. 
  
  
 TCYA     BSS    0
 I        ARG    I,I,400B    INPUT FILE 
 O        ARG    O,O,400B    OUTPUT FILE
 V        ARG    =0,VF,400B  VERIFY OPTION
 M        ARG    =0,CM,400B  CODED MODE 
 TC       ARG    =0,TC       TERMINATION CONDITION
 N        ARG    =0,DCT      COPY COUNT 
 BS       ARG    =0,BS,400B  BLOCK SIZE 
 CC       ARG    =0,CC,400B  CHARACTER COUNT
 EL       ARG    =0,EL       ERROR LIMIT
 PO       ARG    =0,PO,400B  PROCESSING OPTIONS 
 L        ARG    L,L,400B    ALTERNATE OUTPUT FILE
 NS       ARG    =0,NS,400B  NOISE SIZE 
 TCYAL    EQU    *-TCYA 
          CON    0
 TTYA     SPACE  4,10 
**        TTYA - TABLE OF TCOPY COMMAND ARGUMENTS.
  
  
 TTYA     BSS    0
 I        ARG    I,I,400B    INPUT FILE 
 O        ARG    O,O,400B    OUTPUT FILE
 F        ARG    =0,CF,400B  CONVERSION FORMAT
 TC       ARG    =0,TC       TERMINATION CONDITION
 N        ARG    =0,DCT      COPY COUNT 
 CC       ARG    =0,CC,400B  CHARACTER COUNT
 EL       ARG    =0,EL       ERROR LIMIT
 PO       ARG    =0,PO,400B  PROCESSING OPTIONS 
 L        ARG    L,L,400B    ALTERNATE OUTPUT FILE
 NS       ARG    =0,NS,400B  NOISE SIZE 
 TTYAL    EQU    *-TTYA 
          CON    0
 PRS      SPACE  4,15 
**        PRS - PRESET FOR COPYBR, COPYBF, COPYEI, AND COPYX. 
* 
*         ENTRY  (X6) = -1, IF *COPYX* CALL.
*                     = 0, IF *COPYBR* CALL.
*                     = 1, IF *COPYBF* CALL.
*                     = 2, IF *COPYEI* CALL.
* 
*         EXIT   (B1) = 1.
*                TO *PER2*, IF ARGUMENT ERROR.
* 
*         USES   A - 0, 1, 2, 5, 6, 7.
*                B - 6, 7.
*                X - 0, 1, 2, 3, 5, 6, 7. 
* 
*         CALLS  BVR, CDT, CFN, CIC, DXB, GPS, RBL, RBP, SFM, STC.
  
  
 PRS7     SA7    I+CWF       DISABLE CONTROL WORD READ
          SA7    O+CWF       DISABLE CONTROL WORD WRITE 
  
 PRS      SUBR               ENTRY/EXIT 
          SB1    1           (B1) = 1 
          SA6    CRI         SAVE CALLING ROUTINE INDICATOR 
          SB6    X6 
          MX0    42 
          SA1    ACTR        GET ARGUMENT COUNT 
          SB7    X1 
          ZR     B7,PRS6     IF NO ARGUMENTS
  
*         PROCESS INPUT FILE NAME.
  
          R=     A5,ARGR     INPUT FILE NAME
          SA2    I
          BX7    X0*X5
          SX3    X2 
          ZR     X7,PRS1     IF NULL PARAMETER
          BX7    X7+X3
          SA7    A2 
  
*         PROCESS OUTPUT FILE NAME. 
  
 PRS1     SB7    B7-B1
          ZR     B7,PRS6     IF END OF ARGUMENTS
          SA5    A5+B1
          SA2    O
          BX7    X0*X5
          SX3    X2 
          ZR     X7,PRS2     IF NULL PARAMETER
          BX7    X7+X3
          SA7    A2 
  
*         PROCESS COPY COUNT PARAMETER, VERIFY PARAMETER, OR
*         TERMINATION CONDITION PARAMETERS. 
  
 PRS2     SB7    B7-1 
          ZR     B7,PRS6     IF END OF ARGUMENTS
          GE     B6,PRS3     IF NOT COPYX CALL
          RJ     STC         PROCESS TERMINATION CONDITION PARAMETERS 
          EQ     PRS5        PROCESS MODE PARAMETER 
  
 PRS3     SA5    A5+B1
          BX5    X0*X5
          ZR     X5,PRS5     IF NULL PARAMETER
          GT     B6,B1,PRS4  IF COPYEI CALL 
          BX6    X5 
          SA6    DCT         SAVE DISPLAY CODE COPY COUNT 
          RJ     DXB         CONVERT COPY COUNT 
          NZ     X4,PER2     IF CONVERSION ERROR
          ZR     X6,PER2     IF INCORRECT COUNT 
          SA6    CT 
          EQ     PRS5        PROCESS MODE PARAMETER 
  
 PRS4     SX6    B1+         SET VERIFY FLAG
          SA6    VF 
  
*         PROCESS MODE PARAMETER. 
  
 PRS5     SB7    B7-B1
          ZR     B7,PRS6     IF END OF ARGUMENTS
          SA5    A5+B1
          MX0    42 
          SB7    B7-B1
          BX5    X0*X5
          SX6    -B1
          NZ     B7,PER2     IF TOO MANY ARGUMENTS
          ZR     X5,PRS6     IF NULL PARAMETER
          SA6    CM          SET CODED MODE FLAG (BOTH FILES) 
 PRS6     SA0    I           CHECK IF CONTROL WORDS ALLOWED ON INPUT
          RJ     CDT
          SA0    O           CHECK IF CONTROL WORDS ALLOWED ON OUTPUT 
          RJ     CDT
          RJ     SFM         SET FILE MODE
          RJ     CFN         CHECK FILE NAMES 
          RJ     CIC         CHECK FOR INDETERMINATE COPY 
          SA0    I           GET INPUT PRU SIZE 
          RJ     GPS
          SA0    O           GET OUTPUT PRU SIZE
          RJ     GPS
          SA1    CRI         GET CALLING ROUTINE INDICATOR
          BX7    X7-X7
          SB6    X1 
          LE     B6,PRS7     IF COPYBR OR COPYX CALL
          RJ     RBL         RESET BUFFER LENGTHS 
          RJ     RBP         RESET BUFFER POINTERS
          RJ     BVR         BUILD VERIFY REQUEST 
          EQ     PRSX        RETURN 
          TITLE  PRESET SUBROUTINES.
 AEM      SPACE  4,10 
**        AEM - ADJUST ERROR MESSAGES.
* 
*         EXIT   ERROR MESSAGES ADJUSTED FOR TYPE OF COPY.
* 
*         USES   A - 1, 2, 3, 5, 6, 7.
*                X - 1, 2, 3, 5, 6, 7.
* 
*         CALLS  SFN. 
  
  
 AEM      SUBR               ENTRY/EXIT 
          SA3    =10H 
          SA2    =0LDELETED.
          SA1    CCDR+8 
          BX6    X3 
          SA5    NSFG 
          NZ     X5,AEM0     IF NOISE BLOCK TO BE DELETED 
          SA5    NPDI 
          ZR     X5,AEM1     IF NOISE BLOCK TO BE PADDED
 AEM0     BX7    X2          ADJUST NOISE BLOCK SUMMARY MESSAGE 
          SA7    IESD+3 
 AEM1     SA1    A1-B1       BLANK FILL COMMAND IMAGE 
          SA6    A1 
          ZR     X1,AEM1     IF NOT END OF COMMAND
          RJ     SFN         BLANK FILL LAST WORD OF COMMAND
          SA6    A1 
          EQ     AEMX        RETURN 
 BVR      SPACE  4,15 
**        BVR - BUILD VERIFY REQUEST. 
* 
*         EXIT   IF VERIFY REQUESTED, VERIFY PARAMETERS BUILT,
*                     VERIFY COMMAND DAYFILE MESSAGE BUILT, 
*                     AND INPUT AND OUTPUT FILES ARE REWOUND. 
* 
*         USES   A - 1, 2, 3, 6, 7. 
*                B - 2, 3, 5, 6.
*                X - 0, 1, 2, 3, 5, 6, 7. 
* 
*         CALLS  CDD, CIO=, SNM.
  
  
 BVR7     SX6    B0+         CLEAR VERIFY FLAG
          SA6    VF 
  
 BVR      SUBR               ENTRY/EXIT 
          SA2    VF 
          ZR     X2,BVRX     IF VERIFY NOT REQUESTED
          REWIND I           REWIND FILES 
          SA1    SK 
          NZ     X1,BVR7     IF SKIP SET
          REWIND O
          SA1    I           GET INPUT FILE NAME
          SB5    VFYC        BUILD VERIFY COMMAND MESSAGE 
          MX5    42 
          BX1    X5*X1
          SB2    1RX
          RJ     SNM         SET INPUT FLE NAME IN MESSAGE
          SA1    O           GET OUTPUT FILE NAME 
          SB2    1R+
          BX1    X5*X1
          RJ     SNM         SET OUTPUT FILE NAME IN MESSAGE
          SA1    L           GET ALTERNATE OUTPUT FILE NAME 
          SB6    VFYA+4      BUILD VERIFY COMMAND PARAMETERS
          BX1    X5*X1
          SB2    1R/
          LX6    X1 
          SA6    B6-B1
          RJ     SNM         SET ALTERNATE OUTPUT FILE NAME IN MESSAGE
          SA3    TC 
          SX0    1R=
          SX5    1R,
          PL     X3,BVR1     IF NOT COPY TO EOI 
          SX6    1RN
          LX6    -6 
          BX1    X1-X1
          EQ     BVR2        CHECK CODED MODE 
  
 BVR1     SX6    1R0
          SB6    B6+1 
          LX6    -6 
          SA2    DCT         DISPLAY CODE COPY COUNT
          BX1    X6+X0
          ZR     X3,BVR2     IF COPY TO DOUBLE EOF
          LX6    X2 
          BX1    X2+X0
 BVR2     SA6    B6 
          LX1    -6 
          SB2    1R(
          RJ     SNM         SET TERMINATION CONDITION IN MESSAGE 
          SA2    CM 
          SB6    B6+B1
          BX1    X1-X1
          ZR     X2,BVR4     IF NOT CODED MODE
          SX6    2RC1 
          SB2    X2 
          EQ     B2,B1,BVR3  IF FIRST FILE ONLY 
          SX6    X6+B1
          GT     B2,B1,BVR3  IF SECOND FILE ONLY
          AX6    6
          LX6    6
 BVR3     LX6    -12
          BX1    X6+X5
          SA6    B6 
          SB6    B6+B1
 BVR4     SB2    1R$
          LX1    -6 
          RJ     SNM         SET MODE PARAMETER IN MESSAGE
          SA1    I+SLF
          SA2    O+SLF
          SB2    X1 
          SB3    X2 
          SA1    I+PRU
          BX3    X3-X3
          GT     B2,BVR5     IF INPUT IS S OR L TAPE
          SA1    O+PRU
          LE     B3,BVR6     IF OUTPUT NOT S OR L TAPE
 BVR5     RJ     CDD         CONVERT PRU SIZE TO DISPLAY
          SB2    B2-B1       BUILD BS= PARAMETER
          MX2    1
          SX7    2RBS 
          AX2    B2 
          LX7    -12
          BX6    X2*X4
          BX3    X7+X5
          SA6    B6+B1
          BX7    X7+X0
          LX3    -6 
          BX6    X6+X0
          SA7    B6+
          LX6    -24
          BX3    X3+X6
 BVR6     SB2    1R)
          BX1    X3 
          RJ     SNM         SET BLOCK SIZE IN MESSAGE
          EQ     BVRX        RETURN 
 CCP      SPACE  4,15 
**        CCP - CRACK THE COMMAND PARAMETERS. 
* 
*         ENTRY  (A0) = FWA ARGUMENT TABLE. 
*                (X0) = ARGUMENT TABLE LENGTH.
* 
*         EXIT   TO *PER2*, IF ARGUMENT ERROR.
* 
*         USES   A - 6. 
*                B - 2, 3, 4, 6.
*                X - 6. 
* 
*         CALLS  ARM, CPA, POP, USB.
  
  
 CCP      SUBR               ENTRY/EXIT 
          SB2    CCDR        UNPACK COMMAND 
          RJ     USB
          RJ     POP         SKIP OVER PROGRAM NAME 
          ZR     B6,CCPX     IF NO ARGUMENTS
          SB2    X0          ARGUMENT TABLE LENGTH
          SB3    A0          FWA ARGUMENT TABLE 
          SB4    PASB        POSITIONAL ARGUMENT STRING BUFFER
          RJ     CPA         CONVERT TO POSITIONAL ARGUMENTS
          NG     B5,PER2     IF CONVERSION ERROR
          PL     X1,CCPX     IF NO ARGUMENTS PROCESSED
          SX6    B5+         LWA POSITIONAL ARGUMENT STRING 
          SB6    PASB        FWA POSITIONAL ARGUMENT STRING 
          SA6    USBC 
          RJ     ARM         CRACK COMMAND PARAMETERS 
          NZ     X1,PER2     IF ARGUMENT ERROR
          EQ     CCPX        RETURN 
 CDT      SPACE  4,15 
**        CDT - CHECK DEVICE TYPE.
* 
*         ENTRY  (A0) = FWA FET.
* 
*         EXIT   ((A0)+CWF) .NE. 0, IF CONTROL WORDS ALLOWED. 
*                ((A0)+SLF)  = -1, IF F FORMAT TAPE.
*                            = 1, IF S FORMAT TAPE. 
*                            = 2, IF L FORMAT TAPE. 
*                ((A0)+NSZ) = NOISE SIZE IN FRAMES, IF TAPE FILE. 
*                ((A0)+TRK) = TRACK BITS, TAPE TYPE AND LABEL TYPE, 
*                               IF TAPE FILE. 
*                ((A0)+PRU) = PRU SIZE, IF F FORMAT TAPE. 
*                WARNING MESSAGE ISSUED IF INPUT FILE NOT FOUND.
* 
*         USES   A - 1, 2, 3, 6, 7. 
*                B - 2, 5.
*                X - 0, 1, 2, 3, 6, 7.
* 
*         CALLS  GPS, SNM.
* 
*         MACROS FILINFO, MESSAGE.
  
  
 CDT4     RJ     GPS         CHECK FOR TERMINAL FILE
          SA3    A0+B1       GET DEVICE TYPE
          MX2    -11
          LX3    12 
          BX3    -X2*X3 
          SX7    X3-2RTT
          SX2    A0-I 
          ZR     X7,CDTX     IF TERMINAL FILE 
          NZ     X2,CDT5     IF NOT INPUT FILE
          SA1    A0          GET INPUT FILE NAME
          SB5    -CDTA       * FILE NOT FOUND - LFN.* 
          BX1    X0*X1
          SB2    1RX
          SX6    1
          SB3    ENDF        REPLACE COPY COUNT MESSAGE 
          SA6    ENDG        FLAG *FILE NOT FOUND*
          RJ     SNM         SET NAME IN MESSAGE
 CDT5     SX7    B1+         ENABLE CONTROL WORDS 
          SA7    A0+CWF 
  
 CDT      SUBR               ENTRY/EXIT 
          SA1    A0          SET FILE NAME IN PARAMETER BLOCK 
          MX0    42 
          SA2    CDTB 
          BX1    X0*X1
          SX2    X2 
          BX6    X1+X2
          SA6    A2 
          FILINFO  CDTB      GET FILE INFORMATION 
          SA1    CDTB+1      GET DEVICE TYPE AND STATUS 
          BX3    X1 
          AX3    48 
          ZR     X3,CDT4     IF FILE NOT FOUND
          SX2    X3-2ROD     OPTICAL DISK DEVICE TYPE 
          NZ     X2,CDT1     IF NOT OD DEVICE 
          SX7    FETODL      OD FET EXTENSION LENGTH
          SX2    A0+12B      BUILD POINTER TO FET EXTENSION 
          LX7    18 
          BX7    X2+X7
          SA7    A0+11B      STORE POINTER AND LENGTH 
          SX7    3           INDICATE OPTICAL DISK FILE 
          SA7    A0+ODF 
          EQ     CDT5        ENABLE CONTROL WORDS 
  
 CDT1     SX2    X3-2RNE
          LX1    59-15
          NG     X1,CDT5     IF FILE ON MASS STORAGE
          LX1    59-24-59+15
          ZR     X2,CDT5     IF NULL EQUIPMENT
          PL     X1,CDTX     IF NOT TAPE FILE 
          MX0    2
          LX1    59-19-59+24
          BX6    X0*X1       ISOLATE NT/MT FLAGS
          LX1    59-26-59+19
          SA2    CDTB+FIPBL+1  GET LABEL TYPE 
          BX1    X0*X1       ISOLATE TAPE DEVICE TYPE 
          LX1    -2 
          BX6    X6+X1
          SA3    A2-B1       GET TAPE FORMAT
          LX2    -12
          MX0    -6 
          BX2    -X0*X2 
          SA1    A2+B1       GET BLOCK SIZE AND NOISE SIZE
          LX3    -6 
          BX6    X6+X2
          LX1    -6 
          SA6    A0+TRK      SAVE TRACK BITS, TAPE TYPE AND LABEL TYPE
          BX3    -X0*X3 
          BX6    -X0*X1 
          SA6    A0+NSZ      SAVE NOISE SIZE
          SX7    B1 
          SX2    X3-/MTX/TFLI 
          ZR     X2,CDT5     IF LI FORMAT TAPE
          SX2    X3-/MTX/TFS
          ZR     X2,CDT3     IF S FORMAT TAPE 
          SX7    2
          SX2    X3-/MTX/TFL
          ZR     X2,CDT3     IF L FORMAT TAPE 
          SX7    -1 
          SX2    X3-/MTX/TFF
          NZ     X2,CDT5     IF NOT F FORMAT TAPE 
          LX1    -18
          SX6    X1 
          SA6    A0+PRU      SET F TAPE PRU SIZE
 CDT3     SA7    A0+SLF      SET S/L/F TAPE INDICATOR 
          SA7    A0+ODF      SET S/L/F/OD INDICATOR 
          EQ     CDT5        SET CONTROL WORD FLAG
  
  
 CDTA     DATA   C* FILE NOT FOUND - XXXXXXX.*
  
 CDTB     VFD    42/0,6/CDTBL,12/1  *FILINFO* PARAMETER BLOCK 
          BSS    FIPBL-1
          CON    FMTK        TAPE FORMAT KEYWORD
          CON    LTYK        TAPE LABEL TYPE KEYWORD
          CON    BSZK        TAPE BLOCK SIZE, NOISE SIZE KEYWORD
 CDTBL    EQU    *-CDTB 
 CFN      SPACE  4,10 
**        CFN - CHECK FILE NAMES. 
* 
*         EXIT   SKIP FLAG SET IF INPUT FILE NAME SAME AS OUTPUT
*                     FILE NAME.
*                TO *PER1*, IF ALTERNATE OUTPUT FILE NAME CONFLICT. 
* 
*         USES   A - 1, 2, 3, 4, 6, 7.
*                B - 5. 
*                X - 0, 1, 2, 3, 4, 6, 7. 
  
  
 CFN      SUBR               ENTRY/EXIT 
          SA1    I           COMPARE FILE NAMES 
          SA4    O
          MX0    42 
          BX1    X0*X1
          SA3    L
          BX4    X0*X4
          SA2    =10H SKIPPING   SET SKIP FLAG AND MESSAGE
          BX7    X1-X4
          LX6    X2 
          NZ     X7,CFN1     IF INPUT .NE. OUTPUT FILE NAME 
          SX7    B1 
          SA6    DRNA 
          SA7    SK 
          SA6    PEFB 
 CFN1     SA2    SEWI        SKIP EOF WRITE INDICATOR 
          SB5    PERE        * FILE NAME CONFLICT.* 
          ZR     X2,CFN2     IF PO=M NOT SELECTED 
          SA6    PEFB 
 CFN2     SX6    A3          SET ALTERNATE OUTPUT FILE POINTER
          BX3    X0*X3
          SX7    A4          SET OUTPUT FILE POINTER
          BX6    X6+X3
          SA2    EL          CHECK IF ALTERNATE OUTPUT FILE TO BE USED
          BX7    X7+X4
          R=     A6,ARGR
          BX1    X1-X3
          SA7    A6+B1
          ZR     X2,CFNX     IF ERROR LIMIT = 0 
          ZR     X1,PER1     IF ALTERNATE OUTPUT = INPUT FILE NAME
          BX7    X4-X3
          ZR     X7,PER1     IF ALTERNATE OUTPUT = OUTPUT FILE NAME 
          EQ     CFNX        RETURN 
 CIC      SPACE  4,15 
**        CIC - CHECK FOR INDETERMINATE COPY. 
* 
*         EXIT   WARNING MESSAGE ISSUED IF S, L, OR F TAPE COPY.
*                L TAPE PRU SIZE LIMITED IF COPYBF OR COPYEI CALL.
*                TO *PER*, IF F TAPE PRU SIZE .GT. WORKING BUFFER SIZE. 
* 
*         USES   A - 1, 2, 3, 6.
*                B - 2, 3, 4. 
*                X - 0, 1, 2, 3, 6. 
* 
*         CALLS  SYS=.
  
  
 CIC      SUBR               ENTRY/EXIT 
          SA1    I+SLF
          SA2    O+SLF
          NZ     X1,CIC1     IF S, L, OR F TAPE INPUT 
          ZR     X2,CICX     IF OUTPUT NOT S, L, OR F TAPE
 CIC1     SA3    CRI         GET CALLING ROUTINE INDICATOR
          SB4    X2 
          SB2    X3 
          SB3    X1+
          LE     B2,CIC5     IF COPYBR OR COPYX CALL
          SX6    BUFL-3      LIMIT L TAPE PRU SIZE TO WORKING BUFFER
          LE     B3,B1,CIC2  IF INPUT NOT L TAPE
          SA6    I+6         SET MLRS FIELD IN INPUT FET
 CIC2     LE     B4,B1,CIC3  IF OUTPUT NOT L TAPE 
          SA6    O+6         SET MLRS FIELD OF OUTPUT FET 
 CIC3     SB5    PERB        * BLOCK SIZE TOO LARGE ON LFN.*
          GE     B3,CIC4     IF INPUT NOT F TAPE
          SA2    I+PRU       GET INPUT FILE PRU SIZE
          IX2    X6-X2
          SA1    I
          NG     X2,PER      IF F TAPE PRU SIZE EXCEEDS WORKING BUFFER
 CIC4     GE     B4,CIC5     IF OUTPUT NOT F TAPE 
          SA3    O+PRU       GET OUTPUT FILE PRU SIZE 
          SA1    O
          IX3    X6-X3
          NG     X3,PER      IF F TAPE PRU SIZE EXCEEDS WORKING BUFFER
 CIC5     MESSAGE CICA,3     * COPY INDETERMINATE.* 
          EQ     CICX        RETURN 
  
  
 CICA     DATA   C* COPY INDETERMINATE.*
 CNS      SPACE  4,15 
**        CNS - CALCULATE NOISE SIZE. 
* 
*         ENTRY  (A0) = FWA FET.
*                ((A0)+NSZ) = NOISE SIZE IN FRAMES. 
* 
*         EXIT   ((A0)+NSZ) = 24/NOISE SIZE IN BITS,
*                     18/MINIMUM NUMBER OF CHARACTERS IN LAST WORD, 
*                     18/MINIMUM NUMBER OF WORDS FOR NOISE SIZE,
*                     IF S, L, OR F TAPE. 
*                (X6) = NOISE SIZE IN BITS, IF S, L, OR F TAPE. 
* 
*         USES   A - 1, 2, 3, 7.
*                B - 7. 
*                X - 1, 2, 3, 4, 6, 7.
  
  
 CNS      SUBR               ENTRY/EXIT 
          SA3    A0+SLF 
          SA1    A0+NSZ      GET NOISE SIZE IN FRAMES 
          ZR     X3,CNSX     IF NOT S, L, OR F TAPE 
          SA2    A0+TRK      GET TRACK BITS 
          LX2    59-56
          NG     X2,CNSX     IF CT OR AT TAPE 
          LX2    59-58-59+56
          SX6    6
          NG     X2,CNS1     IF 7-TRACK 
          SX6    8
 CNS1     IX6    X1*X6       CALCULATE NOISE SIZE IN BITS 
          SX2    5           CALCULATE MINIMUM NUMBER OF CHARACTERS 
          IX1    X6+X2
          SX2    X2+B1
          BX7    X6 
          IX1    X1/X2
          SX2    9           CALCULATE MINIMUM NUMBER OF WORDS
          IX3    X1+X2
          SX2    X2+B1
          BX4    X2 
          IX3    X3/X2
          LX7    18 
          SX2    X3-1        CALCULATE CHARACTERS IN LAST WORD
          IX4    X2*X4
          IX4    X1-X4
          BX7    X7+X4
          LX7    18 
          BX7    X7+X3
          SA7    A1 
          EQ     CNSX        RETURN 
 CPV      SPACE  4,10 
**        CPV - CONVERT PARAMETER VALUES. 
* 
*         EXIT   TO *PER2*, IF CONVERSION ERROR.
* 
*         USES   A - 1, 4, 5, 6, 7. 
*                B - 6, 7.
*                X - 0, 1, 4, 5, 6, 7.
* 
*         CALLS  DXB, RPV.
  
  
 CPV      SUBR               ENTRY/EXIT 
          SX4    1RU         CONVERT ERROR LIMIT
          SA5    EL 
          LX4    -6 
          SX6    -B1
          BX4    X4-X5
          SB7    B1 
          ZR     X4,CPV1     IF UNLIMITED ERROR LIMIT 
          RJ     DXB
          NZ     X4,PER2     IF CONVERSION ERROR
 CPV1     SA6    A5+
          SA5    NS          NOISE SIZE 
          ZR     X5,CPV1.1   IF NS NOT SPECIFIED
          RJ     DXB
          NZ     X4,PER2     IF CONVERSION ERROR
          SX1    MNSZ 
          IX4    X1-X6
          NG     X4,PER2     IF EXCEEDS MAXIMUM NS SIZE 
          SA6    A5 
          NZ     X6,CPV1.1   IF NOT NS=0
          SX6    DFNS        SET TO DEFAULT NOISE SIZE
          SA6    A5+
 CPV1.1   SA5    BS          CONVERT BLOCK SIZE 
          ZR     X5,CPV2     IF BS NOT SPECIFIED
          RJ     DXB
          NZ     X4,PER2     IF CONVERSION ERROR
          ZR     X6,PER2     IF BS=0 SPECIFIED
          SA6    A5+
 CPV2     SA5    CC          CONVERT CHARACTER COUNT
          ZR     X5,CPV3     IF CC NOT SPECIFIED
          RJ     DXB
          NZ     X4,PER2     IF CONVERSION ERROR
          ZR     X6,PER2     IF CC=0 SPECIFIED
          SA6    A5+
 CPV3     SA4    TC          CONVERT TERMINATION CONDITION
          SA1    TTCV        TABLE OF TERMINATION CONDITION VALUES
          RJ     RPV
          ZR     X1,PER2     IF NOT LEGAL TERMINATION CONDITION 
          SA6    A4 
          SB6    X6 
          SA5    DCT         CONVERT COPY COUNT 
          RJ     DXB
          NZ     X4,PER2     IF CONVERSION ERROR
          ZR     X6,PER2     IF ZERO COPY COUNT SPECIFIED 
          GE     B6,CPV4     IF NOT COPY TO EOI 
          SX6    -1          SET UNLIMITED COPY COUNT 
 CPV4     SA6    CT 
          SA4    CM          CONVERT CODED MODE PARAMETER 
          BX6    X6-X6
          ZR     X4,CPV5     IF MODE PARAMETER NOT SPECIFIED
          SX6    -B1         SET DEFAULT VALUE
          SA1    TCMV        TABLE OF CODED MODE VALUES 
          RJ     RPV
 CPV5     SA6    A4 
          MX0    6
          SA4    CF          CONVERT CONVERSION FORMAT
          SA5    PO 
          SA1    TCFV        TABLE OF CONVERSION FORMAT VALUES
          ZR     X4,CPV6     IF CONVERSION FORMAT NOT SPECIFIED 
          RJ     RPV
          ZR     X1,PER2     IF NOT LEGAL CONVERSION FORMAT 
          SA6    A4+
 CPV6     SA4    CRI         GET CALLING ROUTINE INDICATOR
          SA1    TCPO        CONVERT PROCESSING OPTIONS 
          NG     X4,CPV7     IF *COPY* CALL 
          SA1    TTPO 
 CPV7     ZR     X5,CPVX     IF END OF PROCESSING OPTIONS 
          BX4    X0*X5
          BX5    -X0*X5 
          LX5    6
          SX7    -B1
          RJ     RPV         GET INDICATOR ADDRESS
          ZR     X1,PER2     IF NOT LEGAL PROCESSING OPTION 
          SA7    X6+
          EQ     CPV6        CONTINUE CONVERTING PROCESSING OPTIONS 
 TCFV     SPACE  4,10 
**        TCFV - TABLE OF CONVERSION FORMAT VALUES. 
  
  
 TCFV     BSS    0
          VFD    42/0LI,18/-3   I CONVERSION FORMAT 
          VFD    42/0LSI,18/-2  SI CONVERSION FORMAT
          VFD    42/0LX,18/-1   X CONVERSION FORMAT 
          VFD    42/0LE,18/1    E CONVERSION FORMAT 
          VFD    42/0LB,18/2    B CONVERSION FORMAT 
          CON    0              END OF TABLE
 TCMV     SPACE  4,10 
**        TCMV - TABLE OF CODED MODE VALUES.
  
  
 TCMV     BSS    0
          VFD    42/0LC1,18/1 CODED MODE ON INPUT ONLY
          VFD    42/0LC2,18/2 CODED MODE ON OUTPUT ONLY 
          CON    0            END OF TABLE
 TPOA     SPACE  4,10 
**        TCPO - TABLE OF *COPY* PROCESSING OPTIONS.
  
  
 TCPO     BSS    0
          VFD    42/0LE,18/ESPI  PROCESS PARITY ERRORS
          VFD    42/0LD,18/NPDI  DELETE NOISE BLOCKS
          VFD    42/0LR,18/RSAI  ALLOW RECORD SPLIT 
          VFD    42/0LM,18/SEWI  SKIP EOF WRITE ON OUTPUT 
          CON    0               END OF TABLE FOR COPY
 TTPO     SPACE  4,10 
**        TTPO - TABLE OF *TCOPY* PROCESSING OPTIONS. 
  
  
 TTPO     BSS    0
          VFD    42/0LE,18/ESPI  PROCESS PARITY ERRORS
          VFD    42/0LT,18/TLLI  TRUNCATE LONG LINES
          CON    0
 TTCV     SPACE  4,10 
**        TTCV - TABLE OF TERMINATION CONDITION VALUES. 
  
  
 TTCV     BSS    0
          VFD    42/0LI,18/-1    END OF INFORMATION 
          VFD    42/0LEOI,18/-1 
          VFD    42/0LD,18/0     DOUBLE END OF FILE 
          VFD    42/0LEOD,18/0
          VFD    42/0LF,18/1     FILE COUNT 
          VFD    42/0LEOF,18/1
          CON    0               END OF TABLE 
 GPS      SPACE  4,10 
**        GPS - GET PRU SIZES.
* 
*         ENTRY  (A0) = FWA FET.
* 
*         EXIT   (A0+PRU) = PRU SIZE, IF NOT PREVIOUSLY SET.
* 
*         USES   A - 1, 4, 6. 
*                X - 1, 4, 6. 
* 
*         CALLS  CIO=.
  
  
 GPS      SUBR               ENTRY/EXIT 
          SA4    A0+PRU 
          PL     X4,GPSX     IF PRU SIZE ALREADY SET
          OPEN   A0,READNR,R
          SA1    A0+4        GET PRU SIZE 
          LX1    -18
          SX6    X1 
          SA6    A4 
          EQ     GPSX        RETURN 
 PER      SPACE  4,10 
**        PER - PRESET ERROR PROCESSOR. 
* 
*         ENTRY  (B5) = FWA MESSAGE, IF ENTRY AT *PER* OR *PER1*. 
*                (X1) = FILE NAME, IF ENTRY AT *PER*. 
* 
*         USES   B - 2, 5.
*                X - 1, 2.
* 
*         CALLS  MSG=, SNM, SYS=. 
  
  
 PER2     SB5    PERA        * ARGUMENT ERROR.* 
          EQ     PER1        ISSUE ERROR MESSAGE
  
 PER      MX2    42          SET NAME IN MESSAGE
          SB2    1RX
          BX1    X2*X1
          RJ     SNM
 PER1     MESSAGE B5,0
          ABORT 
  
  
 PERA     DATA   C* ARGUMENT ERROR.*
 PERB     DATA   C* BLOCK SIZE TOO LARGE ON XXXXXXX.* 
 PERC     DATA   C* BLOCK SIZE TOO SMALL ON XXXXXXX.* 
 PERD     DATA   C* COPY FL ABOVE USER LIMIT.*
 PERE     DATA   C* FILE NAME CONFLICT.*
 PERF     DATA   C* INCORRECT COPY.*
 PERG     DATA   C* INCORRECT NOISE SIZE ON XXXXXXX.* 
 PERH     DATA   C* UNLABELED TAPE REQUIRED - XXXXXXX.* 
 PERI     DATA   C* UNRECOGNIZED TERMINATION CONDITION.*
 PERJ     DATA   C* UNRECOGNIZED BACKSPACE CODE.* 
 PERK     DATA   C* BLOCK SIZE NOT APPLICABLE.* 
 PERL     DATA   C* PROCESSING OPTION NOT APPLICABLE.*
 RBL      SPACE  4,40 
**        RBL - RESET BUFFER LENGTHS. 
* 
*         WHEN NO MANIPULATION OF DATA IS REQUIRED (COMPATIBLE FILES
*         AND SAME PRU SIZE, DOES NOT APPLY TO *TCOPY*), A SINGLE 
*         BUFFER COPY WILL BE USED.  FOR *COPY* L TO L AND F TO F 
*         TAPE COPIES, THE SINGLE BUFFER SIZE WILL BE SET TO PROVIDE
*         ROOM FOR AT LEAST 6 BLOCKS IN THE CIO BUFFER, OR A BUFFER 
*         SIZE OF *SBUFL*, WHICHEVER IS GREATER.  FOR ALL OTHER 
*         SINGLE-BUFFER COPIES, A BUFFER SIZE OF *SBUFL* WILL BE USED.
* 
*         FOR ALL OTHER TYPES OF COPIES, A DOUBLE BUFFER COPY WILL
*         BE USED.  FOR *COPY* L OR F TO MS/I/LI/SI-B OR MS/I/LI/SI-B 
*         TO L OR F TAPE COPY, THE BUFFER SIZES WILL BE SET TO PROVIDE
*         ROOM FOR AT LEAST 3 BLOCKS IN EACH BUFFER, OR A BUFFER
*         SIZE OF *FBUFL*, WHICHEVER IS GREATER.  FOR ALL OTHER 
*         DOUBLE-BUFFER COPIES, A BUFFER SIZE OF *FBUFL* WILL BE USED.
* 
*         IF THE FL REQUIRED TO SUPPORT THESE BUFFER SIZES IS LESS
*         THAN THE MINIMUM OF THE CURRENT MAXIMUM FL (MAXFL) AND THE
*         LOWER OPTIMUM FL (LOFL), THE BUFFER SIZES WILL BE INCREASED 
*         UNTIL THE FL REACHES THIS VALUE.
* 
*         IF THE FL REQUIRED TO SUPPORT THESE BUFFER SIZES EXCEEDS THE
*         MINIMUM OF THE CURRENT MAXIMUM FL (MAXFL) AND THE MAXIMUM FL
*         FACTOR (MFLF), THE BUFFER SIZES WILL BE REDUCED UNTIL THE FL
*         REACHES THIS VALUE. 
* 
*         ENTRY  (I+PRU) = INPUT FILE PRU SIZE. 
*                (O+PRU) = OUTPUT FILE PRU SIZE.
* 
*         EXIT   (WBL) = WORKING BUFFER LENGTH. 
*                (IBL) = INPUT BUFFER LENGTH. 
*                (OBL) = OUTPUT BUFFER LENGTH.
* 
*         USES   A - 1, 2, 3, 4, 6, 7.
*                B - 3, 4.
*                X - ALL. 
* 
*         CALLS  SYS=.
  
  
 RBL      SUBR               ENTRY/EXIT 
          MEMORY CM,STAT,R   GET CURRENT MAXIMUM FL (MAXFL) 
          SA3    STAT 
          AX3    30 
          SX0    MFLF        MAXIMUM FL FACTOR
          SX6    X3 
          SX5    LOFL        LOWER OPTIMUM FL 
          SX3    X3-2 
          SA6    MAXFL
          IX7    X3-X0
          PL     X7,RBL1     IF MAXFL .GE. MFLF 
          IX2    X3-X5
          BX0    X3          (X0) = MINIMUM(MAXFL,MFLF) 
          PL     X2,RBL1     IF MAXFL .GE. LOFL 
          BX5    X3          (X5) = MINIMUM(MAXFL,LOFL) 
 RBL1     SA1    I+ODF
          SA2    O+ODF
          SB3    X1          (B3) = I+ODF 
          SB4    X2          (B4) = O+ODF 
          SA1    I+PRU       GET INPUT FILE PRU SIZE
          SA2    O+PRU       GET OUTPUT FILE PRU SIZE 
          SX3    3           ALLOW FOR CONTROL WORDS
          IX1    X1+X3
          IX2    X2+X3
          SX6    X2-BUFL
          NG     X6,RBL2     IF PRU SIZE SHORTER THAN DEFAULT WBL 
          BX6    X2 
          SA6    WBL         SET WORKING BUFFER = OUTPUT PRU SIZE 
 RBL2     SA4    CRI         GET CALLING ROUTINE INDICATOR
          ZR     X4,RBL10    IF *TCOPY* 
          NE     B3,B4,RBL7  IF NOT SAME FORMAT FILES 
          SA3    NSFG 
          NZ     X3,RBL7     IF DOUBLE BUFFER REQUIRED
          SX7    SBUFL       DEFAULT SINGLE BUFFER LENGTH 
          IX3    X1-X2
          BX2    X7 
          SX6    SBUF        FWA SINGLE BUFFER
          LT     B3,RBL3     IF F TO F TAPE COPY
          GT     B3,B1,RBL3  IF L TO L TAPE COPY
          SA1    I+CWF
          ZR     X1,RBL10    IF CONTROL WORD READ DISABLED
          SA1    O+CWF
          ZR     X1,RBL10    IF CONTROL WORD WRITE DISABLED 
          ZR     X3,RBL4     IF SAME PRU SIZE 
          EQ     RBL10       CHECK CALCULATED FL
  
*         RESET BUFFER LENGTHS FOR SINGLE BUFFER COPY.
  
 RBL3     PL     X4,RBL4     IF NOT *COPY*
          LX7    X1,B1       SINGLE BUFFER = INPUT BLOCK SIZE * 6 
          IX7    X7+X1
          LX7    1
          SX4    X7-SBUFL 
          PL     X4,RBL4     IF BUFFER SIZE .GE. *SBUFL*
          SX7    SBUFL       SET DEFAULT SINGLE BUFFER SIZE 
 RBL4     IX3    X6+X7
          IX4    X5-X3
          NG     X4,RBL5     IF CALCULATED FL .GT. MINIMUM(MAXFL,LOFL)
          IX7    X7+X4       INCREASE SINGLE BUFFER SIZE
          BX2    X7 
          EQ     RBL6        SET SINGLE BUFFER SIZE 
  
 RBL5     IX4    X0-X3
          BX2    X7 
          PL     X4,RBL6     IF CALCULATED FL .LE. MINIMUM(MAXFL,MFLF)
          IX7    X7-X4       DECREASE SINGLE BUFFER SIZE
          BX2    X7 
          LX3    X1,B1
          IX3    X3-X7
          NG     X3,RBL6     IF BUFFER STILL AT LEAST TWO BLOCKS LONG 
          BX2    X2-X2       FORCE BUFFER THRESHOLD = 0 
  
 RBL6     SA6    FWWB        SET FWA SINGLE BUFFER
          SX1    3           CALCULATE SINGLE BUFFER THRESHOLD
          SA7    OBL         SET OUTPUT BUFFER LENGTH 
          IX6    X2/X1
          BX7    X7-X7
          SA7    A7-B1       CLEAR INPUT BUFFER LENGTH
          SA6    SBT         BUFFER THRESHOLD = 1/3(BUFFER SIZE)
          SA7    A7-B1       CLEAR WORKING BUFFER LENGTH
          EQ     RBLX        RETURN 
  
*         RESET BUFFER LENGTHS FOR DOUBLE BUFFER COPY.
  
 RBL7     SX3    X1 
          IX4    X3-X2
          PL     X4,RBL8     IF IBL .GE. OBL
          SX3    X2          (X3) = MAXIMUM(IBL,OBL)
 RBL8     LX6    X3,B1       SET BUFFER SIZE = MAXIMUM(IBL,OBL) * 3 
          IX6    X6+X3
          SX4    X6-FBUFL 
          PL     X4,RBL9     IF BUFFER SIZE .GE. *FBUFL*
          SX6    FBUFL       SET DEFAULT BUFFER SIZE
 RBL9     SX7    X3          SET WORKING BUFFER = MAXIMUM(IBL,OBL)
          SA6    IBL         SET INPUT BUFFER LENGTH
          SA7    WBL
          SA6    OBL         SET OUTPUT BUFFER LENGTH 
  
*         CHECK CALCULATED FL FOR DOUBLE BUFFER COPY. 
  
 RBL10    SA1    IBL
          SA2    OBL
          SA3    WBL
          SX3    BUF1+1+X3
          IX3    X1+X3
          IX3    X3+X2
          IX4    X5-X3
          IX3    X3-X0
          PL     X4,RBL11    IF CALCULATED FL .LE. MINIMUM(MAXFL,LOFL)
          NG     X3,RBLX     IF CALCULATED FL .LT. MINIMUM(MAXFL,MFLF)
          AX3    1           DECREASE FL TO USE MINIMUM(MAXFL,MFLF) 
          IX6    X1-X3
          SA6    A1 
          IX7    X2-X3
          SA7    A2 
          EQ     RBLX        RETURN 
  
 RBL11    AX4    1           INCREASE FL TO USE MINIMUM(MAXFL,LOFL) 
          IX6    X1+X4
          SA6    A1 
          IX7    X2+X4
          SA7    A2 
          EQ     RBLX        RETURN 
 RBP      SPACE  4,20 
**        RBP - RESET BUFFER POINTERS.
* 
*         RESETS INPUT AND OUTPUT BUFFER POINTERS (FIRST, IN, OUT,
*         AND LIMIT) AND FIELD LENGTH AS REQUIRED, OVERLAYING 
*         NON-APPLICABLE CODE.
* 
*         ENTRY  (FWWB) = FWA WORKING BUFFER. 
*                (WBL) = WORKING BUFFER LENGTH. 
*                (IBL) = INPUT BUFFER LENGTH. 
*                (OBL) = OUTPUT BUFFER LENGTH.
*                (MAXFL) = CURRENT MAXIMUM FIELD LENGTH.
* 
*         EXIT   TO *PER1*, IF FL .GT. USER LIMIT.
* 
*         USES   A - 1, 2, 3, 5, 6, 7.
*                B - 5. 
*                X - 0, 1, 2, 3, 5, 6, 7. 
* 
*         CALLS  SYS=.
  
  
 RBP      SUBR               ENTRY/EXIT 
          SA3    FWWB        FWA WORKING BUFFER 
          SA1    WBL         WORKING BUFFER LENGTH
          SA2    I+1         SET INPUT FILE CIO BUFFER POINTERS 
          MX0    42 
          BX2    X0*X2
          IX7    X1+X3
          BX6    X2+X7
          SA6    A2 
          SA7    A6+B1
          SA1    A1+B1       INPUT BUFFER LENGTH
          SA7    A7+B1
          SA2    A7+B1
          IX7    X7+X1
          BX2    X0*X2
          BX6    X2+X7
          NZ     X1,RBP1     IF NOT SINGLE BUFFERING
          SA3    A1+1        SINGLE BUFFER LENGTH 
          IX3    X7+X3
          BX6    X2+X3
 RBP1     SA3    O+1         SET OUTPUT FILE CIO BUFFER POINTERS
          SA6    A2 
          BX3    X0*X3
          BX6    X3+X7
          SA6    A3 
          SA7    A6+B1
          SA1    A1+B1       OUTPUT BUFFER LENGTH 
          SA7    A7+B1
          SA2    A7+B1
          IX7    X7+X1
          BX2    X0*X2
          BX6    X2+X7
          SA6    A2 
          SX1    B1+B1
          IX7    X7+X1
          SA5    MAXFL       GET CURRENT MAXIMUM FL 
          SB5    PERD        * COPY FL ABOVE USER LIMIT.* 
          IX1    X5-X7
          LX7    30 
          NG     X1,PER1     IF REQUIRED FL .GT. MAXIMUM FL 
          SA7    STAT 
          MEMORY CM,STAT,R   INCREASE FL
          EQ     RBPX        RETURN 
 RPV      SPACE  4,15 
**        RPV - RETURN PARAMETER VALUE. 
* 
*         ENTRY  (A1) = FWA PARAMETER VALUE TABLE.
*                (X1) = FIRST ENTRY FROM PARAMETER VALUE TABLE. 
*                (X4) = PARAMETER, LEFT-JUSTIFIED, ZERO FILLED. 
* 
*         EXIT   (X1) = 0, IF PARAMETER NOT FOUND IN TABLE. 
*                (X6) = PARAMETER VALUE IF MATCH FOUND, OTHERWISE 
*                     UNCHANGED.
* 
*         USES   A - 1. 
*                X - 1, 2, 3, 6.
  
  
 RPV2     SX6    X1+         RETURN PARAMETER VALUE 
  
 RPV      SUBR               ENTRY/EXIT 
 RPV1     MX2    42 
          ZR     X1,RPVX     IF PARAMETER NOT FOUND 
          BX3    X2*X1
          BX3    X3-X4
          ZR     X3,RPV2     IF MATCH 
          SA1    A1+B1
          EQ     RPV1        CONTINUE SEARCH
 SFM      SPACE  4,10 
**        SFM - SET FILE MODE.
* 
*         EXIT   CODED MODE SET ON INPUT, OUTPUT, OR BOTH FILES,
*                     IF REQUESTED. 
* 
*         USES   A - 1, 2, 6. 
*                B - 2. 
*                X - 1, 2, 6. 
  
  
 SFM      SUBR               ENTRY/EXIT 
          SA2    CM          GET MODE INDICATOR 
          ZR     X2,SFMX     IF CODED MODE NOT REQUESTED
          SB2    X2 
          SX2    B1+B1
          GT     B2,B1,SFM1  IF SECOND FILE ONLY
          SA1    I
          BX6    -X2*X1 
          SA6    A1 
 SFM1     EQ     B2,B1,SFMX  IF FIRST FILE ONLY 
          SA1    O
          BX6    -X2*X1 
          SA6    A1 
          EQ     SFMX        RETURN 
 SPS      SPACE  4,10 
**        SPS - SET PRU SIZE ON S AND L TAPES.
* 
*         ENTRY  (A0) = FWA FET.
* 
*         EXIT   MLRS FIELD OF S OR L TAPE FET SET TO PRU SIZE. 
*                (A0+PRU) = PRU SIZE, IF S OR L TAPE. 
*                TO *PER*, IF INCORRECT BLOCK SIZE. 
* 
*         USES   A - 1, 2, 6, 7.
*                B - 2, 5.
*                X - 0, 1, 2, 3, 4, 6, 7. 
  
  
 SPS      SUBR               ENTRY/EXIT 
          SA1    A0+SLF 
          SB2    X1+
          LE     B2,SPSX     IF NOT S OR L TAPE 
          SX6    DLPS        DEFAULT L TAPE PRU SIZE
          GT     B2,B1,SPS1  IF L TAPE
          SX6    DSPS        DEFAULT S TAPE PRU SIZE
 SPS1     SA1    MCC         MAXIMUM CHARACTER COUNT
          ZR     X1,SPS2     IF CHARACTER COUNT NOT SPECIFIED 
          SX2    9           CALCULATE PRU SIZE 
          BX0    X1 
          IX1    X1+X2
          SX2    X2+B1
          BX3    X2 
          IX6    X1/X2
          IX7    X6*X3       CALCULATE UNUSED BIT COUNT 
          SA2    A0+NSZ      CHECK CHARACTER COUNT AGAINST NOISE SIZE 
          IX7    X7-X0
          SX4    6
          AX2    36 
          IX7    X7*X4
          SA1    A0 
          IX4    X0*X4
          SB5    PERC        * BLOCK SIZE TOO SMALL ON LFN.*
          IX4    X4-X2
          SA7    FUBC 
          NG     X4,PER      IF BLOCK SIZE TOO SMALL
          GT     B2,B1,SPS2  IF L TAPE
          SX2    MCBS        CHECK CHARACTER COUNT AGAINST MAXIMUM
          SB5    PERB        * BLOCK SIZE TOO LARGE ON LFN.*
          IX2    X2-X0
          NG     X2,PER      IF BLOCK SIZE TOO LARGE
 SPS2     SA6    A0+6        SET MLRS FIELD OF FET
          SA6    A0+PRU      SET PRU SIZE ON S OR L TAPE
          EQ     SPSX        RETURN 
 STC      SPACE  4,20 
**        STC - SET TERMINATION CONDITION.
* 
*         ENTRY  (B7) = REMAINING ARGUMENT COUNT. 
*                (A5) = ADDRESS OF PREVIOUS ARGUMENT. 
* 
*         EXIT   (B7) = UPDATED REMAINING ARGUMENT COUNT - 1. 
*                (A5) = UPDATED ADDRESS OF PREVIOUS ARGUMENT. 
*                (TM) = COPYX TERMINATION CONDITION  (0 IF ZERO 
*                     RECORD, .GT. 0 IF RECORD NAME, .LT. 0 IF
*                     RECORD COUNT).
*                (RN - RN+1) = COPYX TERMINATION RECORD NAME AND
*                     TYPE, IF SPECIFIED. 
*                (BK1) = COPYX LFN1 BACKSPACE CONTROL.
*                (BK2) = COPYX LFN2 BACKSPACE CONTROL.
*                TO *PER2*, IF ARGUMENT ERROR.
* 
*         USES   X - 0, 1, 2, 3, 5, 6, 7. 
*                B - 2, 5, 7. 
*                A - 1, 2, 5, 6, 7. 
* 
*         CALLS  DXB. 
  
  
 STC      SUBR               ENTRY/EXIT 
          SA5    A5+B1
          MX0    42 
          SA1    =2L00
          BX5    X0*X5
          BX6    X1-X5
          ZR     X5,STC5     IF BLANK ARGUMENT
          ZR     X6,STC4     IF *00*
          RJ     DXB         CONVERT NUMBER 
          SB5    PERI        * UNRECOGNIZED TERMINATION CONDITION.* 
          NZ     X4,STC1     IF ASSEMBLY ERROR
          ZR     X6,PER1     IF COUNT = 0 
          SA6    CT          SET COUNT
          EQ     STC5 
  
 STC1     SA5    A5          SET NAME 
          MX0    42 
          SX3    X5-1R/      CHECK SEPARATOR
          BX6    X0*X5
          MX7    1
          NZ     X3,STC3     IF NO TYPE SPECIFIED 
          SB7    B7-B1
          SA5    A5+B1       RECORD NAME
          LX3    X6 
          SA2    STCA        CHECK TYPE 
          BX6    X0*X5
 STC2     ZR     X2,PER1     IF TYPE NOT IDENTIFIED 
          BX7    X2-X3
          SA2    A2+B1
          NZ     X7,STC2
          SX7    A2-STCA-1   SET TYPE 
 STC3     SA6    RN          SET RECORD NAME
          SA7    A6+B1       SET TYPE 
          SX6    B1 
 STC4     SA6    TM          SET TERMINATION CONDITION
          SX7    -B1         SET NEGATIVE COUNT 
          SA7    CT 
  
*         PROCESS BACKSPACE CONTROL.
  
 STC5     EQ     B7,B1,STCX  IF END OF ARGUMENTS
          SB7    B7-B1
          SA5    A5+B1       CHECK BACKSPACE ARGUMENT 
          MX1    42 
          BX5    X1*X5
          LX5    6
          BX1    X1*X5
          SB5    PERJ        * UNRECOGNIZED BACKSPACE CODE.*
          NZ     X1,PER1     IF BACKSPACE CODE TOO LONG 
          SB2    X5-1R0 
          ZR     X5,STCX     IF NULL PARAMETER
          ZR     B2,STCX     IF ZERO ARGUMENT 
          NG     B2,PER1     IF ALPHABETIC CHARACTER
          SB2    B2-2 
          GT     B2,B1,PER1  IF BACKSPACE CODE .GT. 3 
          SX6    B0 
          ZR     B2,STC6     IF BACKSPACE CODE = 2
          SX6    B1          SET FILE 1 BACKSPACE 
          SX7    B0 
 STC6     NG     B2,STC7     IF BACKSPACE CODE = 1
          SX7    B1          SET FILE 2 BACKSPACE 
 STC7     SA6    BK1
          SA7    BK2
          EQ     STCX        RETURN 
  
  
 STCA     BSS    0
          LOC    0
 .E       ECHO   ,RT=("RTMIC")
 .A       IFC    NE,/RT// 
          DATA   L/RT/
 .A       ELSE
          DATA   1
 .A       ENDIF 
 .E       ENDD
          CON    0           END OF TABLE 
          LOC    *O 
 VCY      SPACE  4,15 
**        VCY - VALIDATE COPY.
* 
*         EXIT   TO *PER*, IF INCORRECT NOISE SIZE OR BLOCK SIZE. 
*                TO *PER1*, IF INCORRECT COPY OR BLOCK SIZE OR
*                     PROCESSING OPTION NOT APPLICABLE. 
* 
*         USES   A - 0, 1, 2, 3, 4, 6.
*                B - 3, 4, 5. 
*                X - 0, 1, 2, 3, 4, 6, 7. 
* 
*         CALLS  CNS, SFM.
  
  
 VCY      SUBR               ENTRY/EXIT 
  
*         VALIDATE COPY FILE TYPES. 
  
          SA1    I+SLF
          SA2    O+SLF
          SB3    X1 
          SB4    X2 
          SB5    PERF        * INCORRECT COPY.* 
          ZR     B4,VCY1     IF OUTPUT FILE NOT S, L, OR F TAPE 
          EQ     B3,B4,VCY1  IF INPUT = OUTPUT FILE TYPE
          LT     B3,PER1     IF INPUT FILE IS F TAPE
          LT     B4,PER1     IF OUTPUT FILE IS F TAPE 
          GT     B3,B1,PER1  IF INPUT FILE IS L TAPE
          NE     B3,B1,VCY1  IF NOT S TO L TAPE COPY
          SX6    B1          PROCESS AS S TO S TAPE COPY
          SB4    B1 
          SA6    A2+
  
*         SET FILE MODE.
  
 VCY1     RJ     SFM
  
*         VALIDATE R AND D PROCESSING OPTIONS.
  
          SA1    RSAI        RECORD SPLIT ALLOWED INDICATOR 
          SA2    NPDI        NOISE BLOCKS PADDED/DELETED INDICATOR
          BX1    X1+X2
          ZR     X1,VCY2     IF R AND D PROCESSING OPTIONS NOT SELECTED 
          SB5    PERL        * PROCESSING OPTION NOT APPLICABLE.* 
          NZ     B3,PER1     IF INPUT NOT MS/I/LI/SI-B
          LE     B4,PER1     IF OUTPUT NOT S OR L TAPE
  
*         CALCULATE NOISE SIZE FOR S, L, AND F TAPES.  VERIFY NOISE 
*         SIZES IF S TO S, L TO L, OR F TO F TAPE COPY. 
  
 VCY2     SA0    I           CALCULATE INPUT FILE NOISE SIZE
          RJ     CNS
          SA2    NS          NOISE SIZE IN CHARACTERS 
          SX3    6
          IX1    X2*X3
          ZR     X1,VCY2.1   IF NS PARAMETER NOT SPECIFIED
          IX7    X6-X1
          ZR     B3,PER2     IF INPUT TAPE NOT S/L/F FORMAT 
          PL     X7,VCY2.1   IF NS PARAMETER .LE. INPUT TAPE NOISE SIZE 
          BX6    X2          NOISE SIZE IN CHARACTERS 
          SA6    A0+NSZ      INCREASE INPUT TAPE NOISE SIZE TO NS 
          SX6    B1          FLAG FOR NOISE SIZE PROCESSING 
          SA6    NSFG 
          RJ     CNS
 VCY2.1   BX0    X6 
          SA0    O           CALCULATE OUTPUT FILE NOISE SIZE 
          RJ     CNS
          NE     B3,B4,VCY3  IF INPUT .NE. OUTPUT FILE TYPE 
          ZR     B3,VCY3     IF NOT S, L, OR F TAPE COPY
          IX6    X0-X6
          PL     X6,VCY2.2   IF INPUT NOISE SIZE .GT. OUTPUT NOISE SIZE 
          SA1    O+NSZ       SET INPUT NOISE SIZE = OUTPUT NOISE SIZE 
          BX6    X1 
          SA6    I+NSZ
          SA1    NS 
          SX6    B1+         SET NOISE SIZE PROCESSING IN EFFECT
          SA6    NSFG 
          ZR     X1,VCY2.2   IF NOISE SIZE PARAMETER NOT SPECIFIED
          SX6    B1+B1       NOISE BLOCK SIZE AUTOMATICALLY INCREASED 
          SA6    A6          SET NOISE SIZE FORCED UP FLAG
  
*         VALIDATE F TO F TAPE COPY BLOCK SIZE. 
  
 VCY2.2   GE     B3,VCY3     IF NOT F TO F TAPE COPY
          SA2    I+PRU       GET INPUT FILE BLOCK SIZE
          SA3    O+PRU       GET OUTPUT FILE BLOCK SIZE 
          IX3    X3-X2
          SB5    PERC        * BLOCK SIZE TOO SMALL ON LFN.*
          NG     X3,PER      IF INPUT .GT. OUTPUT BLOCK SIZE
  
*         VALIDATE BS AND CC PARAMETER USAGE. 
  
 VCY3     SA1    BS 
          SA2    CC 
          SX3    10 
          BX4    X1+X2
          IX6    X1*X3
          ZR     X2,VCY4     IF CC NOT SPECIFIED
          NZ     X1,PER2     IF BS AND CC SPECIFIED 
          BX6    X2 
 VCY4     ZR     X4,VCY5     IF BS AND CC NOT SPECIFIED 
          SA6    MCC
          GE     B3,B1,VCY5  IF S OR L INPUT TAPE 
          SB5    PERK        * BLOCK SIZE NOT APPLICABLE.*
          LE     B4,PER1     IF NOT S OR L TAPE 
 VCY5     SA1    NSFG 
          ZR     X1,VCYX     IF NO NOISE PROCESSING 
          SB2    X1 
          SB5    VCYA        * INSUFFICIENT NOISE SIZE.*
          NE     B2,B1,VCY6  IF NOISE SIZE AUTOMATICALLY INCREASED
          SA1    NS 
          NZ     X1,VCYX     IF NOISE SIZE PARAMETER SPECIFIED
          SB5    VCYB        * NOISE BLOCK PROCESSING IN EFFECT.* 
 VCY6     MESSAGE B5,3
          EQ     VCYX        RETURN 
  
  
 VCYA     DATA   C* INSUFFICIENT NOISE SIZE, AUTOMATICALLY INCREASED.*
 VCYB     DATA   C* NOISE BLOCK PROCESSING IN EFFECT.*
 VTY      SPACE  4,15 
**        VTY - VALIDATE TCOPY. 
* 
*         EXIT   TO *PER*, IF LABELED TAPE NOT ALLOWED OR INCORRECT 
*                     NOISE SIZE, OR INCORRECT BLOCK SIZE.
*                TO *PER1* IF INCORRECT FILE/CONVERSION TYPES FOR COPY. 
*                TO *PER2*, IF ARGUMENT ERROR.
* 
*         USES   A - 0, 1, 2, 3, 4, 6, 7. 
*                B - 2, 3, 4, 5, 6, 7.
*                X - 1, 2, 3, 4, 6, 7.
* 
*         CALLS  CNS, SFM.
  
  
 VTY8     SB2    O           DISABLE CONTROL WORD WRITE FOR E/B TO MS 
          SX7    B0+
          NZ     B3,VTY9     IF NOT MS/I/LI/SI-B INPUT FILE 
          SB2    I           DISABLE CONTROL WORD READ FOR MS TO E/B
 VTY9     SA7    B2+CWF      DISABLE CONTROL WORD READ/WRITE
  
 VTY      SUBR               ENTRY/EXIT 
  
*         VALIDATE TCOPY FILE TYPES AND CONVERSION FORMAT.
  
          SA1    I+SLF
          SA2    O+SLF
          SA3    CF 
          SB3    X1 
          SB4    X2 
          SB5    PERF        * INCORRECT COPY.* 
          LT     B3,B1,VTY1  IF NOT S/L INPUT TAPE
          SA2    TLLI        CHECK FOR INCORRECT PROCESSING OPTION
          SB5    PERL        * PROCESSING OPTION NOT APPLICABLE.* 
          NZ     X2,PER1     IF *PO=T* PROCESSING OPTION SPECIFIED
          SA1    SK 
          SA0    I
          NZ     X1,VTY2     IF SKIP SET
          NZ     B4,PER1     IF OUTPUT FILE NOT MS/OD/I/LI/SI-B 
          EQ     VTY2        CONTINUE TCOPY VALIDATION
  
 VTY1     NZ     B3,PER1     IF INPUT FILE NOT MS/OD/I/LI/SI-B
          NE     B4,B1,PER1  IF OUTPUT FILE IS NOT S TAPE 
          NG     X3,PER1     IF NOT E OR B CONVERSION FORMAT
          SA0    O
  
*         ENFORCE UNLABELED S TAPE FOR E, B, AND X CONVERSION.
  
 VTY2     BX6    X3          SET CONVERSION FORMAT ON S TAPE
          SB7    -B1
          SA6    A0+TCF 
          SB6    X3+
          LT     B6,B7,VTY3  IF SI-C CONVERSION 
          SA2    A0+TRK      CHECK LABEL TYPE 
          SA1    A0 
          SX2    X2 
          SB5    PERH        * UNLABELED TAPE REQUIRED - LFN.*
          NZ     X2,PER      IF LABELED S TAPE
  
*         VALIDATE CC PARAMETER USAGE AND SET MAXIMUM CHARACTER COUNT.
  
 VTY3     SA3    CC 
          SA4    TTCD+B6     DEFAULT MAXIMUM CHARACTER COUNT
          SX6    X4 
          ZR     X3,VTY5     IF CC PARAMETER NOT SPECIFIED
          BX6    X3 
          SB5    PERK        * BLOCK SIZE NOT APPLICABLE.*
          LE     B6,PER1     IF NOT E OR B CONVERSION 
          SX2    MCBS 
          SB5    PERB        * BLOCK SIZE TOO LARGE ON LFN.*
          IX2    X2-X3
          SA1    A0 
          NG     X2,PER      IF EXCEEDS MAXIMUM BLOCK SIZE
          GT     B6,B1,VTY4  IF B CONVERSION
          SX2    A0-I 
          ZR     X2,VTY4     IF READING E TAPE
          LX3    -1          TRUNCATE CC VALUE TO EVEN NUMBER 
          PL     X3,VTY5     IF EVEN NUMBER 
          SX6    X6-1 
          EQ     VTY5        SET MODE ON S TAPE 
  
 VTY4     SX2    10          ROUND UP CC VALUE TO MULTIPLE OF 10
          SX6    X6+9 
          BX1    X2 
          IX6    X6/X2
          IX6    X6*X1
  
*         GENERATE CODED MODE FLAG. 
  
 VTY5     AX4    18 
          SA6    MCC
          SB2    X4 
          BX6    X6-X6
          EQ     B2,VTY7     IF BINARY MODE 
          SX6    B1 
          EQ     B3,B1,VTY6  IF S INPUT TAPE
          SX6    B1+1 
 VTY6     EQ     B2,B1,VTY7  IF CODED MODE
          SA1    A0+TRK      GET TRACK BITS 
          LX1    59-58
          NG     X1,VTY7     IF 7-TRACK TAPE
          SX6    B0 
 VTY7     SA6    CM 
          RJ     SFM         SET FILE MODE
  
*         CALCULATE NOISE SIZE AND VALIDATE NOISE FOR X, SI-CODED, AND
*         I FILES (REQUIRED NOISE SIZE OF EIGHT FOR 7-TRACK, SIX FOR
*         9-TRACK).  CALCULATE NOISE SIZE FOR E/B TAPE AND SET TO THROW 
*         AWAY BLOCKS LESS THAN THE NS PARAMETER WHICH THE USER 
*         SPECIFIED.
  
          RJ     CNS         CALCULATE NOISE SIZE ON S TAPE 
          SA2    NS          CHECK NOISE SIZE PARAMETER 
          PL     B6,VTY7.2   IF NOT X, SI-C, OR I CONVERSION
          NZ     X2,PER2     IF NOISE SIZE PARAMETER SPECIFIED
          SA1    A0+
          SX6    X6-48
          SB5    PERG        * INCORRECT NOISE SIZE ON LFN.*
          ZR     X6,VTYX     IF CORRECT NOISE SIZE
          PL     X6,PER      IF INCORRECT NOISE SIZE
          SA2    A0+TRK      GET TRACK BIT
          SX6    8
          PL     X2,VTY7.1   IF 7 TRACK 
          SX6    6
 VTY7.1   SA6    A0+NSZ      FORCE IT UP TO 48 BITS 
          RJ     CNS
          SX6    B1+B1       SET FLAG FOR INSUFFICIENT NOISE SIZE 
          SA6    NSFG 
          EQ     VTYX        RETURN 
  
 VTY7.2   SX3    6
          IX1    X3*X2
          ZR     X1,VTY8     IF NS PARAMETER NOT SPECIFIED
          IX6    X6-X1
          PL     X6,VTY8     IF NS PARAMETER .LE. INPUT TAPE NOISE SIZE 
          BX6    X2 
          SA6    A0+NSZ      THROW AWAY BLOCKS .LT. NS PARAMETER
          RJ     CNS
          SX6    B1+         SET FLAG FOR NOISE SIZE PROCESSING 
          SA6    NSFG 
          EQ     VTY8        DISABLE CONTROL WORD WRITE FOR E/B TO MS 
 TTCD     SPACE  4,10 
**        TTCD - TABLE OF TCOPY DEFAULTS FOR CONVERSION TYPE. 
* 
*T        42/MODE, 18/CHCNT 
*         MODE   0=BINARY, 1=CODED, 2=CODED 7-TRACK, BINARY 9-TRACK 
*         CHCNT  DEFAULT MAXIMUM CHARACTER COUNT
* 
*         NOTE - THIS TABLE IS BOTH POSITIVELY AND NEGATIVELY INDEXED.
  
  
          VFD    42/0,18/1001B*10  I
          VFD    42/2,18/200B*10   SI-C 
          VFD    42/0,18/1000B*10  X
 TTCD     CON    0
          VFD    42/1,18/136       E
          VFD    42/1,18/150       B
          SPACE  4,10 
**        PRESET DATA STORAGE.
  
  
 BS       CON    0           BLOCK SIZE 
 CC       CON    0           CHARACTER COUNT
 CF       CON    0           CONVERSION FORMAT
 CM       CON    0           CODED MODE (-1=BOTH,0=NEITHER,1=1ST,2=2ND) 
 DCT      CON    1L1         DISPLAY CODE COPY COUNT
 MAXFL    CON    0           CURRENT MAXIMUM FIELD LENGTH 
 MCC      CON    0           MAXIMUM CHARACTER COUNT
 PO       CON    0           PROCESSING OPTIONS 
 STAT     VFD    30/-1,30/0  FIELD LENGTH STATUS WORD 
  
*         THE ORDER OF THE FOLLOWING MUST BE PRESERVED. 
  
 WBL      CON    BUFL        WORKING BUFFER LENGTH
 IBL      CON    FBUFL       INPUT BUFFER LENGTH
 OBL      CON    FBUFL       OUTPUT BUFFER LENGTH 
          SPACE  4,10 
**        COMMON DECKS. 
  
  
*CALL     COMCARM 
*CALL     COMCCPA 
*CALL     COMCDXB 
*CALL     COMCLFM 
*CALL     COMCPOP 
*CALL     COMCUSB 
          SPACE  4,10 
**        PRESET BUFFERS. 
  
  
 PASB     EQU    *           POSITIONAL ARGUMENT STRING BUFFER
          ERRNG  RFL=-PASB-200  CHECK FOR BUFFER OVERFLOW FL
          SPACE  4,10 
          END 
