/* REXX REALIAS Automatically reassign aliases for routines whose 'Impact Analysis' section indicates the need. Use '(routine name) ?' for HELP-text. Written by Frank Clarke rexxhead@yahoo.com 20010320 Impact Analysis . SYSEXEC RUNDATA . SYSEXEC TRAPOUT Modification History 20020125 fxc use PDS to DELETE and ALIAS; use of TSO DELETE and RENAME causes dataset enqueues; 20230519 fxc adjust HELP; 20230726 fxc adjust HELP; 20240104 fxc RUNDATA was padding TV; 20240217 fxc add RUNDATA to I/A section; 20240308 fxc chg dollar-sign to @ everywhere; 20240415 fxc DUMP_QUEUE quiet; */ arg argline address TSO /* REXXSKEL ver.19991109 */ arg parms "((" opts signal on syntax signal on novalue call TOOLKIT_INIT /* conventional start-up -*/ rc = trace("O") rc = trace(tv) info = parms /* to enable parsing */ call A_INIT /* -*/ call E_READ_SOURCE /* -*/ if \sw.nested then call DUMP_QUEUE 'quiet' /* -*/ exit /*@ REALIAS */ /* Initialization . ----------------------------------------------------------------- */ A_INIT: /*@ */ if branch then call BRANCH address TSO if info = "" then call HELP parse var info basetext info if Sysdsn(basetext) <> "OK" then do helpmsg = basetext "is an invalid parameter." call HELP /* ...and don't come back */ end /* basetext is not a dsn(mbr) */ parse var basetext dsn "(" basenm ")" back if basenm = "" then do /* membername not present */ helpmsg = "No membername was specified." call HELP /* ...and don't come back */ end /* basetext is not a dsn(mbr) */ dsn = dsn""back /* possible ending quote */ if Sysdsn(dsn) <> "OK" then do /* dsn is not a dsn! */ helpmsg = dsn "is an invalid dataset name." call HELP /* ...and don't come back */ end /* basetext is not a dsn(mbr) */ /* DSN will be used in JCL -- clean it up */ if Left(dsn,1) = "'" then, /* quoted */ dsn = Strip(dsn ,, "'") else, /* unquoted */ dsn = Userid()"."dsn /* fully-qualified */ parse value "0 0 0 0 0 0 0 0" with, aliasrows, . return /*@ A_INIT */ /* Read the subject EXEC top to bottom to discover all ALIAS lines in the Impact Analysis section. First locate "Impact Analysis", then any lines which contain the string "(alias)" as the 2nd word. Stop when a blank line is encountered. . ----------------------------------------------------------------- */ E_READ_SOURCE: /*@ */ if branch then call BRANCH address TSO "ALLOC FI(@TMP) DA("basetext") SHR REU" if rc > 0 then do /* failed to allocate */ helpmsg = basetext "failed to allocate." call HELP /* ...and don't come back */ end "NEWSTACK" "EXECIO * DISKR @TMP (FINIS" /* load the queue */ "FREE FI(@TMP)" do queued() parse pull line if Pos("Impact Analysis",line) > 0 then leave end if Pos("Impact Analysis",line) = 0 then do say "No impact analysis section found" end /* ran off the queue */ else, do queued() parse pull line if line = "" then leave /* end of IA section */ if WordPos("(alias)",line) > 0 then, do parse var line dot alit aliasnm . "PDS '"dsn"' DELETE" aliasnm "PDS '"dsn"' ALIAS " basenm aliasnm end end /* queued */ "DELSTACK" return /*@ E_READ_SOURCE */ /* . ----------------------------------------------------------------- */ LOCAL_PREINIT: /*@ customize opts */ address TSO "NEWSTACK" "RUNDATA READ PROGRAM REALIAS " pull tag tagval if tag = "" then nop else @z = Value( tag,Strip( tagval ) ) "DELSTACK" return /*@ LOCAL_PREINIT */ /* subroutines below LOCAL_PREINIT are not selected by SHOWFLOW */ /* . ----------------------------------------------------------------- */ HELP: /*@ */ address TSO;"CLEAR" if helpmsg <> "" then say helpmsg; say "" ex_nam = Left(exec_name,8) /* predictable size */ say " " say " "ex_nam" scans a REXX exec for information about required ALIASes. " say " " say " Syntax: "ex_nam" dsn(mbr) (Required) " say " " say " dsn(mbr) is a TSO-format datasetname with membername. This " say " must be immediately allocable or "exec_name "fails. " say " " "NEWSTACK"; pull ; "CLEAR" ; "DELSTACK" say " Debugging tools provided include: " say " " say " BRANCH show all paragraph entries. " say " " say " TRACE tv will use value following TRACE to place the execution in" say " 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" (( BRANCH TRACE ?R " if sysvar("SYSISPF") = "ACTIVE" then, 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 */ /* . ----------------------------------------------------------------- */ 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+1) /* 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")" if wordpos(dlm,back) = 0 then /* search for ending delimiter*/ helpmsg = helpmsg, "No matching second delimiter("dlm") with KEYPHRS("kp")" 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 sourceline(ssii) ; 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 */ 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 . sw.nested = sysvar("SYSNEST") = "YES" sw.batch = sysvar("SYSENV") = "BACK" sw.inispf = sysvar("SYSISPF") = "ACTIVE" parse value KEYWD("TRACE") "N" with tv . tk_globalvars = "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 */