VERIFY
          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 
