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 

how to read the file dynamically in cobol

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


Joined: 15 Jul 2005
Posts: 2
Topics: 1
Location: chennai
PostPosted: Fri Jul 15, 2005 7:25 am    Post subject: how to read the file dynamically in cobol Reply with quote
i will receive the file name dynamically from jcl , how can we read the such files.
_________________
sudhakar
Back to top
View user's profile Send private message AIM Address Yahoo Messenger
bauer
Intermediate


Joined: 10 Oct 2003
Posts: 315
Topics: 49
Location: Germany
PostPosted: Sun Jul 17, 2005 1:33 pm    Post subject: Reply with quote
sudhakar_mf,

i cann't provide a cobol soulution, but an assembler macro for dynamic file allocation.

Pls let me know, wether with helps. If so, I will look to an some years old assembler code, to find out the macro name.

regards,
bauer
Back to top
View user's profile Send private message
bauer
Intermediate


Joined: 10 Oct 2003
Posts: 315
Topics: 49
Location: Germany
PostPosted: Mon Jul 18, 2005 2:05 am    Post subject: Reply with quote
sudhakar_mf,

update:

documentation see

Application Development Guide:
Authorized Assembler Language Programs

MVS/ESA System Product:
JES2 Version 4
JES3 Version 4

Document Number GC28-1645-05



Name of macro: DYNALLOC


regards,
bauer
Back to top
View user's profile Send private message
sudhakar_mf
Beginner


Joined: 15 Jul 2005
Posts: 2
Topics: 1
Location: chennai
PostPosted: Mon Jul 18, 2005 3:12 am    Post subject: Reply with quote
thanks bauer
can u send me the exact location of the document of that macro or can u send me the piece of code of that macro
_________________
sudhakar
Back to top
View user's profile Send private message AIM Address Yahoo Messenger
bauer
Intermediate


Joined: 10 Oct 2003
Posts: 315
Topics: 49
Location: Germany
PostPosted: Mon Jul 18, 2005 4:37 am    Post subject: Reply with quote
sudhakar_mf,


follwowing code sample uses PL/1 and the already mentioned assemblermacro.

dynamic allocate dataset

Code:


MYNAME   START
***********************************************************************
         SPACE
         YREGS
         SPACE
***********************************************************************
*        S T A R T  -  KONVENTIONEN                                   *
***********************************************************************
MYNAME   AMODE 31
MYNAME   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





dynamic free dataset

Code:

MYNAM2   START
***********************************************************************
         YREGS
***********************************************************************
*        S T A R T  -  KONVENTIONEN                                   *
***********************************************************************
MYNAM2   AMODE 31
MYNAM2   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





PL1 declarations


Code:


    DCL DatasetDynAlloc GENERIC (MYNAME WHEN(*)) ;
         DCL DatasetDynFree  GENERIC (MYNAM2 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  MYNAME 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  MYNAM2 EXT ENTRY OPTIONS(ASM,INTER,RETCODE);
 



Sample


Code:


 
         /* ALLOCATE DATASET */
         DatasetAlloc = '' ;
         DatasetAlloc.DDName = 'DDNAME' ;
         DatasetAlloc.DSN    = 'hlq.my.dataset' ;
         DatasetAlloc.Status = 8 ;       /* SHR */
         DatasetAlloc.DISPNO = 8 ;       /* KEEP */
         DatasetAlloc.DISPAB = 8 ;       /* KEEP */
         Call DatasetDynAlloc(DataSetAlloc) ;
         IF DatasetAlloc.Error ^= 0 THEN DO;
            SIGNAL Error ;
         END;
         ELSE DO;
         END;
 
 
         /* access dataset ......................................... */
         DCL DDNAME EXTERNAL FILE RECORD INPUT ;
         OPEN FILE (DDNAME) ;
         ....
         CLOSE FILE (DDNAME) ;
 
 
         /* FREE DATASET ........................................... */
         DatasetFree  = '' ;
         DatasetFree.DDName = 'DDNAME' ;
         DatasetFree.DSN    = 'hlq.my.dataset' ;
         Call DatasetDynFree(DataSetAlloc) ;
         IF DatasetFree.Error ^= 0 THEN DO;
            SIGNAL Error ;
         END;
         ELSE DO;
         END;
 





Typing the IBM document number GC28-1645-05 to Google, .. you will find the documentation.


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


Joined: 26 Nov 2002
Posts: 12376
Topics: 75
Location: San Jose
PostPosted: Wed Jul 27, 2005 9:26 am    Post subject: Reply with quote
sudhakar_mf,

Please search before posting. There are several examples showing dynamic allocation using BPXWDYN.

Check this link

http://www.mvsforums.com/helpboards/viewtopic.php?t=1905&highlight=bpxwdyn

Hope this helps...

Cheers

kolusu
_________________
Kolusu
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