/* */ /* RTVINVSTK Retrieve invoked program name */ /* */ /* 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 */