© unbekannterkünstler@newsgroup

Das Programm liefert die meisten interessanten Informationen, welche im Verlauf einer Verarbeitung von Interesse sein können. Über den Programmnamen kann REXX im Batch beispielsweise feststellen, ob es unter IKJEFT01 (das TSO) oder unter IRXJCL (das Batch-Interface von REXX) läuft. Dies ist oft wichtig zu wissen, da unter IRXJCL nur sehr eingeschränkte TSO-Funktionalität zur Verfügung steht.

Im ermittelbaren Informationen sind:


Um die einzelnen Funktions-Ergebnisse besser sehen zu können wird neben dem eigentlichen Programm auch ein Treiberprogramm mit hinterlegt, welches die verschiedenen Funktionen der Reihe nach aufruft.

Das Programm SYSINFO
/* 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 executing 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ängige:"
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 = §SYSINFO(parm)

   Inhalt parm   mögliches 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ückgegeben
*/


Der Treiber für 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
zurück zu The Power of REXX