Retro1.org codex

          IDENT  VERIFY,FETS 
          ABS
          ENTRY  VERIFY
          ENTRY  RFL=
          ENTRY  SSM=
          SYSCOM B1          DEFINE (B1) = 1
          SPACE  4,10
          TITLE  VERIFY - VERIFY FILES.
*COMMENT  VERIFY - VERIFY FILES.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
          SPACE  4,10
*****     VERIFY - VERIFY FILES.
*
*         G. R. MANSFIELD.   70/12/20.
*
*         J. L. LARSON.      77/03/16.
*
*         VERIFY EQUALITY OF RECORDS AND FILES ON TWO MEDIA,
*         WORD BY WORD.
          SPACE  4,10
***              VERIFY COMPARES RECORDS ON TWO MEDIA FOR EQUALITY WORD
*         BY WORD.  WHEN AN ERROR IS DETECTED THE RECORD NUMBER, WORD
*         NUMBER, AND THE DATA FROM EACH MEDIA ARE LISTED ON THE
*         OUTPUT FILE.  THE LOGICAL DIFFERENCE WILL ALSO BE LISTED ON
*         THE OUTPUT FILE IF THE OUTPUT FILE IS NOT ASSIGNED TO AN
*         INTERACTIVE TERMINAL.
          SPACE  4,10
***       CONTROL CARD CALL.
*
*
*         VERIFY (FILE1,FILE2,P1,P2,...,PN)
*
*                FILE1       FIRST FILE NAME.
*
*                FILE2       SECOND FILE NAME.
*
*                PN          ANY OF FOLLOWING IN ANY ORDER.
*
*                N=X         VERIFY X FILES.
*                            IF X = 0, VERIFY WILL TERMINATE ON AN
*                            EMPTY FILE FROM EITHER MEDIA.
*
*                N           VERIFY TO EOI.
*
*                E=X         LIST FIRST X DATA ERRORS.
*
*                L=FNAME     LIST ON FILE *FNAME*.
*
*                A           ABORT IF ERRORS OCCUR.
*
*                R           REWIND BOTH FILES BEFORE AND AFTER VERIFY.
*
*                C           CODED MODE SET ON BOTH FILES.
*
*                C1          CODED MODE SET ON FILE 1 ONLY.
*
*                C2          CODED MODE SET ON FILE 2 ONLY.
*
*                BS=BSIZE    MAXIMUM BLOCK SIZE IN CM WORDS.
*                            APPLIES ONLY TO S AND L FORMAT TAPES.
*
*         ASSUMED PARAMETERS.
*                FILE1 = *TAPE1*
*                FILE2 = *TAPE2*
*                N=1
*                E=100
*                L=*OUTPUT*
*                A  NOT PRESENT  (PROCESS ERRORS)
*                R  NOT PRESENT  (NO REWIND)
*                C, C1, C2  NOT PRESENT  (BINARY)
*                BS = 1000B FOR S FORMAT TAPE.
*                BS = 2000B FOR L FORMAT TAPE.
          SPACE  4,10
***       DAYFILE MESSAGES.
*
*
*         * FILE NOT FOUND - LFN.* = WARNING MESSAGE INDICATING THAT
*         LFN DID NOT EXIST PRIOR TO VERIFY.
*
*         * FILE STRUCTURES NOT COMPATIBLE.* = WARNING MESSAGE ISSUED
*         BEFORE VERIFICATION BEGINS, TO INDICATE THAT THE RESULTS
*         OF THE VERIFY ARE NOT GUARANTEED SINCE THE LOGICAL
*         STRUCTURES OF THE FILES BEING COMPARED ARE NOT COMPATIBLE.
*
*         * VERIFY ARGUMENT ERROR.* = CONTROL CARD CONTAINS ILLEGAL
*         PARAMETER.
*
*         * VERIFY COMPLETE.* = VERIFY OPERATION COMPLETED WITH NO
*         ERRORS.
*
*         * VERIFY ERRORS.* = ERRORS DETECTED DURING VERIFY.
*
*         * VERIFY FILE NAME CONFLICT - LFN.* = REQUESTED FILE NAMES
*         THE SAME.
*
*         * VERIFY FL ABOVE USER LIMIT.* = FIELD LENGTH REQUIRED
*         TO PROCESS L OR F TAPE VERIFY EXCEEDS USERS CURRENT
*         MAXIMUM FL.
          SPACE  4,10
****      ASSEMBLY CONSTANTS.
 
 
 BUFL     EQU    4000B       WORKING BUFFER LENGTH = MAX PRUSIZE (OD)
 OBUFL    EQU    1001B       OUTPUT FILE BUFFER LENGTH
 FBUFL    EQU    30061B      VERIFY FILES BUFFER LENGTH
 FETODL   EQU    16          OPTICAL DISK FET EXTENSION BUFFER
 
 DSPS     EQU    1000B       DEFAULT S TAPE PRU SIZE
 DLPS     EQU    2000B       DEFAULT L TAPE PRU SIZE
 MSPS     EQU    1000B       MAXIMUM S TAPE PRU SIZE
 
 MFLF     EQU    70000B-2    MAXIMUM FIELD LENGTH FACTOR
****
 
 
*         SPECIAL ENTRY POINT.
 
 SSM=     EQU    0           SUPPRESS DUMPS OF FIELD LENGTH
 READW    SPACE  4,10
**        READW - REDEFINE READ WORDS MACRO TO USE CONTROL WORDS.
 
 
          PURGMAC READW
 
 READW    MACRO  F,S,N
          R=     B6,S
          R=     B7,N
          R=     X2,F
          RJ     RDA
          ENDM
          SPACE  4
*CALL     COMCMAC
*CALL     COMCCMD
*CALL     COMSLFM
          QUAL   MTX
*CALL     COMSMTX
          QUAL   *
*CALL     COMSSRT
          TITLE  STORAGE ASSIGNMENTS.
*         FETS.
 
 
          ORG    110B
 FETS     BSS    0
 
 
 O        BSS    0
 OUTPUT   FILEC  OBUF,OBUFL,(FET=8)
 
 
*         INDEX TAGS FOR WORDS PRECEEDING FILE 1 AND FILE 2 FETS.
 
 
 EFF      EQU    8           EMPTY FILE FLAG
 LWD      EQU    7           LWA+1 DATA TRANSFERRED TO WORKING BUFFER
 RST      EQU    6           LAST READ STATUS
 CWF      EQU    5           CONTROL WORD FLAG
 SLF      EQU    4           S, L, OR F TAPE FLAG
 UBC      EQU    3           UNUSED BIT COUNT
 WRB      EQU    2           WORDS REMAINING IN BLOCK
 ERF      EQU    1           EOR FLAG
 
 
          CON    0           ZERO IF EMPTY FILE ENCOUNTERED ON FILE 1
          CON    0           LWA+1 DATA IN WORKING BUFFER FOR FILE 1
          CON    0           FILE 1 LAST READ STATUS
          CON    0           NONZERO IF CONTROL WORDS ENABLED ON FILE 1
          CON    0           1= S TAPE, 2= L TAPE, -1= F TAPE, 0= OTHER
          CON    0           UNUSED BIT COUNT FOR FILE 1 BLOCK
          CON    0           WORDS REMAINING IN FILE 1 BLOCK
          CON    0           EOR FLAG
 F1       BSS    0
 TAPE1    FILEB  BUF1,FBUFL,(FET=9)
          BSSZ   FETODL      TAPE1 OD FET EXTENSION BUFFER
 
 
          CON    0           ZERO IF EMPTY FILE ENCOUNTERED ON FILE 2
          CON    0           LWA+1 DATA IN WORKING BUFFER FOR FILE 2
          CON    0           FILE 2 LAST READ STATUS
          CON    0           NONZERO IF CONTROL WORDS ENABLED ON FILE 2
          CON    0           1= S TAPE, 2= L TAPE, -1= F TAPE, 0= OTHER
          CON    0           UNUSED BIT COUNT FOR FILE 2 BLOCK
          CON    0           WORDS REMAINING IN FILE 2 BLOCK
          CON    0           EOR FLAG
 F2       BSS    0
 TAPE2    FILEB  BUF2,FBUFL,(FET=9)
          BSSZ   FETODL      TAPE2 OD FET EXTENSION BUFFER
          SPACE  4
