I got this rexx somewhere from:
/* REXX *** */
/* track down various name token pair pointers */
Trace N
NUMERIC DIGITS 10
/* TCB level */
tcb = C2D(Storage(21C,4)) /* get current TCB */
if tcb /= 0 then do
stcb = C2D(Storage(D2X(tcb+312),4))
nttp = C2D(Storage(D2X(stcb+200),4))
If nttp /= 0 then Call donttp nttp,'Task'
end
/* ASCB level */
ascb = C2D(Storage(224,4)) /* get current ascb */
if ascb /= 0 then do
assb = C2D(Storage(D2X(ascb+336),4))
nttp = C2D(Storage(D2X(assb+220),4))
If nttp /= 0 then Call donttp nttp,'Address space'
end
/* system level */
cvt = C2d(Storage(10,4)) /* get CVT pointer */
ecvt = C2d(Storage(D2x(cvt+140),4)) /* get CVTECVT */
nttp = C2D(Storage(D2X(ecvt+140),4))
Call donttp nttp,'System'
exit 0
/* routine to report on name token pairs */
Donttp:
Parse Arg ptr,title
Say ''
Say Copies('=',78)
Say Left(title,13)' level NTTP at 'D2X(ptr)
eye = Storage(D2X(ptr),4)
If eye /= 'NTTH' then Do
Say '** Invalid eye catcher found for NTTP'
Return
End
base = C2D(Storage(D2X(ptr+64),4))
Say ''
Do While base /= 0
Say Copies('-',78)
tcbt = C2X(Storage(D2X(base+4),4))
name = Storage(D2X(base+8),16)
token = C2X(Storage(D2X(base+24),16))
/* Say Length('Name 'name' from 'tcbt)
*/ Say 'Name 'name' from 'tcbt
display = X2C(token)
/* translate out characters between 00 and 3f */
display = TRANSLATE(display,,XRANGE(,'3f'x),'00'x)
/* Say Length(' Token = 'token' ('display')')
*/ Say ' Token = 'token' ('display')'
base = C2D(Storage(D2X(base+64),4))
End
Return
__________________________________________
Thomas Berg Specialist IT-U SWEDBANK
> -----Ursprungligt meddelande-----
> Från: IBM Mainframe Discussion List
> [mailto:[EMAIL PROTECTED] För Rolf Ernst
> Skickat: den 9 september 2008 15:51
> Till: [email protected]
> Ämne: Name/tokens
>
> Hi,
>
> I have a need to traverse all system level name/tokens on an
> lpar. I vaguely recall that this can be done but for the life
> of me cannot remember. Does anybody know which chain to follow?
>
> /re
>
> ----------------------------------------------------------------------
> For IBM-MAIN subscribe / signoff / archive access
> instructions, send email to [EMAIL PROTECTED] with the
> message: GET IBM-MAIN INFO Search the archives at
> http://bama.ua.edu/archives/ibm-main.html
>
>
----------------------------------------------------------------------
For IBM-MAIN subscribe / signoff / archive access instructions,
send email to [EMAIL PROTECTED] with the message: GET IBM-MAIN INFO
Search the archives at http://bama.ua.edu/archives/ibm-main.html
