Converts ACF2 UID(LID) based Rules to LID based ROLES

RULE2ROLE

/* REXX EXEC                                                          */
/* Converts ACF2 Rulesets to Rolesets
      - All Rule Lines must be written to the LID

      - To execute:
          1)  Change the LIDPARMS variables:
              - LIDSTART = Starting Position of LID in UID String
              - LIDLENGTH = Length of LID
*/
                lidstart = 17
               lidlength = 8
/*
          1)  Change the Dataset Names:
              - IN_DATASET = Unloaded Rules
              - OUT_DATASET = Converted Roles
*/
              in_dataset = 'KLERO03.ACF2.RULES.SEQ'
             out_dataset = 'KLERO03.ACF2.ROLES.SEQ'
/*

   Revision History:

   Date      Changes
   --------  ------------------------------------------------
   20100705  B.Kleamovich - Initial Release
   *** End of Revision History
*/
trace o
/*                                                                    */
/*Mainline - Start                                                    */
call define_vars
call read_file
call process_file
call write_file
say "Output has" j "lines"
Exit 0
/*Mainline - End                                                      */
/*                                                                    */
define_vars:
   Out. = ' '
   i = 0
   j = 0
   k = 0
   l = 0
   x = 0
   y = 0
   ts = '----+----0'
   tt = ts||ts||ts||ts||ts
   sp = '                                             '
   sp = sp||sp||sp||sp
   sp = substr(sp,1,46)
return
/*                                                                    */
read_file:
   "ALLOC F(INPUT) DA('"||in_dataset||"') SHR REUSE"
   "EXECIO * DISKR INPUT (STEM DATA. FINIS"
   "FREE F(INPUT)"
return
/*                                                                    */
process_file:
   Do i=1 to Data.0
      if pos('$KEY(',strip(data.i,both)) > 0 then
         do
         j = j + 1
         out.j =  strip(data.i,both)|| ' ROLESET '
         iterate
         end
      if pos('UID(*)',strip(data.i,both)) > 1 then
         do
         parse var data.i what who other
         role = 'LID(*)'
         j = j + 1
         out.j =  ' ' what role other
         iterate
         end
      if pos('UID(',strip(data.i,both)) > 1 then
         do
         parse var data.i what who other
         who = strip(who,both)
         spos = lidstart + 4
         epos = lidlength
         lid = substr(who,spos,epos)
/*       say '      ' tt
         say ' WHO: ' who
         say 'SPOS: ' spos
         say 'EPOS: ' epos
         say ' LID: ' lid
         say                                         */
         if pos(')',lid) > 1 then
            do
            k = pos(')',lid)
            lid = strip(substr(lid,1,k - 1),both)
            end
         if pos('*',lid) > 1 then
            do
            k = pos('*',lid)
            lid = strip(substr(lid,1,k - 1),both)
            end
         role = 'LID('||lid||')'
         j = j + 1
         out.j =  ' ' what role other
         iterate
         end
      j = j + 1
      out.j = data.i
      end
return
/*                                                                    */
write_file:
   "ALLOC F(OUTPUT) DA('"||out_dataset||"') OLD REUSE"
   "EXECIO "j" DISKW OUTPUT (STEM OUT. FINIS"
   "FREE F(OUTPUT)"
return
/*

The program returns the volume with the master catalog

/* REXX ***************************************************************/
/* Master Cat Info                                                    */
/**********************************************************************/
cvt      = Storage(10,4)                    /* Get the CVT address    */
amcbs    = Storage(D2x(256+C2d(cvt)),4)     /* Get the AMCBS address  */
acb      = Storage(D2x(8+C2d(amcbs)),4)     /* Get the ACB address    */
caxwa    = Storage(D2x(64+C2d(acb)),4)      /* Get the CAXWA address  */
dsncat   = Storage(D2x(52+C2d(caxwa)),44)   /* Dsn of Master Cat      */
dsncat   = Strip(dsncat,T)                  /*                        */
ucbcat   = Storage(D2x(28+C2d(caxwa)),4)    /* UCB name for Master Cat*/
volcat   = Storage(D2x(28+C2d(ucbcat)),6)   /* Volume for Master Cat  */
Say dsncat" on "volcat
exit

The program calculates the CPU performance of a system in MIPS

/* REXX */
CVT  = STORAGE(10,4)
RMCT = STORAGE(D2X(C2D(CVT)+604),4)
SU   = STORAGE(D2X(C2D(RMCT)+64),4)
SU   = 16000000/C2D(SU)
SAY  'SU/SEC FACTOR IS' SU ,
'(1 CPU SECOND EQUALS' SU 'SERVICE UNITS)'
CVTPCCAT = STORAGE(D2X(C2D(CVT)+764),4)
SAY 'PCCA VECTOR TABLE AT' C2X(CVTPCCAT)
I = 0
P = 0
SAY '----------------------------------------'
SAY ' PROC   VERSION  CPUID   MODEL    PCCA  '
SAY 'NUMBER    CODE                   ADDRESS'
SAY '----------------------------------------'
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
      SAY ' ' I '     ' PCCAVC '   ' PCCACPID ,
          ' '!!PCCAMDL ' ' C2X(PCCA)
      P = P + 1
      END
   END
I = I + 1
END
IF P > 1 THEN PROCS = 'PROCESSORS'
         ELSE PROCS = 'PROCESSOR'
SAY
SAY P PROCS 'IN THIS COMPLEX'
MIPS = SU/48.5
SAY
SAY '** TOTAL MIPS                   :' MIPS*P
IF P > 1 THEN SAY ,
 '** EQUIVALENT UNIPROCESSOR MIPS :' MIPS
/*                                           */
/*  MSU EVALUATION                           */
/*                                           */
MSU = SU*P*3600/1000000
SAY FORMAT(MSU,,0) 'MSU (FOR PSLC PRICING -'