*         COMMON DATA.
 
 
 EC       CON    0           ERROR COUNT
 EL       CON    0L100       ERROR LIMIT
 FC       CON    0L1         FILE COUNT
 DFN      CON    0           DISPLAY FILE NUMBER
 EOIF     CON    0           NONZERO IF EOI ENCOUNTERED ON EIHER FILE
 AB       CON    0           ABORT FLAG
 RW       CON    0           REWIND FLAG
 FN       CON    1           FILE NUMBER
 RN       CON    1           RECORD NUMBER
 ER       CON    0           WORD NUMBER
          CON    0           WORD FROM FILE 1
          CON    0           WORD FROM FILE 2
          CON    0           LOGICAL DIFFERENCE
 TY       CON    0           RECORD TYPE FROM FILE 1
          CON    0           RECORD TYPE FROM FILE 2
 
*         LIST DATA.
 
 LC       CON    99999,0     LINE COUNTER
 LL       EQU    LC+1        LINE LIMIT - PAGE SIZE
 PD       CON    0           PRINT DENSITY
 PN       CON    1           PAGE NUMBER
 PW       CON    0           PAGE WIDTH
 
 TITL     DATA   50H VERIFY ERROR LIST.
 DATE     DATA   1H
 TIME     DATA   1H
          DATA   30H
          DATA   4APAGE
 PAGE     DATA   8L
 TITLL    EQU    *-TITL
 TITSL    EQU    TITLL-5     SHORT TITLE LENGTH
 
 SBTL     DATA   10H RECORD
          DATA   10HWORD
          DATA   10HDATA FROM
 F1NM     DATA   20H
          DATA   10HDATA FROM
 F2NM     DATA   10H
          DATA   2ALO
          DATA   20CGICAL DIFFERENCE
          DATA   2L
 SBTLL    EQU    *-SBTL
 SBTSL    EQU    SBTLL-5     SHORT SUBTITLE LENGTH
 VERIFY   TITLE  MAIN PROGRAM.
**        VERIFY - MAIN PROGRAM.
 
 
 VERIFY   SB1    1           (B1) = 1
          RJ     PRS         PRESET PROGRAM
          RECALL F1
          RECALL F2
          SA3    PW
          ZR     X3,VFY1     IF TERMINAL FILE
          WRITEC O,PD        WRITE PRINT DENSITY FORMAT CONTROL
 VFY1     BX6    X6-X6       CLEAR EMPTY FILE FLAGS
          SX7    B1          INITIALIZE RECORD NUMBER
          SA6    F1-EFF
          SX0    B0+         INDICATE INITIAL READ
          SA6    F2-EFF
          SA7    RN
          SA6    LEWA        CLEAR ERROR LINE RECORD NUMBER
 VFY2     SX2    F1          INITIATE READ FUNCTION ON FILE 1
          RJ     IRF
          SX2    F2          INITIATE READ FUNCTION ON FILE 2
          RJ     IRF
          SX7    B0+         CLEAR WORD COUNT
          SA7    ER
          READW  F1,SBF1,BUFL
          SX4    X1+B1
          ZR     X4,VFY3     IF EOF ON FILE 1
          SX7    B1+         INDICATE NOT EMPTY FILE
          SA7    F1-EFF
 VFY3     READW  F2,SBF2,BUFL
          SA3    F1-RST
          SX4    X1+B1
          ZR     X4,VFY4     IF EOF ON FILE 2
          SX7    B1          INDICATE NOT EMPTY FILE
          BX4    X1+X3
          SA7    F2-EFF
          NG     X4,VFY4     IF EOF OR EOI ON EITHER FILE
          RJ     SRM         SEND RECORD MESSAGE
          RJ     CPR         COMPARE RECORDS
          SA1    RN          ADVANCE RECORD NUMBER
          SX0    B1          INDICATE NON-INITIAL READ
          SX6    X1+B1
          SA6    A1
          EQ     VFY2        CONTINUE RECORD COMPARISONS
 
*         PROCESS EXCESS RECORDS OR FILES.
 
 VFY4     SA4    EOIF        CHECK EOI ENCOUNTERED FLAG
          SA0    F2
          SX4    X4-F1
          SX2    SBF2
          ZR     X4,VFY6     IF EXTRA FILES ON FILE 2
          PL     X4,VFY5     IF EXTRA FILES ON FILE 1
          BX6    X1*X3
          NG     X6,VFY7     IF EOF OR EOI ON BOTH FILES
          NG     X3,VFY6     IF EXTRA RECORDS ON FILE 2
 VFY5     SA0    F1
          SX2    SBF1
          BX1    X3
 VFY6     RJ     EXR         PROCESS EXCESS RECORDS OR FILES
 
*         CHECK FOR EOI.
 
 VFY7     SA1    F1-RST      CHECK FILE STATUS
          SA2    F2-RST
          SX1    X1+B1
          SX2    X2+B1
          BX3    X1*X2
          BX4    X1+X2
          NG     X3,VFY11    IF EOI ENCOUNTERED ON BOTH FILES
          PL     X4,VFY9     IF EOF ENCOUNTERED ON BOTH FILES
          SA3    EOIF
          NZ     X3,VFY9     IF EOI PREVIOUSLY ENCOUNTERED
          SX6    F1          SET EOI ENCOUNTERED FLAG
          NG     X1,VFY8     IF EOI ON FILE 1
          SX6    F2
 VFY8     SA6    A3
          SA1    EXRG        BUILD EXCESS FILE LINE
          SA2    A1+B1
          BX6    X1
          SA6    EXRD
          LX7    X2
          SA7    A6+B1
          SA3    =1H         CLEAR FILE NUMBER FROM TITLE LINE
          BX7    X7-X7       CLEAR SUBTITLE LINE
          LX6    X3
          SA7    SBTL
          SX7    99999       FORCE PAGE EJECT
          SA7    LC
 
*         CHECK FOR VERIFY COMPLETE.
 
 VFY9     RJ     EOF         PROCESS END OF FILE
          SA1    FC
          ZR     X1,VFY10    IF EMPTY FILE REQUEST
          SX2    B1          DECREMENT FILE COUNT
          IX6    X1-X2
          SA6    A1+
          ZR     X6,VFY11    IF FILE COUNT EXHAUSTED
          EQ     VFY1        CONTINUE VERIFY
 
 VFY10    SA1    F1-EFF      CHECK FOR EMPTY FILE
          SA2    F2-EFF
          BX1    X1*X2
          NZ     X1,VFY1     IF NO EMPTY FILE ENCOUNTERED
 
*         PROCESS REWIND REQUEST, ISSUE COMPLETION MESSAGE,
*         AND END OR ABORT.
 
 VFY11    SA1    RW
          ZR     X1,VFY12    IF NO REWIND
          REWIND F1
          REWIND F2
 VFY12    SA1    EC
          NZ     X1,VFY14    IF ERRORS DETECTED
          MESSAGE (=C* VERIFY GOOD.*)
 VFY13    ENDRUN
 
 VFY14    WRITER O           FLUSH OUTPUT BUFFER
          MESSAGE (=C* VERIFY ERRORS.*)
          SA1    AB
          ZR     X1,VFY13    IF ABORT NOT REQUESTED
          ABORT
          TITLE  SUBROUTINES.
 CPR      SPACE  4,10
