Find own library

Although I have posted this before, I think it is useful to repost it to
MI400 to make it
more available. This little program retrieves the library where it actually
resides.     
There are basically three ways you can manage how to locate programs to
call:

1) Hardcode the LIB/PGM (also known as 'qualified call')
2) Rely on the library list
3) Use the following technique that relies on neither.

Ideally (from my perspective) you would like to write the application in
such 
a way that it can be installed in any library of the user's choice and run
from
there. Typically you have several applications each installed in their own 
library. You may want to run them from within the same session without
having to manage library list entries and *curlib. The following program
GETOWNLIB helps solve that problem. You install that program in
a well-known place, e.g. QGPL or a special library where you keep
things that must be globally known (at least ONE program - namely 
GETOWNLIB - has to be called with a 'qualified call').

Each application can now call QGPL/GETOWNLIB. This program
returns the library of the application program that called GETOWNLIB.
That library can now be used to dynamically qualify other program
calls, data areas used, files needed, etc.

Phil Hall will probably in his eminent style explain in more detail
how the program works. Here it is:

     /*================================================================
      * This program creates GETOWNLIB in *CURLIB.                    =
      *================================================================
     E                    MI      1  40 80
     I            DS
     I                                    B   1   40#SRCLN
     I I            'GETOWNLIB *CURLIB'       5  24 #PGMLB
     I                                       25  74 #TEXT
     I I            '*NONE'                  75  94 #SRCFL
     I                                       95 104 #MBR
     I                                      105 117 #CHGDT
     I                                      105 105 #CENT
     I                                      106 107 #YY
     I                                      108 111 #MMDD
     I                                      112 117 #HMS
     I                                      118 137 #PRTFL
     I                                    B 138 1410#STRPG
     I                                      142 151 #AUT
     I                                      152 327 #OP
     I                                    B 328 3310#NOOPT
     C                     CALL 'QPRCRTPG'
     C                     PARM           MI
     C                     PARM 3200      #SRCLN
     C                     PARM           #PGMLB
     C                     PARM ' '       #TEXT
     C                     PARM           #SRCFL
     C                     PARM           #MBR
     C                     PARM           #CHGDT
     C                     PARM ' '       #PRTFL
     C                     PARM 0         #STRPG
     C                     PARM '*USE'    #AUT
     C                     PARM '*REPLACE'#OP
     C                     PARM 1         #NOOPT
     C                     MOVE *ON       *INLR
**                                                             */
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-BYTES-AVL      BIN(4) DEF(PROGRAM) POS( 5);
    DCL DD  PGM-PTR-TYPE      CHAR(1) DEF(PROGRAM) POS( 9);
    DCL DD  PGM-LIB-TYPE      CHAR(2) DEF(PROGRAM) POS(10);
    DCL DD  PGM-LIB-NAME     CHAR(30) DEF(PROGRAM) POS(12);
    DCL DD  PGM-PGM-TYPE      CHAR(2) DEF(PROGRAM) POS(42);
    DCL DD  PGM-PGM-NAME     CHAR(30) DEF(PROGRAM) POS(44);

DCL SPCPTR .THE-STACK INIT(THE-STACK);
DCL DD      THE-STACK CHAR(12816) 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-THREAD-COUNTER BIN(4) DEF(THE-STACK) POS(13);
    DCL DD  STK-ENTRY(100)  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;
    ADDN       STK-BYTES-PRV, 12800, 16;
    MATINVS   .THE-STACK, *;
    SUBN       CALLING-PGM-NBR, STK-NBR-OF-ENTRIES, 1;
    CPYBWP     THE-ENTRY, STK-ENTRY(CALLING-PGM-NBR);
    MATPTR    .PROGRAM, THE-ENTRY-PGM; /* CALLER */
    CPYBLA     PARM-LIB-NAME, PGM-LIB-NAME;
    RTX        *;

PEND;

Some things to note:
a) GETOWNLIB returns a 10-char library name, even though objects
internally really have 30-char names.
b) GETOWNLIB assumes that the call-stack is never more than 100
entries deep. We can in a later posting see how to relax that assumption
and dynamically allocate just what we need to hold the invocation stack.

+---
| 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
+---