COPYTP# TITLE ' PROGRAM TO COPY TAPE TO TAPE SEVERAL FILES' 00010000 *--------------------------------------------------------------------* 00020004 * COPY TAPE TO TAPE, MIRROR IMAGE * 00030004 * THIS WILL COPY TAPES THAT NO OTHER UTILITY WILL * 00040004 * SUPPORTS 64K BLKSIZE * 00050004 * SJB3 CHECK TO SEE IF SYSUT2 IS DD DUMMY (MAPTAPE) AND NEVER CALL* 00051018 * WTAPE * 00052018 *--------------------------------------------------------------------* 00060004 * //SB1 EXEC PGM=COPYTP ,PARM='003' 00070004 * //STEPLIB DD DISP=SHR,DSN=KBASS.PERM.LOAD 00080004 * //SYSPRINT DD SYSOUT=* 00090004 * //SYSUT1 DD DSN=&&I1,DISP=(OLD,PASS),UNIT=CTAPE1, 00100004 * // VOL=(,RETAIN,SER=201226), 00110004 * // LABEL=(1,BLP,EXPDT=98000) 00120004 * //SYSUT2 DD DSN=&&O1,DISP=(NEW,PASS),UNIT=CTAPE1, 00130004 * // VOL=(,RETAIN,SER=XX1226), 00140004 * // LABEL=(1,BLP,EXPDT=98000) 00150004 *--------------------------------------------------------------------* 00160004 * CAN BE USED TO MAP A TAPE VIA SYSUT2 DD DUMMY * 00170004 *--------------------------------------------------------------------* 00180004 * 00190004 MACRO 00200000 &L CNVT &FLD,&EMASK,&LENGTH,&OFF 00210000 &L CVD R0,DEC 00220015 OI DEC+7,X'0F' 00230000 MVC &FLD.(&LENGTH),&EMASK 00240000 ED &FLD.(&LENGTH),DEC+&OFF 00250000 MEND 00260000 * PRINT NOGEN 00270000 &MAXERR SETA 0100 MAX IS 4096, USING LA 00271012 EJECT 00280000 COPYTP CSECT 00290000 CONNECT LSIZE,WORK,BASE=R12,PARM=R11,LI=L SJB 00300000 ENTRY COPYTP 00310000 LR R1,R11 SJB 00320000 L R1,0(,R1) ADDR OF PARM 00330000 LH R2,0(,R1) LENGTH OF PARM 00340000 CH R2,=H'5' SEE IF MORE THAN 3 DIG 00350000 BH BAD 00360000 CH R2,=H'0' SEE IF NO PARM 00370000 BH OK 00380000 L R11,=F'99999' 00390000 B OK2 00400000 BAD WTO 'COPYTP - PARM FIELD ERROR' 00410000 ABEND 2 00420000 OK DS 0H 00430000 BCTR R2,0 DECR BY 1 FOR PACK 00440000 PK PACK DEC(8),2(*-*,R1) PACK NUMBER 00450000 EX R2,PK 00460000 CVB R11,DEC CONVERT IT TO BINARY 00470000 LTR R11,R11 MAKE SURE ITS POSITIVE 00480000 BNP BAD 00490000 OK2 DS 0H 00500000 MVI FLAG,0 SJB3 00501018 CALL OPENT,(ONE,ONE) OPEN SYSUT1 FOR INPUT 00510000 *--------------------------------------------------------------------* 00510118 * CHECK TO SEE IF SYSUT2 IS DD DUMMY (MAPTAPE) * 00510218 * IF SO THEN SET $NULL2 AND NEVER CALL WTAPE * 00510318 *--------------------------------------------------------------------* 00510418 DEVTYPE =CL8'SYSUT2',DEC SJB3 00511018 CLC DEC,=F'0' IS A DD DUMMY SJB3 00512018 BNE XOPEN2 SJB3 00513018 OI FLAG,$NULL2 SJB3 00514018 B XOPEN2A SJB3 00514118 XOPEN2 DS 0H SJB3 00515018 CALL OPENT,(TWO,TWO) OPEN SYSUT2 FOR OUTPUT 00520000 XOPEN2A DS 0H SJB3 00521018 OPEN (PTR,(OUTPUT)) STATITICS FILE 00530000 * 00540000 PUT PTR,TITL1 00550000 PUT PTR,TITL2 00560000 MVC TMIN,NINES MIN BLOCK/TAPE = 999999 00570000 MVC TMAX,ZERO MAX BLOCK/TAPE = 0 00580000 LA R3,0 # BLOCKS/TAPE = 0 00590000 LA R8,0 # FILES DONE = 0 00600000 * 00610000 LOOP LA R4,0 # BLOCKS/FILE = 0 00620000 LA R8,1(,R8) COUNT # FILES DONE 00630000 * 00640000 MVC MIN,NINES MIN BLOCK/FILE = 999999 00650000 MVC MAX,ZERO MAX BLOCK/FILE = 0 00660000 * 00670000 LOOP1 LA R6,&MAXERR ERROR COUNTER 00680011 * 00690000 LOOP2 LA R2,BUF READ TAPE 00700000 CALL RTAPE,(ONE,(2),BYTES) READ TAPE 00710000 C R15,FOUR EOF? 00720000 BE EOF YES 00730000 C R15,EIGHT ERR? 00740000 BNE RGOOD NOPE 00750000 LA R1,=CL8'READ' SAY WHERE THE ERR CAME FROM SJB5 00760002 BAL R14,ERR YES, GOTO ERR ROUTINE 00770000 B LOOP2 TRY READ AGAIN 00780000 RGOOD DS 0H 00790000 CLC =C'VOL1',BUF 00800004 BE RGVOL1 00810004 CLC =C'HDR1',BUF 00820004 BE RGDSN1 00830004 CLC =C'HDR2',BUF 00840004 BE RGDSN2 00850004 CLC =C'EOF1',BUF 00860006 BE RGDSN3F 00870009 CLC =C'EOV1',BUF ONLY OF DSN SPANS VOLUMES 00880010 BE RGDSN3V 00890009 B RG0100 00900004 RGVOL1 DS 0H VOL1 FOUND 00910016 MVC VOLSER,BUF+04 00920004 B RG0100 00930004 RGDSN1 DS 0H HDR1 FOUND 00940016 MVC DSNAM,BUF+04 LAST 17 BYTES OF DSN 00950004 B RG0100 00960004 RGDSN2 DS 0H HDR2 FOUND 00970016 MVC RECFM+0(1),BUF+04 RECFM-1 00980004 MVC RECFM+1(1),BUF+38 RECFM-2 00990004 MVI RECFM+2,C'/' 01000004 MVC LRECL,BUF+10 LRECL 01010004 MVI LRECL+5,C'/' 01020004 MVC BLKSZ,BUF+05 BLKSIZE 01030004 MVC JOBSTEP,BUF+17 JOB-STEP 01040004 B RG0100 01050004 RGDSN3V DS 0H EOV1 FOUND (DSN SPANS VOLUMES) 01060016 MVC VOLSER(3),=C'EOV' 01070009 B RGDSN3 01080009 RGDSN3F DS 0H EOF1 FOUND 01090016 MVC VOLSER(3),=C'EOF' 01100009 *--------------------------------------------------------------------* 01100116 * ADD CREATION DATE CYYDDD WHERE C=B(1900), =0(2000) * 01100220 *--------------------------------------------------------------------* 01100316 MVC DSNAM,BLANKS 01100419 MVC DSNAM+9+0(2),=C'19' 01100519 CLI BUF+41,C'0' BLANK IS 1900, 0=2000, 1=2100 01100620 BL CRDT0100 NO 01100719 MVC DSNAM+9+0(2),=C'20' 01100819 OC DSNAM+9+1(1),BUF+41 MAKE IT 20, 21, 22 ETC. 01100920 CRDT0100 DS 0H 01101019 MVC DSNAM+9+2(2),BUF+42 MOVE IN YY 01101120 MVI DSNAM+9+4,C'.' . 01101220 MVC DSNAM+9+5(3),BUF+44 MOVE IN DDD 01101320 *--------------------------------------------------------------------* 01105419 * ADD DATE AND TIME TO THE EOF LINE WHERE JOBSTEP IS * 01105519 *--------------------------------------------------------------------* 01105619 TIME DEC R0=HHMMSSTT R1=0CYYDDDF 01105719 STM R0,R1,DEC2 DEC2(0-3)=TIME, DEC2(4-7)=DATE 01105819 TR DEC2+4(1),TRANCENT CNVT 00 TO 19, 01 TO 20 ETC 01105919 OI DEC2+4+3,X'0F' ZONE IT. 01106019 UNPK JOBSTEP+00+00(05),DEC2+4+0(3) YYYY 01106119 MVI JOBSTEP+00+04,C'.' . 01106219 UNPK JOBSTEP+05+00(03),DEC2+4+2(2) DDD 01106319 * DEC2+4 TIME=HHMMSSTT 01107019 UNPK JOBSTEP+09+00(03),DEC2+0+0(2) HH 01109016 MVI JOBSTEP+09+02,C':' : 01109116 UNPK JOBSTEP+09+03(03),DEC2+0+1(2) MM 01109216 MVI JOBSTEP+09+05,C':' : 01109316 UNPK JOBSTEP+09+06(03),DEC2+0+2(2) SS 01109416 MVI JOBSTEP+09+08,C' ' 01109516 RGDSN3 DS 0H 01110009 CLC =C'0000',BUF+76 IS IT ALL ZEROS? 01120013 BE RGDSN3A 01130006 MVC BLKSZ-04(04),BUF+76 MOVE IN TOP 4 BYTES OF #BLKS 01140013 RGDSN3A DS 0H 01150006 MVC BLKSZ(06),BUF+54 MOVE IN LAST 6 BYTES OF IT 01160007 RG0100 DS 0H 01170004 MVI EOT,X'00' TURN OFF EOT SJB 01180000 MVI IOERROR,X'00' TURN OFF IOERROR FOR THIS REC SJB3 01190000 LA R3,1(,R3) # BLOCKS/TAPE 01200000 LA R4,1(,R4) # BLOCKS/FILE 01210000 L R5,BYTES # BYTES/BLOCK 01220000 * 01230000 * CHECK FOR MIN NUMBER OF BYTES IN ONE BLOCK AND TOTAL 01240000 * 01250000 C R5,MIN NEW MIN BLOCK/FILE 01260000 BNL MAXCHECK NOPE 01270000 ST R5,MIN SAVE NEW MIN/FILE 01280000 C R5,TMIN NEW MIN BLOCK/TAPE 01290000 BNL MAXCHECK NOPE 01300000 ST R5,TMIN SAVE NEW MIN/TAPE 01310000 * 01320000 * CHECK FOR MAX NUMBER OF BYTES IN ONE BLOCK AND TOTAL 01330000 * 01340000 MAXCHECK C R5,MAX NEW MAX BLOCK/FILE 01350000 BNH WRITE NOPE 01360000 ST R5,MAX SAVE NEW MAX/FILE 01370000 C R5,TMAX NEW MAX BLOCK/TAPE 01380000 BNH WRITE NOPE 01390000 ST R5,TMAX SAVE NEW MAX/TAPE 01400000 * 01410000 WRITE LA R2,BUF WRITE TAPE 01420000 TM FLAG,$NULL2 IS SYSUT2 DD DUMMY? SJB3 01421018 BO LOOP1 YES, DON'T WRITE SJB3 01422018 CALL WTAPE,(TWO,(2),BYTES) WRITE TAPE 01430000 C R15,FOUR ERR? 01440000 BNE LOOP1 NOPE 01450000 LA R1,=CL8'WRITE' SAY WHERE THE ERR CAME FROM SJB5 01460002 BAL R14,ERR GO ERR ROUTINE 01470000 ABEND 1,DUMP 01480003 B WRITE 01490000 * 01500000 EOF DS 0H 01510018 TM FLAG,$NULL2 IS SYSUT2 DD DUMMY? SJB3 01510118 BO EOF2 YES, DON'T WRITE SJB3 01510218 CALL WTMARK,(TWO) PUT EOF ON OUTPUT TAPE 01511018 EOF2 DS 0H SJB3 01512018 CLI EOT,X'FF' SECOND EOT 01520000 BE ENDTAPE YES,GO TERM 01530000 CLC =C'EOV1',BUF EOT? (ONLY OF DSN SPANS VOLS) 01531017 BE ENDTAPE YES, END OF TAPE 01532017 * 01540000 EOFO DS 0H 01550000 MVI EOT,X'FF' INDICATE EOF 01560000 BAL R9,REPORT 01570000 BCT R11,LOOP ALL OF FILES DONE? 01580000 ENDTAPE CALL CLOSET,(ONE) YES,CLOSE THEM ALL 01590000 TM FLAG,$NULL2 IS SYSUT2 DD DUMMY? SJB3 01591018 BO EOT2 YES, DON'T WRITE SJB3 01592018 CALL CLOSET,(TWO) 01600000 EOT2 DS 0H SJB3 01601018 MVC MIN,TMIN 01610000 MVC MAX,TMAX 01620000 LR R4,R3 01630000 MVI EOJ,X'FF' END OF JOB FLAG 01640000 BAL R9,REPORT 01650000 CLOSE (PTR) 01660000 RELEASE LSIZE,RC=0,LI=L BYE 01670000 * 01680000 REPORT DS 0H 01690000 TM EOJ,X'FF' 01700000 BZ NOTEOJ 01710000 PUT PTR,TITL4 PRINT DASHES 01720000 MVC FILEN,BLANKS 01730004 B REPEOJ 01740004 * 01750000 NOTEOJ LR R0,R8 01760015 CNVT DEC2,MASK1,6,5 R0=INPUT, 01770015 MVC FILEN,DEC2+1 01771014 REPEOJ DS 0H 01780004 * 01790000 LR R0,R4 01800015 CNVT BLKREAD,MASK2,12,3 01810000 * 01820000 L R0,MIN 01830015 CNVT MINBLK,MASK3,7,5 01840000 * 01850000 L R0,MAX 01860015 CNVT MAXBLK,MASK3,7,5 01870000 PUT PTR,TITL3 01880000 MVC VOLSER(VOLSERLN),BLANKS 01890004 BR R9 01900000 * 01910000 ERR DS 0H 01920000 ST R14,SAVER142 01930000 CLI IOERROR,X'00' IOERROR ON SAME REC 2ND TIME SJB3 01940000 BNE ERRDIE YES 01950000 * 01960000 MVC ERRTASK,0(R1) MOVE IN WHERE ERR CAME FROM SJB5 01970002 LR R0,R4 01980015 CNVT ERRBLK,MASK2,12,3 01990000 PUT PTR,ERRMSG 02000000 * 02010000 BCT R6,ERRET DECREMENT MAX ERROR COUNT 02020000 LA R6,&MAXERR 02030011 MVC FSREC,=F'1' SJB 02040002 CALL FSREC,(ONE,FSREC) SKIP ONE RECORD 02050000 CLC FSREC,=F'1' SKIP RECORD FAILED SJB4 02060001 BE ERRDIE RIGHT, GO DIE SJB4 02070001 MVI IOERROR,X'FF' 02080000 B ERRET 02090000 ERRDIE DS 0H IOERROR 2ND TIME ON RECORD SJB3 02100000 ABEND 101 SJB3 02110000 ERRET DS 0H 02120000 L R14,SAVER142 02130000 BR R14 02140000 FSREC DC F'1' SJB 02150000 DEC DS D 02160000 DEC2 DS D 02161014 LTORG 02170000 SAVER14 DC F'0' 02180000 SAVER142 DC F'0' 02190000 BYTES DC F'0' 02200000 ZERO DC F'0' 02210000 ONE DC F'1' 02220000 TWO DC F'2' 02230000 FOUR DC F'4' 02240000 EIGHT DC F'8' 02250000 NINES DC F'999999' 02260000 MIN DC F'0' 02270000 MAX DC F'0' 02280000 TMIN DC F'0' 02290000 TMAX DC F'0' 02300000 * 02310000 TITL1 DC CL133'1 NUMBER OF LENGTH OF LENGTH OF ' 02320000 TITL2 DC CL133' FILE BLOCKS READ SHORTEST BLOCK LONGEST BLOCK X02330015 VOLSER RF/LRECL/BLKSZ DSNAME-17 JOB-STEP' 02340004 TITL3 DC CL133' ' 02350000 ORG TITL3 02360000 FILEN DC CL5' ' 02370014 FILL1 DC CL1' ' 02380014 BLKREAD DC CL12' ' 02390000 FILL2 DC CL9' ' 02400000 MINBLK DC CL7' ' 02410000 FILL3 DC CL9' ' 02420000 MAXBLK DS CL7' ' 02430000 DS C' ' 02440004 VOLSER DC CL6' ',C' ' 02450004 RECFM DC CL2' ',C' ' 02460004 LRECL DC CL5' ',C' ' 02470004 BLKSZ DC CL5' ',C' ' 02480004 DSNAM DC CL17' ',C' ' 02490004 JOBSTEP DC CL17' ' 02500004 VOLSERLN EQU *-VOLSER 02510004 ORG TITL3+133 02520000 TITL4 DS 0CL133 02530000 DC 52CL1'-',CL81' ' 02540000 ERRMSG DC CL133' ' 02550000 ORG ERRMSG 02560000 DC C'**** ERROR ON BLOCK # ' 02570000 ERRBLK DC CL12' ' 02580000 DC C' **** DOING A ' 02590002 ERRTASK DC CL8' ' 02600002 ORG ERRMSG+133 02610000 TRANCENT DC X'19202122' CENTURY CONVERT 0=19, 1=20, ETC 02611016 MASK1 DC X'402020202120' 02620014 MASK2 DC X'402020206B2020206B202120' 02630000 MASK3 DC X'4020206B202120' 02640000 * 02650000 FLAG DC X'00' SJB3 02660018 $NULL2 EQU X'80' SYSUT2 IS "DD DUMMY" MAPTAPE SJB3 02660118 EOJ DC X'00' 02661018 EOT DC X'00' 02670000 IOERROR DC X'00' 02680000 BLANKS DC CL133' ' 02690004 PRINT NOGEN 02700000 PTR DCB DDNAME=SYSPRINT,MACRF=(PM),LRECL=133,RECFM=FBA, X02710000 BLKSIZE=3990,DSORG=PS,BUFNO=2 02720000 LSIZE DC A(LWORK) SJB 02730000 WORK DSECT SJB 02740000 SAVEA DS 9D SJB 02750000 BUF DS (X'FFFF')C,C SJB 02760005 LWORK EQU *-WORK SJB 02770000 REGS SJB 02780000 END 02790000