**        CPR - COMPARE RECORDS.
*
*         ENTRY  (F1-RST) = FILE 1 READ STATUS.
*                (F2-RST) = FILE 2 READ STATUS.
*                (F1-LWD) = LWA+1 DATA IN WORKING BUFFER FOR FILE 1.
*                (F2-LWD) = LWA+1 DATA IN WORKING BUFFER FOR FILE 2.
*
*         USES   A - ALL.
*                X - ALL.
*
*         CALLS  CDD, COD, LEW, WOF.
*
*         MACROS READW.
 
 
 CPR      SUBR               ENTRY/EXIT
 CPR1     SA4    F1-LWD      GET LWA+1 DATA FOR FILE 1
          SA5    F2-LWD      GET LWA+1 DATA FOR FILE 2
          SX4    X4-SBF1     SET WORD COUNT FOR FILE 1
          SX5    X5-SBF2     SET WORD COUNT FOR FILE 2
          IX6    X4-X5
          PL     X6,CPR2     IF FILE 2 WORD COUNT .LE. FILE 1
          SX5    X4          SET NUMBER OF WORDS TO COMPARE
 CPR2     SA6    CPRA        SAVE WORD COUNT DIFFERENCE
          ZR     X5,CPR6     IF NO DATA TO COMPARE
          SA0    B0+         INITIALIZE WORD INDEX
 
*         COMPARE DATA WORDS.
 
 CPR3     SA1    SBF1+A0     COMPARE FILE 1 AND FILE 2 DATA WORDS
          SA2    SBF2+A0
          BX6    X1-X2
          NZ     X6,CPR4     IF NO MATCH
          PL     X6,CPR5     IF MATCH
 CPR4     SA6    ER+3        STORE DIFFERENCE
          BX7    X2          STORE WORD 2
          LX6    X1          STORE WORD 1
          SA7    A6-B1
          SA6    A7-B1
          RJ     LEW         LIST ERROR WORDS
 CPR5     SA1    ER          ADVANCE WORD NUMBER
          SX2    B1
          IX7    X1+X2
          SA0    A0+B1       ADVANCE WORD INDEX
          IX5    X5-X2       DECREMENT WORD COUNT
          SA7    A1
          NZ     X5,CPR3     IF MORE WORDS TO COMPARE
 CPR6     SA5    CPRA        GET WORD COUNT DIFFERENCE
          NZ     X5,CPR7     IF EXCESS WORDS
          SA1    F1-RST      GET FILE 1 READ STATUS
          NZ     X1,CPR11    IF EOR/EOF/EOI ENCOUNTERED ON BOTH FILES
          READW  F1,SBF1,BUFL
          READW  F2,SBF2,BUFL
          EQ     CPR1        CONTINUE PROCESSING DATA IN RECORD
 
*         PROCESS EXCESS WORDS.
 
 CPR7     SX2    F1
          SX0    B0+
          PL     X5,CPR8     IF FILE 1 RECORD LONGER
          SX2    F2
          BX5    -X5
 CPR8     SA1    X2-RST      CHECK FILE LAST READ STATUS
          NZ     X1,CPR10    IF EOR/EOF/EOI ENCOUNTERED
 CPR9     IX5    X5+X0       COUNT EXCESS WORDS
          READW  X2,SBF1,BUFL
          SX0    BUFL
          ZR     X1,CPR9     IF NOT EOR
          SX0    B6-SBF1
          IX5    X5+X0
 CPR10    SA1    X2          SPACE FILL NAME
          MX0    42
          BX6    X0*X1
          SX1    X5          CONVERT WORD COUNT
          SA6    CPRE
          RJ     COD
          SA6    CPRD+1
          SA1    RN          CONVERT RECORD NUMBER
          RJ     CDD
          LX6    30
          SA1    EC          ADVANCE ERROR COUNT
          SA6    CPRD
          SX7    X1+B1
          SA7    A1
          SX2    CPRL
          SX1    A6          LIST ERROR LINE
          RJ     WOF
 
*         CHECK FOR NONSTANDARD RECORD COMPARED WITH STANDARD RECORD.
 
 CPR11    SA2    F1-RST      CHECK FILE 1 LAST READ STATUS
          SA3    F2-RST      CHECK FILE 2 LAST READ STATUS
          MX0    42
          BX3    X2-X3
          PL     X3,CPRX     IF MATCHING RECORD STRUCTURE
          SA1    F1
          SA3    EC
          NG     X2,CPR12    IF NONSTANDARD RECORD ON FILE 1
          SA1    F2
 CPR12    BX6    X0*X1       SET FILE NAME IN MESSAGE
          SX7    X3+B1       ADVANCE ERROR COUNT
          SA6    CPRC
          SA7    A3
          SA1    RN          CONVERT RECORD NUMBER
          RJ     CDD
          LX6    30
          SA6    CPRB
          SX1    CPRB        LIST ERROR LINE
          SX2    CPRL
          RJ     WOF
          EQ     CPRX        RETURN
 
 
 CPRA     CON    0           WORD COUNT DIFFERENCE
 
 CPRB     DATA   1H
          DATA   1H
          DATA   20H EOR MISSING ON
 CPRC     DATA   1H
 
 CPRD     DATA   1H
          DATA   1H
          DATA   20H EXCESS WORD(S) ON
 CPRE     DATA   1H
 CPRL     EQU    *-CPRD
 EOF      SPACE  4,10
**        EOF - PROCESS END OF FILE.
*
*         USES   A - 1, 6, 7.
*                X - 1, 6, 7.
*
*         CALLS  CDD.
 
 
 EOF      SUBR               ENTRY/EXIT
          SA1    FN          ADVANCE FILE NUMBER
          SX6    X1+B1
          SA6    A1
          SX1    X6          CONVERT NUMBER
          RJ     CDD
          SA1    =10HVERIFYING
          LX6    5*6
          BX7    X1
          SA7    SRMA
          SB2    B2-B1       CLEAR BLANK FILL FROM FILE NUMBER
          MX7    1
          AX7    B2
          BX7    X7*X4
          SA1    EOIF
          SA7    DFN         SAVE DISPLAY FILE NUMBER
          NZ     X1,EOFX     IF EOI ENCOUNTERED
          SX7    99999       FORCE PAGE EJECT
          SA7    LC
          EQ     EOFX        RETURN
 EXR      SPACE  4,15
**        EXR - PROCESS EXCESS RECORDS.
*
*         ENTRY  (A0) = FET ADDRESS.
*                (X2) = BUFFER ADDRESS.
*                (X1) = FILE READ STATUS.
*
*         USES   A - 1, 2, 3, 4, 6, 7.
*                B - 2, 5.
*                X - ALL.
*
*         CALLS  CDD, CIO=, RDA, SFN, SNM, SRT, SYS=, WOF.
*
*         MACROS MESSAGE, READ, READW.
 
 
 EXR5     SA1    RN
          ZR     X5,EXR6     IF NO DATA TRANSFERRED
          SX1    X1+B1       INCREMENT RECORD COUNT
 EXR6     RJ     CDD         CONVERT RECORD COUNT TO DISPLAY
          SA6    EXRC
          SA1    A0+         ADD FILE NAME
          MX2    42
          SX3    1R
          BX6    X2*X1
          SA4    EOIF
          BX6    X6+X3
          LX6    -6
          SA6    EXRE
          ZR     X4,EXR7     IF EOI NOT ENCOUNTERED ON EITHER FILE
          SA1    EXRH
          SA6    EXRF
          SA2    A1+B1
          BX6    X1
          SA6    EXRE
          LX7    X2
          SA7    A6+B1
          SA1    DFN         GET DISPLAY CODE FILE NUMBER
          SB2    1RZ
          SB5    EXRB
          RJ     SNM         ENTER FILE NUMBER INTO MESSAGE
 EXR7     SX1    EXRB
          SA3    PW
          NZ     X3,EXR8     IF NOT SHORT FORMAT
          SA4    EXRB
          MX3    6
          BX6    -X3*X4
          SA3    =1L
          BX6    X3+X6
          SA6    A4
 EXR8     RJ     WOF         WRITE EXCESS RECORDS/FILE LINE
 
 EXR      SUBR               ENTRY/EXIT
          SA3    EC          ADVANCE ERROR COUNT
          BX7    X7-X7       CLEAR EXCESS RECORD COUNT
          SX6    X3+B1
          SA7    RN
          SA6    A3
          BX5    X5-X5       CLEAR DATA TRANSFERRED FLAG
          SX0    B1          SET PREVIOUS EOR FLAG
          EQ     EXR3        DISPLAY RECORD NAME
 
 EXR1     SA4    RN          INCREMENT RECORD COUNT
          BX5    X5-X5       CLEAR DATA TRANSFERRED FLAG
          SX6    X4+B1
          SA3    A0-CWF
          SA6    A4+
          NZ     X3,EXR2     IF CONTROL WORDS ENABLED
          READ   A0
 EXR2     READW  A0,SBF1,BUFL
          SX2    SBF1
 EXR3     NG     X1,EXR5     IF EOF OR EOI ENCOUNTERED
          SB5    X1          SAVE CURRENT READ STATUS
          SX5    B1          INDICATE DATA TRANSFERRED
          ZR     X0,EXR4     IF PREVIOUS READ NOT EOR
          SA1    A0-LWD      LWA+1 OF DATA READ
          RJ     SRT         SET RECORD TYPE
          SA7    EXRA+1
          MESSAGE A7-B1,B1   DISPLAY RECORD NAME
 EXR4     SX0    B5
          ZR     X0,EXR2     IF NOT EOR
          EQ     EXR1        INCREMENT RECORD COUNT
 
 
 EXRA     DATA   10H READING
          CON    0
 
 EXRB     DATA   10H0  *****
 EXRC     CON    0
 EXRD     DATA   20H EXCESS RECORD(S) ON
 EXRE     CON    0,0
 EXRF     CON    0
 
 EXRG     DATA   20H RECORD(S) IN EXCESS
 EXRH     DATA   20H FILE ZZZZZZZZZZZ ON
 IRF      SPACE  4,15
