COBOL examples using CEEHDLR, CEEGTST, CEECZST, and CEEMRCR
The following program calls CEEHDLR to register a user-written
condition handler for the out-of-storage condition, calls CEEGTST
to allocate heap storage, and calls CEECZST to alter the size of the
heap storage requested.
CBL LIB,QUOTE,NODYNAM
*Module/File Name: IGZTOOSR
**************************************************************
* *
* CECNDXP - Call the following Language Environment *
* services: *
* *
* : CEEHDLR - Register user condition handler *
* : CEEGTST - Get Heap Storage *
* : CEECZST - Change the size of heap element *
* *
* 1. A user condition handler CECNDHD is registered. *
* 2. A large amount of HEAP storage is allocated. *
* 3. A subroutine CESUBXP is called that is known to *
* require a large amount of storage. It is not known *
* whether the storage for CESUBXP is available during *
* this run of the application. *
* 4. If sufficient storage for CESUBXP is not available, *
* a storage condition is generated by Language *
* Environment. *
* 5. CECNDHD gets control and sets resume at the *
* next instruction following the call to CESUBXP. *
* 6. A test for completion of CESUBXP is made after *
* the subroutine call. If CESUBXP did not complete, *
* a large amount of storage is freed, and CESUBXP *
* is invoked a second time. *
* 7. CESUBXP runs successfully once it has enough *
* storage available. *
* *
* Note: In order for this example to complete *
* successfully, the FREE suboption of the HEAP *
* runtime option must be in effect. *
**************************************************************
IDENTIFICATION DIVISION.
PROGRAM-ID. CECNDXP.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 TOKEN PIC X(4).
01 HEAPID PIC S9(9) BINARY.
01 HPSIZE PIC S9(9) BINARY.
01 NEWSIZE PIC S9(9) BINARY.
01 ADDRSS PIC S9(9) BINARY.
01 PGMPTR USAGE IS PROCEDURE-POINTER.
01 FEEDBACK.
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.
01 COMPLETED PIC X.
88 RAN VALUE "Y".
88 NOTRUN VALUE "N".
PROCEDURE DIVISION.
0001-BEGIN-PROCESSING.
*************************************************************
** Register user condition handler CECNDHD using CEEHDLR. **
*************************************************************
SET PGMPTR TO ENTRY "CECNDHD".
MOVE 97 TO TOKEN
CALL "CEEHDLR" USING PGMPTR TOKEN.
MOVE 0 TO HEAPID.
*************************************************************
** Allocate large amount of heap storage. **
*************************************************************
MOVE 500000 TO HPSIZE.
CALL "CEEGTST" USING HEAPID, HPSIZE, ADDRSS, FEEDBACK.
IF CEE000 OF FEEDBACK THEN
*************************************************************
** Call CESUBXP, which requires a large stack. **
*************************************************************
SET NOTRUN TO TRUE
CALL "CESUBXP" USING COMPLETED
*************************************************************
* Check whether CESUBXP completed, or failed with *
* storage condition. If CESUBXP did not run, *
* resize the heap element down by a large amount *
* and call it again. *
*************************************************************
IF NOTRUN THEN
DISPLAY "Reduce storage acquired BY main program"
" AND CALL CESUBXP again."
MOVE 300 TO NEWSIZE
CALL "CEECZST" USING ADDRSS, NEWSIZE
CALL "CESUBXP" USING COMPLETED
END-IF
ELSE
DISPLAY "Call TO GET Storage Failed WITH MESSAGE "
Msg-No OF FEEDBACK
END-IF.
GOBACK.
END PROGRAM CECNDXP.When any condition occurs in the main program, the user condition
handler CECNDHD (see the following program) receives control and tests
for the out-of-storage condition. If the out-of-storage condition
has occurred, then CECNDHD calls CEEMRCR to return to the instruction
in the main program after the subroutine call that produced the out-of-storage
condition.
CBL LIB,QUOTE,NODYNAM
*Module/File Name: IGZTOOSH
***********************************************************
* *
* CECNDHD - Call CEEMRCR to move the resume cursor *
* relative to the handle cursor. *
* *
* CECNDHD is a user condition handler that is registered *
* by the program CECNDXP. CECNDHD gets control from the *
* condition manager and tests for the STORAGE CONDITION. *
* If a STORAGE CONDITION is detected, the resume cursor *
* is moved so that control is returned to the caller of *
* the routine encountering the STORAGE CONDITION. *
* *
***********************************************************
IDENTIFICATION DIVISION.
PROGRAM-ID. CECNDHD.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 Movetyp PIC S9(9) BINARY.
01 Feedback.
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.
LINKAGE SECTION.
01 Current-condition.
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.
**
01 Token PIC X(4).
**
01 Result-code PIC S9(9) BINARY.
88 resume VALUE +10.
88 percolate VALUE +20.
88 perc-sf VALUE +21.
88 promote VALUE +30.
88 promote-sf VALUE +31.
01 New-condition.
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 USING current-condition, token,
result-code, new-condition.
***********************************************************
** Determine if entry was for OUT OF STORAGE condition. **
***********************************************************
IF CEE0PD OF current-condition THEN
DISPLAY "COBOL subroutine could NOT RUN because",
" of the insufficient storage condition."
***********************************************************
** Call CEEMRCR to move the resume cursor **
***********************************************************
MOVE 0 TO Movetyp
CALL "CEEMRCR" USING Movetyp, Feedback
IF CEE000 OF Feedback THEN
SET resume TO TRUE
ELSE
SET promote TO TRUE
MOVE feedback TO new-condition
END-IF
ELSE
SET percolate TO TRUE
END-IF
GOBACK.
END PROGRAM CECNDHD.The following program is a COBOL subroutine that causes the out-of-storage
condition.
CBL LIB,QUOTE,NODYNAM
*Module/File Name: IGZTOOSS
************************************************************
* *
* CESUBXP - *
* *
* When CESUBXP gets control, a request is made to *
* Language Environment to allocate storage for the *
* declared array W2. An out-of-storage condition takes *
* place, provided the caller has not allocated a large *
* amount of storage. *
* *
************************************************************
IDENTIFICATION DIVISION.
PROGRAM-ID. CESUBXP.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 ARRAY.
05 W2 PIC X OCCURS 3000000 TIMES.
LINKAGE SECTION.
01 PARM1 PIC X.
88 RAN-OK VALUE "Y".
PROCEDURE DIVISION USING PARM1.
PARA-CND01A.
MOVE "B" TO W2(2999999).
SET RAN-OK TO TRUE.
GOBACK.
End program CESUBXP.