|
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 +---
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.