TITLE ' TAPE UTILITY SUBROUTINES CALLABLE FROM FORTRAN' 00010019 * ---------------------------------------------------------- 00011019 * ATTRIBUTES NORENT, AMODE=24, RMODE=24--------------------- 00012019 * ---------------------------------------------------------- 00013019 * CALL RTAPE(K,BUF,N,&99,&999) READ TAPE 00020019 * K = 1 OR 2 (WHICH TAPE) 00030019 * BUF = INPUT ARRAY 00040019 * N = NUMBER OF BYTES READ R15 = 0 GOOD READ 00050019 * &99 = EOF LABEL R15 = 4 EOF READ 00060019 * &999 = ERR EXIT LABEL R15 = 8 ERR ON READ 00070019 * ---------------------------------------------------------- 00080019 * CALL WTAPE(K,BUF,N,&9999) WRITE TAPE 00090019 * K = 1 OR 2 (WHICH TAPE) 00100019 * BUF = OUTPUT ARRAY 00110019 * N = NUMBER OF BYTES TO WRITE R15 = 0 GOOD WRITE 00120019 * &9999 = ERR EXIT LABEL R15 = 4 ERR ON WRITE 00130019 * ---------------------------------------------------------- 00140019 * CALL OPENT(K,L) OPEN TAPE 00150019 * K = 1 OR 2 (WHICH TAPE) 00160019 * L = 1 FOR INPUT 00170019 * L = 2 FOR OUTPUT 00180019 * ---------------------------------------------------------- 00190019 * CALL CLOSET(K,L) CLOSE TAPE 00200019 * K = 1 OR 2 (WHICH TAPE) 00210019 * L = 1 FOR INPUT 00220019 * L = 2 FOR OUTPUT 00230019 * ---------------------------------------------------------- 00240019 * CALL RWTAPE(K) REWIND TAPE 00250019 * K = 1 OR 2 (WHICH TAPE) 00260019 * ---------------------------------------------------------- 00270019 * CALL SFILE(K) SKIP FILE 00280019 * K = 1 OR 2 (WHICH TAPE) 00290019 * ---------------------------------------------------------- 00300019 * CALL FSREC(K,N) FORWARD-SPACE RECORD 00310019 * K = 1 OR 2 (WHICH TAPE) 00320019 * N = NUMBER OF REC (INPUT) (MUST BE A VARIABLE) 00330019 * = NUMBER OF REC (OUTPUT) NOT PROCESSED 00340019 * BECAUSE OF EOF 00350019 * ---------------------------------------------------------- 00360019 * CALL BSREC(K,N) BACKWARD-SPACE RECORD 00370019 * K = 1 OR 2 (WHICH TAPE) 00380019 * N = NUMBER OF REC (INPUT) (MUST BE A VARIABLE) 00390019 * = NUMBER OF REC (OUTPUT) NOT PROCESSED 00400019 * BECAUSE OF EOF 00410019 * ---------------------------------------------------------- 00420019 * CALL FSFILE(K) FORWARD-SPACE FILE 00430019 * K = 1 OR 2 (WHICH TAPE) 00440019 * ---------------------------------------------------------- 00450019 * CALL BSFILE(K) BACKWARD-SPACE FILE 00460019 * K = 1 OR 2 (WHICH TAPE) 00470019 * ---------------------------------------------------------- 00480019 * CALL WTMARK(K) WRITE TAPE MARK 00490019 * K = 1 OR 2 (WHICH TAPE) 00500019 * ---------------------------------------------------------- 00510019 * 00520019 * 00530019 * IF K = 1 THEN THE SUBROUTINES DOES ITS PROCESSING FROM 00540019 * DDNAME = "SYSUT1" EX. 00550019 * 00560019 *//GO.SYSUT1 DD VOL=SER=SYSUT1,UNIT=TAPE,DISP=OLD,LABEL=(1,NL) 00570019 * 00580019 * IF K = 2 THEN THE SUBROUTINES DOES ITS PROCESSING FROM 00590019 * DDNAME = "SYSUT2" EX. 00600019 * 00610019 *//GO.SYSUT2 DD VOL=SER=SYSUT2,UNIT=TAPE,DISP=OLD,LABEL=(1,NL) 00620019 * ------------------------------------------------------------------* 00630019 * CHANGES * 00640019 *KBASS 0519-11 CHECK SYSUT1 AND SYSUT2 TO SEE IF TAPE * 00650019 *KBASS 0524-11 PROPERLY HANDLE RESIDUAL BYTE COUNT (IOBCSW CCW@) * 00660019 * ------------------------------------------------------------------* 00670019 EJECT 00680019 MACRO 00690019 &LABEL EEXCP &CCW,&D=,&L= 00700019 &LABEL DS 0H MOVE CCWS INTO WORK AREA 00710019 &IX SETC 'EX&SYSNDX.' 00720019 * 00730019 * USES R14-R1 AND R9 00740019 * 00750019 BAL R9,TAPEDCB SETS CURRDCBT 00760019 ICM R15,15,CURRDCBT GET CURRENT DCB TABLE 00770019 BZ &IX.CURR 00780019 .* 00790019 L R1,$DDFLAG(R15) GET @ CURRENT FLAGS 00800019 MVI ECB,X'7F' PRESET GOOD I/O IF DUMMY 00810019 TM 0(R1),$NULL IS IT DD DUMMY ? 00820019 BO &IX.EXIT 00830019 XC ECB,ECB CLEAR ECB 00840019 XC WIOB(WIOBLN),WIOB CLEAR WIOB 00850019 L R1,$DDDCB(,R15) GET @ CURR DCB 00860019 TM 48(R1),X'10' IS TAPE OPEN? 00870019 BZ &IX.D NO, ABEND 00880019 .* $DROP R1,R15 00890019 MVI WIOB,X'02' TURN ON UN RELATED FLAG 00900019 MVC WIOB+05(3),ECBA AL3(ECB) 00910019 MVC WIOB+17(3),=AL3(CCWS) CCW 00920019 STCM R1,B'0111',WIOB+21 MOVE IN DCB ADDR 00930019 .* 00940019 MVC CCWS(&CCW.LN),&CCW MOVE CCWS INTO WORK AREA 00950019 AIF ('&CCW' EQ 'CCWRDL' OR '&CCW' EQ 'CCWWRL').CCWL 00960019 AIF ('&CCW' EQ 'CCWRD' OR '&CCW' EQ 'CCWWR').CCWN 00970019 AGO .CCWOK ONLY R/W CCWS NEED DATA/LEN CHNGED 00980019 .CCWL ANOP 00990019 .CCWN ANOP 01000019 LA R0,&CCW.LN/8 NUMBER OF CCWS IN CHAIN 01010019 LA R15,CCWS LIST OF CCWS 01020019 &IX.A DS 0H 01030019 LR R14,&L LENGTH 01040019 CL R14,F64K IS CURRENT LEN > 64K 01050019 BL *+8 NO, THEN USE IT 01060019 L R14,F64K YES, USE 64K 01070019 STCM &D,B'0111',1(R15) STORE IN DATA AREA ADDR. 01080019 STCM R14,B'0011',6(R15) MOVE IN NUMBER OF BYTES 01090019 S &L,F64K CURRENT LEN - 64K 01100019 BNP &IX.B NOTHING LEFT TO MOVE 01110019 AL &D,F64K INCR DATA AREA 01120019 LA R15,8(,R15) NEXT CCW IN CHAIN 01130019 BCT R0,&IX.A 01140019 B &IX.B 01150019 &IX.B DS 0H 01160019 MVI 4(R15),$SLI TURN OFF CHAINING 01170019 &IX.C DS 0H 01180019 .CCWOK ANOP 01190019 * DC H'1' 01200019 * EXCP WIOB 01210019 EXCP WIOB DO IT 01220019 * WAIT ECB=ECB 01230019 WAIT ECB=ECB WAIT FOR COMPLETION 01240019 &IX.EXIT DS 0H 01250019 LA R15,0 SET RETURN CODE 01260019 B &IX.RET 01270019 &IX.NULL DS 0H 01280019 MVI ECB,X'7F' 01290019 B &IX.RET 01300019 &IX.D DS 0H 01310019 WTO 'RTAPE DCB NOT OPEN ',ROUTCDE=11 01320019 ABEND 1 01330019 &IX.CURR DS 0H 01340019 WTO 'RTAPE CURRDCBT ZERO',ROUTCDE=11 01350019 ABEND 1 01360019 &IX.RET DS 0H 01370019 MEND 01380019 MACRO 01390019 &LABEL SAVEIT &ENTRY 01400019 &LABEL SAVE (14,12),T,&ENTRY 01410019 BALR 12,0 01420019 USING *,12 01430019 AIF ('&ENTRY' NE 'OPENT').NOPENT 01440019 ST R13,SAVEOT+4 01450019 LA R5,SAVEOT 01460019 AGO .GOPENT 01470019 .NOPENT ANOP 01480019 ST R13,SAVE+4 01490019 LA R5,SAVE 01500019 .GOPENT ANOP 01510019 ST R5,8(R13) 01520019 LR R13,R5 01530019 MEND 01540019 MACRO 01550019 &LABEL RESTORE 01560019 &LABEL L R13,SAVE+4 01570019 L R14,12(R13) 01580019 LM 0,12,20(R13) 01590019 MVI 12(R13),X'FF' 01600019 MEND 01610019 EJECT 01620019 RTAPE2 CSECT 01630019 RTAPE2 AMODE 24 01640019 RTAPE2 RMODE 24 01650019 RTAPE EQU RTAPE2 01660019 * CALL RTAPE(K,BUF,N,&99,&999) READ TAPE 01670019 * K = 1 OR 2 (WHICH TAPE) 01680019 * BUF = INPUT ARRAY 01690019 * N = NUMBER OF BYTES READ R15 = 0 GOOD READ 01700019 * &99 = EOF LABEL R15 = 4 EOF READ 01710019 * &999 = ERR EXIT LABEL R15 = 8 ERR ON READ 01720019 * ---------------------------------------------------------- 01730019 ENTRY WTAPE,OPENT,CLOSET,RWTAPE,SFILE,FSREC 01740019 ENTRY BSREC,FSFILE,BSFILE,WTMARK 01750019 USING PARMS,R10 01760019 SAVEIT RTAPE 01770019 LR R10,R1 PARM ADDRESS 01780019 LM R2,R4,PARMS DCB + BUFF + LEN 01790019 LR R5,R3 COPY BUFFER ADDR 01800019 L R6,=A(256*1024) 64K-1 LENGTH 01810019 EEXCP CCWRDL,D=R5,L=R6 READ IT 01820019 TM WIOB+12,X'0D' EOF? 01830019 BO RDEOF BIF YES 01840019 CLI WIOB+04,X'41' CHANNEL PROGRAM ERROR? 01850019 BNE RDCHK2 NO, CHECK AGAIN 01860019 TM WIOB+13,X'40' INCORRECT LENGTH (SHORT RECORD) 01870019 BO RTOK YES, THEN OK 01880019 RDCHK2 DS 0H 01890019 TM WIOB+12,X'02' ERR? 01900019 BO RDERR BIF YES 01910019 TM ECB,X'7F' X'7F' = GOOD 01920019 BNO RDERR NO, ERROR 01930019 RTOK DS 0H 01940019 LA R15,0 01950019 *--------------------------------------------------------------------* 01960019 * CALCULATE BYTES READ * 01970019 * SUM UP THE CCW-LEN FOR EACH CCW, IOB+9 IS LAST CCW+1(AL3) * 01980019 * THEN SUBSTRACT THE RESIDUAL BYTE COUNT (IOB+14 AL2) * 01990019 *IOBCSW+1 THE FIRST THREE BYTES ARE THE VIRTUAL ADDRESS POINTING * 02000019 * AFTER THE LAST-EXECUTED CCW IN YOUR CHANNEL PROGRAM * 02010019 *--------------------------------------------------------------------* 02020019 SLR R0,R0 02030019 LA R1,CCWS 02040019 N R1,=A(X'00FFFFFF') TURN OFF HI BYTE. 02041019 L R2,WIOB+8 GET LAST CCW+1 02050019 N R2,=A(X'00FFFFFF') TURN OFF HI BYTE. 02060019 RTBYTE DS 0H 02070019 SLR R15,R15 02080019 ICM R15,B'0011',6(R1) GET BYTE COUNT FROM CCW 02090019 ALR R0,R15 SUM UP BYTE COUNTS. 02100019 LA R1,8(,R1) POINT TO NEXT CCW 02110019 CLR R1,R2 AT WE AT THE LAST CCW+1? 02120019 BL RTBYTE NO,ADD UP NEXT CCW BYTE COUNT 02130019 CL R2,=A(0) IS IOBCCW LAST RD ZERO 0524-11 02140019 BE RTABEND YES, BAD CCW ADDRESS 0524-11 02150019 RTSHORT DS 0H 02151019 SLR R1,R1 02160019 ICM R1,B'0011',WIOB+14 GET RESIDUAL BYTE COUNT 02170019 SLR R0,R1 SUBSTRACT FROM TOTAL 02180019 L R1,PARMLEN 02190019 ST R0,0(,R1) AND SAVE IT 02200019 LA R15,0 02210019 B RDRET 02220019 RDEOF DS 0H 02230019 LA R15,4 02240019 LA R0,0 02250019 L R1,PARMLEN GET LENGTH DATA AREA 02260019 ST R0,0(,R1) SET IT TO ZERO 02270019 B RDRET 02280019 RDERR DS 0H 02290019 LA R15,8 02300019 RDERR2 LA R0,0 02310019 L R1,PARMLEN GET LENGTH DATA AREA 02320019 ST R0,0(,R1) SET IT TO ZERO 02330019 RDRET DS 0H 02340019 RESTORE 02350019 BR R14 02360019 RTABEND DC H'0' 02370019 EJECT 02380019 WTAPE SAVEIT WTAPE 02390019 * CALL WTAPE(K,BUF,N,&9999) WRITE TAPE 02400019 * K = 1 OR 2 (WHICH TAPE) 02410019 * BUF = OUTPUT ARRAY 02420019 * N = NUMBER OF BYTES TO WRITE R15 = 0 GOOD WRITE 02430019 * &9999 = ERR EXIT LABEL R15 = 4 ERR ON WRITE 02440019 * ---------------------------------------------------------- 02450019 LR R10,R1 PARM ADDRESS 02460019 LM R2,R4,PARMS @ OF DCB,DATA,LEN 02470019 L R4,0(,R4) LENGTH 02480019 LR R5,R3 02490019 LR R6,R4 NUMBER OF BYTES TO WRITE 02500019 EEXCP CCWWRL,D=R5,L=R6 WRITE IT 02510019 TM ECB,X'7F' IS WRITE GOOD 02520019 BO *+8 YES 02530019 LA R15,4 02540019 RESTORE 02550019 BR R14 02560019 EJECT 02570019 RWTAPE SAVEIT RWTAPE 02580019 * CALL RWTAPE(K) REWIND TAPE 02590019 * K = 1 OR 2 (WHICH TAPE) 02600019 * ---------------------------------------------------------- 02610019 LR R10,R1 PARM ADDRESS 02620019 EEXCP CCWRW 02630019 RESTORE 02640019 BR R14 02650019 EJECT 02660019 FSREC SAVEIT FSREC 02670019 * CALL FSREC(K,N) FORWARD-SPACE RECORD 02680019 * K = 1 OR 2 (WHICH TAPE) 02690019 * N = NUMBER OF REC (INPUT) (MUST BE A VARIABLE) 02700019 * = NUMBER OF REC (OUTPUT) NOT PROCESSED 02710019 * BECAUSE OF EOF 02720019 * ---------------------------------------------------------- 02730019 LR R10,R1 PARM ADDRESS 02740019 LM R2,R3,PARMS DCB & SKIP # 02750019 L R4,0(R3) FILES TO SKIP 02760019 C R4,F0 02770019 BNH FSRET 02780019 FSREE DS 0H FOWARD SPACE REC 02790019 EEXCP CCWFSR 02800019 TM WIOB+12,X'03' EOF? 02810019 BM *+8 02820019 BCT R4,FSREE DO N TIMES 02830019 ST R4,0(R3) 02840019 FSRET RESTORE 02850019 BR R14 02860019 EJECT 02870019 BSREC SAVEIT BSREC 02880019 * CALL BSREC(K,N) BACKWARD-SPACE RECORD 02890019 * K = 1 OR 2 (WHICH TAPE) 02900019 * N = NUMBER OF REC (INPUT) (MUST BE A VARIABLE) 02910019 * = NUMBER OF REC (OUTPUT) NOT PROCESSED 02920019 * BECAUSE OF EOF 02930019 * ---------------------------------------------------------- 02940019 LR R10,R1 PARM ADDRESS 02950019 LM R2,R3,PARMS DCB & SKIP # 02960019 L R4,0(R3) RECORDS TO BACKSPACE 02970019 C R4,F0 02980019 BNH BSRET 02990019 BSREE DS 0H BACKWARD SPACE REC 03000019 EEXCP CCWBSR 03010019 TM WIOB+12,X'03' EOF? 03020019 BM *+8 03030019 BCT R4,BSREE DO N TIMES 03040019 ST R4,0(R3) 03050019 BSRET RESTORE 03060019 BR R14 03070019 EJECT 03080019 FSFILE SAVEIT FSFILE 03090019 * CALL FSFILE(K) FORWARD-SPACE FILE 03100019 * K = 1 OR 2 (WHICH TAPE) 03110019 * ---------------------------------------------------------- 03120019 SFILE EQU FSFILE 03130019 LR R10,R1 PARM ADDRESS 03140019 EEXCP CCWFSF FOWARD SPACE FILE 03150019 RESTORE 03160019 BR R14 03170019 EJECT 03180019 BSFILE SAVEIT BSFILE 03190019 * CALL BSFILE(K) BACKWARD-SPACE FILE 03200019 * K = 1 OR 2 (WHICH TAPE) 03210019 * ---------------------------------------------------------- 03220019 LR R10,R1 PARM ADDRESS 03230019 EEXCP CCWBSF BACKWARD SPACE FILE 03240019 RESTORE 03250019 BR R14 03260019 EJECT 03270019 WTMARK SAVEIT WTMARK 03280019 * CALL WTMARK(K) WRITE TAPE MARK 03290019 * K = 1 OR 2 (WHICH TAPE) 03300019 * ---------------------------------------------------------- 03310019 LR R10,R1 PARM ADDRESS 03320019 EEXCP CCWWTM WRITE TAPE MARK 03330019 WTEOF RESTORE 03340019 BR R14 03350019 EJECT 03360019 OPENT SAVEIT OPENT 03370019 * CALL OPENT(K,L) OPEN TAPE 03380019 * K = 1 OR 2 (WHICH TAPE) 03390019 * L = 1 FOR INPUT 03400019 * L = 2 FOR OUTPUT 03410019 * ---------------------------------------------------------- 03420019 LR R10,R1 PARM ADDRESS 03430019 BAL R9,TAPEDCB SET CURRENT DCBT 03440019 L R2,CURRDCBT GET CURRENT DCBT 03450019 L R3,$DDDCB(,R2) GET DCB 03460019 L R4,$DDFLAG(,R2) GET FLAGS 03470019 L R5,PARMOPEN @ OF PARMOPEN 1 OR 2 03480019 DEVTYPE $DDNAM(R2),DEVDT 03490019 CLC DEVD1,=F'0' IS A DD DUMMY 03500019 BNE XOPEN1 03510019 OI 0(R4),$NULL YES IT IS DD DUMMY 03520019 B OTRET EXIT THE OPEN. 03530019 XOPEN1 DS 0H 03540019 CLC F1,0(R5) OPEN FOR INPUT? 03550019 BE OPENIN 03560019 CLC F2,0(R5) OPEN FOR OUTPUT? 03570019 BE OPENOUT 03580019 B OPENERR 03590019 OPENIN DS 0H 03600019 OI 0(R4),$INPUT 03610019 MVC DEVD1,DEVDT COPY DEVTYPE 0519-11 03620019 TM DEVD1+02,X'80' IS THIS TAPE 0519-11 03630019 BZ NOTTAPE1 NO 0519-11 03640019 OPEN ((3),INPUT) 03650019 B OTRET 03660019 OPENOUT DS 0H 03670019 OI 0(R4),$OUTPUT 03680019 MVC DEVD2,DEVDT COPY DEVTYPE 0519-11 03690019 TM DEVD2+02,X'80' IS THIS TAPE 0519-11 03700019 BZ NOTTAPE2 NO 0519-11 03710019 OPEN ((3),OUTPUT) 03720019 B OTRET 03730019 OTRET L R13,SAVEOT+4 03740019 RETURN (14,12),RC=0 03750019 OPENERR DS 0H 03760019 WTO 'RTAPE, INVALID OPEN DCB NUMBER',ROUTCDE=11 03770019 ABEND 4 03780019 NOTTAPE1 DS 0H 0519-11 03790019 WTO 'RTAPE SYSUT1 NOT TAPE',ROUTCDE=11 0519-11 03800019 ABEND 101 03810019 NOTTAPE2 DS 0H 0519-11 03820019 WTO 'RTAPE SYSUT2 NOT TAPE',ROUTCDE=11 0519-11 03830019 ABEND 102 03840019 EJECT 03850019 CLOSET SAVEIT CLOSET 03860019 * CALL CLOSET(K,L) CLOSE TAPE 03870019 * K = 1 OR 2 (WHICH TAPE) 03880019 * L = 1 FOR INPUT 03890019 * L = 2 FOR OUTPUT 03900019 * ---------------------------------------------------------- 03910019 LR R10,R1 PARM ADDRESS 03920019 BAL R9,TAPEDCB 03930019 L R2,CURRDCBT GET CURRENT DCBT 03940019 L R3,$DDDCB(,R2) GET DCB 03950019 L R4,$DDFLAG(,R2) GET FLAGS 03960019 TM 0(R4),$INPUT+$OUTPUT OPENED AT ALL? 03970019 BZ CLOSERET 03980019 CLOSE ((3),REWIND) 03990019 CLOSERET DS 0H 04000019 RESTORE 04010019 LA R15,0 04020019 BR R14 04030019 *--------------------------------------------------------------------* 04040019 *--------------------------------------------------------------------* 04050019 * INTERNAL ROUTINES * 04060019 *--------------------------------------------------------------------* 04070019 *--------------------------------------------------------------------* 04080019 *--------------------------------------------------------------------* 04090019 * TAPEDCB SET CURRDCBT * 04100019 *--------------------------------------------------------------------* 04110019 DROP R12 04120019 TAPEDCB DS 0H 04130019 BALR R11,0 04140019 USING *,R11 04150019 XC CURRDCBT,CURRDCBT 04160019 L R1,PARMDCB 04170019 CLC F1,0(R1) IS IT SYSUT1 04180019 BE TAPEUT10 YES 04190019 CLC F2,0(R1) IS IT SYSUT2 04200019 BE TAPEUT20 YES 04210019 WTO 'RTAPE DCB VALID IN VALID',ROUTCDE=11 04220019 ABEND 2 04230019 TAPEUT10 DS 0H 04240019 LA R0,DDUT1 04250019 ST R0,CURRDCBT 04260019 BR R9 04270019 TAPEUT20 DS 0H 04280019 LA R0,DDUT2 04290019 ST R0,CURRDCBT 04300019 BR R9 04310019 DROP R11 04320019 EJECT 04330019 *--------------------------------------------------------------------* 04340019 * DATA * 04350019 *--------------------------------------------------------------------* 04360019 SAVE DS 18F 04370019 SAVEOT DS 18F 04380019 F0 DC F'0' 04390019 F1 DC F'1' 04400019 F2 DC F'2' 04410019 FFFF DC X'FFFF',AL2(0) 04420019 F64K DC A(X'0000FFFF') 04430019 * 04440019 CURRDCBT DC A(0) POINTS TO CURRENT DDUT BELOW 04450019 $DDNAM EQU 0 04460019 $DDFLAG EQU 8 04470019 $DDDCB EQU 12 04480019 * 04490019 DDUT1 DC CL8'SYSUT1',A(FLAG1),A(SYSUT1) 04500019 DDUT2 DC CL8'SYSUT2',A(FLAG2),A(SYSUT2) 04510019 * 04520019 FLAG1 DC X'00' 04530019 FLAG2 DC X'00' 04540019 $NULL EQU X'80' 04550019 $INPUT EQU X'40' 04560019 $OUTPUT EQU X'20' 04570019 DUM DS C 04580019 *--------------------------------------------------------------------* 04590019 * CCW AND IOB * 04600019 *--------------------------------------------------------------------* 04610019 DC 0D'0',CL8'IOB HERE' 04620019 WIOB DC 7D'0' 04630019 WIOBLN EQU *-WIOB 04640019 DC 0D'0',CL8'CCW HERE' 04650019 CCWS DC 8D'0' WORKING CCWS 04660019 ECB DC F'0' 04670019 ECBA DC AL3(ECB),X'00' 04680019 * 04690019 WDEC DC 2D'0' WORKING STORAGE 04700019 DEVDT DC F'0' DEVTYPE FOR GENERIC DEVTYPE 0519-11 04710019 DEVD1 DC F'0' DEVTYPE FOR SYSUT1 0519-11 04720019 DEVD2 DC F'0' DEVTYPE FOR SYSUT2› 0519-11 04730019 * 04740019 XJFCB1 DC 0F'0',X'87',AL3(JFCB1) 04750019 XJFCB2 DC 0F'0',X'87',AL3(JFCB2) 04760019 JFCB1 DC 0F'0',CL176' ' 04770019 JFCB2 DC 0F'0',CL176' ' 04780019 EJECT 04790019 SYSUT1 DCB DDNAME=SYSUT1,DSORG=PS,RECFM=U,BUFNO=2, X04800019 OPTCD=Z,EXLST=XJFCB1, DCBE=SYSUT1E, X04810019 DEVD=TA,EODAD=RDEOF,MACRF=(E),BUFOFF=0 04820019 SYSUT1E DCBE BLKSIZE=256*1024 04830019 EJECT 04840019 SYSUT2 DCB DDNAME=SYSUT2,DSORG=PS,RECFM=U,BUFNO=2, X04850019 OPTCD=Z,EXLST=XJFCB2, DCBE=SYSUT2E, X04860019 DEVD=TA,EODAD=RDEOF,MACRF=(E),BUFOFF=0 04870019 SYSUT2E DCBE BLKSIZE=256*1024 04880019 LTORG , 04890019 DROP , 04900019 $DC EQU X'80' 04910019 $CC EQU X'40' 04920019 $SLI EQU X'20' 04930019 * CMD ,BUFFER ADDR ,FLGS ,LENGTH 04940019 USING BUF1,R9 04950019 CCWRDN CCW X'06',65535*0,$SLI,X'FFFF' READ NORMAL 04960019 CCWRDNLN EQU *-CCWRDN 04970019 CCWWRN CCW X'01',65535*0,$SLI,X'FFFF' WRITE NORMAL 04980019 CCWWRNLN EQU *-CCWWRN 04990019 CCWRDL CCW X'02',65535*0,$DC+$SLI,X'FFFF' READ LARGE 05000019 CCW X'00',65535*1,$DC+$SLI,X'FFFF' 05010019 CCW X'00',65535*2,$DC+$SLI,X'FFFF' 05020019 CCW X'00',65535*3,$DC+$SLI,X'FFFF' 05030019 CCW X'00',65535*4,$SLI,4 05040019 CCWRDLLN EQU *-CCWRDL 05050019 CCWWRL CCW X'01',65535*0,$DC+$SLI,X'FFFF' WRITE LARGE 05060019 CCW X'00',65535*1,$DC+$SLI,X'FFFF' 05070019 CCW X'00',65535*2,$DC+$SLI,X'FFFF' 05080019 CCW X'00',65535*3,$DC+$SLI,X'FFFF' 05090019 CCW X'00',65535*4,$SLI,4 05100019 CCWWRLLN EQU *-CCWWRL 05110019 CCWRW CCW X'07',DUM,$SLI,1 REWIND TAPE 05120019 CCWRWLN EQU *-CCWRW 05130019 CCWWTM CCW X'1F',DUM,$SLI,1 WRITE TAPE MARK 05140019 CCWWTMLN EQU *-CCWWTM 05150019 CCWFSF CCW X'3F',DUM,$SLI,1 FOWARD SPACE FILE 05160019 CCWFSFLN EQU *-CCWFSF 05170019 CCWBSF CCW X'2F',DUM,$SLI,1 BACK SPACE FILE 05180019 CCWBSFLN EQU *-CCWBSF 05190019 CCWFSR CCW X'37',DUM,$SLI,1 FOWARD SPACE RECORD 05200019 CCWFSRLN EQU *-CCWFSR 05210019 CCWBSR CCW X'2F',DUM,$SLI,1 BACK SPACE RECORD 05220019 CCWBSRLN EQU *-CCWBSR 05230019 BUF1 DS X 05240019 EJECT , 05250019 *--------------------------------------------------------------------* 05260019 * DSECTS * 05270019 *--------------------------------------------------------------------* 05280019 PARMS DSECT , 05290019 PARMDCB DS A DCB @ -> F'1' OR F'2' 05300019 PARMDATA DS A READ/WRITE @ OF BUFFER 05310019 PARMOPEN EQU PARMDATA OPEN @ -> F'1' INPUT, F'2' OUTPUT 05320019 PARMSKIP EQU PARMDATA FSR/BSR @ -> COUNT OF RECORDS TO SKIP 05330019 PARMLEN DS A READ/WRITE @ OF LENGTH 05340019 * 05350019 IEZIOB DSECT=YES 05360019 YREGS , 05370019 END 05380019