**        IRF - INITIATE READ FUNCTION.
*
*         IF EOI STATUS IS DETECTED ON THIS FILE, NO FURTHER READ
*         FUNCTION IS INITIATED.  IF CONTROL WORDS ARE ALLOWED OR IF
*         EOF STATUS IS DETECTED, NO FURTHER READ IS INITIATED UNLESS
*         AN INITIAL READ IS REQUESTED (INDICATES PREVIOUS EOF HAS
*         BEEN PROCESSED).
*
*         ENTRY  (X2) = FWA FET.
*                (X0) = 0, IF INITIAL READ.
*
*         USES   A - 1, 3, 6.
*                X - 1, 3, 6.
*
*         CALLS  CIO=.
 
 
 IRF1     PL     X3,IRF2     IF NOT EOF
          NZ     X0,IRFX     IF NOT INITIAL READ
 IRF2     READ   X2
 
 IRF      SUBR               ENTRY/EXIT
          SA3    X2
          SA1    X2-CWF      CONTROL WORD FLAG
          LX3    59-9        CHECK FOR EOI
          MX6    1
          NG     X3,IRFX     IF EOI ENCOUNTERED
          LX3    59-3-59+9   CHECK FOR EOF
          ZR     X1,IRF1     IF CONTROL WORDS DISABLED
          NZ     X0,IRFX     IF NOT INITIAL READ
          SA6    X2-WRB      SET FIRST READ FLAG
          READCW X2,17B
          EQ     IRFX        RETURN
 LEW      SPACE  4,15
**        LEW - LIST ERROR WORDS.
*
*         ENTRY  (RN) = RECORD NUMBER.
*                (ER) = WORD NUMBER.
*                (ER+1) = WORD FROM FILE 1.
*                (ER+2) = WORD FROM FILE 2.
*                (ER+3) = LOGICAL DIFFERENCE.
*
*         USES   A - 1, 2, 3, 6, 7.
*                B - 7.
*                X - 1, 2, 3, 4, 6, 7.
*
*         CALLS  CDD, COD, UPN, UPW, WOF.
*
*         MACROS MOVE.
 
 
 LEW      SUBR               ENTRY/EXIT
          SA2    EL
          SA3    EC
          ZR     X2,LEW4     IF ERROR LIMIT ZERO
          IX6    X3-X2
          PL     X6,LEWX     IF ERROR LIMIT EXCEEDED
          SA1    RN          CHECK RECORD CHANGE
          SA2    LEWA
          BX6    X1-X2
          ZR     X6,LEW3     IF NO CHANGE
          BX6    X1
          SA6    A2          SET NEW RECORD
          SA3    LC          CHECK LINE COUNT
          SX7    X3+5
          SA1    A3+B1       GET LINE LIMIT
          IX7    X7-X1
          NG     X7,LEW1     IF NOT BOTTOM OF PAGE
          SX7    99999       FORCE EJECT
          SA7    A3
          EQ     LEW2
 
 LEW1     SX1    =C*  *
          RJ     WOF
          SX1    =C*  *
          RJ     WOF
 LEW2     SA1    SRMB        PRINT RECORD NAME
          SA2    A1+B1
          SA3    =3R
          MX4    -18
          LX1    18
          LX2    18
          BX6    X4*X1
          IX6    X6+X3
          BX7    X4*X2
          IX7    X7+X3
          SA6    LEWB+3
          SA7    LEWB+6
          BX6    -X4*X1
          BX7    -X4*X2
          SA1    TY          PRINT TYPE
          SA2    A1+B1
          SA1    X1+LEWC
          SA2    X2+LEWC
          IX6    X6+X1
          IX7    X7+X2
          SA6    A6-B1
          SA7    A7-B1
          SX1    LEWB
          RJ     WOF
          SX1    =C*  *
          RJ     WOF
 LEW3     SA1    RN          CONVERT RECORD NUMBER
          RJ     CDD
          SB7    CHAR
          RJ     UPN
          SA1    ER          CONVERT WORD NUMBER
          RJ     COD
          SX7    1R
          SA7    B7
          SA7    A7+B1
          SA7    A7+B1
          SB7    A7+B1
          RJ     UPN
          SA1    ER+1        UNPACK WORD FROM FILE 1
          SA2    TY
          RJ     UPW
          SA1    ER+2        UNPACK WORD FROM FILE 2
          SA2    TY+1
          SB7    B7-B1
          RJ     UPW
          SX6    B7+
          SA6    LEWL        SAVE LENGTH OF SHORT LINE
          SA1    ER+3        UNPACK LOGICAL DIFFERENCE
          SA2    TY+1
          RJ     UPW
          SA1    PW
          ZR     X1,LEW3.1   IF SHORT LINE
          SX6    B7+         RESET LINE LENGTH
          SA6    LEWL
 LEW3.1   SX1    4
          SX2    CHAR+6
          SX3    CHAR+11D
          MOVE   X1,X2,X3    PACK RECORD NUMBER INTO WORD COUNT WORD
          SX6    1RB         INSERT OCTAL CHARACTER
          SX3    CHAR+10D    RESET FWA OF LINE
          SA6    CHAR+23D
          BX1    -X3         LIST LINE
          SA2    LEWL
          IX2    X2-X3
          RJ     WOF
 LEW4     SA1    EC          ADVANCE ERROR COUNT
          SA2    EL
          SX6    X1+B1
          SA6    A1
          ZR     X2,LEWX     IF ZERO ERROR LIMIT
          IX7    X6-X2
          NG     X7,LEWX     IF LIMIT NOT REACHED
          SX1    =C+     ** ERROR LIMIT EXCEEDED **+
          RJ     WOF
          SX1    =C*  *
          RJ     WOF
          EQ     LEWX        RETURN
 
 
 LEWA     DATA   0           RECORD NUMBER
 LEWB     DATA   10H
          DATA   10H
          DATA   0,0         RECORD NAME 1
          DATA   20H
          DATA   0,0         RECORD NAME 2
 
 LEWC     BSS    0
 .E       ECHO   ,RT=("RTMIC")
 .A       IFC    NE,/RT//
          VFD    36/0A_RT,24/1L/
 .A       ELSE
          VFD    36/3A   ,24/1L/
 .A       ENDIF
 .E       ENDD
 LEWL     CON    0
 RDA      SPACE  4,20
