BCS MVS Dynamic File Allocation COBOL

It would be nice to dynamically allocate and free the files need for applications via COBOL. This article describes how a subroutine may be used to accomplish such a feat.

First we will examine the sub program that allow us to accomplish dynamic allocation. The BPXWDYN routine allows a text interface access to the allocate process.  The string command may be used but I found it did not exactly give me the result I desired so I used a couple existing programs to fill the bill.  The sub program ABS00004 that detects the end of the string performs most of the heavy lifting.

000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID.    ABS00018.
000300 AUTHOR.        ARCH BROOKS.
000400 INSTALLATION   BROOKS COMPUTING SYSTEMS, LLC.
000500 DATE-WRITTEN.  10/24/2014.
000600 DATE-COMPILED. 10/24/2014.
000700 ENVIRONMENT DIVISION.
000800 CONFIGURATION SECTION.
000900 SOURCE-COMPUTER. IBM-Z-OS.
001000 OBJECT-COMPUTER. IBM-Z-OS.
001100 INPUT-OUTPUT SECTION.
001200 FILE-CONTROL.
001300 DATA DIVISION.
001400 FILE SECTION.
001500 WORKING-STORAGE SECTION.
001600 01  PGM PIC X(8) VALUE 'BPXWDYN'.
001700 01  BUF-500 PIC X(500).
001800 01  CMD-BUF PIC X(250).
001900 01  RLEN PIC S9(9) COMP.
002000 01  RCOB PIC S9(9) COMP.
002100 LINKAGE SECTION.
002200 01  DDNAME PIC X(9).
002300 01  DSN PIC X(100).
002400 01  DISP PIC X(50).
002500 01  DCB PIC X(100).
002600 01  FREE-CMD PIC X(100).
002700 01  RC PIC S9(9) COMP.
002800 PROCEDURE DIVISION USING DDNAME DSN DISP DCB RC.
002900     MOVE 'ALLOC FI(' TO CMD-BUF.
003000     PERFORM 0010-DET-RCOB-LEN.
003100     MOVE DDNAME TO BUF-500.
003200     PERFORM 0020-GET-500-LEN.
003300     MOVE DDNAME TO CMD-BUF(RCOB:).
003400     PERFORM 0010-DET-RCOB-LEN.
003500     MOVE DSN TO BUF-500.
003600     PERFORM 0020-GET-500-LEN.
003700     MOVE ') DSN(' TO CMD-BUF(RCOB:).
003800     PERFORM 0010-DET-RCOB-LEN.
003900     MOVE DSN TO CMD-BUF(RCOB:).
004000     PERFORM 0010-DET-RCOB-LEN.
004100     MOVE ')' TO CMD-BUF(RCOB:).
004200     PERFORM 0010-DET-RCOB-LEN.
004300     MOVE DISP TO BUF-500.
004400     PERFORM 0020-GET-500-LEN.
004500     ADD 1 TO RCOB.
004600     PERFORM 0010-DET-RCOB-LEN.
004700     ADD 1 TO RCOB.
004800     MOVE DISP TO CMD-BUF(RCOB:).
004900     PERFORM 0010-DET-RCOB-LEN.
005000     PERFORM 0040-XQT-ALLOC.
005100     PERFORM 0030-LEAVE-PROGRAM.
005200     ENTRY 'ABS0018A' USING FREE-CMD RC.
005300     MOVE FREE-CMD TO CMD-BUF.
005400     PERFORM 0040-XQT-ALLOC.
005500     PERFORM 0030-LEAVE-PROGRAM.
005600 0010-DET-RCOB-LEN.
005700     MOVE CMD-BUF TO BUF-500.
005800     CALL 'ABS00004' USING BUF-500 RCOB.
005900     ADD 1 TO RCOB.
006000 0020-GET-500-LEN.
006100     CALL 'ABS00004' USING BUF-500 RLEN.
006200 0030-LEAVE-PROGRAM.
006300     GOBACK.
006400 0040-XQT-ALLOC.
006500     CALL PGM USING CMD-BUF.
006600     MOVE RETURN-CODE TO RC.

I have added the subroutine that actually performs the IO write to verify that the allocation was successful.

