MVSFORUMS.com Forum Index MVSFORUMS.com
A Community of and for MVS Professionals
 
 FAQFAQ   SearchSearch   Quick Manuals   RegisterRegister 
 ProfileProfile   Log in to check your private messagesLog in to check your private messages   Log inLog in 

dynalloc dataset name

 
Post new topic   Reply to topic   printer-friendly view    MVSFORUMS.com Forum Index -> Application Programming
View previous topic :: View next topic  
Author Message
Earl
Beginner


Joined: 09 Jun 2007
Posts: 26
Topics: 1

PostPosted: Tue Jun 12, 2007 12:27 am    Post subject: dynalloc dataset name Reply with quote

does anyone have sample assembler code on how to dynamically allocate
a dataset on the fly ?

I have a need to open files using the dataset name as input
to my program.

//xx exec pgm=myprogram
//sysin dd *
DSN=ANYGDG.DATASET(0)
//
Back to top
View user's profile Send private message
dbzTHEdinosauer
Supermod


Joined: 20 Oct 2006
Posts: 1411
Topics: 26
Location: germany

PostPosted: Tue Jun 12, 2007 4:25 am    Post subject: Reply with quote

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
Back to top
View user's profile Send private message
dbzTHEdinosauer
Supermod


Joined: 20 Oct 2006
Posts: 1411
Topics: 26
Location: germany

PostPosted: Tue Jun 12, 2007 4:40 am    Post subject: Reply with quote

Also there is the CB-Tape collection Tape 653 has what you probably want.
_________________
Dick Brenholtz
American living in Varel, Germany
Back to top
View user's profile Send private message
bauer
Intermediate


Joined: 10 Oct 2003
Posts: 314
Topics: 48
Location: germany

PostPosted: Tue Jun 12, 2007 7:23 am    Post subject: Reply with quote

Earl,

are you talking about assembler macro DYNALLOC ?
Back to top
View user's profile Send private message
Earl
Beginner


Joined: 09 Jun 2007
Posts: 26
Topics: 1

PostPosted: Tue Jun 12, 2007 9:18 am    Post subject: Reply with quote

I was looking for assembler macro DYNALLOC.

Will try using the sample DICK provided using BPXWDYN,
providing the z/os site I'm at, grants me access to proper loadlib.

Thanks ! Smile
Back to top
View user's profile Send private message
Phantom
Data Mgmt Moderator
Data Mgmt Moderator


Joined: 07 Jan 2003
Posts: 1056
Topics: 91
Location: The Blue Planet

PostPosted: Tue Jun 12, 2007 9:33 am    Post subject: Reply with quote

Earl,

Its good that you got the solution that could solve your problem. But could I request you to post your queries in the right forum ?

We have the "Application Programming" forum for these kind of queries - including Assembler.

Thanks,
Phantom
Back to top
View user's profile Send private message
semigeezer
Supermod


Joined: 03 Jan 2003
Posts: 1014
Topics: 13
Location: Atlantis

PostPosted: Tue Jun 12, 2007 7:03 pm    Post subject: Reply with quote

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.
Back to top
View user's profile Send private message Visit poster's website
bauer
Intermediate


Joined: 10 Oct 2003
Posts: 314
Topics: 48
Location: germany

PostPosted: Wed Jun 13, 2007 2:01 am    Post subject: Reply with quote

Earl,

see this link: http://www.mvsforums.com/helpboards/viewtopic.php?t=6968&highlight=dynalloc

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                                                           









This is the PL1 sample program.

