Joined: 20 Oct 2006 Posts: 1411 Topics: 26 Location: germany
Posted: Tue Jun 12, 2007 4:25 am Post subject:
using BPXWDYN, I found the the following code from a web search:
Code:
LOAD EP=BPXWDYN
LTR R15,R0
BZ LOADERR
OI PARML,X'80'
LA R1,PARML
BALR R14,R15
LTR R15,R15
BNZ ALLOCERR
B NEXT
PARML DC AL4(LENGTH)
LENGTH DC AL2(TEXTLEN)
LENGTH DC AL2(TEXTLEN)
TEXT DC C'ALLOC FI(DDOUT) DSN(TSJR.WDYN) NEW CATALOG '
* DC C'UNIT(3390) TRACKS SPACE(1,1) '
* DC C'DSORG(PS) RECFM(F,B) LRECL(80) BLKSIZE(0) '
TEXTLEN EQU *-TEXT
DDOUT DCB DSORG=PS,RECFM=FB,MACRF=(PM),BLKSIZE=0,LRECL=100, X
DDNAME=DDOUT
those items unique to your situation need to be changed. _________________ Dick Brenholtz
American living in Varel, Germany
Joined: 03 Jan 2003 Posts: 1014 Topics: 13 Location: Atlantis
Posted: Tue Jun 12, 2007 7:03 pm Post subject:
Code:
SVCTEST CSECT , Simplified SVC 99 invocation
SVCTEST AMODE 31 Generated to duplicate SVC
SVCTEST RMODE 24 call made by ISPF
BAKR 14,0 19:58 - 06/12/07
LR 12,15 Run this with TSO PROFILE WTP
USING SVCTEST,12 -----------------------------------
LA 1,S99RBPTR Get addr of parm list
LR 2,1 Save R1 for TSO TEST
SVC 99 Call Dynalloc
L 0,S99ERROR Save error code
NOPR 0 Place for TSO test breakpoint
PR , Return to caller
S99RBPTR DC A(X'80000000'+S99RB) Address of request block
S99RB DC AL1(20),AL1(1),XL2'6400' Allocate,Flags
S99ERROR DC AL2(0) Returned error code
S99INFO DC AL2(0) Returned info code
S99TXTPP DC A(TULIST,EXTBLOCK,0) Pointer to text units
TU0001 DC X'0001',AL2(1),AL2(8),CL8'ISP19581' DDNAME
TU0002 DC X'0002',AL2(1),AL2(44),CL44'USER1.PROJDEFS.LOAD' DSname
TU0003 DC X'0004',AL2(1),AL2(1),X'08' Status SHR
TU0004 DC X'0005',AL2(1),AL2(1),X'08' Norm disp KEEP
TU0005 DC X'0006',AL2(1),AL2(1),X'08' Cond disp KEEP
TU0006 DC X'0010',AL2(1),AL2(6),CL6'CSPU13' Volser
TU0007 DC X'0015',AL2(1),AL2(8),CL8'3390' Unit
TU0008 DC X'0052',AL2(0) Perm
TU0009 DC X'0056',AL2(1),AL2(44),CL44' ' Ret DSN
TU0010 DC X'0057',AL2(1),AL2(2),X'0000' Ret DSORG
TU0011 DC X'005D',AL2(1),AL2(6),CL6' ' Ret volsr
TULIST DC A(TU0001,TU0002,TU0003,TU0004,TU0005,TU0006,TU0007,TU0008)
DC A(TU0009,TU0010,TU0011+X'80000000')
EXTBLOCK DC CL6'S99RBX',X'01',X'C4',XL200'00' Ext. block.
END SVCTEST
Code:
SVCTEST CSECT , Simplified SVC 99 invocation
SVCTEST AMODE 31 Generated to duplicate SVC
SVCTEST RMODE 24 call made by ISPF
BAKR 14,0 20:12 - 06/12/07
LR 12,15 Run this with TSO PROFILE WTP
USING SVCTEST,12 -----------------------------------
LA 1,S99RBPTR Get addr of parm list
LR 2,1 Save R1 for TSO TEST
SVC 99 Call Dynalloc
L 0,S99ERROR Save error code
NOPR 0 Place for TSO test breakpoint
PR , Return to caller
S99RBPTR DC A(X'80000000'+S99RB) Address of request block
S99RB DC AL1(20),AL1(2),XL2'6400' Unallocate,Flags
S99ERROR DC AL2(0) Returned error code
S99INFO DC AL2(0) Returned info code
S99TXTPP DC A(TULIST,EXTBLOCK,0) Pointer to text units
TU0001 DC X'0001',AL2(1),AL2(8),CL8'ISP19581' DDNAME
TU0002 DC X'0007',AL2(0) Unalc
TULIST DC A(TU0001,TU0002+X'80000000')
EXTBLOCK DC CL6'S99RBX',X'01',X'C4',XL200'00' Ext. block.
END SVCTEST
Basic but compact examples... Change as needed such as adding better linkage. Also, real code should use mnemonics, but since this code is generated from traces of existing SVC calls, it just uses the raw values.
Because the question for dynamic allocation was sometimes posted, here and other internet forums, requested by collegues ..., now the solution for dynamic allocation and PL1.
First code the following assembler routine to invoke the DYNALLOC macro and assemble and linkedit this module. This module allocates the dataset.
Code:
DALLOC START
* *******************************************************************
* DALLOC: Dynamic allocate of PS/PO Datasets *
* *
* *
* MVS/ESA *
* *
* Application Development Guide: *
* Authorized Assembler Language Programs *
* *
* MVS/ESA System Product: *
* JES2 Version 4 *
* JES3 Version 4 *
* *
* Document Number GC28-1645-05 *
* *
* Program Number *
* 5695-047 *
* 5695-048 *
* *
* File Number S370/S390-40 *
* *
* *
* *******************************************************************
*
* DYNAMISCHES ALLOCIEREN EINER DATEI MIT MACRO DYNALLOC
* *
* FUER PS UND PO DATEIEN.
*
* ES GELTEN FOLGENDE DEFAULTWERTE:
* - DISP=(SHR,KEEP,KEEP)
* - DSORG=PO FALLS MEMBER ^= (BLANK)
* - DIRECTORY-BLOCKS = 1 FALLS DSORG=PO U. DISP=NEW
* - RECFM = FB FALLS DISP=NEW
* - LRECL = 80 FALLS DISP=NEW
* - BLKSIZE = 4000 FALLS DISP=NEW
* - SPACE=(TRK,(15,15)) FALLS DISP=NEW
*
* HINWEIS ZUR PROGRAMMIERUNG:
* FUER BESTIMMTE TEXTUNITS WERDEN DEFAULTS VORGEGEBEN,
* FALLS KEINE WERTE UEBERGEBEN WURDEN.
* ANDERE UNITS WERDEN NUR DANN BENUTZT, WENN WIRKLICH WERTE
* UEBERGEBEN WURDEN (D.H. KEIN DEFAULT).
*
***********************************************************************
SPACE
YREGS
SPACE
***********************************************************************
* S T A R T - KONVENTIONEN *
***********************************************************************
DALLOC AMODE 31
DALLOC RMODE ANY
SAVE (14,12)
DS 0H
STM 14,12,12(13) SAVE REGISTERS
BALR R12,0 LADEN ENTRY ADDRESS
USING *,R12 BASIS-REGISTER
ST R13,SAVEA+4 STORE REG 13 IN SAVEAREA
LA R13,SAVEA LADEN ADDR. D. SAVEAREA IN REG13
USING UEBERG,R4
L R4,0(R1) PARAMETER V. PLI-PGM
***********************************************************************
SPACE 2
MVC S99DDN,DDN
MVC S99DSN,DSN
*
MVI S99STAT,X'08' DEFAULT STATUS = SHR
CLI STATUS+1,X'00'
BE *+10
MVC S99STAT,STATUS+1
*
MVI S99DISN,X'08' DEFAULT DISPOSITON = KEEP
CLI DISPN+1,X'00'
BE *+10
MVC S99DISN,DISPN+1
*
MVI S99DISA,X'08' DEFAULT ABNORM. DISPOSITON = KEEP
CLI DISPA+1,X'00'
BE *+10
MVC S99DISA,DISPA+1
*
LA R3,TUPLISTO-TUPLIST LOAD OFFSET TO OPTIONAL TU'S
*
CLC MEMBER,=8C' '
BE NOMEMB
MVC S99DSO,=X'0200' DSORG = PO
MVC S99MEMB,MEMBER SET MEMBER NAME
LA R1,TUDSORG
ST R1,TUPLIST(R3) DEFINE TEXT UNIT DSORG
LA R1,TUMEMBER
ST R1,TUPLIST+4(R3) DEFINE TEXT UNIT MEMBERNAME
LA R3,8(,R3)
NOMEMB EQU *
CLC VOLSER,=6C' '
BE NOVOLUME
MVC S99VOL,VOLSER SET SPEC. VOLUME
LA R1,TUVOLUME
ST R1,TUPLIST(R3) DEFINE TEXT UNIT VOLUME
LA R3,4(,R3)
NOVOLUME EQU *
*
CLC UNIT,=6C' '
BE NOUNIT
MVC S99UNIT,UNIT SET SPEC. UNIT
LA R1,TUUNIT
ST R1,TUPLIST(R3) DEFINE TEXT UNIT 'UNIT'
LA R3,4(,R3)
NOUNIT EQU *
*
MVC S99BLK,BLKS SET SPEC. BLOCKSIZE
CLC BLKS,=X'0000'
BNE BLOCKSIZ
CLI S99STAT,X'04' STATUS = NEW ?
BNE NOBLOCK
MVC S99BLK,=H'4000' SET DEFAULT BLOCKSIZE
BLOCKSIZ LA R1,TUBLKSIZ
ST R1,TUPLIST(R3) DEFINE TEXT UNIT BLOCKSIZE
LA R3,4(,R3)
NOBLOCK EQU *
*
MVC S99LREC,LRECL SET SPEC. LRECL
CLC LRECL,=X'0000'
BNE RECLEN
CLI S99STAT,X'04' STATUS = NEW ?
BNE NOLRECL
MVC S99LREC,=H'80' SET DEFAULT LRECL
RECLEN LA R1,TULRECL
ST R1,TUPLIST(R3) DEFINE TEXT UNIT LRECL
LA R3,4(,R3)
NOLRECL EQU *
*
MVC S99RECF,RECFM+1 SET SPEC. RECFM
CLI RECFM+1,X'00'
BNE RECORDFM
CLI S99STAT,X'04' STATUS = NEW ?
BNE NORECFM
MVI S99RECF,X'90' SET DEFAULT RECFM
RECORDFM LA R1,TURECFM
ST R1,TUPLIST(R3) DEFINE TEXT UNIT RECFM
LA R3,4(,R3)
NORECFM EQU *
*
MVC S99BSPP+1(2),SPACP SET SPEC. PRIMARY SPACE
MVC S99BSPS+1(2),SPACS SET SPEC. SECOND. SPACE
CLC SPACP(4),=F'0'
BNE SETSPACE
CLI S99STAT,X'04' STATUS = NEW ?
BNE NOSPACE
MVC S99BSPP,=X'00000F' SET DEFAULT PRIM. SPACE
MVC S99BSPS,=X'00000F' SET DEFAULT SEC. SPACE
SETSPACE LA R1,TUTRACK
ST R1,TUPLIST(R3) DEFINE TEXT UNIT TRACK-ALLOCATION
LA R1,TUPRIMSP
ST R1,TUPLIST+4(R3) DEFINE TEXT UNIT PRIMARY SPACE
LA R1,TUSECSP
ST R1,TUPLIST+8(R3) DEFINE TEXT UNIT SECOND. SPACE
LA R3,12(,R3)
NOSPACE EQU *
*
MVC S99DIR+1(2),DIRECT SET DIRECTORY BLOCKS
CLC DIRECT,=X'0000'
BNE SETDIR
CLC S99DSO,=X'0200' DSORG = PO ?
BNE NODIR AND
CLI S99STAT,X'04' STATUS = NEW ?
BNE NODIR
MVC S99DIR,=X'000001' DEFAULT FOR DIRECTORY BL.
SETDIR LA R1,TUDIRBLK
ST R1,TUPLIST(R3) DEFINE TEXT UNIT DIR. BLOCKS
LA R3,4(,R3)
NODIR EQU *
*
L R1,=X'80000000' END OF TEXT UNITS
ST R1,TUPLIST(R3)
*
LA R1,S99RBPTR
DYNALLOC
***********************************************************************
MVC ERROR,S99ERR
MVC INFO,S99INFO
ENDE L R13,SAVEA+4
RETURN (14,12),RC=(15)
EJECT
***********************************************************************
* DEFINITIONEN
***********************************************************************
DS 0D
*
S99RBPTR DC A(S99RB+X'80000000') ADDR. REQUEST BLOCK + BIT0
S99RB DC AL1(20) LAENGE
S99VERB DC X'01' VERB CODE (DSNAME ALLOC)
S99FLAG1 DC X'0000' FLAGS1
S99ERR DC H'0' ERROR-CODE
S99INFO DC H'0' INFO-CODE
DC A(TUPLIST) ADDR. TEXT-UNITS POINTER LIST
DC F'0' RESERVED
DC F'0' FLAGS2
TUPLIST DC A(TUDDNAM) ADDR. TEXT-UNIT DDNAME
DC A(TUDSNAM) " DSNAME
DC A(TUSTATUS) " DS-STATUS
DC A(TUDISPN) " NORMAL DISPOSITION
DC A(TUDISPA) " ABNORMAL DISP.
TUPLISTO DS 15F ROOM FOR OPTIONAL TEXT UNITS
*
TUDDNAM DC X'0001' KEY DDNAME
DC X'0001' NUMBER
DC AL2(L'S99DDN) LAENGE
S99DDN DS CL8 DDNAME
TUDSNAM DC X'0002' KEY DSNAME
DC X'0001' NUMBER
DC AL2(L'S99DSN) LAENGE
S99DSN DS CL44 DSNAME
TUSTATUS DC X'0004' KEY STATUS
DC X'0001' NUMBER
DC X'0001' LAENGE
S99STAT DS X DATASET STATUS (1=OLD,2=MOD,
* 4=NEW,8=SHR)
TUDISPN DC X'0005' KEY DISPOS. NORMAL
DC X'0001' NUMBER
DC X'0001' LAENGE
S99DISN DS X DATASET DISPOS.(1=UNCATLG,2=CATLG,
* 4=DELETE,8=KEEP)
TUDISPA DC X'0006' KEY DISPOS. ABEND
DC X'0001' NUMBER
DC X'0001' LAENGE
S99DISA DS X DATASET DISPOS.(1=UNCATLG,2=CATLG,
* 4=DELETE,8=KEEP)
TUDSORG DC X'003C' KEY DSORG
DC X'0001' NUMBER
DC X'0002' LAENGE
S99DSO DS XL2 DSORG (PS = X'4000')
TUTRACK DC X'0007' KEY TRKS
DC X'0000' NUMBER
TUPRIMSP DC X'000A' KEY PRIM. SPACE
DC X'0001' NUMBER
DC X'0003' LAENGE
S99BSPP DS XL3 SPACE PRIM.
TUSECSP DC X'000B' KEY SECOND. SPACE
DC X'0001' NUMBER
DC X'0003' LAENGE
S99BSPS DS XL3 SPACE SECOND
TUVOLUME DC X'0010' KEY VOLSER
DC X'0001' NUMBER
DC AL2(L'S99VOL) LAENGE
S99VOL DS CL6 VOLSER KEIN DEFAULT
TUUNIT DC X'0015' KEY UNIT
DC X'0001' NUMBER
DC AL2(L'S99UNIT) LAENGE
S99UNIT DS CL6 UNIT KEIN DEFAULT
TUBLKSIZ DC X'0030' KEY BLKSIZE
DC X'0001' NUMBER
DC X'0002' LAENGE
S99BLK DS XL2 BLKSIZE (4000)
TULRECL DC X'0042' KEY LRECL
DC X'0001' NUMBER
DC X'0002' LAENGE
S99LREC DS XL2 LRECL (80)
TURECFM DC X'0049' KEY RECFM
DC X'0001' NUMBER
DC X'0001' LAENGE
S99RECF DS X RECFM (64=V,128=F,)
* (80=VB,144=FB)
*UPERM DC X'0052' KEY PERMANENT ALLOCATION
* DC X'0000' NUMBER
TUMEMBER DC X'0003' KEY MEMBER B. PART. DS
DC X'0001' NUMBER
DC AL2(L'S99MEMB) LAENGE
S99MEMB DS CL8 MEMBER-NAME
TUDIRBLK DC X'000C' KEY DIRECTORY BLOCKS
DC X'0001' NUMBER
DC X'0003' LAENGE
S99DIR DS XL3 DIRECTORY BLOCKS
*
SAVEA DS 18F
LTORG
UEBERG DSECT
DDN DS CL8
DSN DS CL44
MEMBER DS CL8
STATUS DS XL2
DISPN DS XL2
DISPA DS XL2
SPACP DS XL2
SPACS DS XL2
DIRECT DS XL2
VOLSER DS CL6
UNIT DS CL6
BLKS DS XL2
LRECL DS XL2
RECFM DS XL2
ERROR DS XL2
INFO DS XL2
*
END
This module is for deallocate.
Code:
DFREE START
* *******************************************************************
* DFREE: DYNAMIC DEALLOCATE OF PS/PO DATASETS *
* *
* *
* MVS/ESA *
* *
* Application Development Guide: *
* Authorized Assembler Language Programs *
* *
* MVS/ESA System Product: *
* JES2 Version 4 *
* JES3 Version 4 *
* *
* Document Number GC28-1645-05 *
* *
* Program Number *
* 5695-047 *
* 5695-048 *
* *
* File Number S370/S390-40 *
* *
* *
* *******************************************************************
*
***********************************************************************
*
* DYNAMISCHES UNALLOCIEREN EINER DATEI MIT MACRO DYNALLOC
* DIE ZUVOR DYNAMISCH ALLOCIERT WURDE
*
***********************************************************************
* REGISTER-NAMEN
***********************************************************************
YREGS
***********************************************************************
* S T A R T - KONVENTIONEN *
***********************************************************************
DFREE AMODE 31
DFREE RMODE ANY
SAVE (14,12)
BALR R3,0 LADEN ENTRY ADDRESS
USING *,R3 REG 3 BASIS-REGISTER
USING UEBERG,R4
ST R13,SAVEA+4 STORE REG 13 IN SAVEAREA
LA R13,SAVEA LADEN ADDR. D. SAVEAREA IN REG13
L R4,0(R1) PARAMETER V. PLI-PGM
EJECT
***********************************************************************
MVC S99DDN,DDN
MVC S99DSN,DSN
*
CLC MEMBER,=8C' '
BE *+14
MVC S99MEMB,MEMBER PART. DATASET
B *+8
OI S99TUPLN,X'80' ENDE TEXTUNITS BEI SEQU.
*
LA R1,S99RBPTR
DYNALLOC
SPACE 2
***********************************************************************
MVC ERROR,S99ERR
MVC INFO,S99INFO
ENDE L R13,SAVEA+4
RETURN (14,12),RC=(15)
EJECT
***********************************************************************
* DEFINITIONEN
***********************************************************************
DS 0D
S99RBPTR DC A(S99RB+X'80000000') ADDR. REQUEST BLOCK + BIT0
S99RB DC AL1(20) LAENGE
S99VERB DC X'02' VERB CODE (DSNAME UNALLOC)
S99FLAG1 DC X'F000' FLAGS1
S99ERR DC H'0' ERROR-CODE
S99INFO DC H'0' INFO-CODE
DC A(S99TUPL) ADDR. TEXT-UNITS BEGIN
DC F'0' RESERVED
DC F'0' FLAGS2
S99TUPL DC A(S99TU01) ADDR. TEXT-UNIT 01
DC A(S99TU02) " 02
S99TUPLN DC A(S99TU03) " 03
DC A(S99TU04+X'80000000') " 04 + ENDE-BIT
S99TU01 DC X'0001' KEY DDNAME
DC X'0001' NUMBER
DC AL2(L'S99DDN) LAENGE
S99DDN DC CL8' ' DDNAME
S99TU02 DC X'0002' KEY DSNAME
DC X'0001' NUMBER
DC AL2(L'S99DSN) LAENGE
S99DSN DC CL44' ' DSNAME
S99TU03 DC X'0007' UNALLOC DDNAME/DSNAME
DC X'0000' NUMBER
S99TU04 DC X'0003' KEY MEMBER B. PART. DS
DC X'0001' NUMBER
DC AL2(L'S99MEMB) LAENGE
S99MEMB DC CL8' ' MEMBER-NAME
*
SAVEA DS 18F
LTORG
UEBERG DSECT
DDN DS CL8
DSN DS CL44
MEMBER DS CL8
ERROR DS XL2
INFO DS XL2
END
OPEN FILE (MYDATA) TITLE ('DD99');
READ FILE (MYDATA) INTO (DATA);
DO WHILE (^EOF) ;
PUT SKIP EDIT(DATA)(A);
READ FILE (MYDATA) INTO (DATA);
END;
CLOSE FILE (MYDATA);
Joined: 10 Oct 2003 Posts: 315 Topics: 49 Location: Germany
Posted: Wed Jun 22, 2022 9:59 am Post subject:
Hallo,
I'm responding to my own post from 2007 (!!).
I used the last days my own coding to allocate a new PS file (never done the last years, always PO files). This PS file allocation with DISP=NEW does not work using the provided assembler coding. Bug.
PS File allocation with DISP = SHR works with the above coding.
My solution: I use now BPXWDYN from PL/1, PS File, DISP=NEW. This works.
The bug in the above assembler coding for PS, DISP=NEW will not be fixed.
If anybody is interested in an general PL/1 code snippet for BPXWDYN, please let me know.
Joined: 10 Oct 2003 Posts: 315 Topics: 49 Location: Germany
Posted: Wed Jun 22, 2022 1:52 pm Post subject:
Hi *,
this PL/1 code snippet creates a new dataset, DSORG = PS, LRECL=80 in the zOS file system, writes one line and close the dataset. After execution the dataset is cataloged.
Details for all parameters to BPXWDYN can be found in the IBM documentation.
To be 100% clean an RELEASE might be nice for the fetched entry.
Code:
DCL X FILE RECORD OUTPUT;
DCL Y CHAR(80) AUTO INIT('Testline');
DCL PLIRETV BUILTIN ;
DCL BPXWDYN EXT ENTRY OPTIONS (ASM INTER RETCODE);
DCL ALLOC CHAR(256) VAR AUTO NOINIT;
DCL FREE CHAR(256) VAR AUTO NOINIT;
Joined: 26 Nov 2002 Posts: 12367 Topics: 75 Location: San Jose
Posted: Wed Jun 22, 2022 8:11 pm Post subject:
bauer,
Thank you very much for sharing the code. Much appreciated. _________________ Kolusu - DFSORT Development Team (IBM)
DFSORT is on the Web at:
www.ibm.com/storage/dfsort
You cannot post new topics in this forum You cannot reply to topics in this forum You cannot edit your posts in this forum You cannot delete your posts in this forum You cannot vote in polls in this forum
FAQ
Search
Quick Manuals
Register
Profile
Log in to check your private messages
Log in
