COBOL example of storage management

Following is an example of how to manage storage for a COBOL program using callable services.

CBL LIB,QUOTE
      *Module/File Name: IGZTSTOR
      ************************************************************
      ** CE90STO - Call the following LE services:
      **           : CEE3RPH - Set report heading
      **           : CEECRHP - Create user heap
      **           : CEEGTST - obtain storage from user heap
      **           : CEECZST - change size of this piece of storage
      **           : CEEFRST - free this piece of storage
      **           : CEEDSHP - discard user heap
      **   This example illustrates the invocation of the LE
      **   Dynamic Storage Callable Services from a COBOL program.
      **   1.  A report heading is set for display at the beginning
      **       of the storage or options report.
      **   2.  A user heap is created.
      **   3.  Storage is allocated from the user heap.
      **   4.  A change is made to the size of the allocated storage.
      **   5.  The allocated storage is freed.
      **   6.  The user heap is discarded.
      ************************************************************
       IDENTIFICATION DIVISION.
       PROGRAM-ID. CE90STO.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
       01  RPTHEAD                 PIC X(80).
       01  HEAPID                  PIC S9(9) BINARY.
       01  HPSIZE                  PIC S9(9) BINARY.
       01  INCR                    PIC S9(9) BINARY.
       01  OPTS                    PIC S9(9) BINARY.
       01  ADDRSS                  USAGE IS POINTER.
       01  NBYTES                  PIC S9(9) BINARY.
       01  NEWSIZE                 PIC S9(9) BINARY.
       01  FC.
           02  Condition-Token-Value.
           COPY  CEEIGZCT.
               03  Case-1-Condition-ID.
                   04  Severity    PIC S9(4) BINARY.
                   04  Msg-No      PIC S9(4) BINARY.
               03  Case-2-Condition-ID
                         REDEFINES Case-1-Condition-ID.
                   04  Class-Code  PIC S9(4) BINARY.
                   04  Cause-Code  PIC S9(4) BINARY.
               03  Case-Sev-Ctl    PIC X.
               03  Facility-ID     PIC XXX.
           02  I-S-Info            PIC S9(9) BINARY.
       PROCEDURE DIVISION.
       0001-BEGIN-PROCESSING.
           DISPLAY "***************************************".
           DISPLAY "CE90STO COBOL Example is now in motion.".
           DISPLAY "***************************************".
           MOVE "User defined report heading" TO RPTHEAD.
      *************************************************************
      *   Call CEE3RPH to set the user defined report heading
      *************************************************************
           CALL "CEE3RPH" USING RPTHEAD, FC.
           IF NOT CEE000 THEN
               DISPLAY "Error in setting Report Heading"
               GOBACK
           END-IF.
      *************************************************************
      *   Call CEECRHP to create a user heap
      *************************************************************
           MOVE 0 TO HEAPID.
           MOVE 1 TO HPSIZE.
           MOVE 0 TO INCR.
           MOVE 0 TO OPTS.
           CALL "CEECRHP" USING HEAPID, HPSIZE, INCR, OPTS, FC.
           IF CEE000 of FC THEN
      *************************************************************
      *        Call CEEGTST to get storage from user heap
      *************************************************************
               MOVE 4000 TO NBYTES
               CALL "CEEGTST" USING HEAPID, NBYTES, ADDRSS, FC
               IF CEE000 of FC THEN
      *************************************************************
      *            Call CEECZST to change the size of heap element
      *************************************************************
                   MOVE 2000 TO NEWSIZE
                   CALL "CEECZST" USING ADDRSS, NEWSIZE, FC
                   IF CEE000 of FC THEN
                       PERFORM 100-FREE-ALL
                       DISPLAY "COBOL Storage example pgm ended"
                   ELSE
                       DISPLAY "Error in changing size of storage"
                   END-IF
               ELSE
                   DISPLAY "Error in obtaining storage from heap"
               END-IF
           ELSE
               DISPLAY "Error in creating user heap"
           END-IF.

           GOBACK.

       100-FREE-ALL.
      *************************************************************
      *     Call CEEFRST to free this storage from user heap
      *************************************************************
           CALL "CEEFRST" USING ADDRSS, FC.
           IF CEE000 of FC THEN
      *************************************************************
      *        Call CEEDSHP to discard user heap
      *************************************************************
               CALL "CEEDSHP" USING HEAPID, FC
               IF CEE000 THEN
                   NEXT SENTENCE
               ELSE
                   DISPLAY "Error discarding user heap"
               END-IF
           ELSE
               DISPLAY "Error freeing storage from heap"
           END-IF.