Code:




 TEST: PROC OPTIONS(MAIN) REORDER  ;                                   
                                                                       
                                                                       
   DCL DatasetDynAlloc GENERIC (DALLOC WHEN(*)) ;                       
   DCL DatasetDynFree  GENERIC (DFREE WHEN(*)) ;                       
                                                                       
   DCL 1 DatasetAlloc  UNAL,                                           
          2 DDNAME    CHAR(08),      /* DDNAME                 */       
          2 DSN       CHAR(44),      /* DSNAME                 */       
          2 MEMBER    CHAR(08),      /* MEMBER-NAME B. PO      */       
          2 STATUS    BIN FIXED(15), /* DS-STATUS 1=OLD,2=MOD, */       
                                     /*           4=NEW,8=SHR  */       
          2 DISPNO    BIN FIXED(15), /* 1=UNCATLG,2=CATLG,     */       
                                     /* 4=DELETE,8=KEEP        */       
          2 DISPAB    BIN FIXED(15), /* wie DISPNO             */       
          2 SPACPR    BIN FIXED(15), /* PRIM. SPACE IN TRKS    */       
          2 SPACSE    BIN FIXED(15), /* SECOND SPACE IN TRKS   */       
          2 DIRECT    BIN FIXED(15), /* DIRECT.-BLOCKS B. PO   */       
          2 VOLSER    CHAR(06),      /* VOLSER                 */       
          2 UNIT      CHAR(06),      /* UNIT                   */       
          2 BLKSIZ    BIN FIXED(15), /* BLKSIZE MAX. 32760     */       
          2 LRECL     BIN FIXED(15), /* LRECL   MAX. 32760     */       
          2 RECFM     BIN FIXED(15), /* RECFM 64=V,128=F,      */       
                                     /*       80=VB,144=FB     */       
          2 ERROR     BIN FIXED(15), /* ERROR-RETURNCODE       */       
          2 INFO      BIN FIXED(15); /* INFO-RETURNCODE        */       
   DCL  DALLOC EXT ENTRY OPTIONS(ASM,INTER,RETCODE);                   
                                                                       
   DCL 1 DatasetFree UNAL,                                             
          2 DDNAME    CHAR(08),      /* DSNAME                 */       
          2 DSN       CHAR(44),      /* DSNAME                 */       
          2 MEMBER    CHAR(08),      /* MEMBER-NAME B. PO      */       
          2 ERROR     BIN FIXED(15), /* ERROR-RETURNCODE       */       
          2 INFO      BIN FIXED(15); /* INFO-RETURNCODE        */       
   DCL  DFREE EXT ENTRY OPTIONS(ASM,INTER,RETCODE);                     
                                                                       
    DCL MYDATA FILE RECORD INPUT ;                                     
    DCL EOF BIT(1) AUTO INIT('0'B);                                     
    ON ENDFILE(MYDATA) EOF = '1'B;                                     
    DCL DATA CHAR(80) AUTO INIT('');                                   
                                                                       
    DataSetAlloc = '' ;                                                 
    DataSetAlloc.DDNAME = 'DD99';                                       
    DataSetAlloc.DSN    = 'USERID.DATA.LREC080' ;                       
    CALL DataSetDynAlloc(DataSetAlloc) ;                               
                                                                       
    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);                                               
                                                                       
    DataSetFree  = '' ;                                                 
    DataSetFree.DDNAME = 'DD99';                                       
    DataSetFree.DSN    = 'USERID.DATA.LREC080' ;                       
    CALL DataSetDynFree(DataSetFree) ;                                 
                                                                       
                                                                       
 END;                                                                   






Sorry for some german comments in the source code.
bauer
Back to top
View user's profile Send private message
Earl
Beginner


Joined: 09 Jun 2007
Posts: 26
Topics: 1

PostPosted: Wed Jun 13, 2007 8:46 am    Post subject: Reply with quote

Bauer,
Looks great ! and Danke vielmals!

Earl Very Happy
Back to top
View user's profile Send private message
bauer
Intermediate


Joined: 10 Oct 2003
Posts: 314
Topics: 48
Location: germany

PostPosted: Wed Jun 22, 2022 9:59 am    Post subject: Reply with quote

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. bonk

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.

kind regards,
bauer
Back to top
View user's profile Send private message
kolusu
Site Admin
Site Admin


Joined: 26 Nov 2002
Posts: 12354
Topics: 75
Location: San Jose

PostPosted: Wed Jun 22, 2022 11:19 am    Post subject: Reply with quote

bauer wrote:
If anybody is interested in an general PL/1 code snippet for BPXWDYN, please let me know.

kind regards,
bauer


Bauer,

I would really if you can post the PL/I code snippet here.

Thanks much
_________________
Kolusu - DFSORT Development Team (IBM)
DFSORT is on the Web at:
www.ibm.com/storage/dfsort

www.linkedin.com/in/kolusu
Back to top
View user's profile Send private message Send e-mail Visit poster's website
bauer
Intermediate


Joined: 10 Oct 2003
Posts: 314
Topics: 48
Location: germany

PostPosted: Wed Jun 22, 2022 1:52 pm    Post subject: Reply with quote

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;

ALLOC =    'ALLOC DD(OTTO)'
        || ' DSN(MY.HLQ.WORK.BAUER01)'
        || ' NEW CATALOG'
        || ' SPACE(10,5)'
        || ' LRECL(80)'
        || ' RECFM(F,B)'
        || ' DSORG(PS)'
        ;

FREE  =    'FREE DD(OTTO)'
        || ' DSN(MY.HLQ.WORK.BAUER01)'
        ;

FETCH BPXWDYN ;

CALL BPXWDYN (ALLOC);
IF PLIRETV() ^= 0 THEN SIGNAL ERROR;

OPEN FILE (X) TITLE('OTTO');
WRITE FILE (X) FROM(Y);
CLOSE FILE (X);

CALL BPXWDYN (FREE);
IF PLIRETV() ^= 0 THEN SIGNAL ERROR;



I hope this sample might help anybody,
kind regards,
bauer


Last edited by bauer on Thu Jun 23, 2022 12:26 pm; edited 1 time in total
Back to top
View user's profile Send private message
kolusu
Site Admin
Site Admin


Joined: 26 Nov 2002
Posts: 12354
Topics: 75
Location: San Jose

PostPosted: Wed Jun 22, 2022 8:11 pm    Post subject: Reply with quote

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

www.linkedin.com/in/kolusu
Back to top
View user's profile Send private message Send e-mail Visit poster's website
Display posts from previous:   
Post new topic   Reply to topic   printer-friendly view    MVSFORUMS.com Forum Index -> Application Programming All times are GMT - 5 Hours
Page 1 of 1

 
Jump to:  
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


MVSFORUMS
Powered by phpBB © 2001, 2005 phpBB Group