**        RDA - READ DATA.
*         PROCESSES CALLS TO READ WORDS (RDW=).
*         DEBLOCKS DATA IF CONTROL WORD READS.
*
*         ENTRY  (X2) = FWA FET.
*                (B6) = FWA WORKING BUFFER.
*                (B7) = NUMBER OF WORDS TO TRANSFER.
*
*         EXIT   (X1) = 0, IF TRANSFER COMPLETE.
*                (X1) = -1, IF EOF DETECTED ON FILE.
*                (X1) = -2, IF EOI DETECTED ON FILE.
*                (X1) = (B6), IF EOR DETECTED BEFORE TRANSFER COMPLETE.
*                (B6) = LWA+1 DATA TRANSFERRED TO WORKING BUFFER.
*                ((X2)-RST) = (X1).
*                ((X2)-LWD) = (B6).
*
*         USES   A - 1, 3, 4, 6, 7.
*                B - 3, 4, 5, 6, 7.
*                X - 1, 3, 4, 6, 7.
*
*         CALLS  RDW=.
 
 
 RDA7     SX6    B5-B7       UPDATE WORDS REMAINING
          SA6    A1
 RDA8     RJ     RDW=        READ WORDS
          SA3    X2-WRB
          NZ     X3,RDA10    IF MORE WORDS IN BLOCK
 RDA9     SA4    X2-UBC
          ZR     X4,RDA10    IF NO UNUSED BIT COUNT
          SB3    X4          CLEAR EXTRANEOUS DATA IN LAST WORD
          MX6    1
          SB4    B3-B1
          AX6    B4
          SA3    B6-B1       LAST WORD TRANSFERRED
          LX6    B3
          BX6    -X6*X3
          SA6    A3
 RDA10    BX6    X1          SAVE FILE READ STATUS
          SX7    B6          SAVE LWA+1 DATA IN WORKING BUFFER
          SA6    X2-RST
          SA7    X2-LWD
 
 RDA      SUBR               ENTRY/EXIT
          SA1    X2-CWF
          ZR     X1,RDA8     IF CONTROL WORD READ DISABLED
 RDA1     SA1    X2-WRB      NUMBER OF WORDS BEFORE CONTROL WORD
          SB5    X1+
          PL     X1,RDA2     IF NOT FIRST READ
          SX7    B7+         SET WORDS NEEDED
          SA7    RDAA
          JP     RDA4
 
 RDA2     GE     B5,B7,RDA7  IF ENOUGH DATA TO FILL BUFFER
          SA3    X2-ERF      CHECK EOR FLAG
          PL     X3,RDA3     IF NOT EOR ON FILE
          MX6    1           SET NEW READ FLAG
          SB7    B5+B1       SET WORDS TO READ
          SA6    A3
          SA6    A1
          RJ     RDW=        READ WORDS
          SA1    B6-B1       CHECK CONTROL WORD
          AX1    48
          SX6    X1-17B
          MX1    -1
          SB6    B6-B1       BACK UP LAST WORD ADDRESS
          ZR     X6,RDA10    IF *EOF* CONTROL WORD
          SX1    B6          SET *EOR* INDICATION
          EQ     RDA9        CLEAR EXTRANEOUS DATA IN LAST DATA WORD
 
 RDA3     SX6    B7-B5       SAVE ADDITIONAL WORDS NEEDED
          SA6    RDAA
          SB7    B5+B1       SET WORDS TO TRANSFER
          RJ     RDW=        READ WORDS
          SB6    B6-1        BACK UP OVER LAST CONTROL WORD
 RDA4     SB7    B1          READ CONTROL WORD
          RJ     RDW=
          NG     X1,RDA10    IF EOF/EOI ENCOUNTERED
          SB6    B6-B1       BACK UP WORKING BUFFER
          SA1    B6          CONTROL WORD
 
*         FOR MASS STORAGE AND WORD BOUNDARY FORMAT TAPES (ALL EXCEPT
*         S, L, AND F FORMATS), UNUSED BIT COUNT IN CONTROL WORD HEADER
*         IS ASSUMED ZERO AND BYTE COUNT SHOULD BE A MULTIPLE OF 5.
 
          MX3    -24
          BX7    -X3*X1      BYTE COUNT
          SX3    4
          LX4    X7
          IX7    X7+X3       ROUND UP BYTE COUNT
          SX3    X3+B1
          IX7    X7/X3       WORD COUNT
          MX3    -6
          SA7    X2-WRB
          LX1    -24
          BX6    -X3*X1      UNUSED BIT COUNT (BASED ON BYTE)
          SX3    5
          IX3    X7*X3
          IX4    X3-X4       UNUSED BYTES
          ZR     X4,RDA5     IF NO EXTRANEOUS DATA BYTES
          SX3    12
          IX3    X4*X3
          IX6    X3+X6
 RDA5     SA6    X2-UBC      STORE UNUSED BIT COUNT
          LX4    X6
          SX6    -B1         INDICATE EOR
          NZ     X4,RDA6     IF EXTRANEOUS DATA IN LAST WORD
          SA3    X2-SLF
          LX1    -12
          NZ     X3,RDA6     IF S, L, OR F TAPE
          SX1    X1          PRU SIZE
          IX6    X7-X1       NO EOR IF FULL BLOCK
 RDA6     SA6    X2-ERF      SAVE EOR FLAG
          SA1    RDAA        RESET WORDS NEEDED
          SB7    X1
          EQ     RDA1        LOOP
 
 
 RDAA     CON    0
 SRM      SPACE  4,10
**        SRM - SEND RECORD MESSAGE.
*
*         ENTRY  (F1-LWD) = LWA+1 OF DATA IN FILE 1 BUFFER.
*                (F2-LWD) = LWA+1 OF DATA IN FILE 2 BUFFER.
*
*         USES   A - 1, 6.
*                X - 1, 2, 6.
*
*         CALLS  SFN, SRT, SYS=.
 
 
 SRM      SUBR               ENTRY/EXIT
          SA1    F1-LWD      LWA+1 OF DATA IN FILE 1
          SX2    SBF1
          RJ     SRT         SET RECORD TYPE
          SA6    TY
          BX1    X7
          RJ     SFN         SPACE FILL NAME
          SA6    SRMB
          SA1    F2-LWD      LWA+1 OF DATA IN FILE 2
          SX2    SBF2
          RJ     SRT         SET RECORD TYPE
          SA6    TY+1
          BX1    X7
          RJ     SFN         SPACE FILL NAME
          SA6    SRMB+1
          SA1    EC
          ZR     X1,SRM1     IF NO ERRORS
          SA1    =0LERRORS.
          BX6    X1
          SA6    SRMC
 SRM1     MESSAGE SRMA,1
          EQ     SRMX        RETURN
 
 
 SRMA     DATA   10HVERIFYING
 SRMB     DATA   0,0
 SRMC     DATA   0
 UPN      SPACE  4,10
**        UPN - UNPACK NAME.
*
*         ENTRY  (X6) = NAME LEFT JUSTIFIED.
*                (B7) = CHARACTER ADDRESS.
*
*         EXIT   (B7) ADVANCED.
*
*         USES   A - 7.
*                B - 2, 7.
*                X - 1, 6, 7.
 
 
 UPN      SUBR               ENTRY/EXIT
          MX1    60-6
          SB2    B7+10
          LX6    6
 UPN1     BX7    -X1*X6
          ZR     B7,UPNX     IF END OF NAME
          SA7    B7
          SB7    B7+B1
          LX6    6
          NE     B7,B2,UPN1  LOOP FOR 10 CHARACTERS
          EQ     UPNX        RETURN
 UPW      SPACE  4,15
**        UPW - UNPACK WORD.
*
*         ENTRY  (X1) = WORD.
*                (B7) = CHARACTER ADDRESS.
*                (X2) = RECORD TYPE.
*
*         EXIT   (B7) ADVANCED.
*
*         USES   A - 7.
*                B - 2, 4, 5, 7.
*                X - 0, 1, 2, 7.
 
 
 UPW      SUBR               ENTRY/EXIT
          SB2    X2
          SX2    UPWA
          LX2    48
          LX2    X2,B2
          SB5    4
          SB4    5
          PL     X2,UPW1     IF TEXT TYPE
          SB5    B4
          SB4    B4-B1
 UPW1     SX7    1R
          SX7    1R
          MX0    60-3
          SA7    B7
          SA7    A7+B1
          SA7    A7+B1
          SA7    A7+B1
          SA7    A7+B1
 UPW2     SB2    B5
 UPW3     LX1    3
          SB2    B2-B1
          BX2    -X0*X1      CONVERT DIGIT
          SX7    X2+1R0
          SA7    A7+B1       STORE CHARACTER
          NZ     B2,UPW3     IF MORE DIGITS
          SX7    1R
          SB4    B4-B1
          SA7    A7+B1       SPACE
          NZ     B4,UPW2     IF MORE BYTES
          SB2    B5-4
          ZR     B2,UPW4     IF 5 GROUPS OF 4
          SA7    A7+B1       SPACE
 UPW4     SB7    A7+B1       ADVANCE CHARACTER ADDRESS
          EQ     UPWX        RETURN
 
 
 UPWA     EQURT  (RLRT,OVRT,ABRT),12
 WOF      SPACE  4,15
