/* REXX * SYSINFO
*/
if arg() = 0 then return "ERROR (Parameter fehlt)"
main_start:
_info = translate(arg(1))
if words(_info) > 1 then parse var _info _info parms
_progname = left(prog_name(),3)
select
when _info = "JOBNAME" then erg = stor_infos("JOBNAME")
when _info = "JOBTYP" then erg = stor_infos("JOBTYP")
when _info = "JOBNUM" then erg = stor_infos("JOBNUM")
when _info = "STEPNAME" then erg = stor_infos("STEPNAME")
when _info = "PROCSTEP" then erg = stor_infos("PROCSTEP")
when _info = "SYSLEVEL" then erg = stor_infos("SYSLEVEL")
when _info = "JES" then erg = stor_infos("JES")
when _info = "SYSID" then erg = stor_infos("SYSID")
when _info = "IPLVOL" then erg = stor_infos("IPLVOL")
when _info = "NJENODE" then erg = stor_infos("NJENODE")
when _info = "PROC" then erg = stor_infos("PROC")
when _info = "IPLDATE" then erg = stor_infos("IPLDATE")
when _info = "IPLDAY" then erg = stor_infos("IPLDAY")
when _info = "IPLTAG" then erg = stor_infos("IPLTAG")
when _info = "IPLTIME" then erg = stor_infos("IPLTIME")
when _info = "PROGNAME" then erg = prog_name()
when _info = "SMIPS" then erg = get_mips("S")
when _info = "TMIPS" then erg = get_mips("T")
when _info = "ISPFSCRN" then erg = ispf_screens()
otherwise erg = "ERROR"
end
main_ende:
return erg
get_mips: procedure
arg parm
if parm <> "S" then parm = "T"
CVT = STORAGE(10,4)
RMCT = STORAGE(D2X(C2D(CVT)+604),4)
SU = STORAGE(D2X(C2D(RMCT)+64),4)
SU = 16000000/C2D(SU)
CVTPCCAT = STORAGE(D2X(C2D(CVT)+764),4)
I = 0
P = 0
DO WHILE I < 16
PCCA = STORAGE(D2X(C2D(CVTPCCAT)+I*4),4)
IF PCCA ^= '00000000'X THEN DO
PCCAPCCA = STORAGE(D2X(C2D(PCCA)),4)
PCCAVC = STORAGE(D2X(C2D(PCCA)+4),2)
PCCACPID = STORAGE(D2X(C2D(PCCA)+6),6)
PCCAMDL = STORAGE(D2X(C2D(PCCA)+12),4)
IF PCCAPCCA = 'PCCA' THEN DO
P = P + 1
END
END
I = I + 1
END
IF P > 1 THEN PROCS = 'PROCESSORS'
ELSE PROCS = 'PROCESSOR'
MIPS = SU/48.5
MSU = SU*P*3600/1000000
if parm = "S" then erg= mips p
else erg = mips * p
return erg
/* ENDE MIPS */
get_lpar_name: procedure
/*---REXX--EXEC-GETSMFID---*/
SMCA = D2X(C2D(STORAGE(10,4))+197)
SMFID = D2X(C2D(STORAGE(SMCA,3))+16)
SMFID = STORAGE(SMFID,4)
SAY 'LPAR IS' SMFID
EXIT
prog_name: procedure
/*
From: wooda@IBM.NET
Subject: How to find program executin environment under MVS
Andy Wood
*/
xp = storage(0000021c,4)
xp2 = ptr2(xp,'b4'x)
xp3 = d2x(c2d(xp2) + c2d('168'x))
progname = storage(xp3,8)
return progname
ptr2: procedure
address = c2d(arg(1))
offset = c2d(arg(2))
return storage(d2x(address+offset),4)
return
/* ENDE job_step_exec_name */
stor_infos: procedure expose _progname
/* diverse infos aus der Task-Control-Table */
arg infotyp
CVT = C2d(Storage(10,4))/* point to CVT */
tcb = storage(21c,4)
tiot = storage(d2x(c2d(tcb)+12),4)
jscb = storage(d2x(c2d(tcb)+180),4)
ssib = storage(d2x(c2d(jscb)+316),4)
jobname = strip(storage(d2x(c2d(tiot)),8))
jobtype = storage(d2x(c2d(ssib)+12),3)
jobnum = strip(storage(d2x(c2d(ssib)+15),5),l,0)
stepname = strip(storage(d2x(c2d(tiot)+8),8),l,0)
procstep = strip(storage(d2x(c2d(tiot)+16),8),l,0)
/* */
SMCA = Storage(D2x(CVT + 196),4) /* point to SMCA*/
SMCA = Bitand(SMCA,'7FFFFFFF'x)/* zero high order bit*/
SMCA = C2d(SMCA) /* convert to decimal */
/*
The IPL date is stored in packed decimal format - so to make
the date printable, it needs to be converted back to hex and
the packed sign needs to be removed.
*/
IPLTIME= C2d(Storage(D2x(SMCA + 336),4)) /* IPL Time - binary*/
IPLDATE= C2d(Storage(D2x(SMCA + 340),4)) /* IPL Date - 0CYYDDDF*/
IPLDATE= D2x(IPLDATE) /* convert back to hex*/
parse var IPLDATE . 2 IPLDATE 7 .
iplday = date('w',ipldate,'j')
x = wordpos(left(iplday,2),"Mo Tu We Th Fr Sa Su")
y = "Montag Dienstag Mittwoch Donnerstag Freitag Samstag Sonntag"
ipltag = word(y,x)
parse value date('s',ipldate,'j') with 1 jjjj 5 mm 7 dd
ipldate= dd"."mm"."jjjj
IPLTIME= IPLTIME / 100 /* remove hundreths */
HH = IPLTIME % 3600/* IPL hour */
MM = (IPLTIME - (3600 * HH)) % 60/* IPL minute */
SS = (IPLTIME - (3600 * HH)- (60 * MM)) % 1/* IPL seconds*/
HH = Right(HH,2,'0') /* ensure 2 digit HH*/
MM = Right(MM,2,'0') /* ensure 2 digit MM*/
SS = Right(SS,2,'0') /* ensure 2 digit SS*/
IPLTIME= HH':'MM':'SS/* time in HH:MM format */
select
when infotyp = "JOBNAME" then erg = jobname
when infotyp = "JOBTYP" then erg = jobtype
when infotyp = "JOBNUM" then erg = jobnum
when infotyp = "STEPNAME" then erg = stepname
when infotyp = "PROCSTEP" then erg = procstep
when infotyp = "SYSLEVEL" then erg = left(mvsvar('sysmvs'),10)
when infotyp = "JES" then do
if _progname = "IRX" then erg = ""
else erg = sysvar("SYSJES")
end
when infotyp = "SYSID" then erg = mvsvar("SYSNAME")
when infotyp = "IPLVOL" then erg = "" !! ,
left(mvsvar('symdef','sysr1'),10)
when infotyp = "NJENODE" then do
if _progname = "IRX" then erg = ""
else erg = left(sysvar('sysnode'),10)
end
when infotyp = "PROC" then do
if _progname = "IRX" then erg = ""
else erg = sysvar("SYSPROC")
end
when infotyp = "IPLDATE" then erg = ipldate
when infotyp = "IPLDAY" then erg = iplday
when infotyp = "IPLTAG" then erg = ipltag
when infotyp = "IPLTIME" then erg = ipltime
otherwise erg = "ERROR"
end
return erg
ispf_screens: procedure expose _progname
if _progname = "IRX" then return ""
if sysvar("SYSISPF") <> "ACTIVE" then return ""
/* active ISPF-Screens */
/* RESULT = scr1 name1 \ ... \ */
TCBP=PTR(132+PTR(540)) /* CURRENT ISPTASK TCB */
TCBP=PTR(TCBP+132) /* ISPMAIN TCB VIA TCBOTC */
TCBP=PTR(TCBP+136) /* ISPTASK TCB VIA TCBLTC */
erg =
DO WHILE TCBP <> 0
X=TLDID(TCBP)
erg = erg !! scrnr scrname "\"
TCBP=PTR(128+TCBP) /* FOLLOW NTC */
END
RETURN erg
PTR: RETURN C2D(STORAGE(D2X(ARG(1)),4))
STG: RETURN STORAGE(D2X(ARG(1)),ARG(2))
TLDID:
R9=PTR(112+ARG(1))
IF STG(R9+40,4)='ISPF' & STG(R9+24,1)='00'X THEN DO
R9= PTR(R9+24)
IF R9 <>0 & STG(R9+24,1)='00'X THEN DO
SCRNR =STG(PTR(R9)+003,1)
SCRNAME=STG(PTR(R9)+852,8)
RETURN 0
END
END
RETURN 'NONE'
/* Ende ISPF-SCREENS */
get_symbols: procedure
call set_sym_names
say
say "Standars MVS Symbols:"
do I = 1 while SYS.I <> "SYS."I
say left(SYS.I,10) ">>" mvsvar("SYMDEF",SYS.I)
end
say
say "Installationsabh鄚gige:"
do I = 1 while SYM.I <> "SYM."I
say left(SYM.I,10) ">>" mvsvar("SYMDEF",SYM.I)
end
exit
set_sym_names:
I = 0 /* Standard MVS */
I=I+1;SYS.I= "JOBNAME"
I=I+1;SYS.I= "LYYMMDD"
I=I+1;SYS.I= "LHHMMSS"
I=I+1;SYS.I= "HHMMSS"
I=I+1;SYS.I= "LYR4"
I=I+1;SYS.I= "SYSR1"
I = 0 /* Definiert in der SYS1.PARMLIB(IEASYMxx) */
I=I+1;SYM.I= "CPUNAME"
I=I+1;SYM.I= "CSABELOW"
I=I+1;SYM.I= "CSAHIGH"
I=I+1;SYM.I= "SUFFIX"
I=I+1;SYM.I= "PAGELOC1"
I=I+1;SYM.I= "PAGECOM1"
I=I+1;SYM.I= "MAXUSER"
I=I+1;SYM.I= "GRSMODE"
I=I+1;SYM.I= "RSUPARM"
I=I+1;SYM.I= "RWGSYSID"
return
/*
Quelle TSO-REXX NewsGroup at GOOGLE
Die SYMBOLS aus der SYS1.PARMLIB werden zur Zeit nicht benutzt
Aufruf-Syntax: INFO = 刨YSINFO(parm)
Inhalt parm m鐷liches Funktionsergebnis
----------- ------------------------------------------------------
JOBNAME DAAKW
JOBTYP TSU
JOBNUM 13716
STEPNAME RWGTSO
PROCSTEP RWGTSO
SYSLEVEL SP6.1.0
JES JES2 OS 2.10
SYSID S6UP
IPLVOL OS#11F
NJENODE GNO45NJ1
PROC RWGTSO
IPLDATE 13.02.2002
IPLDAY Wednesday
IPLTAG Mittwoch
IPLTIME 21:38:42
PROGNAME IKJEFT01
SMIPS 173.447375 5
TMIPS 867.236875
ISPFSCRN 4 DSLIST \3 SD \2 EDIT \1 DSLIST \
ist einer der Werte nicht ermittelbar wird SPACE zur𡡷kgegeben
*/
The driver for SYSINFO
/* REXX * SYSINFO-Treiberprogramm
trace ?r
*/
call test1_vars
do i = 1 to words(tstvars)
say left(word(tstvars,i),10) ">>" sysinfo(word(tstvars,i))
end
call get_symbols
exit
get_symbols: procedure
call set_sym_names
say
say "Standars MVS Symbols:"
do I = 1 while SYS.I <> "SYS."I
say left(SYS.I,10) ">>" mvsvar("SYMDEF",SYS.I)
end
say
say "Installationsabhängige:"
do I = 1 while SYM.I <> "SYM."I
say left(SYM.I,10) ">>" mvsvar("SYMDEF",SYM.I)
end
return
set_sym_names:
I = 0 /* Standard MVS */
I=I+1;SYS.I= "JOBNAME"
I=I+1;SYS.I= "LYYMMDD"
I=I+1;SYS.I= "LHHMMSS"
I=I+1;SYS.I= "HHMMSS"
I=I+1;SYS.I= "LYR4"
I=I+1;SYS.I= "SYSR1"
I = 0 /* Definiert in der SYS1.PARMLIB(IEASYMxx) */
I=I+1;SYM.I= "CPUNAME"
I=I+1;SYM.I= "CSABELOW"
I=I+1;SYM.I= "CSAHIGH"
I=I+1;SYM.I= "SUFFIX"
I=I+1;SYM.I= "PAGELOC1"
I=I+1;SYM.I= "PAGECOM1"
I=I+1;SYM.I= "MAXUSER"
I=I+1;SYM.I= "GRSMODE"
I=I+1;SYM.I= "RSUPARM"
I=I+1;SYM.I= "RWGSYSID"
return
test1_vars:
tstvars = "JOBNAME" ,
"JOBTYP" ,
"JOBNUM" ,
"STEPNAME" ,
"PROCSTEP" ,
"SYSLEVEL" ,
"JES2" ,
"SYSID" ,
"IPLVOL" ,
"NJENODE" ,
"PROC" ,
"IPLDATE" ,
"IPLDAY" ,
"IPLDAYG" ,
"IPLTIME" ,
"PROGNAME" ,
"SMIPS" ,
"TMIPS" ,
"ISPFSCRN" ,
""
return
2013年9月13日 星期五
Get system information via REXX
訂閱：
張貼留言 (Atom)
沒有留言:
張貼留言