RE: GETOWNLIB automatic memory allocation -- MI400

OK, I gave in and joined this list. Leif you could avoid the whole size
issue by doing this instead:

                                            
 DCL DD INVINFO CHAR(16) BDRY(16);         
 DCL SYSPTR INVPGM DEF(INVINFO) POS(1);    
 DCL SPCPTR P#INVINF INIT(INVINFO);        
/* The attribute info selects the program pointer.            
 DCL DD ATTINFO CHAR(144) BDRY(16);                            
 DCL DD NUMATT BIN(4) DEF(ATTINFO) POS(1) INIT(1);             
 DCL DD ATTID BIN(4) DEF(ATTINFO) POS(17) INIT(6);             
 DCL DD ATTLGH BIN(4) DEF(ATTINFO) POS(29) INIT(16);           
 DCL SPCPTR P#ATTINF INIT(ATTINFO);                            
 /* The selection criteria controls the invocation level.      
 DCL DD SELECT CHAR(48) BDRY(16);                              
 DCL DD SRCINV BIN(4) DEF(SELECT) POS(1) INIT(-1);  

 /* Materialize the INVOCATION stack - current-1    
   MATINVAT P#INVINF,SELECT,P#ATTINF;               

then you can materialize INVPGM...short too!


TrailBlazer Systems, Inc.
http://www.softwarejungle.com
AS/400 E-Commerce Solutions

Chaos, panic, & disorder - my work here is done.

> -----Original Message-----
> From: Leif Svalgaard [SMTP:l.svalgaard@pentasafe.com]
> Sent: Thursday, November 11, 1999 2:24 PM
> To:   MI/400 Mailing List
> Subject:      GETOWNLIB automatic memory allocation
> 
> 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
> +---
+---
| 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
+---