MACRO , PATTERN FOR @@DYNAL'S DYNAMIC WORK AREA &NM DYNPAT &P=MISSING-PFX .* NOTE THAT EXTRA FIELDS ARE DEFINED FOR FUTURE EXPANSION .* &NM DS 0D ALLOCATION FIELDS &P.ARBP DC 0F'0',A(X'80000000'+&P.ARB) RB POINTER &P.ARB DC 0F'0',AL1(20,S99VRBAL,0,0) DC A(0,&P.ATXTP,0,0) SVC 99 REQUEST BLOCK &P.ATXTP DC 10A(0) &P.AXVOL DC Y(DALVLSER,1,6) &P.AVOL DC CL6' ' &P.AXDSN DC Y(DALDSNAM,1,44) &P.ADSN DC CL44' ' &P.AXMEM DC Y(DALMEMBR,1,8) &P.AMEM DC CL8' ' &P.AXDSP DC Y(DALSTATS,1,1) &P.ADSP DC X'08' DISP=SHR &P.AXFRE DC Y(DALCLOSE,0) FREE=CLOSE &P.AXDDN DC Y(DALDDNAM,1,8) DALDDNAM OR DALRTDDN &P.ADDN DC CL8' ' SUPPLIED OR RETURNED DDNAME &P.ALEN EQU *-&P.ARBP LENGTH OF REQUEST BLOCK SPACE 1 &P.URBP DC 0F'0',A(X'80000000'+&P.URB) RB POINTER &P.URB DC 0F'0',AL1(20,S99VRBUN,0,0) DC A(0,&P.UTXTP,0,0) SVC 99 REQUEST BLOCK &P.UTXTP DC A(X'80000000'+&P.UXDDN) &P.UXDDN DC Y(DUNDDNAM,1,8) &P.UDDN DC CL8' ' RETURNED DDNAME &P.ULEN EQU *-&P.URBP LENGTH OF REQUEST BLOCK &P.DYNLN EQU *-&P.ARBP LENGTH OF ALL DATA MEND , COPY MVSMACS COPY PDPTOP CSECT , PRINT GEN SPACE 1 *********************************************************************** * * * CALL @@DYNAL,(ddn-len,ddn-adr,dsn-len,dsn-adr),VL * * * * "-len" fields are self-defining values in the calling list, * * or else pointers to 32-bit signed integer values * * * * "ddn-adr" is the address of the DD name to be used. When the * * contents is hex zero or blank, and len=8, gets assigned. * * * * "dsn-adr" is the address of a 1 to 44 byte data set name of an * * existing file (sequential or partitioned). * * * * Calling @@DYNAL with a DDNAME and a zero length for the DSN * * results in unallocation of that DD (and a PARM error). * * * *---------------------------------------------------------------------* * * * Author: Gerhard Postpischil * * * * This program is placed in the public domain. * * * *---------------------------------------------------------------------* * * * Assembly: Any MVS or later assembler may be used. * * Requires SYS1.MACLIB * * Intended to work in any 24 and 31-bit environment. * * * * Linker/Binder: RENT,REFR,REUS * * * *---------------------------------------------------------------------* * Return codes: R15:04sssnnn it's a program error code: * * 04804 - GETMAIN failed; 1400000n PARM list error * * * * Otherwise R15:0-1 the primary allocation return code, and * * R15:2-3 the reason codes. * *********************************************************************** * Maintenance: new on 2008-06-07 * * * *********************************************************************** @@DYNAL FUNHEAD , DYNAMIC ALLOCATION LA R11,16(,R13) REMEMBER RETURN CODE ADDRESS MVC 0(4,R11),=X'04804000' PRESET LR R9,R1 SAVE PARAMETER LIST ADDRESS LA R0,DYNALDLN GET LENGTH OF SAVE AND WORK AREA GETMAIN RC,LV=(0) GET STORAGE LTR R15,R15 SUCCESSFUL ? BZ DYNALHAV YES STC R15,3(,R11) SET RETURN VALUES B DYNALRET RELOAD AND RETURN * * CLEAR GOTTEN STORAGE AND ESTABLISH SAVE AREA * DYNALHAV ST R1,8(,R13) LINK OURS TO CALLER'S SAVE AREA ST R13,4(,R1) LINK CALLER'S TO OUR AREA LR R13,R1 USING DYNALWRK,R13 MVC 0(4,R11),=X'14000001' PRESET FOR PARM LIST ERROR MVC DYNLIST(ALLDYNLN),PATLIST INITIALIZE EVERYTHING LDINT R4,0(,R9) DD NAME LENGTH L R5,4(,R9) -> DD NAME LDINT R6,8(,R9) DSN LENGTH L R7,12(,R9) -> DATA SET NAME * NOTE THAT THE CALLER IS EITHER COMPILER CODE, OR A COMPILER * LIBRARY ROUTINE, SO WE DO MINIMAL VALIDITY CHECKING * * PREPARE DYNAMIC ALLOCATION REQUEST LISTS * LA R0,ALLARB STCM R0,7,ALLARBP+1 REQUEST POINTER LA R0,ALLATXTP ST R0,ALLARB+8 TEXT UNIT POINTER LA R0,ALLAXDSN LA R1,ALLAXDSP LA R2,ALLAXDDN O R2,=X'80000000' STM R0,R2,ALLATXTP TEXT UNIT ADDRESSES * COMPLETE REQUEST WITH CALLER'S DATA * LTR R4,R4 CHECK DDN LENGTH BNP DYNALEXT OOPS CH R4,=AL2(L'ALLADDN) REASONABLE SIZE ? BH DYNALEXT NO BCTR R4,0 EX R4,DYNAXDDN MOVE DD NAME OC ALLADDN,=CL11' ' CONVERT HEX ZEROES TO BLANKS CLC ALLADDN,=CL11' ' NAME SUPPLIED ? BNE DYNALDDN YES MVI ALLAXDDN+1,DALRTDDN REQUEST RETURN OF DD NAME CH R4,=AL2(L'ALLADDN-1) CORRECT SIZE FOR RETURN ? BE DYNALNDD AND LEAVE R5 NON-ZERO B DYNALEXT NO DYNALDDN SR R5,R5 SIGNAL NO FEEDBACK * WHEN USER SUPPLIES A DD NAME, DO AN UNCONDITIONAL UNALLOCATE ON IT LA R0,ALLURB STCM R0,7,ALLURBP+1 REQUEST POINTER LA R0,ALLUTXTP ST R0,ALLURB+8 TEXT UNIT POINTER LA R2,ALLUXDDN O R2,=X'80000000' ST R2,ALLUTXTP TEXT UNIT ADDRESS MVC ALLUDDN,ALLADDN SET DD NAME LA R1,ALLURBP POINT TO REQUEST BLOCK POINTER DYNALLOC , REQUEST ALLOCATION DYNALNDD LTR R6,R6 CHECK DSN LENGTH BNP DYNALEXT OOPS CH R6,=AL2(L'ALLADSN) REASONABLE SIZE ? BH DYNALEXT NO STH R6,ALLADSN-2 SET LENGTH INTO TEXT UNIT BCTR R6,0 EX R6,DYNAXDSN MOVE DS NAME * ALLOCATE LA R1,ALLARBP POINT TO REQUEST BLOCK POINTER DYNALLOC , REQUEST ALLOCATION STH R15,0(,R11) PRIMARY RETURN CODE STH R0,2(,R11) REASON CODES LTR R5,R5 NEED TO RETURN DDN ? BZ DYNALEXT NO MVC 0(8,R5),ALLADDN RETURN NEW DDN, IF ANY B DYNALEXT AND RETURN DYNAXDDN MVC ALLADDN(0),0(R5) COPY DD NAME DYNAXDSN MVC ALLADSN(0),0(R7) COPY DATA SET NAME * PROGRAM EXIT, WITH APPROPRIATE RETURN CODES * DYNALEXT LR R1,R13 COPY STORAGE ADDRESS L R9,4(,R13) GET CALLER'S SAVE AREA LA R0,DYNALDLN GET ORIGINAL LENGTH FREEMAIN R,A=(1),LV=(0) AND RELEASE THE STORAGE LR R13,R9 RESTORE CALLER'S SAVE AREA DYNALRET FUNEXIT , RESTORE REGS; SET RETURN CODES LTORG , PUSH PRINT PRINT NOGEN DON'T NEED TWO COPIES PATLIST DYNPAT P=PAT EXPAND ALLOCATION DATA POP PRINT * DYNAMICALLY ACQUIRED STORAGE * DYNALWRK DSECT , MAP STORAGE DS 18A OUR OS SAVE AREA DYNLIST DYNPAT P=ALL EXPAND ALLOCATION DATA DYNALDLN EQU *-DYNALWRK LENGTH OF DYNAMIC STORAGE CSECT , RESTORE LTORG , SPACE 2 COPY CLIBSUPA * SPACE 2 PRINT NOGEN IHAPSA , MAP LOW STORAGE CVT DSECT=YES IKJTCB , MAP TASK CONTROL BLOCK IKJECT , MAP ENV. CONTROL BLOCK IKJPTPB , PUTLINE PARAMETER BLOCK IKJCPPL , IKJPSCB , IEZJSCB , IEZIOB , IEFZB4D0 , MAP SVC 99 PARAMETER LIST IEFZB4D2 , MAP SVC 99 PARAMETERS IEFUCBOB , MYTIOT DSECT , IEFTIOT1 , IHAPDS PDSBLDL=YES SPACE 1 IFGACB , GP14233 SPACE 1 IFGRPL , GP14233 IEFJESCT , IKJUPT , END