**        WOF - WRITE LINE TO OUTPUT.
*
*         ENTRY  (X1) = FWA LINE.
*                IF (X1) < 0, LINE IS *S* FORMAT.
*                OTHERWISE LINE IS *C* FORMAT.
*                (X2) = WORD COUNT.
*
*         USES   A - 1, 2, 3, 4, 6, 7.
*                X - 1, 2, 3, 4, 6, 7.
*                B - 7.
*
*         CALLS  CDD.
*
*         MACROS WRITEC, WRITES, WRITEW.
 
 
 WOF4     BX1    -X1
          WRITES O,X1,X2
 
 WOF      SUBR               ENTRY/EXIT
          SA4    EL
          ZR     X4,WOFX     IF ERROR LIMIT
          SA3    LC          ADVANCE LINE COUNT
          SX6    X3+B1
          SA6    A3
          SA4    A3+B1       GET PAGE LENGTH
          IX7    X6-X4
          NG     X7,WOF3     IF BOTTOM OF PAGE NOT REACHED
          BX6    X1          SAVE REQUEST
          LX7    X2
          SA6    WOFA
          SA7    A6+B1
          SA1    PN          ADVANCE PAGE NUMBER
          SX7    X1+B1
          SX6    3
          SA6    A3
          SA7    A1
          RJ     CDD         CONVERT PAGE NUMBER
          MX1    48
          LX6    18          STORE PAGE NUMBER
          BX6    X1*X6
          SA6    PAGE
          SA3    PW
          ZR     X3,WOF1     IF SHORT PAGE FORMAT
          WRITEW O,(=1H1),1
          WRITEC X2,TITL     WRITE TITLE LINE
          WRITEC X2,SBTL     WRITE SUBTITLE LINE
          WRITEW X2,(=1L ),1 WRITE BLANK LINE
          EQ     WOF2        RESTORE REQUEST
 
 WOF1     SA3    PN
          SB7    X3-2
          NZ     B7,WOF2     IF TITLE NOT ISSUED
          WRITEW O,(=1L ),1  WRITE BLANK LINE
          WRITEW X2,TITL,TITSL  WRITE SHORT TITLE
          WRITEC X2,(=C*  *)
          WRITEW X2,SBTL,SBTSL  WRITE SHORT SUBTITLE
          WRITEC X2,(=C*  *)
 WOF2     SA1    WOFA        RESTORE REQUEST
          SA2    A1+B1
 WOF3     NG     X1,WOF4     IF *S* FORMAT
          WRITEC O,X1,X2
          EQ     WOFX        RETURN
 
 
 WOFA     DATA   0,0
          SPACE  4,10
**        COMMON DECKS.
 
 
*CALL     COMCCDD
*CALL     COMCCIO
*CALL     COMCCOD
*CALL     COMCMVE
*CALL     COMCRDW
*CALL     COMCSFN
*CALL     COMCSNM
*CALL     COMCSRT
*CALL     COMCSYS
*CALL     COMCWTC
*CALL     COMCWTS
*CALL     COMCWTW
          SPACE  4,10
**        BUFFERS.
 
 
          USE    //
          SEG
 OBUF     BSS    0           OUTPUT FILE CIO BUFFER
 CHAR     EQU    OBUF+OBUFL  CHARACTER STRING BUFFER
 SBF1     EQU    CHAR+136    FILE 1 WORKING BUFFER
 SBF2     EQU    SBF1+BUFL+1 FILE 2 WORKING BUFFER
 BUF1     EQU    SBF2+BUFL   FILE 1 CIO BUFFER
 BUF2     EQU    BUF1+FBUFL  FILE 2 CIO BUFFER
 RFL=     EQU    BUF2+FBUFL+4  FIELD LENGTH
          TITLE  PRESET.
 PRS      SPACE  4,10
**        PRS - PROCESS ARGUMENTS.
*
*         ENTRY  NONE
*
*         EXIT   (PW) .EQ. ZERO IF SMALL PAGE WIDTH
*                     .NE. ZERO IF STANDARD PAGE WIDTH.
*
*         USES   A - ALL.
*                B - 4, 5, 7.
*                X - ALL.
*
*         CALLS  ARG, CBS, CDT, DXB, PCM, RLF, SFN, STF.
*
*         MACROS CLOCK, DATE, GETPP, MEMORY, MESSAGE, REWIND.
 
 
 PRS      SUBR               ENTRY/EXIT
          DATE   DATE
          CLOCK  TIME
          MEMORY ,,,RFL=     SET FIELD LENGTH
          SA1    ACTR        CHECK ARGUMENT COUNT
          SB4    X1
          MX0    42
          ZR     B4,PRS3     IF NO ARGUMENTS
          SA4    ARGR
          BX7    X0*X4
          SB4    B4-B1
          SX2    3
          ZR     X7,PRS1     IF FIRST ARGUMENT NULL
          IX7    X7+X2
          SA7    F1
 PRS1     ZR     B4,PRS3     IF END OF ARGUMENTS
          SA4    A4+B1
          BX7    X0*X4
          ZR     X7,PRS2     IF SECOND ARGUMENT NULL
          IX7    X7+X2
          SA7    F2
 PRS2     SB4    B4-B1
          ZR     B4,PRS3     IF END OF ARGUMENTS
          SA4    A4+B1       CONVERT SPECIAL ARGUMENTS
          SB5    PRSA
          RJ     ARG
          NZ     X1,PER2     IF ARGUMENT ERROR
 PRS3     SA5    FC          CHECK FILE COUNT
          SB7    B1+         DECIMAL CONVERSION
          RJ     DXB
          SA6    FC          STORE VALUE
          NZ     X4,PER2     IF ASSEMBLY ERROR
          SA1    O
          SX6    B1
          SX2    A1
          ZR     X1,PRS4     IF NO FILE NAME IN FET
          RJ     STF         SET TERMINAL FILE
 PRS4     SA6    PW          SET PAGE WIDTH
          GETPP  *,LL,PD     GET PAGE SIZE PARAMETERS
          SA5    EL          CONVERT ERROR LIMIT
          RJ     DXB
          SA6    EL          STORE VALUE
          NZ     X4,PER2     IF ASSEMBLY ERROR
          RJ     PCM         PROCESS CODED MODE PARAMETER
          SA1    F1          COMPARE FILE NAMES
          SA2    F2
          MX0    42
          BX1    X0*X1
          SA3    O
          BX2    X0*X2
          IX6    X1-X2
          SX5    PERB        * VERIFY FILE NAME CONFLICT - LFN.*
          ZR     X6,PER3     IF FILE 1 = FILE 2
          BX3    X0*X3
          IX4    X3-X1
          BX7    X3-X2
          ZR     X4,PER3     IF O = FILE 1
          BX0    X1
          LX1    X2
          ZR     X7,PER3     IF O = FILE 2
          RJ     SFN         SPACE FILL FILE NAMES
          SA6    F2NM
          BX1    X0
          RJ     SFN
          SA1    PRSG        SET POINTER TO OUTPUT FET
          SA6    F1NM
          BX7    X1
          MX6    0
          SA7    B1+B1
          SA6    A7+B1
          SA0    F1
          RJ     CDT         CHECK IF CONTROL WORDS ALLOWED ON FILE 1
          SA0    F2
          RJ     CDT         CHECK IF CONTROL WORDS ALLOWED ON FILE 2
          RJ     CBS         CHECK BLOCK SIZE
          RJ     RLF         RFL UP FOR LARGE L AND F TAPES
          SA1    RW
          ZR     X1,PRS5     IF REWIND NOT REQUESTED
          REWIND F1
          REWIND F2
 PRS5     SA1    F1-SLF
          SA2    F2-SLF
          BX3    X1+X2
          ZR     X3,PRSX     IF NO S, L, OR F TAPES
          BX3    X1-X2
          ZR     X3,PRSX     IF FILES HAVE SAME FORMAT
          MESSAGE PRSH,3     ISSUE VERIFY NOT GUARANTEED WARNING
          EQ     PRSX        RETURN
 
 
 PRSA     BSS    0           CONTROL CARD ARGUMENT EQUIVALENCE TABLE
 L        ARG    O,O         ERROR LIMIT FILE
 N        ARG    PRSD,FC     FILE COUNT
 E        ARG    PRSE,EL     ERROR LIMIT
 R        ARG    -PRSF,RW    REWIND
 A        ARG    -PRSF,AB    ABORT ON ERROR
 C        ARG    -PRSB,CM    CODED MODE ON BOTH FILES
 C1       ARG    -PRSF,CM    CODED MODE ON FIRST FILE ONLY
 C2       ARG    -PRSC,CM    CODED MODE ON SECOND FILE ONLY
 BS       ARG    PRSE,BS     BLOCK SIZE
          ARG
 
 PRSB     CON    -1
 PRSC     CON    2
 PRSD     CON    0L999999
 PRSE     CON    0L0
 PRSF     CON    1
 PRSG     CON    0LOUTPUT+O
 PRSH     DATA   C* FILE STRUCTURES NOT COMPATIBLE.*
 CBL      SPACE  4,10
