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.
[codesyntax lang=”cobol”]
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.
[/codesyntax]
I have added the subroutine that actually performs the IO write to verify that the allocation was successful.
[codesyntax lang=”cobol”]
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.
[/codesyntax]
Next we will review our driver or calling program.
[codesyntax lang=”cobol”]
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.
[/codesyntax]
Mr. Arch Brooks, Software Engineer, Brooks Computing Systems, LLC authored this article.