IBM Mainframe Forum

#! /opt/ooRexx/bin/rexx
/*REXX - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
/*                                                                    */
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/

Trace "O"
parse      source  _source_
parse      var _source_ _opsys_ _envir_ _commnd_ .
_opsys_    = lower(_opsys_)
if   abbrev(_opsys_,"windows") then do
   __PSEP__   = "\"
end
else do
   __PSEP__   = "/"   
end
p       = lastpos(__PSEP__,_commnd_)
parse   var _commnd_ with 1 _mypath =(p) . =(p+1) _myname "." _myextn

TRKCAP   = 56664
MAXREC   = 32760
MAXBLK   = 27998
MAXBLK2   = 27648
MAXKEY   = 256

parse arg  args
args = strip(args)
argc = words(args)

if    argc = 0 then do
   say _myname "- needs at least one argument"
   say _myname "- syntax is '"_myname" lrecl [keylength]'"
   exit
end

if    argc > 2 then do
   say _myname "- supports only two arguments"
   say _myname "- syntax is '"_myname" lrecl [keylength]'"
   exit
end

parse var args reclen keylen
reclen = strip(reclen)
keylen = strip(keylen)

if   keylen = "" then ,
   keylen = 0

if   datatype(reclen) \= "NUM" | ,
   datatype(keylen) \= "NUM" then do
   say _myname "- not numeric arguments, retry "
   exit
end

if   reclen > MAXREC then do
   say _myname "- reclen" reclen "out of range, up to" MAXREC "allowed"
   exit
end

if   keylen > MAXKEY then do
   say _myname "- keylen" keylen "out of range, up to" MAXKEY "allowed"
   exit
end

c_blksz = reclen
c_count = blksxtrk(c_blksz,keylen)
i_blksz = c_blksz
i_count = c_count
p_blksz = c_blksz
p_count = c_count

if keylen \= 0 then ,
   say _myname "-     keylen     lrecl min-blksz max-blksz    blocks  min_recs  max-recs"
else ,
   say _myname "-      lrecl min-blksz max-blksz    blocks  min_recs  max-recs"

do   i = reclen to MAXBLK*(keylen=0) + MAXBLK2*(keylen>0) by reclen
   c_blksz = i
   c_count = blksxtrk(c_blksz,keylen)

   if   c_count \= p_count then do
      if keylen \= 0 then ,
         say _myname "-" right(keylen, 10) || ,
            right(reclen,  10) || ,
            right(i_blksz, 10) || , 
            right(p_blksz, 10) || ,
            right(p_count, 10) || ,
            right(p_count*(i_blksz/reclen), 10) || ,
            right(p_count*(p_blksz/reclen), 10)
      else ,
         say _myname "-" right(reclen, 10) || ,
            right(i_blksz, 10) || , 
            right(p_blksz, 10) || ,
            right(p_count, 10) || ,
            right(p_count*(i_blksz/reclen), 10) || ,
            right(p_count*(p_blksz/reclen), 10)
      
      i_blksz = c_blksz
      i_count = c_count
   end
   p_blksz = c_blksz
   p_count = c_count

end

if keylen \= 0 then ,
   say _myname "-" right(keylen, 10) || ,
      right(reclen,  10) || ,
      right(i_blksz, 10) || , 
      right(p_blksz, 10) || ,
      right(p_count, 10) || ,
      right(p_count*(i_blksz/reclen), 10) || ,
      right(p_count*(p_blksz/reclen), 10)
else ,
   say _myname "-" right(reclen, 10) || ,
      right(i_blksz, 10) || , 
      right(p_blksz, 10) || ,
      right(p_count, 10) || ,
      right(p_count*(i_blksz/reclen), 10) || ,
      right(p_count*(p_blksz/reclen), 10)
exit

blksxtrk:procedure
parse arg blksz, keyln
   c = 10
   if keyln = 0  then ,
      k = 0
   else do
      kn = ( keyln + 6 ) % 232 + 1 - ( ( ( keyln + 6 ) // 232) = 0 )
      k  = 9 + ( keyln + 6 * kn + 6 ) % 34 + 1 - ( ( ( keyln + 6 * kn + 6 ) // 34) = 0 )
   end
   dn = ( blksz + 6 ) % 232 + 1 - ( ( ( blksz + 6 ) // 232) = 0 )
   d  = 9 + ( blksz + 6 * dn + 6 ) % 34 + 1 - ( ( ( blksz + 6 * dn + 6 ) // 34) = 0 )
   s = c + k + d
   return 1729 % s