GETOWNLIB automatic memory allocation -- MI400

Our previous version of GETOWNLIB had a hardcoded limitation
on the size of the call stack. Here is a version without such
limitation. It illustrates how to allocate just the space needed
at run-time:

DCL SPCPTR .PARM1 PARM;
DCL DD PARM1 CHAR(10) BAS(.PARM1);
    DCL DD PARM-LIB-NAME CHAR(10) DEF(PARM1) POS(1);
DCL OL PARMS(.PARM1) EXT PARM MIN(1);

DCL SPCPTR .PROGRAM INIT(PROGRAM);
DCL DD      PROGRAM CHAR(77) BDRY(16);
    DCL DD  PGM-BYTES-PRV      BIN(4) DEF(PROGRAM) POS( 1) INIT(77);
    DCL DD  PGM-LIB-NAME     CHAR(30) DEF(PROGRAM) POS(12);

DCL SPCPTR .THE-STACK;
DCL DD      THE-STACK CHAR(8) AUTO  BDRY(16);
    DCL DD  STK-BYTES-PRV      BIN(4) DEF(THE-STACK) POS( 1);
    DCL DD  STK-BYTES-AVL      BIN(4) DEF(THE-STACK) POS( 5);
    DCL DD  STK-NBR-OF-ENTRIES BIN(4) DEF(THE-STACK) POS( 9);
    DCL DD  STK-ENTRY(1)    CHAR(128) DEF(THE-STACK) POS(17);

DCL DD THE-ENTRY CHAR(128) BDRY(16);
    DCL SYSPTR .THE-ENTRY-PGM DEF(THE-ENTRY) POS(33);

DCL DD CALLING-PGM-NBR BIN(4);

/*********************************************************************/

ENTRY * (PARMS) EXT;
    CPYNV      STK-BYTES-PRV, 8; /* MINIMUM */
    SETSPP    .THE-STACK, THE-STACK;
    MATINVS   .THE-STACK, *;
    MODASA    .THE-STACK, STK-BYTES-AVL;

    CPYNV      STK-BYTES-PRV, STK-BYTES-AVL;
    SETSPP    .THE-STACK, THE-STACK;
    MATINVS   .THE-STACK, *;

    SUBN       CALLING-PGM-NBR, STK-NBR-OF-ENTRIES, 1;
    OVRPGATR   1, 2; /* DO NOT CONSTRAIN ARRAY REFS */
    CPYBWP     THE-ENTRY, STK-ENTRY(CALLING-PGM-NBR);
    MATPTR    .PROGRAM, .THE-ENTRY-PGM; /* CALLER */
    CPYBLA     PARM-LIB-NAME, PGM-LIB-NAME;
    RTX        *;

PEND;


Note that THE-STACK is now declared to be in AUTOmatic storage:

DCL DD      THE-STACK CHAR(8) AUTO  BDRY(16);
    DCL DD  STK-BYTES-PRV      BIN(4) DEF(THE-STACK) POS( 1);
    DCL DD  STK-BYTES-AVL      BIN(4) DEF(THE-STACK) POS( 5);
    DCL DD  STK-NBR-OF-ENTRIES BIN(4) DEF(THE-STACK) POS( 9);
    DCL DD  STK-ENTRY(1)    CHAR(128) DEF(THE-STACK) POS(17);

It is only big enough (CHAR(8)) to hold the first two binary numbers.
It's OK that the other variables are actually outside of the initial size
of THE-STACK. That is OK as long as we do not use them.
Since we do not know how many stack entries there will be,
STK-ENTRY is declared to have only one element. We shall
see how to override the subscript checking.

We now materialize the first 8 bytes by setting the Bytes-Provided to 8:

    CPYNV      STK-BYTES-PRV, 8; /* MINIMUM */
    SETSPP    .THE-STACK, THE-STACK;
    MATINVS   .THE-STACK, *;

Since our stack is now dynamically allocated, we also
set the space pointer .THE-STACK to it dynamically
with:

    SETSPP    .THE-STACK, THE-STACK;

After materialization, Bytes-Available tells us how many
bytes we *could* have gotten (i.e. the full call stack).
We can allocate that many bytes with the MODASA
(Modify Automatic Storage Allocation):

    MODASA    .THE-STACK, STK-BYTES-AVL;

then set Bytes-Provided to Bytes-Allocated and materialize again:

    CPYNV      STK-BYTES-PRV, STK-BYTES-AVL;
    SETSPP    .THE-STACK, THE-STACK;
    MATINVS   .THE-STACK, *;

As before, we calculate the entry number for our caller:

    SUBN       CALLING-PGM-NBR, STK-NBR-OF-ENTRIES, 1;

Only problem is that it will be larger than the number of elements
of array STK-ENTRY (which we had just declared as 1).
The following instruction (OVerRide ProGram ATtRibutes)  turns
of the subscript check (the funny constants are just the way
it works):

    OVRPGATR   1, 2; /* DO NOT CONSTRAIN ARRAY REFS */

and we can continue as before.

    CPYBWP     THE-ENTRY, STK-ENTRY(CALLING-PGM-NBR);
    MATPTR    .PROGRAM, .THE-ENTRY-PGM; /* CALLER */



+---
| This is the MI Programmers Mailing List!
| To submit a new message, send your mail to MI400@midrange.com.
| To subscribe to this list send email to MI400-SUB@midrange.com.
| To unsubscribe from this list send email to MI400-UNSUB@midrange.com.
| Questions should be directed to the list owner/operator: dr2@cssas400.com
+---