|
At 07:34 PM 1/10/98 -0500, Walden Leverich wrote: > >I would love to see an API to list the program stack, but I sure can't find >one, and I've looked hard. Anyone with enough knowledge of the internal >OS/400 job structures and MI care to write one? > Walden, Here's some code that'll get you started. It returns the name of the program n levels above the current program in the invocation stack. The current program is of course, the MI program, so the program that calls it would be at offset 1. It could be made to return all of the programs in the stack if it was passed an array to put the names in. It already has all of the information. If you run it at security level 40 or 50 you will need to trap MCH6801 where it tries to materialize the object pointer to get the name. MCH6801 is issued when a user program tries to materialize a pointer to a system program. For the purpose of checking the program that caused a trigger to fire, I think this will work as is. I haven't tried it, but I'd expect the program in question to be at a fixed offset relative to the trigger, and to always be a user program. The caller should monitor for MCH6801 though, just in case. Pete Pete Hall peteh@inwave.com <http://www.inwave.com/~peteh>http://www.inwave.com/~peteh/ /* ================================================================= */ /* */ /* RTVIVPN Retrieve a program name from the invocation stack */ /* */ /* Retrieves the name of the program which is n levels */ /* above this one in the current invocation stack. */ /* */ /* Parms: RELINVNBR PKD 3,0 Invocation entry relative */ /* to this program. CVIVK00010 */ /* will return its own name if */ /* RELINVNBR = 0. Entry parm. */ /* */ /* PGMNAM CHAR 20 Qualified program name from */ /* the requested invocation */ /* entry in the current invocation */ /* stack. 1:10 = program name */ /* 11:10 = library name */ /* Return value. */ /* */ /* Under security level 40, MCH6801 is returned if an */ /* attempt is made to retrieve the name of a program */ /* which is running in the system state. */ /* */ /* MCH0601 or MCH3601 will be returned if RELINVNBR */ /* exceeds the size of the current invocation stack. */ /* */ /* All messages are resignalled to the caller. */ /* */ /* This program should be created with the *NOCLRPASA */ /* and *NOCLRPSSA attributes. */ /* */ /* ----------------------------------------------------------------- */ /* Declare program entry parameters and data */ DCL SPCPTR RELINVNBR@ PARM; /* Relative invocation number */ DCL DD RELINVNBR PKD(3,0) BAS(RELINVNBR@); /* Input parm */ DCL SPCPTR PGMNAM@ PARM; /* Qualified program name */ DCL DD PGMNAM CHAR(20) BAS(PGMNAM@); /* Return value */ DCL DD PGM CHAR(10) DEF(PGMNAM) POS(1); DCL DD LIB CHAR(10) DEF(PGMNAM) POS(11); DCL OL *ENTRY (RELINVNBR@, PGMNAM@) PARM EXT; /* Parameter list */ /* Declare pointers and data structures to materialize the program stack */ DCL DD MTZSPC CHAR(32767) BDRY(16); /* Materialization space */ DCL DD MTZHDR CHAR(16) DEF(MTZSPC) POS(1); /* MTZ header data structure */ DCL DD MTZPVD BIN(4) DEF(MTZHDR) POS(1); /* Bytes for materialization */ DCL DD MTZAVL BIN(4) DEF(MTZHDR) POS(5); /* Bytes returned by MTZ */ DCL DD MTZNBRENT BIN(4) DEF(MTZHDR) POS(9); /* Number of entries MTZD */ DCL DD MTZMRKCTR BIN(4) DEF(MTZHDR) POS(13); /* Cur value of invocat ctr */ DCL SPCPTR MTZSPC@ INIT(MTZSPC); /* Ptr to materialization space */ DCL SPCPTR MTZENT@; /* Ptr to materialization entries in MTZSPC */ DCL DD MTZENT CHAR(128) BAS(MTZENT@); /* Materialization entry structure */ DCL SYSPTR MEOBJPTR DEF(MTZENT) POS(33); /* Pointer to object */ DCL DD MEINVNBR BIN(2) DEF(MTZENT) POS(49); /* Invocation number */ DCL DD MEINVTYP CHAR(1) DEF(MTZENT) POS(51); /* Invocation type */ /* X'00' = Data base select/omit program X'01' = Call external X'02' = Transfer control X'03' = Event handler X'04' = External exception handler X'05' = Initial program in process problem state X'06' = Initial program in process initiation state X'07' = Initial program in process termination state X'08' = Invocation exit */ DCL DD MEINVMRK BIN(4) DEF(MTZENT) POS(53); /* Invocation mark */ DCL DD MEINSNBR BIN(4) DEF(MTZENT) POS(57); /* Instruction no. */ /* Data structures for materializing system pointer */ DCL DD MPSPACE CHAR(75) BDRY(16); /* MATPTR data structure */ DCL DD MPPVD BIN(4) DEF(MPSPACE) POS(1); /* Size of materialization space */ DCL DD MPAVL BIN(4) DEF(MPSPACE) POS(5); /* Bytes available from MTZ*/ DCL DD MPTYP CHAR(1) DEF(MPSPACE) POS(9); /* Pointer is SYSPTR */ DCL DD MPCTX CHAR(32) DEF(MPSPACE) POS(10); /* Context ID */ DCL DD MPCTXTYP CHAR(1) DEF(MPCTX) POS(1); /* Context type */ DCL DD MPCTXSBT CHAR(1) DEF(MPCTX) POS(2); /* Context subtype */ DCL DD MPCTXNAM CHAR(30) DEF(MPCTX) POS(3); /* Context name */ DCL DD MPOBJ CHAR(32) DEF(MPSPACE) POS(42); /* Object ID */ DCL DD MPOBJTYP CHAR(1) DEF(MPOBJ) POS(1); /* Object type */ DCL DD MPOBJSBT CHAR(1) DEF(MPOBJ) POS(2); /* Object subtype */ DCL DD MPOBJNAM CHAR(30) DEF(MPOBJ) POS(3); /* Object name */ DCL DD MPAUT CHAR(2) DEF(MPSPACE) POS(74); /* Pointer authorization */ /* Bit 0 = Object control 1 = Object management 2 = Authorization pointer 3 = Space authority 4 = Retrieve 5 = Insert 6 = Delete 7 = Update 8 = Ownership 9 - 15 = Reserved (binary 0) */ DCL SPCPTR MPSPACE@ INIT(MPSPACE); /* Ptr to MATPTR MTZ space */ DCL DD INVNBR BIN(4) AUTO; /* Actual invocation entry to return */ DCL DD OFFSET BIN(4) AUTO; /* Displacement into materialization */ DCL EXCM ALLERR EXCID(0000) BP (EXIT) RSG; /* Resignal all errors */ /* Program entry point */ ENTRY * (*ENTRY) EXT; /* Materialize the current invocation stack */ CPYNV MTZPVD,H'00007FFF'; /* Bytes provided for materialization */ MATINVS MTZSPC@,*; /* Materialize invocation stack */ /* Displace to the selected invocation entry */ SUBN INVNBR,MTZNBRENT,RELINVNBR; /* Current invocation entry - relative */ MULT OFFSET,INVNBR,H'0080'; /* Entry * length of entry */ SUBN(S) OFFSET,H'0070'; /* Less 1 entry, + 16 bytes for header */ ADDSPP MTZENT@,MTZSPC@,OFFSET; /* Point to materialization entry */ /* Materialize the invocation entry object pointer */ CPYNV MPPVD,H'00000046'; /* 75 bytes provided for materialization */ CPYBLA MPTYP,X'01'; /* Materializing a system pointer */ MATPTR MPSPACE@,MEOBJPTR; /* Materialize the invoked object */ /* Return the invocation entry object name */ CPYBLA LIB,MPCTXNAM; /* Return library name */ CPYBLA PGM,MPOBJNAM; /* Return program name */ /* Return to caller */ EXIT: RTX *; PEND; /* End of source */ +--- | This is the Midrange System Mailing List! | To submit a new message, send your mail to "MIDRANGE-L@midrange.com". | To unsubscribe from this list send email to MIDRANGE-L-UNSUB@midrange.com. | Questions should be directed to the list owner/operator: david@midrange.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.
midrange.com