**        CBL - CALCULATE BUFFER LENGTH.
*
*         ENTRY  (A0) = FWA FET.
*                ((A0)+6) = PRU SIZE, IF S OR L FORMAT TAPE.
*                ((A0)+8) = PRU SIZE, IF F FORMAT TAPE.
*
*         EXIT   (X6) = DESIRED BUFFER LENGTH.
*                (B3) .LT. 0, IF BUFFER LENGTH CHANGE REQUIRED.
*
*         USES   A - 1.
*                B - 2, 3.
*                X - 1, 2, 3, 6.
 
 
 CBL      SUBR               ENTRY/EXIT
          SA1    A0-SLF      S, L, OR F TAPE INDICATOR
          SX6    FBUFL       DEFAULT BUFFER LENGTH
          SB2    X1
          SB3    B1
          SX3    3
          SA1    A0+6        GET S/L TAPE MAXIMUM BLOCK SIZE
          GT     B2,B1,CBL1  IF L TAPE
          PL     B2,CBLX     IF NOT F TAPE
          SA1    A0+8        GET F TAPE PRU SIZE
 CBL1     IX2    X1+X3       ALLOW FOR CONTROL WORDS
          LX2    1           PRU SIZE * 2
          IX3    X6-X2
          PL     X3,CBLX     IF CALCULATED BUFFER LENGTH .LE. DEFAULT
          BX6    X2
          SB3    -B1
          EQ     CBLX        RETURN
 CBS      SPACE  4,15
**        CBS - CHECK BLOCK SIZE.
*
*         EXIT   BS PARAMETER VERIFIED, PRU SIZE SET IN MLRS FIELD OF
*                S AND L TAPE FET(S).
*                TO PER2, IF ERROR ENCOUNTERED.
*
*         USES   A - 0, 1, 2, 5, 6.
*                B - 2, 7.
*                X - 1, 2, 5, 6.
*
*         CALLS  DXB, SPS.
 
 
 CBS      SUBR               ENTRY/EXIT
          SA5    BS          CONVERT BLOCK SIZE
          SX1    X5
          SB7    B1
          NZ     X1,CBS2     IF BS NOT SPECIFIED
          RJ     DXB
          SA6    BS
          NZ     X4,PER2     IF ASSEMBLY ERROR
          ZR     X6,PER2     IF BS=0 SPECIFIED
          SA1    F1-SLF
          SA2    F2-SLF
          SB3    X1
          SB4    X2
          GT     B3,CBS1     IF S OR L TAPE
          LE     B4,PER2     IF BS PARAMETER NOT ALLOWED
 CBS1     SX2    X6-MSPS-1
          NG     X2,CBS2     IF BS .LE. MAXIMUM S TAPE PRU SIZE
          GT     B3,B1,CBS2  IF FILE 1 IS L TAPE
          LE     B4,B1,PER2  IF FILE 2 IS NOT L TAPE
 CBS2     SA0    F1
          RJ     SPS         SET FILE 1 PRU SIZE IF S OR L TAPE
          SA0    F2
          RJ     SPS         SET FILE 2 PRU SIZE IF S OR L TAPE
          EQ     CBSX        RETURN
 CDT      SPACE  4,15
**        CDT - CHECK DEVICE TYPE.
*
*         ENTRY  (A0) = FWA FET.
*
*         EXIT   CONTROL WORD FLAG AND S, L, OR F TAPE INDICATOR
*                SET APPROPRIATELY FOR THIS FILE.
*         OPTICAL DISK FET EXTENSION INITIALIZED, IF APPLICABLE.
*                WARNING MESSAGE ISSUED IF FILE NOT FOUND.
*                ((A0)+8) = PRU SIZE, IF F FORMAT TAPE.
*
*         USES   A - 1, 2, 3, 6, 7.
*                B - 2, 3, 5.
*                X - 0, 1, 2, 3, 6, 7.
*
*         CALLS  SNM.
*
*         MACROS FILINFO, MESSAGE, OPEN.
 
 
 CDT4     OPEN   A0,READNR,R  CHECK FOR TERMINAL FILE
          SA3    A0+B1       GET DEVICE TYPE
          MX2    -11
          LX3    12
          BX3    -X2*X3
          SX7    X3-2RTT
          ZR     X7,CDTX     IF TERMINAL FILE
          SA1    A0          GET FILE NAME
          SB5    -CDTA       * FILE NOT FOUND - LFN.*
          BX1    X0*X1
          SB3    CDTB        MESSAGE ASSEMBLY AREA
          SB2    1RX         SET REPLACEMENT CHARACTER
          RJ     SNM         SET NAME IN MESSAGE
          MESSAGE  CDTB,3    ISSUE WARNING 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    CDTC
          BX1    X0*X1
          SX2    X2
          BX6    X1+X2
          SA6    A2
          FILINFO  CDTC      GET FILE INFORMATION
          SA1    CDTC+1      GET DEVICE TYPE AND STATUS
          ZR     X1,CDT4     IF FILE NOT FOUND
          BX3    X1
          AX3    48
          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
          OPEN   A0,READNR,R
          EQ     CDT5        ENABLE CONTROL WORDS
 
 CDT1     LX1    59-15
          NG     X1,CDT5     IF FILE ON MASS STORAGE
          LX1    59-24-59+15
          PL     X1,CDTX     IF FILE NOT ON TAPE
 CDT2     SA1    CDTC+FIPBL  GET TAPE FORMAT
          MX0    -6
          LX1    -6
          SX7    B1
          BX1    -X0*X1
          SX2    X1-/MTX/TFS
          ZR     X2,CDT3     IF S TAPE
          SX2    X1-/MTX/TFL
          SX7    B1+B1
          ZR     X2,CDT3     IF L TAPE
          SX7    -B1
          SX2    X1-/MTX/TFF
          NZ     X2,CDT5     IF NOT F TAPE
          SA3    A1+B1       GET BLOCK SIZE
          LX3    -24
          SX6    X3+
          SA6    A0+8
 CDT3     SA7    A0-SLF      SET S/L/F TAPE INDICATOR
          EQ     CDT5        SET CONTROL WORD FLAG
 
 
 CDTA     DATA   C* FILE NOT FOUND - XXXXXXX.*
 CDTAL    EQU    *-CDTA
 
 CDTB     BSS    CDTAL       MESSAGE BUFFER
 
 CDTC     VFD    42/0,6/CDTCL,12/1  *FILINFO* PARAMETER BLOCK
          BSS    FIPBL-1
          CON    FMTK        TAPE FORMAT KEYWORD
          CON    BSZK        TAPE BLOCK SIZE KEYWORD
 CDTCL    EQU    *-CDTC
 PCM      SPACE  4,10