000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID.    ABS00003.
000300 AUTHOR.        ARCH BROOKS.
000400 INSTALLATION   BROOKS COMPUTING SYSTEMS, LLC.
000500 DATE-WRITTEN.  09/15/2014.
000600 DATE-COMPILED. 09/15/2014.
000700*
000800*
000900*  THIS PROGRAM IS DESIGNED TO WRITE RECORDS TO THE FILE.
001000*
001100*
001200*
001300*
001400 ENVIRONMENT DIVISION.
001500 INPUT-OUTPUT SECTION.
001600 FILE-CONTROL.
001700     SELECT F-FILE ASSIGN TO UT-S-FSOUT
001800     ORGANIZATION IS SEQUENTIAL.
001900 DATA DIVISION.
002000 FILE SECTION.
002100 FD  F-FILE
002200     DATA RECORD IS F-RECORD
002300     BLOCK CONTAINS 0 RECORDS
002400     RECORDING MODE IS F.
002500 01  F-RECORD PIC X(80).
002600 WORKING-STORAGE SECTION.
002700 LINKAGE SECTION.
002800 01  LSBUF PIC X(80).
002900 PROCEDURE DIVISION.
003000*  OPEN THE OUTPUT FILE
003100     OPEN OUTPUT F-FILE.
003200     PERFORM 0010-RETURN.
003300*  WRITE A RECORD
003400     ENTRY 'ABS0003A' USING LSBUF.
003500     WRITE F-RECORD FROM LSBUF.
003600     PERFORM 0010-RETURN.
003700*  CLOSE THE FILE
003800     ENTRY 'ABS0003B'.
003900     CLOSE F-FILE.
004000     PERFORM 0010-RETURN.
004100*  LETS GET OUT OF HERE
004200 0010-RETURN.
004300     GOBACK.

Next we will review our driver or calling program.

000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. ABM00026.
000300 AUTHOR. ARCH BROOKS.
000400 INSTALLATION BROOKS COMPUTING SYSTEMS, LLC.
000500 DATE-WRITTEN. 10/24/2014.
000600 DATE-COMPILED. 10/24/2014.
000700 ENVIRONMENT DIVISION.
000800 CONFIGURATION SECTION.
000900 SOURCE-COMPUTER. IBM-Z-OS.
001000 OBJECT-COMPUTER. IBM-Z-OS.
001100 INPUT-OUTPUT SECTION.
001200 FILE-CONTROL.
001300 DATA DIVISION.
001400 FILE SECTION.
001500 WORKING-STORAGE SECTION.
001600 01 DDNAME PIC X(9).
001700 01 DSN PIC X(100).
001800 01 DISP PIC X(50).
001900 01 DCB PIC X(100).
002000 01 RC PIC S9(9) COMP.
002100 01 OBUF PIC X(80).
002200 01 FREE-CMD PIC X(100).
002300 PROCEDURE DIVISION.
002400*
002500* PREPARE ALLOCATE STATEMENT
002600*
002700 MOVE 'FSOUT' TO DDNAME.
002800 MOVE 'AMBMVS.PDS.JCL(XXXALC)' TO DSN.
002900 MOVE 'SHR' TO DISP.
003000 MOVE ' ' TO DCB.
003100*
003200* INVOKE ALLOCATE STATEMENT
003300*
003400 CALL 'ABS00018' USING DDNAME DSN DISP DCB RC.
003500*
003600* OPEN OUTPUT FILE
003700*
003800 CALL 'ABS00003'.
003900 MOVE 'CCCC' TO OBUF.
004000*
004100* WRITE A RECORD TO OTPUT FILE
004200*
004300 CALL 'ABS0003A' USING OBUF.
004400 MOVE 'DDDD' TO OBUF.
004500*
004600* WRITE A RECORD TO OTPUT FILE
004700*
004800 CALL 'ABS0003A' USING OBUF.
004900*
005000* CLOSE OUTPUT FILE
005100*
005200 CALL 'ABS0003B'.
005300*
005400* PREPARE FREE COMMAND
005500*
005600 MOVE 'FREE FI(FSOUT)' TO FREE-CMD.
005700*
005800* INVOKE FREE COMMAND
005900*
006000 CALL 'ABS0018B' USING FREE-CMD RC.
006100 GOBACK.

Mr. Arch Brooks, Software Engineer, Brooks Computing Systems, LLC authored this article.

Leave a Reply