207 lines
9.4 KiB
NASM
207 lines
9.4 KiB
NASM
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
|