**        PCM - PROCESS CODED MODE PARAMETER.
*
*         EXIT   CODED MODE SET ON FIRST, SECOND, OR BOTH FILES,
*                IF REQUESTED.
*
*         USES   A - 1, 2, 6.
*                B - 2.
*                X - 1, 2, 6.
 
 
 PCM      SUBR               ENTRY/EXIT
          SA2    CM
          ZR     X2,PCMX     IF CODED MODE NOT REQUESTED
          SB2    X2
          SX2    B1+B1
          GT     B2,B1,PCM1  IF SECOND FILE ONLY
          SA1    F1          SET CODED MODE ON FIRST FILE
          BX6    -X2*X1
          SA6    A1
 PCM1     EQ     B2,B1,PCMX  IF FIRST FILE ONLY
          SA1    F2          SET CODED MODE ON SECOND FILE
          BX6    -X2*X1
          SA6    A1
          EQ     PCMX        RETURN
 PER      SPACE  4,10
**        PER - PRESET ERROR PROCESSOR.
*
*         ENTRY  (X5) = FWA MESSAGE, IF ENTRY AT PER1 OR PER3.
*                (X1) = FILE NAME, IF ENTRY AT PER3.
 
 
 PER3     SB5    X5          SET NAME IN MESSAGE
          SB2    1RX
          RJ     SNM
          EQ     PER1        ISSUE ERROR MESSAGE
 
 PER2     SX5    PERA        * VERIFY ARGUMENT ERROR.*
 PER1     MESSAGE X5,,R
 PER      ABORT
 
 
 PERA     DATA   C* VERIFY ARGUMENT ERROR.*
 PERB     DATA   C* VERIFY FILE NAME CONFLICT - XXXXXXX.*
 PERC     DATA   C* VERIFY FL ABOVE USER LIMIT.*
 RLF      SPACE  4,25
**        RLF - RFL UP FOR LARGE L AND F TAPES.
*
*         IF L OR F TAPE(S) TO BE VERIFIED, CALCULATE REQUIRED FL,
*         RFL UP, AND RESET CIO BUFFER POINTERS IN FETS.
*         1.  FOR L TAPE FILES, USE MLRS VALUE AS MAXIMUM BLOCK SIZE.
*             FOR F TAPE FILES, USE BLOCK SIZE SAVED IN FET+8.
*         2.  GET CURRENT MAXIMUM FL (MAXFL) VIA MEMORY MACRO.
*         3.  FOR EACH L OR F TAPE, BUFFER LENGTH = MAXIMUM(FBUFL,
*             2*BLOCK SIZE).
*         4.  IF FL REQUIREMENTS EXCEED MINIMUM(MAXFL,MFLF), SET EACH
*             L OR F TAPE BUFFER LENGTH = BLOCK SIZE.
*         5.  IF FL REQUIREMENTS EXCEED MAXFL, ABORT WITH * VERIFY
*             FL ABOVE USER LIMIT.*.
*
*         EXIT   FIELD LENGTH INCREASED AS NECESSARY FOR L AND F TAPES.
*                TO PER1, IF FIELD LENGTH ERROR.
*
*         USES   A - 0, 1, 2, 5, 6, 7.
*                B - 3, 4.
*                X - ALL.
*
*         CALLS  CBL, SYS=.
 
 
 RLF      SUBR               ENTRY/EXIT
          SA0    F1
          RJ     CBL         CALCULATE FILE 1 BUFFER LENGTH
          SA6    RLFA
          SA0    F2
          SB4    B3          SAVE BUFFER LENGTH CHANGE INDICATOR
          RJ     CBL         CALCULATE FILE 2 BUFFER LENGTH
          SA6    RLFB
          SX0    MFLF        MAXIMUM FIELD LENGTH FACTOR
          NG     B4,RLF1     IF FILE 1 BUFFER LENGTH CHANGE REQUIRED
          PL     B3,RLFX     IF NO BUFFER LENGTH CHANGE ON FILE 2
 RLF1     MEMORY CM,STAT,R   GET CURRENT MAXIMUM FL
          SA5    STAT
          AX5    30          CURRENT MAXIMUM FL (MAXFL)
          IX1    X5-X0
          PL     X1,RLF2     IF MAXFL .GE. MFLF
          BX0    X5
 RLF2     SA1    RLFA        CALCULATE REQUIRED FL
          SX4    X1+BUF1
          SA2    RLFB
          IX4    X4+X2
          IX3    X0-X4
          PL     X3,RLF4     IF REQUIRED FL .LE. MINIMUM(MAXFL,MFLF)
          PL     B4,RLF3     IF NO BUFFER LENGTH CHANGE ON FILE 1
          AX6    X1,B1       SET BUFFER LENGTH = BLOCK SIZE
          SA6    A1
 RLF3     PL     B3,RLF4     IF NO BUFFER LENGTH CHANGE ON FILE 2
          AX6    X2,B1
          SA6    A2
 RLF4     SA1    RLFA        CALCULATE REQUIRED FL
          SX3    X1+BUF1
          SA2    A1+B1
          IX4    X3+X2
          SX6    X4+2
          IX2    X5-X6
          LX6    30
          SX5    PERC        *VERIFY FL ABOVE USER LIMIT.*
          SA6    STAT
          NG     X2,PER1     IF REQUIRED FL .GT. MAXFL
 
*         INCREASE FIELD LENGTH AS NECESSARY FOR L AND F TAPES AND
*         RESET CIO BUFFER POINTERS IN FETS.
 
          MEMORY CM,STAT,R
          SA1    F1+4        RESET CIO BUFFER POINTERS
          MX0    42
          BX6    X0*X1
          SA2    F2+1
          BX6    X6+X3
          SA6    A1          FILE 1 LIMIT
          BX7    X0*X2
          LX6    X3
          BX7    X7+X3
          SA6    A2+B1       FILE 2 IN
          SA7    A2          FILE 2 FIRST
          SA6    A6+B1       FILE 2 OUT
          SA1    A6+B1
          BX7    X0*X1
          BX7    X7+X4
          SA7    A1          FILE 2 LIMIT
          EQ     RLFX        RETURN
 
 
 RLFA     CON    0           FILE 1 BUFFER LENGTH
 RLFB     CON    0           FILE 2 BUFFER LENGTH
 SPS      SPACE  4,10
**        SPS - SET PRU SIZE.
*
*         ENTRY  (A0) = FWA FET.
*
*         EXIT   PRU SIZE SET IN MLRS FIELD OF FET IF S OR L TAPE.
*                TO PER2, IF ERROR ENCOUNTERED.
*
*         USES   A - 1, 2, 6.
*                B - 2.
*                X - 1, 2, 3, 6.
 
 
 SPS      SUBR               ENTRY/EXIT
          SA1    A0-SLF      S, L, OR F TAPE INDICATOR
          SA2    BS          BLOCK SIZE PARAMETER VALUE
          SX3    MSPS        MAXIMUM S TAPE PRU SIZE
          SB2    X1
          IX3    X3-X2
          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
          NG     X2,SPS2     IF BS PARAMETER NOT SPECIFIED
          NG     X3,SPS2     IF BLOCK SIZE EXCEEDS MAXIMUM S PRU SIZE
 SPS1     NG     X2,SPS2     IF BS PARAMETER NOT SPECIFIED
          BX6    X2
 SPS2     SA6    A0+6        SET MLRS FIELD OF FET
          EQ     SPSX        RETURN
          SPACE  4,10
**        PRESET DATA STORAGE.
 
 
 BS       CON    -1          MAXIMUM BLOCK SIZE
 CM       CON    0           CODED MODE
 STAT     VFD    30/-1,30/0  FIELD LENGTH STATUS WORD
          SPACE  4,10
**        COMMON DECKS.
 
 
*CALL     COMCARG
*CALL     COMCCPM
*CALL     COMCDXB
*CALL     COMCLFM
*CALL     COMCSTF
          SPACE  4
          END