//SYSREPRO  JOB (TSO),
//             'Install SYSREPRO',
//             CLASS=A,
//             MSGCLASS=A,
//             MSGLEVEL=(1,1),
//             USER=IBMUSER,
//             PASSWORD=SYS1
//*
//* -------------------------------------------------------*            00020000
//* *  INSTALL THE 'SYSREPRO' PROGRAM                      *            00030000
//* -------------------------------------------------------*            00040000
//SYSREPRO EXEC ASMFCL,COND=(0,NE),MAC1='SYS1.AMODGEN'                  00050000
//SYSIN    DD *                                                         00060000
         TITLE '   S Y S R E P R O    VERSION  2'
* ------------------------------------------------------------------- *
*
*   LAST UPDATE - JDM - 07/15/97
*
*   SYSREPRO - ORIGINALLY DEVELOPED BY BILL GODFREY,
*              PRC COMPUTER CENTER INC, MCLEAN VA
*
*   THIS PROGRAM COPIES A SEQUENTIAL DATA SET OR A MEMBER OF A PDS.
*   IT IS FASTER THAN IEBGENER AND PRINT A SUMMARY OF THE COPY
*   OPERATION INCLUDING THE RECORD COUNTS.  THE PARM FIELD MAY BE
*   USED TO COPY OR SKIP RECORDS AND THEN COPY A SPECIFIED NUMBER.
*
*   SAMPLE JCL:
*
*     //STEP EXEC PGM=SYSREPRO,PARM=(V1,V2,V3,V4)
*     //SYSPRINT DD SYSOUT=A
*     //SYSUT1   DD DSN=INPUT.DATA,DISP=SHR
*     //SYSUT2   DD DSN=OUTPUT.DATA,DISP=(NEW,KEEP),
*     //            UNIT=,VOL=,LABEL=,SPACE=
*
*   THE PARM FIELD MAY BE USED FOR PARTIAL COPIES.
*   IT MAY CONTAIN ONE INTEGER, INDICATING THE NUMBER OF
*
*   PARM=V1             NUMBER OF RECORDS TO COPY
*   PARM=(V1,V2)        COPY "V1" RECS AFTER SKIPPING "V2" RECS
*   PARM=(,V2)          COPY REST OF RECS AFTER SKIPPING "V2" RECS
*   PARM=(V1,,V3,V4)
*
*   IF THE OUTPUT FILE DOES NOT HAVE DCB ATTRIBUTES, THE
*   ATTRIBUTES WILL BE COPIED FROM THE INPUT FILE.  IF THE
*   BLKSIZE IS OMITTED, THEN SYSTEM DETERMINED BLKSIZE WILL
*   BE USED.
*
*   THE PROGRAM DOES NOT COPY KEYED RECORDS, NOR DOES IT COPY
*   USER DATA FROM A PDS DIRECTORY ENTRY WHEN COPYING A MEMBER.
*
*        WRITTEN BY. BILL GODFREY, PLANNING RESEARCH CORPORATION.
*        INSTALLATION. PRC COMPUTER CENTER INC, MCLEAN VA.
*        DATE WRITTEN. AUGUST 17 1977.
*        DATE UPDATED. JULY 8 1981.
*        ATTRIBUTES. NOT REENTRANT.
*        REMARKS.
*            THIS PROGRAM COPIES PART OR ALL OF A SEQUENTIAL
*            DATASET OF FIXED, VARIABLE, OR UNDEFINED RECORDS.
*
*            THE PARM FIELD CAN SPECIFY
*            1) A LIMIT ON THE NUMBER OF RECORDS TO COPY,
*            2) THE NUMBER OF RECORDS TO SKIP BEFORE COPYING,
*            3) THAT ONLY V4 OUT OF EVERY V3 RECORDS ARE TO BE
*               COPIED, WHERE V3 IS THE THIRD NUMBER IN THE PARM
*               FIELD AND V4 IS THE FOURTH.
*
* ------------------------------------------------------------------- *
         EJECT
* ------------------------------------------------------------------- *
*
* CHANGE LOG:
*
*        21APR80 - SYSPRINT CHANGED TO FIXED LENGTH. ATTRIB ADDED.
*        21APR80 - DEVTYPE AND RDJFCB ADDED.
*        25APR80 - MEMBER FROM JFCB SHOWN.
*        08JUL81 - RECFM U NOW SUPPORTED.  LONGEST AND SHORTEST.
*                  FREEPOOLS ADDED. ADD INPLRECL, OUTLRECL, WHICH
*                  CONTAIN BLKSI IF LRECL ZERO. ALLOW EXPAND.
*        09NOV81 - MAKE EXPAND FILL NEW AREA WITH BLANKS.
*        11NOV91 - RECORD COUNT CAN ONLY GO TO 9,999,999, INCREASE
*                  NUMBER TO 999,999,999 - JDM1
*        10APR96 - REWORKED CODE TO ADD DSECTS, COMMENTS, TOO MANY
*                  CHANGES TO MARK, BUT ESPICALLY TO DOCUMENT SOME NEAT
*                  THINGS THAT YOU DO NOT USUALLY SEE IN DULL CODE
*        15JUL97 - HONOR SYSTEM DETERMINED BLKSIZE - JDM2
*        26FEB02 - COMMENT AMODE/RMODE FOR MVS 3.8                *JLM*
* -------------------------------------------------------------------*
         MACRO
