On 2016-11-20 01:29, Donald Likens wrote:
Has anyone come up with a way for a REXX program to determine the library it resides in?
/* REXX exec to find dataset from which an exec is running */ /*** trace ?r ***************************************************** \| * * (C) Copyright Frank Clarke, 2005-2007 * ************************************************************************ * ------------------------------------------------------------------ * * | Date | By | Remarks | * * |------------+------+----------------------------------------------| * * | | | | * * |------------+------+----------------------------------------------| * * | 2007-09-04 | RAHP | Enclose URL in '<..>' | * * |------------+------+----------------------------------------------| * * | 2005-12-08 | FC | Initial version | * * |------------+------+----------------------------------------------| * ************************************************************************ * ORIGIN is a REXX exec to find the library where the code was run * * from. It assumes cataloged data sets. * * * * Original code by Doug Nadel, with SWA code lifted from Gilbert * * Gilbert Saint-flour's SWAREQ exec. * * * * From: <http://www.tek-tips.com/viewthread.cfm?qid=1162402&page=3> * ***********************************************************************/ say find_origin() exit find_origin: procedure numeric digits 10 /* allow up to 7FFFFFFF */ answer = "* UNKNOWN *" /* assume disaster */ parse source . . name dd ds . /* get known info */ call listdsi(dd "FILE") /* get 1st ddname from file */ if name = "?" then /* if sequential exec */ answer = "'"ds"'" /* use info from parse source */ else /* now test for members */ if sysdsn("'"sysdsname"("name")'") = "OK" then /* if in 1st ds */ answer = "'"sysdsname"("name")'" /* go no further */ else /* hooboy! Lets have some fun!*/ do /* scan tiot for the ddname */ tiotptr = 24 + ptr(12 + ptr(ptr(ptr(16))))/* get ddname array */ tioelngh = c2d(stg(tiotptr, 1)) /* length of 1st entry */ do until tioelngh = 0 | tioeddnm = dd /* scan until dd found */ tioeddnm = strip(stg(tiotptr + 4, 8)) /* get ddname from tiot */ if tioeddnm \= dd then /* if not a match */ tiotptr = tiotptr + tioelngh /* advance to next entry */ tioelngh = c2d(stg(tiotptr, 1)) /* length of next entry */ end if dd = tioeddnm then /* if we found it, loop through the data sets doing an swareq for each one to get the dsname */ do until tioelngh = 0 | stg(4 + tiotptr, 1) \= " " tioejfcb = stg(tiotptr + 12, 3) jfcb = swareq(tioejfcb) /* convert SVA to 31-bit addr */ dsn = strip(stg(jfcb,44)) /* dsname JFCBDSNM */ vol = storage(d2x(jfcb + 118),6)/* volser JFCBVOLS (unused) */ if sysdsn("'"dsn"("name")'") = 'OK' then /* found it? */ leave /* we is some happy campers! */ tiotptr = tiotptr + tioelngh /* get next entry */ tioelngh = c2d(stg(tiotptr, 1)) /* get entry length */ end answer = "'"dsn"("name")'" /* assume we found it */ end return answer ptr: return c2d(storage(d2x(arg(1)), 4)) stg: return storage(d2x(arg(1)), arg(2)) swareq: procedure if right(c2x(arg(1)), 1) \= 'F' then /* SWA=BELOW ? */ return c2d(arg(1)) + 16 /* yes, return sva + 16 */ sva = c2d(arg(1)) /* convert to decimal */ tcb = c2d(storage(21c, 4)) /* TCB PSATOLD */ tcb = ptr(540) /* TCB PSATOLD */ jscb = ptr(tcb + 180) /* JSCB TCBJSCB */ qmpl = ptr(jscb + 244) /* QMPL JSCBQMPI */ qmat = ptr(qmpl + 24) /* QMAT QMADD */ do while sva > 65536 qmat = ptr(qmat + 12) /* next QMAT QMAT + 12 */ sva = sva - 65536 /* 010006F -> 000006F */ end return ptr(qmat + sva + 1) + 16 -- Robert AH Prins robert(a)prino(d)org No programming (yet) @ http://prino.neocities.org/ ---------------------------------------------------------------------- For IBM-MAIN subscribe / signoff / archive access instructions, send email to [email protected] with the message: INFO IBM-MAIN
