PL/I 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.
*Process macro;
/***********************************************************/
/* */
/* CECNDXP - Call the following Language Environment */
/* services: */
/* - CEEHDLR - Register user condition handler */
/* - CEEGTST - Get heap storage */
/* - CEECZST - Change the size of heap element */
/* - CEEHDLU - Unregister user condition handler */
/* */
/* 1. A user condition handler CEENDHD is registered. */
/* 2. A large amount of HEAP storage is allocated. */
/* 3. A subroutine, Sub, is called which is known to */
/* require a large amount of storage. It is not known */
/* whether the storage for Sub is available during */
/* this run of the application. */
/* 4. If sufficient storage for Sub is not available, */
/* a storage condition is generated. */
/* 5. CECNDHD gets control and sets resume at the */
/* next instruction following the call to Sub. */
/* 6. A test for completion of Sub is made after */
/* the subroutine call. If Sub did not complete, */
/* a large amount of storage is freed, and Sub */
/* is invoked a second time. */
/* 7. Sub 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. */
/* */
/***********************************************************/
Cecndxp: proc options(main);
/**************************************************/
/* Important elements are found in these includes */
/* - feedback declaration */
/* - fbcheck macro call */
/* - condition tokens such as CEE000 */
/* - entry declarations such as ceehdlr */
/**************************************************/
%include ceeibmct;
%include ceeibmaw;
dcl Cecndhd external entry;
dcl 1 fback feedback;
dcl token fixed bin(31);
dcl newsize fixed bin(31);
dcl (heapid, hpsize) fixed bin(31);
dcl addrss pointer;
dcl ran char(1);
/*********************************************/
/* Register a user-written condition handler */
/*********************************************/
token = 97;
Call ceehdlr(Cecndhd, token, fback);
If fbcheck (fback, cee000) then
display ('registered user handler');
else
display ('CEEHDLR failed with message number ' ||
fback.MsgNo);
/*********************************************/
/* Allocate some HEAP storage, and then call */
/* subroutine Sub. When Sub becomes active, */
/* an out-of-storage condition arises if */
/* the region is too small. */
/*********************************************/
heapid = 0;
hpsize = 500000;
call ceegtst (heapid, hpsize, addrss, fback);
If fbcheck (fback, cee000) then ;
else
display ('CEEGTST failed with message number ' ||
fback.MsgNo);
ran = 'x';
ran = sub();
if ran ¬= 'r' then
do;
/*******************************************/
/* If Sub did not run, reduce the size of */
/* allocated storage and call Sub a 2nd */
/* time. */
/*******************************************/
newsize = 2000;
call ceeczst (addrss, newsize, fback);
If fbcheck (fback, cee000) then ;
else
display ('CEECZST failed with message number '
|| fback.MsgNo);
display ('Call subroutine for the 2nd time');
ran = sub();
end;
/*********************************************/
/* Unregister the user condition handler */
/*********************************************/
Call ceehdlu (Cecndhd, fback);
If fbcheck (fback, cee000) then ;
else
display ('CEEHDLU failed with message number ' ||
fback.MsgNo);
/*********************************************/
/* Internal subroutine Sub */
/*********************************************/
Sub: proc returns (char(1));
dcl big(3000000) char(1);
big(2999999) = 'B';
return('r');
end sub;
end Cecndxp;When any condition occurs in CECNDXP, the user condition handler
CECNDHD in 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.
*Process macro;
/****************************************************/
/* */
/* 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. */
/* */
/****************************************************/
Cecndhd: Proc (@condtok, @token, @result, @newcond)
options(byvalue);
%include ceeibmct;
%include ceeibmaw;
/* Parameters */
dcl @condtok pointer;
dcl @token pointer;
dcl @result pointer;
dcl @newcond pointer;
dcl 1 condtok based(@condtok) feedback;
dcl token fixed bin(31) based(@token);
dcl result fixed bin(31) based(@result);
dcl 1 newcond based(@newcond) feedback;
dcl 1 fback feedback;
dcl move_type fixed bin(31);
dcl resume fixed bin(31) static initial(10);
dcl percolate fixed bin(31) static initial(20);
dcl promote fixed bin(31) static initial(30);
dcl promote_sf fixed bin(31) static initial(31);
/* Check if this is the out-of-storage token */
if fbcheck (condtok, cee0pd) then
do;
display ('Sub not run: out of storage');
/* Call CEEMRCR to move resume cursor */
move_type = 0;
call ceemrcr (move_type, fback);
If fbcheck (fback, cee000) then
do;
result = resume;
end;
else
do;
result = percolate;
end;
end;
else /* something besides out-of-storage */
do;
result = percolate;
end;
end Cecndhd;