&N       PUTM  &M
         AIF   (T'&M EQ 'O').MO
         MVC   MSG,MSG-1
         MVC   MSG(&M.L),&M
.MO      BAL   R12,PUTPRT
         MEND
         SPACE
         PRINT ON,GEN
         SPACE
R0       EQU   0
R1       EQU   1
R2       EQU   2
R3       EQU   3
R4       EQU   4
R5       EQU   5
R6       EQU   6
R7       EQU   7
R8       EQU   8
R9       EQU   9
R10      EQU   10
R11      EQU   11
R12      EQU   12
R13      EQU   13
R14      EQU   14
R15      EQU   15
         SPACE
* SYSREPRO AMODE 24                                               *JLM*
* SYSREPRO RMODE 24                                               *JLM*
SYSREPRO CSECT
         SAVE  (14,12),,SYSREPRO_&SYSDATE._&SYSTIME
         LR    R10,R15             BASE REGISTER
         USING SYSREPRO,R10,R11
         LA    R15,1
         LA    R11,4095(R15,R10)   BASE REGISTER
         LA    R15,SAVE            GET ADDRESS OF SAVE AREA
         ST    R15,8(,R13)         PUT NEW ADDRESS IN OLD SAVE AREA
         ST    R13,4(,R15)         PUT OLD ADDRESS IN NEW SAVE AREA
         LR    R13,R15             SWITCH TO NEW SAVEAREA
         SPACE
         MVI   MSG-1,C' '
         MVC   MSG,MSG-1
         XC    OUTBUFF,OUTBUFF
         MVI   OPTSW,C'N'
         SPACE
* -------------------------------------------------------------------*
*        EVALUATE THE PARM FIELD
* -------------------------------------------------------------------*
         SPACE
         L     R1,0(,R1)           GET PARM ADDRESS
         ST    R1,PARMPTR          SAVE POINTER TO PARM
         L     R4,=F'999999999'    RECORDS TO COPY               JDM1
         SLR   R5,R5               RECORDS TO SKIP
         LA    R6,1                EVERY NTH RECORD TO COPY
         LA    R7,1                FIRST F OF EVERY N RECORDS
         LH    R3,0(,R1)           GET PARM LENGTH
         LTR   R3,R3               PARM PRESENT?
         BNP   NOPARM              NO - BRANCH
         LA    R2,2(,R1)           POINT TO PARM
         LR    R0,R3
         SLR   R15,R15
         SPACE
         LR    R1,R2               BEGIN FIRST NUMBER
SCAN01   EQU   *
         CLI   0(R1),C'0'
         BL    SCAN01A
         CLI   0(R1),C'9'
         BH    SCANERR
         LA    R15,1(,R15)
         LA    R1,1(,R1)
         BCT   R0,SCAN01
SCAN01A  EQU   *
         LTR   R15,R15             FIRST NUMBER PRESENT?
         BNP   SCAN01B             NO - BRANCH
         CH    R15,=H'7'
         BH    SCANERR
         BCTR  R15,0
         EX    R15,SCANPACK
         CVB   R4,DOUBLE
SCAN01B  EQU   *
         SLR   R15,R15
         BCTR  R0,0
         LTR   R0,R0
         BM    SCAN99              BRANCH IF NOTHING FOLLOWS
         BZ    SCAN98              ENDING COMMA
         CLI   0(R1),C','          COMMA MUST FOLLOW
         BNE   SCANERR
         LA    R1,1(,R1)           POINT BEYOND COMMA
         LR    R2,R1               BEGIN SECOND NUMBER
SCAN02   EQU   *
         CLI   0(R1),C'0'
         BL    SCAN02A
         CLI   0(R1),C'9'
         BH    SCANERR
         LA    R15,1(,R15)
         LA    R1,1(,R1)
         BCT   R0,SCAN02
SCAN02A  EQU   *
         LTR   R15,R15             SECOND NUMBER PRESENT?
         BNP   SCAN02B             NO - BRANCH
         CH    R15,=H'7'
         BH    SCANERR
         BCTR  R15,0
         EX    R15,SCANPACK
         CVB   R5,DOUBLE
SCAN02B  EQU   *
         SLR   R15,R15
         BCTR  R0,0
         LTR   R0,R0
         BM    SCAN99
         BZ    SCAN98
         CLI   0(R1),C','
         BNE   SCANERR
         LA    R1,1(,R1)
         LR    R2,R1               BEGIN THIRD NUMBER
SCAN03   EQU   *
         CLI   0(R1),C'0'
         BL    SCAN03A
         CLI   0(R1),C'9'
         BH    SCANERR
         LA    R15,1(,R15)
         LA    R1,1(,R1)
         BCT   R0,SCAN03
SCAN03A  EQU   *
         LTR   R15,R15             SECOND NUMBER PRESENT?
         BNP   SCAN03B             NO - BRANCH
         CH    R15,=H'7'
         BH    SCANERR
         BCTR  R15,0
         EX    R15,SCANPACK
         CVB   R6,DOUBLE
SCAN03B  EQU   *
         SLR   R15,R15
         BCTR  R0,0
         LTR   R0,R0
         BM    SCAN99
         BZ    SCAN98
         CLI   0(R1),C','
         BNE   SCANERR
         LA    R1,1(,R1)
         LR    R2,R1               BEGIN FOURTH NUMBER
SCAN04   EQU   *
         CLI   0(R1),C'0'
         BL    SCANERR
         CLI   0(R1),C'9'
         BH    SCANERR
         LA    R15,1(,R15)
         LA    R1,1(,R1)
         BCT   R0,SCAN04
         LTR   R15,R15             THIRD NUMBER PRESENT?
         BNP   SCAN99              NO - BRANCH
         CH    R15,=H'7'
         BH    SCANERR
         BCTR  R15,0
         EX    R15,SCANPACK
         CVB   R7,DOUBLE
         B     SCAN99
SCANPACK PACK  DOUBLE(8),0(0,R2)
         SPACE
SCANERR  EQU   *
         LA    R15,12
         ST    R15,RC
         B     BYPRINT
         SPACE
SCAN98   EQU   *
         CLI   0(R1),C','
         BNE   SCANERR
SCAN99   EQU   *
         SPACE
* -------------------------------------------------------------------*
*        BEGIN TO PROCESS
* -------------------------------------------------------------------*
         SPACE
NOPARM   EQU   *
         SPACE
         OPEN  (SYSPRINT,OUTPUT)
         SPACE
         PUTM  MSGH
         SPACE
         MVC   MSG,MSG-1
         SPACE
         PUTM
         SPACE
         L     R1,PARMPTR
         LH    R15,0(,R1)
         LTR   R15,R15
         BZ    NOMSGP
         MVC   MSG,MSG-1
         MVC   MSG+1(5),=C'PARM='
         BCTR  R15,0
         B     *+10
         MVC   MSG+6(0),2(R1)
         EX    R15,*-6
         SPACE
         PUTM
         SPACE
         MVC   MSG,MSG-1
         SPACE
         PUTM
         SPACE
NOMSGP   EQU   *
         SPACE
* -------------------------------------------------------- *
*        GET DEVICE TYPE INFORMATION FOR SYSUT1
* -------------------------------------------------------- *
         SPACE
         LA    R15,SYSUT1          POINT TO DCB
         USING IHADCB,R15          ESTABLISH ADDRESSABILITY
         MVC   DDSYSUT1(8),DCBDDNAM  RETRIEVE ACTUAL DDNAME
         DROP  R15
         DEVTYPE DDSYSUT1,UT1DEV   GET 2 WORDS OF INFO
         SPACE
* -------------------------------------------------------- *
*        ISSUE RDJFCB TO GET DD CARD INFO.
* -------------------------------------------------------- *
         SPACE
         RDJFCB (SYSUT1)
         SPACE
* -------------------------------------------------------- *
*        OPEN SYSUT1
* -------------------------------------------------------- *
         SPACE
         OPEN  (SYSUT1,INPUT)
         LA    R15,12              SET RC=12 IN CASE IT FAILED
         LA    R1,SYSUT1           POINT TO DCB
         USING IHADCB,R1           GET ADDRESSABILITY
         TM    DCBOFLGS,DCBOFOPN   WAS IT SUCCESSFULLY OPENED ?
         BNO   ERRXIT
         MVC   OBTRECFM,DCBRECFM   SAVE RECFM
         MVC   OBTLRECL,DCBLRECL   SAVE LRECL
         MVC   OBTBLKSI,DCBBLKSI   SAVE BLKSIZE
         MVC   WRKRECFM,OBTRECFM
         TM    WRKRECFM,DCBRECU    RECFM U ?
         BNO   OKOPEN3             NO
         NI    WRKRECFM,255-X'C0'  YES, SET BOTH F AND V OFF
OKOPEN3  EQU   *
         MVC   INPLRECL,OBTLRECL
         CLC   INPLRECL,=H'0'      IF NO LRECL
         BNE   *+10                   THEN
         MVC   INPLRECL,OBTBLKSI   LRECL = BLKSIZE
         DROP  R1
         SPACE
* -------------------------------------------------------- *
*         SHOW SYSUT1 CHARACTERISTICS
* -------------------------------------------------------- *
         SPACE
         MVC   MSG7A(6),=C'INPUT '
         MVI   MSG7B,C' '
         MVC   MSG7B+1(53),MSG7B
         MVC   MSG7B(44),UT1JFCB
         LA    R15,UT1JFCB+44      POINT TO MEMBER
         CLI   0(R15),C' '         IS MEMBER ABSENT
         BE    UT1NOMEM            YES, BRANCH
         CLI   0(R15),0            IS MEMBER ABSENT
         BE    UT1NOMEM            YES, BRANCH
         LA    R1,MSG7B+44
UT1JFEND EQU   *
         CLI   0(R1),C' '
         BNE   *+8
         BCT   R1,UT1JFEND
         MVI   1(R1),C'('
         MVC   2(8,R1),0(R15)      MOVE MEMBER
         LA    R1,10(,R1)          POINT PAST MEMBER
         CLI   0(R1),C' '
         BNE   *+8
         BCT   R1,*-8
         MVI   1(R1),C')'
UT1NOMEM EQU   *
         SPACE
         PUTM  MSG7
         SPACE
         TM    UT1DEV+2,X'A0'        TAPE OR DASD
         BZ    UT1NOV                BRANCH IF NEITHER
         MVC   MSG8A(6),=C'INPUT '
         MVC   MSG8C(8),SPACES
         MVC   MSG8B(6),UT1JFCB+118
         TM    UT1DEV+2,X'80'        TAPE
         BZ    UT1NOP                NO, SKIP FILE POS
         LH    R0,UT1JFCB+68         FILE SEQUENCE NUMBER
         CVD   R0,DOUBLE
         MVC   MSG8D,=X'40202120'
         ED    MSG8D,DOUBLE+6
         MVC   MSG8C(5),=C'FILE='
UT1NOP   EQU   *
         PUTM  MSG8
         SPACE
UT1NOV   EQU   *
         LA    R1,SYSUT1
         MVC   MSG6A(6),=C'INPUT '
         SPACE
         BAL   R14,ATTRIB
         SPACE
         PUTM  MSG6
         SPACE
         MVC   MSG,MSG-1
         SPACE
         PUTM
         SPACE
* -------------------------------------------------------- *
*        GET DEVICE TYPE INFORMATION FOR SYSUT1
* -------------------------------------------------------- *
         SPACE
         LA    R15,SYSUT2          POINT TO DCB
         USING IHADCB,R15          ESTABLISH ADDRESSABILITY
         MVC   DDSYSUT2(8),DCBDDNAM  RETRIEVE ACTUAL DDNAME
         DROP  R15
         DEVTYPE DDSYSUT2,UT2DEV   GET 2 WORDS OF INFO
         SPACE
* -------------------------------------------------------- *
*        ISSUE RDJFCB TO GET DD CARD INFO.
* -------------------------------------------------------- *
         SPACE
         RDJFCB (SYSUT2)
         SPACE
* -------------------------------------------------------- *
*        OPEN SYSUT2
* -------------------------------------------------------- *
         SPACE
         OPEN  (SYSUT2,OUTPUT)
         LA    R15,12
         LA    R1,SYSUT2
         USING IHADCB,R1
         TM    DCBOFLGS,DCBOFOPN   WAS IT SUCCESSFULLY OPENED ?
         BNO   ERRXIT IF NOT, GO TO ERROR EXIT
         MVC   OUTLRECL,DCBLRECL
         CLC   OUTLRECL,=H'0'      IF NO LRECL
         BNE   *+10                THEN
         MVC   OUTLRECL,DCBBLKSI   LRECL = BLKSIZE
         DROP  R1
         SPACE
* -------------------------------------------------------- *
*        SHOW SYSUT2 CHARACTERISTICS
* -------------------------------------------------------- *
         SPACE
         MVC   MSG7A(6),=C'OUTPUT'
         MVI   MSG7B,C' '
         MVC   MSG7B+1(53),MSG7B
         MVC   MSG7B(44),UT2JFCB
         LA    R15,UT2JFCB+44          POINT TO MEMBER
         CLI   0(R15),C' '         IS MEMBER ABSENT
         BE    UT2NOMEM            YES, BRANCH
         CLI   0(R15),0            IS MEMBER ABSENT
         BE    UT2NOMEM            YES, BRANCH
         LA    R1,MSG7B+44
UT2JFEND EQU   *
         CLI   0(R1),C' '
         BNE   *+8
         BCT   R1,UT2JFEND
         MVI   1(R1),C'('
         MVC   2(8,R1),0(R15)      MOVE MEMBER
         LA    R1,10(,R1)          POINT PAST MEMBER
         CLI   0(R1),C' '
         BNE   *+8
         BCT   R1,*-8
         MVI   1(R1),C')'
UT2NOMEM EQU   *
         PUTM  MSG7
         TM    UT2DEV+2,X'A0'      TAPE OR DASD
         BZ    UT2NOV              BRANCH IF NEITHER
         MVC   MSG8A(6),=C'OUTPUT'
         MVC   MSG8C(8),SPACES
*        MVC   MSG8B(6),UT2JFCB+118  (REPLACED BELOW)
         LA    R1,SYSUT2
         USING IHADCB,R1           GAIN ADDRESSABILITY
         LH    R0,DCBTIOT          GET TIOT OFFSET
         DROP  R1
         L     R1,CVTPTR           CVTPTR
         USING CVT,R1              ADDRESSABILITY TO CVT
         L     R15,CVTTCBP         TCB WORDS
         DROP  R1
         L     R15,4(,R15)         ADDRESS OF CURRENT TCB
         L     R1,12(,R15)         TIOT
         AR    R1,R0               DD ENTRY FOR SYSUT2
         USING TIOENTRY,R1
         L     R1,16(,R1)          UCB ADDRESS
         DROP  R1
         MVC   MSG8B(6),28(R1)     VOLUME FROM UCB
         TM    UT2DEV+2,X'80'      TAPE
         BZ    UT2NOP              NO, SKIP FILE
         LH    R0,UT2JFCB+68       FILE SEQUENCE NUMBER
         CVD   R0,DOUBLE
         MVC   MSG8D,=X'40202120'
         ED    MSG8D,DOUBLE+6
         MVC   MSG8C(5),=C'FILE='
UT2NOP   EQU   *
         PUTM  MSG8
UT2NOV   EQU   *
         LA    R1,SYSUT2
         MVC   MSG6A(6),=C'OUTPUT'
         SPACE
         BAL   R14,ATTRIB
         SPACE
         PUTM  MSG6
         MVC   MSG,MSG-1
         PUTM
         B     COMPARE
         SPACE
* -------------------------------------------------------- *
*        CHECK FOR VALID RECORD FORMATS
* -------------------------------------------------------- *
         SPACE
COMPARE  EQU   *
         LA    R2,SYSUT2
         USING IHADCB,R2
         TM    DCBRECFM,DCBRECU    RECFM=U ?
         BO    OKUND
         TM    OBTRECFM,DCBRECF    RECFM=F ?
         BO    OKFIXED
OKVAR    EQU   *
         TM    DCBRECFM,DCBRECV    IS OUTPUT ALSO V ?
         BO    OKEQUAL
CONFLICT EQU   *
         PUTM  MSGE3
         LA    R15,12
         B     ERRXIT
         SPACE
OKUND    EQU   *
         TM    DCBRECFM,DCBRECU    IS OUTPUT ALSO U ?
         BO    OKEQUAL
         B     CONFLICT
         SPACE
OKFIXED  EQU   *
         TM    DCBRECFM,DCBRECF    IS OUTPUT ALSO F ?
         DROP  R2
         BNO   CONFLICT
         CLC   INPLRECL,OUTLRECL
         BNL   OKEQUAL             OK TO TRUNCATE
         LH    R0,OUTLRECL         OUTPUT IS LONGER, GET A WORK AREA
         GETMAIN R,LV=(0)
         ST    R1,OUTBUFF
         MVI   0(R1),C' '          FILLER CHARACTER
         LA    R15,1(,R1)          POINT TO AREA TO PROPOGATE CHAR
         LH    R0,OUTLRECL         GET LENGTH OF AREA
         BCTR  R0,0                MINUS THE FIRST BYTE
         BAL   R14,@MVCL           PROPOGATE THE FILLER CHAR
OKEQUAL  EQU   *
         MVC   LOLRECL,=H'32767'   SHORTEST RECORD READ
         MVC   HILRECL,=H'0'       LONGEST RECORD READ
         SPACE
READLOOP EQU   *
         NI    SWIT1,B'01111111'   SET OFF SYNAD SWITCH
         SPACE
         GET   SYSUT1
         SPACE
         LR    R8,R1
         L     R14,COUNTB
         AH    R14,=H'1'
         ST    R14,COUNTB          ADD 1 TO NO. OF RECORDS READ
         SPACE
         LA    R15,SYSUT1          GET ADDR OF DCB
         USING IHADCB,R15          ESTABLISH ADDRESSABILITY
         LH    R0,DCBLRECL         GET RECORD LENGTH
         DROP  R15
         TM    WRKRECFM,DCBRECV    RECFM V
         BNO   *+14                NO
         MVC   DOUBLE(2),0(R8)     YES, GET LRECL FROM RDW
         LH    R0,DOUBLE           GET LRECL FROM RDW
         CH    R0,LOLRECL          IS IT SHORTEST
         BNL   *+8                 NO
         STH   R0,LOLRECL          YES, SAVE LOW WATER MARK
         CH    R0,HILRECL          IS IT LONGEST
         BNH   *+8                 NO
         STH   R0,HILRECL          YES, SAVE HIGH WATER MARK
         SPACE
         CR    R14,R5              BEYOND SKIPPED RECORDS YET?
         BNH   READLOOP            NO - KEEP SKIPPING
         SPACE
         TM    SWIT1,B'10000000'   WAS SYNAD EXIT TAKEN DURING GET?
         BNZ   IOERR               YES - BRANCH
         SPACE
         L     R14,COUNTN
         A     R14,=F'1'
         ST    R14,COUNTN
         CR    R14,R7
         BH    BYPUT
         SPACE
         LA    R15,SYSUT1          GET ADDR OF DCB
         USING IHADCB,R15          ESTABLISH ADDRESSABILITY
         TM    DCBRECFM,DCBRECU    RECFM=U ?
         BNO   O11                 NO
         LH    R0,DCBLRECL         SAVE SYSUT1 LRECL
         DROP  R15
         LA    R15,SYSUT2          GET ADDR OF DCB
         USING IHADCB,R15          ESTABLISH ADDRESSABILITY
         STH   R0,DCBLRECL         COPY LRECL
         DROP  R15
         SPACE
O11      EQU   *
         L     R15,OUTBUFF
         LTR   R15,R15             IS RECORD TO BE EXPANDED
         BZ    NOMOVE              NO, BRANCH
*        TM    INPRECFM,X'80'      RECFM F
*        BZ    NOMOVE              NO, BRANCH
         LR    R1,R8               POINT TO RECORD
         LH    R0,INPLRECL         GET LENGTH OF RECORD
         BAL   R14,@MVCL           MOVE IT TO R15
         L     R8,OUTBUFF          POINT TO NEW RECORD
NOMOVE   EQU   *
         SPACE
         PUT   SYSUT2,(R8)
         SPACE
         L     R14,COUNTP
         A     R14,=F'1'
         ST    R14,COUNTP
         CR    R14,R4              MAXIMUM RECORDS COPIED YET?
         BNL   EODUT1              YES - STOP
         SPACE
BYPUT    EQU   *
         SLR   R14,R14
         C     R6,COUNTN           COUNTN REACHED NTH RECORD?
         BH    *+8
         ST    R14,COUNTN          YES - RESET COUNTN TO ZERO
         B     READLOOP
         SPACE
IOERR    EQU   *
         AP    CTRRDERR,P1
         BAL   R14,FORMAT3
         PUTM  MSG2
         LA    R15,12
         B     ERRXIT
         SPACE
ERRXIT   EQU   *
         ST    R15,RC
EODUT1   EQU   *
         L     R1,OUTBUFF
         LTR   R1,R1
         BZ    NOFREE
         LH    R0,OUTLRECL
         FREEMAIN R,LV=(0),A=(1)
NOFREE   EQU   *
         CLOSE (SYSUT2)
         FREEPOOL SYSUT2
         CLOSE (SYSUT1)
         FREEPOOL SYSUT1
         L     R1,COUNTB
         CVD   R1,DOUBLE
         ED    MSG5A,DOUBLE+2                                    JDM1
         MVC   MSG5A(15),MSG5A+1                                 JDM1
         CLI   MSG5A,C' '
         BE    *-10
         L     R1,COUNTP
         CVD   R1,DOUBLE
         ED    MSG5B,DOUBLE+2                                    JDM1
         MVC   MSG5B(15),MSG5B+1                                 JDM1
         CLI   MSG5B,C' '
         BE    *-10
         LA    R15,SYSPRINT        GET ADDR OF DCB
         USING IHADCB,R15          ESTABLISH ADDRESSABILITY
         TM    DCBOFLGS,DCBOFOPN   WAS IT SUCCESSFUL ?
         DROP  R15
         BNO   BYPRINT
         CP    CTRRDERR,P0         ANY ERRORS?
         BE    NOERRS              NO - BRANCH
         LA    R15,4               YES - SET RC TO AT LEAST 4
         C     R15,RC
         BNH   *+8
         ST    R15,RC
         ED    MSG1A(6),CTRRDERR
         PUTM  MSG1
NOERRS   EQU   *
         PUTM  MSG5
         TM    OBTRECFM,X'40'      WAS RECFM V OR U
         BZ    NOWATER             NEITHER, BYPASS WATER MARKS
         L     R1,COUNTB
         LTR   R1,R1               ANY RECORDS READ
         BZ    NOWATER             NO, BYPASS WATER MARKS
         LH    R0,LOLRECL
         CVD   R0,DOUBLE
         ED    MSG9A,DOUBLE+5
         MVC   MSG9A(6),MSG9A+1
         CLI   MSG9A,C' '
         BE    *-10
         LH    R0,HILRECL
         CVD   R0,DOUBLE
         ED    MSG9B,DOUBLE+5
         MVC   MSG9B(6),MSG9B+1
         CLI   MSG9B,C' '
         BE    *-10
         PUTM  MSG9
NOWATER  EQU   *
         CLOSE (SYSPRINT)
         FREEPOOL SYSPRINT
BYPRINT  EQU   *
         L     R13,SAVE+4
         L     R15,RC
         LM    0,12,20(R13)
         L     R14,12(,R13)
         BR    R14
         SPACE
* ****** SUBROUTINES FOLLOW ****************************************
         SPACE
* ----------------------------------------------------------- *
*        PRINT SUBROUTINE
* ----------------------------------------------------------- *
         SPACE
PUTPRT   EQU   *
         LA    R15,SYSPRINT
         USING IHADCB,R15
         TM    DCBOFLGS,DCBOFOPN   WAS IT SUCCESSFULLY OPENED ?
         DROP  R15
         BNOR  R12
         PUT   SYSPRINT,MSG
         BR    R12
         SPACE
* ----------------------------------------------------------- *
*        PRINT FORMAT3 DATA
* ----------------------------------------------------------- *
         SPACE
FORMAT3  STM   R14,R1,FORMAS
         L     R1,COUNTB
         CVD   R1,DOUBLE
         MVC   MSG3B,=X'4020202020202020'
         ED    MSG3B,DOUBLE+4
         PUTM  MSG3
         LM    R14,R1,FORMAS
         BR    R14
         SPACE
* ----------------------------------------------------------- *
*        MOVE DATA SUBROUTINE
* ----------------------------------------------------------- *
         SPACE
@MVCL    EQU   *
         CH    R0,@MVCLH .         TOO LONG FOR ONE MVC
         BNH   @MVCLR .            NO, BRANCH
         MVC   0(256,R15),0(R1) .  MOVE A 256 BYTE CHUNK
         LA    R15,256(,R15) .     POINT PAST LAST BYTE MOVED
         LA    R1,256(,R1) .       POINT TO NEXT CHUNK TO MOVE
         SH    R0,@MVCLH .         REDUCE LENGTH BY 256
         BP    @MVCL .             LOOP IF MORE DATA REMAINS
         BR    R14 .               NO REMAINDER
@MVCLI   MVC   0(0,R15),0(R1)      (EXECUTED)
@MVCLH   DC    H'256'
@MVCLR   XR    R14,R0 .            SWAP R0 AND R14
         XR    R0,R14 .            SWAP R0 AND R14
         XR    R14,R0 .            SWAP R0 AND R14
         BCTR  R14,0 .             LENGTH MINUS 1 FOR EX
         EX    R14,@MVCLI          MOVE REMAINDER
         LA    R15,1(R14,R15) .    POINT PAST LAST BYTE MOVED
         LR    R14,R0 .            GET RETURN ADDRESS
         BR    R14 .               RETURN
         SPACE
* -------------------------------------------------------- *
*        CONVERT DCB ATTRIBUTES SUBROUTINE.  ROUTINE IS
*        ENTERED WITH ADDR OF A DCB IN R1.
* -------------------------------------------------------- *
         SPACE
ATTRIB   EQU   *
         USING IHADCB,R1
         LA    R15,MSG6B
         MVC   0(5,R15),=C'U    '
         TM    DCBRECFM,DCBRECU    IS IT RECFM=U ?
         BO    ATT2
         BZ    ATTQ
         MVI   0(R15),C'F'
         TM    DCBRECFM,DCBRECF    IS IT RECFM=F ?
         BO    ATT2
         MVI   0(R15),C'V'
         B     ATT2
         SPACE
ATTQ     EQU   *
         MVI   0(R15),C'*'
ATT2     EQU   *
         LA    R15,1(,R15)
         TM    DCBRECFM,DCBRECBR   BLOCKED  ?
         BZ    *+12
         MVI   0(R15),C'B'
         LA    R15,1(,R15)
         TM    DCBRECFM,DCBRECCA   ASA ?
         BZ    *+12
         MVI   0(R15),C'A'
         LA    R15,1(,R15)
         TM    DCBRECFM,DCBRECCM   MACHINE ?
         BZ    *+12
         MVI   0(R15),C'M'
         LA    R15,1(,R15)
         TM    DCBRECFM,DCBRECTO   TRKOV ?
         BZ    *+12
         MVI   0(R15),C'T'
         LA    R15,1(,R15)
         TM    DCBRECFM,DCBRECSB   STANDARD/SPANNED ?
         BZ    *+8
         MVI   0(R15),C'S'
         LH    R15,DCBLRECL GET THE 2 BYTE LRECL
         CVD   R15,DOUBLE
         MVC   MSG6C,MSG6P
         ED    MSG6C,DOUBLE+5
         MVC   MSG6C(5),MSG6C+1
         MVI   MSG6C+5,C' '
         LH    R15,DCBBLKSI GET THE 2 BYTE BLKSIZE
         CVD   R15,DOUBLE
         MVC   MSG6D,MSG6P
         ED    MSG6D,DOUBLE+5
         MVC   MSG6D(5),MSG6D+1
         MVI   MSG6D+5,C' '
         BR    R14
         DROP  R1
         SPACE
* ----------------------------------------------------------- *
*        DATA CONTROL BLOCKS
* ----------------------------------------------------------- *
         SPACE
SYSUT1   DCB   DDNAME=SYSUT1,DSORG=PS,MACRF=(GL),EXLST=EXLUT1,         X
               EODAD=EODUT1,SYNAD=SYNAD
         DS    0F
EXLUT1   DC    X'05',AL3(EXTUT1)   TAKE OPEN EXIT
         DC    X'87',AL3(UT1JFCB)  JFCB EXIT AND LAST ONE
         SPACE
SYSUT2   DCB   DDNAME=SYSUT2,DSORG=PS,MACRF=(PM),EXLST=EXLUT2
         SPACE
         DS    0F
EXLUT2   DC    X'05',AL3(EXTUT2)   TAKE OPEN EXIT
         DC    X'87',AL3(UT2JFCB)  JFCB EXIT AND LAST ONE
         SPACE
SYSPRINT DCB   DDNAME=SYSPRINT,DSORG=PS,MACRF=PM,EXLST=EXLPRT,         X
               RECFM=FBA,LRECL=121
         SPACE
         DS    0F
EXLPRT   DC    X'85',AL3(EXTPRT)   TAKE OPEN EXIT AND LAST ONE
         SPACE
* ----------------------------------------------------------- *
*        DCB EXITS FOLLOW
* ----------------------------------------------------------- *
         SPACE
EXTPRT   EQU   *
         LA    R4,SYSPRINT
         USING IHADCB,R4                GET ADDRESSABILITY
         CLC   DCBBLKSI(2),DCBLRECL     IS PRINT BLKSIZE OK?
         BER   R14                      YES, RETURN
         CLC   DCBBLKSI(2),=H'0'        IS PRINT BLKSIZE UNSPECIFIED
         BE    DEFPRT                   YES, BRANCH
         LH    R3,DCBBLKSI              PREPARE TO DIVIDE
         SR    R2,R2                    PREPARE TO DIVIDE
         LH    R8,DCBLRECL              PREPARE TO DIVIDE
         DR    R2,R8                    DIVIDE BLKSI BY LRECL
         LTR   R2,R2                    IS THERE A REMAINDER
         BZR   R14                      NO, BLKSIZE IS OK
DEFPRT   EQU   *
         MVC   DCBBLKSI(2),DCBLRECL
         BR    R14
         DROP  R4
* ----------------------------------------------------------- *
         SPACE
EXTUT1   EQU   *
         LA    R4,SYSUT1
         USING IHADCB,R4                GET ADDRESSABILITY
         TM    DCBRECFM,DCBRECU    UNDEFINED?
         BOR   R14
         TM    DCBRECFM,DCBRECV+DCBRECSB  VARIABLE + SPANNED
         BNOR  R14
         OI    DCBBFTEK,DCBBFTA    BFTEK=A
         BR    R14
         DROP  R4
         SPACE
* ----------------------------------------------------------- *
         SPACE
EXTUT2   EQU   *
         LA    R4,SYSUT2
         USING IHADCB,R4                GET ADDRESSABILITY
         CLI   DCBRECFM,0
         BNE   *+14
         MVC   DCBRECFM(2),OBTRECFM
         OI    OBTSW,X'80'
         TM    DCBRECFM,DCBRECBR   IS IT BLOCKED?
         BO    EXTUT2L             YES, GO CHECK LRECL
         TM    DCBRECFM,DCBRECV+DCBRECSB   IS IT V SPANNED?
         BNO   EXTUT2B             NO, SKIP LRECL
EXTUT2L  EQU   *
         CLC   DCBLRECL(2),=H'0'
         BNE   *+14
         MVC   DCBLRECL(2),INPLRECL
         OI    OBTSW,X'40'
EXTUT2B  EQU   *
         CLC   DCBBLKSI(2),=H'0'
         B     *+14                WAS BNE                       JDM2
         MVC   DCBBLKSI(2),OBTBLKSI
         OI    OBTSW,X'20'
         BR    R14
         DROP  R4
         SPACE
* ----------------------------------------------------------- *
         SPACE
SYNAD    EQU   *
         SYNADAF ACSMETH=QSAM
         OI    SWIT1,X'80'         REMEMBER THE ERROR
         MVC   MSG2M(78),50(R1)    SAVE THE MSG TEXT
         SYNADRLS                  RELEASE THE SYNAD BUFFER
         SR    R15,R15
         BR    R14
         SPACE
* ------------------------------------------------------------------- *
*        2 FULL WORD AREAS FOR RETURN OF INFO FROM DEVTYPE FOR SYSUT1
* ------------------------------------------------------------------- *
UT1DEV   DS    0D
         DS    F
         DS    F
* ------------------------------------------------------------------- *
*        2 FULL WORD AREAS FOR RETURN OF INFO FROM DEVTYPE FOR SYSUT2
* ------------------------------------------------------------------- *
UT2DEV   DS    0D
         DS    F
         DS    F
* ------------------------------------------------------------------- *
*        176 BYTES FOR RETURN OF INFO FROM RDJFCB FOR SYSUT1
* ------------------------------------------------------------------- *
UT1JFCB  DS    0D,CL176
* ------------------------------------------------------------------- *
*        176 BYTES FOR RETURN OF INFO FROM RDJFCB FOR SYSUT1
* ------------------------------------------------------------------- *
UT2JFCB  DS    0D,CL176
         SPACE
* ----------------------------------------------------------- *
*        DATA AREA FOLLOWS
* ----------------------------------------------------------- *
         SPACE
SAVE     DC    18F'0'
PTREOB   DC    F'0'
PTRIN    DC    F'0'
PTROUT   DC    F'0'
RC       DC    F'0'
OUTBUFF  DC    F'0'
SWIT1    DC    X'00000000'
DDSYSUT1 DS    CL8                 DDNAME FROM DCB FOR SYSUT1
DDSYSUT2 DS    CL8                 DDNAME FROM DCB FOR SYSUT2
OBTRECFM DC    X'00'
OBTSW    DC    X'00'
OBTLRECL DC    H'0'
OBTBLKSI DC    H'0'
INPLRECL DC    H'0'                INPUT LRECL (OR BLKSIZE IF UNBLKED)
OUTLRECL DC    H'0'                OUTPUT RECL (OR BLKSIZE IF UNBLKED)
HALF     DC    H'0'
LOLRECL  DC    H'0'
HILRECL  DC    H'0'
WRKRECFM DC    X'00'
CTRRDERR DC    P'00000'
CTRMULTI DC    P'00000'
CTRTOOBG DC    P'00000'
* ------------------------------------------------------------------- *
MSGH     DC    C'1'
         DC    C'SYSREPRO - SEQUENTIAL COPY UTILITY'
MSGHL    EQU   *-MSGH
* ------------------------------------------------------------------- *
MSG1     DC    C'0'
         DC    C'  '
MSG1A    DC    X'402020202120'
         DC    C' I/O ERRORS.'
MSG1L    EQU   *-MSG1
* ------------------------------------------------------------------- *
MSG2     DC    C' '
         DC    27C' '
         DC    CL10'I/O ERROR '
MSG2M    DC    CL78' '
MSG2L    EQU   *-MSG2
* ------------------------------------------------------------------- *
MSG3     DC    C' '
         DC    C'ERROR IN RECORD NO.'
MSG3B    DC    CL8' '
MSG3L    EQU   *-MSG3
* ------------------------------------------------------------------- *
MSG4     DC    C' '
         DC    34C' '
MSG4M    DC    CL40' '
         DC    CL2' '
MSG4HX   DC    CL48' '
MSG4L    EQU   *-MSG4
* ------------------------------------------------------------------- *
MSG5     DC    C'0'
         DC    C'RECORDS READ = '
MSG5A    DC    X'4020206B2020206B2020206B202120'  99,999,999,999 JDM1
         DC    C'   RECORDS COPIED = '
MSG5B    DC    X'4020206B2020206B2020206B202120'  99,999,999,999 JDM1
         DC    C' '
MSG5L    EQU   *-MSG5
* ------------------------------------------------------------------- *
MSG9     DC    C'0'
         DC    C'LENGTH OF SHORTEST RECORD = '
MSG9A    DC    X'402020202120'
         DC    C' LENGTH OF LONGEST RECORD = '
MSG9B    DC    X'402020202120'
         DC    C' '
MSG9L    EQU   *-MSG9
* ------------------------------------------------------------------- *
MSG6     DC    C' '
MSG6A    DC    C'INPUT '
         DC    C'  RECFM='
MSG6B    DC    CL5' '
         DC    C'  LRECL='
MSG6C    DC    X'402020202120'
         DC    C'  BLKSIZE='
MSG6D    DC    X'402020202120'
MSG6L    EQU   *-MSG6
MSG6P    DC    X'402020202120'
* ------------------------------------------------------------------- *
MSG7     DC    C' '
MSG7A    DC    C'INPUT '
         DC    C'  DSNAME='
MSG7B    DC    CL54' '
MSG7L    EQU   *-MSG7
* ------------------------------------------------------------------- *
MSG8     DC    C' '
MSG8A    DC    C'INPUT '
         DC    C'  VOLUME='
MSG8B    DC    CL6' ',CL3' '
MSG8C    DC    CL4' '              FILE=
MSG8D    DC    CL4' '
MSG8L    EQU   *-MSG8
* ------------------------------------------------------------------- *
MSGE2    DC    C' *** ERROR ***   UNEQUAL LOGICAL RECORD LENGTHS'
MSGE2L   EQU   *-MSGE2
* ------------------------------------------------------------------- *
MSGE3    DC    C' *** ERROR ***   RECORD FORMATS ARE CONFLICTING'
MSGE3L   EQU   *-MSGE3
* ------------------------------------------------------------------- *
H4       DC    H'4'
P1       DC    P'1'
P0       DC    P'0'
COUNTB   DC    F'0'
COUNTP   DC    F'0'
COUNTN   DC    F'0'
DOUBLE   DC    D'0'
FORMAS   DC    4F'0'
PARMPTR  DS    F
OPTSW    DS    CL1
SPACES   DC    CL8' '
         LTORG
MSGMINUS DS    C                  MSG-1
MSG      DS    CL133
         SPACE
         PRINT ON,GEN
         DCBD  DSORG=(PS)
         SPACE
         IEFTIOT1
         SPACE
         IEFUCBOB
         SPACE
         CVT   DSECT=YES,LIST=NO
         END
//LKED.SYSLMOD DD DSN=SYS2.LINKLIB,DISP=SHR                             00080000
//LKED.SYSIN DD *                                                       00090000
 NAME SYSREPRO(R)                                                       00100000
//                                                                      00110000
