*TITLEUSDCBS -- RETURN DCB IN GETMAINED AREA 00010000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** *A AUTHOR RALPH MCMILLAN 00020000 *A DESIGNER RALPH MCMILLAN 00030000 *A LANGUAGE ASSEMBLER 00040000 *A SYSTEM IBM 00050000 *A WRITTEN 10-22-87 00060000 * REVISED 00070000 * 2-24-89 REM ADD BDAM DCB TO TYPE 00080000 *A 00090000 *A 00100000 *A CALL USDCBS (DCBF, DDNAME, RECFM, DCBADR, ERR) 00110000 *A 00120000 *A IN/OUT ARGUMENT TYPE DESCRIPTION 00130000 *A 00140000 *A IN DCBF I4 0 - RETURN QSAM DCB 00150000 *A 1 - RETURN BSAM DCB FOR CREATING DIRECT 00160000 *A ACCESS DATA SET. 00170000 *A 2 - RETURN BDAM DCB 00180000 *A 00190000 *A IN DDNAME CH8 DDNAME TO BE USED 00200000 *A 00210000 *A IN RECFM CH4 RECORD FORMAT TO USED BY DCB 00220000 *A 00230000 *A OUT DCBAD I4 ADDRESS OF DATA CONTROL BLOCK. THE DCB 00240000 *A AREA WILL BE OBTAINED WITH A GETMAIN 00250000 *A MACRO. THE AREA WILL INCLUDE TWO CONTROL 00260000 *A WORDS PRECEDING THE DCB. 00270000 *A WORD ONE CONTAINS THE LENGTH OF THE AREA, 00280000 *A INCLUDING THE CONTROL WORDS. 00290000 *A WORD TWO IS NOT USED (5-31-82). 00300000 *A THE FIRST CONTROL WORD IS USED BY UGUNAL 00310000 *A TO RELEASE THE DCB AREA. 00320000 *A DCBAD POINTS TO THE DCB ITSELF, NOT TO 00330000 *A THE FIRST CONTROL WORD. 00340000 *A DCB PARAMETERS USED: SEE BELOW. 00350000 *A 00360000 *A OUT ERR I4 ERROR CODE. 00370000 *A 0 = OK. 00380000 *A 1 = DCBF INVALID 00390000 *A 2 = GETMAIN (FOR DCB AREA) FAILED. 00400000 *A 00410000 *A THIS PROGRAM ISSUES A GETMAIN FOR A DCB, MOVES A PATTERN DCB TO 00420000 *A THE NEW AREA, SETS THE RECORD FORMAT BITS, AND STORES THE DDNAME. 00430000 *A 00440000 *A DCBF=0 DCBF=1 00450000 *A 00460000 *A ACCESS QSAM BSAM 00470000 *A MACRF (GM,PM) WL 00480000 *A RECFM (FROM INPUT) F 00490000 *A DSORG PS PS 00500000 *AEND 00510000 * REGISTER ASSIGNMENTS. 00520000 FR0 EQU 0 00530000 FR2 EQU 2 00540000 FR4 EQU 4 00550000 FR6 EQU 6 00560000 SPACE 00570000 R0 EQU 0 WORK REGISTER. 00580000 R1 EQU 1 ADDRESS OF PARAMETER LIST. 00590000 R2 EQU 2 00600000 R3 EQU 3 00610000 R4 EQU 4 00620000 R5 EQU 5 00630000 R6 EQU 6 00640000 R7 EQU 7 00650000 R8 EQU 8 00660000 R9 EQU 9 00670000 R10 EQU 10 WORK REGISTER. 00680000 R11 EQU 11 " 00690000 R12 EQU 12 BASE REGISTER = ADDRESS OF USDCBS. 00700000 R13 EQU 13 ADDRESS OF SAVE AREA. 00710000 R14 EQU 14 SUBROUTINE LINKAGE = RETURN ADDRESS. 00720000 R15 EQU 15 SUBROUTINE LINKAGE, RETURN CODE, AND WORK. 00730000 * 00740000 * PRELIMINARY SECTION. SAVE REGS., ESTABLISH BASE REGS. 00750000 USDCBS CSECT 00760000 USING *,R15 00770000 B START 00780000 DC X'06',C'USDCBS ' 00790000 START STM R14,R12,12(R13) 00800000 ST R13,SAVE+4 00810000 LA R12,SAVE 00820000 ST R12,8(,R13) 00830000 LR R13,R12 00840000 SPACE 00850000 LR R12,R15 BASE REGISTER FOR PROGRAM. 00860000 DROP R15 00870000 USING USDCBS,R12 00880000 USING IHADCB,R8 IHADCB = NAME OF DCBD DSECT (DCB MAP). 00890000 **************** ADDRESSING MODE SWITCH ****************** EXT 00900000 USDCBS AMODE ANY EXT 00910000 USDCBS RMODE 24 EXT 00920000 LA R4,UGNEXT EXT 00930000 LA R5,RETURNIT EXT 00940000 BSM R5,R4 EXT 00950000 RETADD DC F'0' EXT 00960000 UGNEXT DS 0H EXT 00970000 ST R5,RETADD EXT 00980000 SPACE 3 00990000 * 01000000 LM R2,R6,0(R1) LOAD PARAMETER ADDRESSES. 01010000 L R2,0(,R2) R2 = VALUE OF DCBF. MUST 0, 1, OR 2 01020001 LTR R2,R2 01030000 BM A10 01040000 C R2,=F'2' 01050001 BNH A20 01060000 A10 LA R15,1 01070000 B RETURN 01080000 A20 SLL R2,2 01090000 * 01100000 * OBTAIN STORAGE FOR DATA CONTROL BLOCK. 01110000 * MOVE MODEL DCB TO AREA OBTAINED, 01120000 * PLACE DDNAME IN DCB. 01130000 * PLACE BLOCK SIZE IN DCB. 01140000 * 01150000 G00 L R11,DCBLEN(R2) GET STORAGE FOR SEISMIC DCB. 01160000 GETMAIN RC,LV=(R11) 01170000 LTR R15,R15 0 = OK, 01180000 BZ G10 4 = NO STORAGE ALLOCATED. 01190000 LA R15,2 GETMAIN FAILED. 01200000 B RETURN USE ERROR RETURN CODE 6. 01210000 SPACE 01220000 G10 LR R8,R1 R1 = ADDRESS OF AREA OBTAINED. 01230000 L R10,DCBADDR(R2) MOVE DCB TO AREA. 01240000 LR R9,R11 R10 = SOURCE, R8 = DESTINATION, 01250000 MVCL R8,R10 R11 = R9 = LENGTH OF MOVE. 01260000 LA R8,8(,R1) ADJUST R8 TO DCB ADDRESS. 01270000 ST R8,0(,R5) RETURN DCB ADDRESS TO CALLER. 01280000 ****** STH LRECL,DCBLRECL MOVE RECORD LENGTH TO DCB. 01290000 ****** STH BLKSIZ,DCBBLKSI MOVE BLOCK SIZE TO DCB. 01300000 MVC DCBDDNAM,0(R3) MOVE DDNAME TO DCB. 01310000 NI DCBRECFM,X'00' CLEAR RECFM BITS 01320000 CLI 0(R4),C'U' CHECK FOR RECFM='U' 01330000 BNE *+8 01340000 OI DCBRECFM,DCBRECU 01350000 CLI 0(R4),C'F' CHECK FOR RECFM='F' 01360000 BNE *+8 01370000 OI DCBRECFM,DCBRECF 01380000 CLI 1(R4),C'T' CHECK FOR TRACK OVERFLOW 01390000 BNE *+8 01400000 OI DCBRECFM,DCBRECTO 01410000 CLI 1(R4),C'B' CHECK FOR BLOCKED RECORDS 01420000 BNE *+8 01430000 OI DCBRECFM,DCBRECBR 01440000 SR R15,R15 NORMAL RETURN CODE. 01450000 SPACE 3 01460000 RETURN ST R15,0(,R6) SEND RETURN CODE TO CALLER. 01470000 **************** ADDRESSING RETURN ****************** EXT 01480000 L R5,RETADD EXT 01490000 BSM 0,R5 EXT 01500000 RETURNIT DS 0H EXT 01510000 L R13,SAVE+4 01520000 LM R0,R12,20(R13) LEAVE RETURN CODE IN R15. 01530000 L R14,12(,R13) 01540000 MVI 12(R13),X'FF' 01550000 BR R14 01560000 SAVE DS 18F 01570000 LTORG 01580000 EJECT 01590000 PRINT NOGEN 01600000 * DATA CONTROL BLOCKS--MODELS TO BE MOVED TO GETMAIN AREA. 01610000 * TWO CONTROL WORDS PRECEDE THE DCB. 01620000 * FIRST WORD CONTAINS LENGTH OF GETMAIN AREA. 01630000 * SECOND WORD NOT USED AT THIS TIME (5-28-82). 01640000 SPACE 01650000 DCBLEN DC A(QSAM2-QSAM1) 01660000 DC A(BSAM2-BSAM1) 01670000 DC A(BDAM2-BDAM1) 01680001 SPACE 01690000 DCBADDR DC A(QSAM1) 01700000 DC A(BSAM1) 01710000 DC A(BDAM1) 01720001 SPACE 01730000 DS 0D 01740000 QSAM1 DC A(QSAM2-QSAM1) QSAM DCB. 01750000 DC CL4'QSAM' 01760000 DCB DDNAME=QSAMFBDD, -01770000 DSORG=PS, -01780000 MACRF=(GM,PM), -01790000 RECFM=FB 01800000 QSAM2 EQU * 01810000 SPACE 01820000 DS 0D 01830000 BSAM1 DC A(BSAM2-BSAM1) BSAM DCB. 01840000 DC CL4'BSAM' 01850000 DCB DDNAME=QSAMUTDD, -01860000 DSORG=PS, -01870000 MACRF=(WL), -01880000 RECFM=F 01890000 BSAM2 EQU * 01900000 SPACE 01910001 DS 0D 01920001 BDAM1 DC A(BDAM2-BDAM1) BDAM DCB. 01930001 DC CL4'BDAM' 01940001 DCB DDNAME=BDAMFTDD, -01950001 DSORG=DA, -01960001 MACRF=(RIC,WIC), -01970001 RECFM=F, -01980001 OPTCD=RF 01990001 BDAM2 EQU * 02000001 SPACE 02010000 PRINT NOGEN 02020000 DCBD DSORG=PS,DEVD=DA 02030000 SPACE 02040000 END 02050000