/* REXX SPACERPT produce a report showing the allocation status of classes of libraries. The caller of SPACERPT will be expected to provide either a single catalog level as the first parm, or a dataset which specifies the catalog level(s) to be examined, or both. SPACERPT will obtain the list of dataset names and the allocation data for each, formatting them as appropriate. Written by Frank Clarke, Oldsmar FL Impact Analysis . SYSEXEC TRAPOUT Modification History 20020916 fxc OUTPUT may be a PO dataset; additional header line; 20250207 fxc upgrade from v.19991109 to v.20240618; upgrade logging; */ arg argline address TSO /* REXXSKEL ver.20240618 */ arg parms "((" opts signal on syntax signal on novalue call TOOLKIT_INIT /* conventional start-up -*/ rc = trace(tv) info = parms /* to enable parsing */ if parms = "" then call HELP /* ...and don't come back */ call A_INIT /* -*/ "NEWSTACK" call B_RUN_LIST /* -*/ call E_WRITE /* -*/ "DELSTACK" if \sw.0SkipLog then, call ZB_SAVELOG /* -*/ if \sw.0nested then call DUMP_QUEUE /* -*/ exit /*@ SPACERPT */ /* . ----------------------------------------------------------------- */ A_INIT: /*@ */ if branch then call BRANCH address TSO parse value "0 0 0 0 0 0" with, outpstat . call A0_SETUP_LOG /* -*/ call AA_KEYWDS /* -*/ call AB_LOAD_LEVELS /* -*/ msg. = "??" msg.0000 = "OK" msg.0005 = "NC" msg.0009 = "MI" return /*@ A_INIT */ /* . ----------------------------------------------------------------- */ A0_SETUP_LOG: /*@ */ if branch then call BRANCH address TSO msglim = SYSVAR( "SYSWTERM" ) - 12 parse value "0 0 0 0 0" with, log# log. . parse value Date("S") Time("S") Time("N") with, yyyymmdd sssss hhmmss . hhmmss = Space( Translate( hhmmss,' ',':' ) ,0 ) parse var yyyymmdd 4 yrdigit 5 mm 7 dd /* 9 12 14 maybe */ if Pos(yrdigit,"13579") > 0 then mm = mm + 12 /* mm=24 */ logtag = Substr("ABCDEFGHIJKLMNOPQRSTUVWX",mm,1) /* logtag=X */ subid = logtag""dd""Left( hhmmss,4 ) /* X141743 ? */ vb128.0 = "NEW CATALOG UNIT(SYSDA) SPACE(1 5) TRACKS", "RECFM( V B ) LRECL( 128 ) BLKSIZE( 0 )" vb128.1 = "MOD" /* if it already exists... */ logdsn = "@LOG."exec_name"."subid".LIST" if Sysdsn( logdsn ) = "OK" then, call ZL_LOGMSG( "-------------------" ) logpref = "("Branch("ID")")" call ZL_LOGMSG( exec_name "started by" Userid() yyyymmdd hhmmss ) call ZL_LOGMSG( logpref "Arg:" argline ) return /*@ A0_SETUP_LOG */ /* . ----------------------------------------------------------------- */ AA_KEYWDS: /*@ */ if branch then call BRANCH address TSO parse value KEYWD("OUTPUT") "VIO" with , outdsn . dsni = KEYWD("LEVELS") parse var info single_lvl /* remaining parms */ if Words(dsni single_lvl) < 1 then do helpmsg = "Either LEVELS or a catalog level must be specified. ", "Both MAY be specified. " call HELP /* ...and don't come back -*/ end if outdsn = "VIO" then return /* can't check status */ outpstat = Sysdsn(outdsn) = "OK" /* 1=exists, 0=missing */ return /*@ AA_KEYWDS */ /* Read to populate . . ----------------------------------------------------------------- */ AB_LOAD_LEVELS: /*@ */ if branch then call BRANCH address TSO info = single_lvl if dsni <> "" then do "ALLOC FI( $LVL ) DA( "dsni" ) SHR REU " if rc > 4 then do helpmsg = dsni "could not be allocated. Make sure this dataset", "exists and is correctly populated." call HELP /* ...and don't come back -*/ end /* ALLOC failure */ end /* dsni */ "NEWSTACK" if dsni <> "" then do "EXECIO * DISKR $LVL (FINIS" /* load the queue */ "FREE FI($LVL)" end /* dsni */ do queued() /* every line */ pull line if Left(line,1) = "*" then iterate /* ignore comments */ info = Space(info line,1) end /* queued() */ "DELSTACK" logpref = "("Branch("ID")")" call ZL_LOGMSG( logpref "Consolidated levels:" info ) return /*@ AB_LOAD_LEVELS */ /* is populated with datasetnames. Use LISTDSI on each datasetname to acquire allocation data. . ----------------------------------------------------------------- */ B_RUN_LIST: /*@ */ if branch then call BRANCH address TSO do bx = 1 to Words( info ) thislvl = Word( info ,bx ) rc = Outtrap( "lc." ) "LISTC LVL( "thislvl" )" rc = Outtrap("off") call BH_HEADER /* initial headers -*/ do bz = 1 to lc.0 parse var lc.bz lit . dsn . if lit <> "NONVSAM" then iterate call BA_LISTDSI end /* bz */ end /* bx */ return /*@ B_RUN_LIST */ /* Format and print allocation data for each dataset. . ----------------------------------------------------------------- */ BA_LISTDSI: /*@ */ if branch then call BRANCH address TSO ldrc = Listdsi("'"dsn"' directory norecall") /* sets: */ dsstat = msg.sysreason /* SYSREASON */ if lines//6 = 0 then do; queue " "; lines = lines + 1; end if dsstat = "MI" then do queue " "Left(dsn,47) "Migrated" lines = lines + 1 end if dsstat <> "OK" then return if sysadirblk = "NO_LIM" then do sysdsorg = "POE" sysused = "---" sysadirblk = "N/L" sysudirblk = "---" end /* NO_LIM */ queue " "Left(dsn,47) Left(sysdsorg,3), Left(sysrecfm,3), Right(syslrecl,5), Right(sysblksize,5), Right(sysalloc,5), Right(sysused,5), Right(sysprimary,5), Right(sysseconds,5), Right(sysextents,2), Right(sysadirblk,4), Right(sysudirblk,4), Right(sysmembers,5), sysunits lines = lines + 1 if lines > 53 then call BH_HEADER /* -*/ return /*@ BA_LISTDSI */ /* Write a header-line for each page. . ----------------------------------------------------------------- */ BH_HEADER: Procedure expose, /*@ */ (tk_globalvars) lines if branch then call BRANCH address TSO lines = 0 dsn = "Dataset Name" sysdsorg = "Org" sysrecfm = "Len" syslrecl = "Lrecl" sysblksize = "Blksz" sysalloc = "Alloc" sysused = "Used " sysprimary = "Prim" sysseconds = "2ry" sysextents = "X" sysadirblk = "D/A" sysudirblk = "D/U" sysmembers = "Mbrs " sysunits = "Units" queue "1 Space Allocation Report " Date("S") Time() queue "0"Left(dsn,47) Left(sysdsorg,3), Left(sysrecfm,3), Right(syslrecl,5), Right(sysblksize,5), Right(sysalloc,5), Right(sysused,5), Right(sysprimary,5), Right(sysseconds,5), Right(sysextents,2), Right(sysadirblk,4), Right(sysudirblk,4), Right(sysmembers,5), sysunits return /*@ BH_HEADER */ /* Dump the queue. . ----------------------------------------------------------------- */ E_WRITE: /*@ */ if branch then call BRANCH address TSO logpref = "("Branch("ID")")" call ZL_LOGMSG( logpref queued() "lines written to" outdsn ) if outdsn = "VIO" then, "ALLOC FI( $TMP ) NEW UNIT( VIO ) SPACE( 1 1 ) TRACKS", "RECFM( V B A ) LRECL( 128 ) BLKSIZE( 0 )" else do alloc.0 = "NEW CATALOG UNIT( SYSDA ) SPACE( 1 1 ) TRACKS", "RECFM( V B A ) LRECL( 128 ) BLKSIZE( 0 )" alloc.1 = "SHR" /* if it already exists... */ "ALLOC FI($TMP) DA( "outdsn" ) REU" alloc.outpstat end "EXECIO" queued() "DISKW $TMP ( FINIS" call EB_BROWSE_OUTPUT /* -*/ "FREE FI( $TMP )" return /*@ E_WRITE */ /* . ----------------------------------------------------------------- */ EB_BROWSE_OUTPUT: /*@ */ if branch then call BRANCH address ISPEXEC if sw.0batch then return if \sw.0inispf then return "CONTROL ERRORS RETURN" /* I'll handle my own */ "LMINIT DATAID( DAID ) DDNAME( $TMP )" "BROWSE DATAID( "daid" )" "LMFREE DATAID( "daid" )" return /*@ EB_BROWSE_OUTPUT */ /* . ----------------------------------------------------------------- */ LOCAL_PREINIT: /*@ customize opts */ address TSO sw.0SkipLog = SWITCH("NOLOG") return /*@ LOCAL_PREINIT */ /* subroutines below LOCAL_PREINIT are not selected by SHOWFLOW */ /* . ----------------------------------------------------------------- */ ZB_SAVELOG: /*@ */ if branch then call BRANCH address TSO if Symbol("LOG#") = "LIT" then return /* not yet set */ dsstat = Sysdsn( logdsn ) = "OK" /* 1 if it exists */ "ALLOC FI(@LOG) DA(" logdsn ") REU" vb128.dsstat "EXECIO" log# "DISKW @LOG (STEM LOG. FINIS" "FREE FI(@LOG)" return /*@ ZB_SAVELOG */ /* . ----------------------------------------------------------------- */ ZL_LOGMSG: Procedure expose, /*@ */ (tk_globalvars) log. log# msglim rc = Trace("O") address TSO parse arg msgtext /* for making the msgline always reasonably short: */ do while Length(msgtext) > msglim pt = LastPos(" ",msgtext,msglim) slug = Left(msgtext,pt) if monitor then say, slug parse value log#+1 slug with, zz log.zz 1 log# . msgtext = " "Substr(msgtext,pt) end /* while msglim */ parse value log#+1 msgtext with, zz log.zz 1 log# . if monitor then say, msgtext return /*@ ZL_LOGMSG */ /* . ----------------------------------------------------------------- */ HELP: /*@ */ address TSO;"CLEAR" if helpmsg <> "" then do ; say helpmsg; say ""; end ex_nam = Left(exec_name,8) /* predictable size */ say " "ex_nam" produces a printable report showing the allocation status " say " for specified datasets. " say " " say " Syntax: "ex_nam" single-lvl " say " LEVELS dsni " say " OUTPUT dsno (Defaults)" say " " say " single-lvl names a catalog level (or levels) to be " say " examined. In operation, any tokens left after " say " parsing of LEVELS and OUTPUT are treated as " say " catalog levels to be examined. " say " " say " dsni names a dataset containing LEVEL data suitable " say " for use by LISTC. Each line of this dataset may" say " contain (0-n) specifications appropriate for " say " LISTC, but any line which begins with an " say " asterisk (*) will be ignored. The contents of " say " this dataset, if used, will be in addition to " say " the single-lvl specified as a parm, if any. " say " " say " At least one of single-lvl and dsni must be specified. " say " " say " more..... " "NEWSTACK" ; pull ; "CLEAR" ; "DELSTACK" say " " say " dsno names a dataset to receive the output, a report " say " showing datasetname and space usage statistics. " say " If does not exist, it will be created as " say " PS/VBA/128. " say " " say " If is not specified, it will be created " say " as a VIO dataset and purged at CLOSE. The VIO " say " dataset used may be printed via any appropriate " say " facility during the final BROWSE session. " say " " "NEWSTACK" ; pull ; "CLEAR" ; "DELSTACK" say " Debugging tools provided include: " say " " say " MONITOR: displays key information throughout processing. " say " Displays most paragraph names upon entry. " say " " say " BRANCH: show all paragraph entries. " say " " say " TRACE tv: will use value following TRACE to place the execution " say " in REXX TRACE Mode. " say " " say " " say " Debugging tools can be accessed in the following manner: " say " " say " TSO "ex_nam" parameters (( debug-options " say " " say " For example: " say " " say " TSO "ex_nam" (( MONITOR TRACE ?R " address ISPEXEC "CONTROL DISPLAY REFRESH" exit /*@ HELP */ /* . ----------------------------------------------------------------- */ BRANCH: Procedure expose, /*@ */ sigl exec_name rc = trace("O") /* we do not want to see this */ arg brparm . origin = sigl /* where was I called from ? */ do currln = origin to 1 by -1 /* inch backward to label */ if Right(Word(Sourceline(currln),1),1) = ":" then do parse value sourceline(currln) with pgfname ":" . /* Label */ leave ; end /* name */ end /* currln */ select when brparm = "NAME" then return(pgfname) /* Return full name */ when brparm = "ID" then do /* wants the prefix */ parse var pgfname pgfpref "_" . /* get the prefix */ return(pgfpref) end /* brparm = "ID" */ otherwise say left(sigl,6) left(pgfname,40) exec_name "Time:" time("L") end /* select */ return /*@ BRANCH */ /* . ----------------------------------------------------------------- */ DUMP_QUEUE: /*@ Take whatever is in stack */ rc = trace("O") /* and write to the screen */ address TSO arg mode . "QSTACK" /* how many stacks? */ stk2dump = rc - tk_init_stacks /* remaining stacks */ if stk2dump = 0 & queued() = 0 then return if mode <> "QUIET" then, say "Total Stacks" rc , /* rc = #of stacks */ " Begin Stacks" tk_init_stacks , /* Stacks present at start */ " Excess Stacks to dump" stk2dump do dd = rc to tk_init_stacks by -1 /* empty each one. */ if mode <> "QUIET" then, say "Processing Stack #" dd " Total Lines:" queued() do queued();parse pull line;say line;end /* pump to the screen */ "DELSTACK" /* remove stack */ end /* dd = 1 to rc */ return /*@ DUMP_QUEUE */ /* Handle CLIST-form keywords added 20020513 . ----------------------------------------------------------------- */ CLKWD: Procedure expose info /*@ hide all except info */ arg kw kw = kw"(" /* form is 'KEY(DATA)' */ kw_pos = Pos(kw,info) /* find where it is, maybe */ if kw_pos = 0 then return "" /* send back a null, not found*/ rtpt = Pos(") ",info" ",kw_pos) /* locate end-paren */ slug = Substr(info,kw_pos,rtpt-kw_pos+1) /* isolate */ info = Delstr(info,kw_pos,rtpt-kw_pos+1) /* excise */ parse var slug (kw) slug /* drop kw */ slug = Reverse(Substr(Reverse(Strip(slug)),2)) return slug /*@CLKWD */ /* Handle multi-word keys 20020513 . ----------------------------------------------------------------- */ KEYWD: Procedure expose info /*@ hide all vars, except info*/ arg kw kw_pos = wordpos(kw,info) /* find where it is, maybe */ if kw_pos = 0 then return "" /* send back a null, not found*/ kw_val = word(info,kw_pos+Words(kw))/* get the next word */ info = Delword(info,kw_pos,2) /* remove both */ return kw_val /*@ KEYWD */ /* . ----------------------------------------------------------------- */ KEYPHRS: Procedure expose, /*@ */ info helpmsg exec_name /* except these three */ arg kp wp = wordpos(kp,info) /* where is it? */ if wp = 0 then return "" /* not found */ front = subword(info,1,wp-1) /* everything before kp */ back = subword(info,wp+1) /* everything after kp */ parse var back dlm back /* 1st token must be 2 bytes */ if length(dlm) <> 2 then /* Must be two bytes */ helpmsg = helpmsg, "Invalid length for delimiter("dlm") with KEYPHRS("kp")", info if wordpos(dlm,back) = 0 then /* search for ending delimiter*/ helpmsg = helpmsg, "No matching second delimiter("dlm") with KEYPHRS("kp")", info if helpmsg <> "" then call HELP /* Something is wrong */ parse var back kpval (dlm) back /* get everything b/w delim */ info = front back /* restore remainder */ return Strip(kpval) /*@ KEYPHRS */ /* . ----------------------------------------------------------------- */ NOVALUE: /*@ */ say exec_name "raised NOVALUE at line" sigl say " " say "The referenced variable is" condition("D") say " " zsigl = sigl signal SHOW_SOURCE /*@ NOVALUE */ /* . ----------------------------------------------------------------- */ SHOW_SOURCE: /*@ */ call DUMP_QUEUE /* Spill contents of stacks -*/ if sourceline() <> "0" then /* to screen */ say sourceline(zsigl) rc = trace("?R") nop exit /*@ SHOW_SOURCE */ /* . ----------------------------------------------------------------- */ SS: Procedure /*@ Show Source */ arg ssbeg ssend . if ssend = "" then ssend = 10 if \datatype(ssbeg,"W") | \datatype(ssend,"W") then return ssend = ssbeg + ssend do ssii = ssbeg to ssend ; say Strip(sourceline(ssii),'T') ; end return /*@ SS */ /* . ----------------------------------------------------------------- */ SWITCH: Procedure expose info /*@ */ arg kw sw_val = Wordpos(kw,info) > 0 /* exists = 1; not found = 0 */ if sw_val then /* exists */ info = Delword(info,Wordpos(kw,info),1) /* remove it */ return sw_val /*@ SWITCH */ /* . ----------------------------------------------------------------- */ SYNTAX: /*@ */ errormsg = exec_name "encountered REXX error" rc "in line" sigl":", errortext(rc) say errormsg zsigl = sigl signal SHOW_SOURCE /*@ SYNTAX */ /* Can call TRAPOUT. . ----------------------------------------------------------------- */ TOOLKIT_INIT: /*@ */ address TSO info = Strip(opts,"T",")") /* clip trailing paren */ parse source sys_id how_invokt exec_name DD_nm DS_nm, as_invokt cmd_env addr_spc usr_tokn parse value "" with tv helpmsg . parse value 0 "ISR00000 YES" "Error-Press PF1" with, sw. zerrhm zerralrm zerrsm if SWITCH("TRAPOUT") then do "TRAPOUT" exec_name parms "(( TRACE R" info exit end /* trapout */ sw.0nested = sysvar("SYSNEST") = "YES" sw.0batch = sysvar("SYSENV") = "BACK" sw.0inispf = sysvar("SYSISPF") = "ACTIVE" parse value KEYWD("TRACE") "N" with tv . if Word(parms,1) = "?" then call HELP /* I won't be back */ "QSTACK" ; tk_init_stacks = rc /* How many stacks? */ parse value SWITCH("BRANCH") SWITCH("MONITOR") SWITCH("NOUPDT") with, branch monitor noupdt . parse value mvsvar("SYSNAME") sysvar("SYSNODE") with, #tk_cpu node . tk_globalvars = "exec_name tv helpmsg sw. zerrhm zerralrm ", "zerrsm zerrlm tk_init_stacks branch monitor ", "noupdt" call LOCAL_PREINIT /* for more opts -*/ return /*@ TOOLKIT_INIT */