/* REXX REXXIA Imp. Analysis for REXXSKEL-based routines. Use '(routine name) ?' for HELP-text. Written by Frank Clarke 20021218 rexxhead@yahoo.com Impact Analysis . SYSEXEC GETIA (macro) . SYSEXEC MEMBERS . SYSEXEC STRSORT . SYSEXEC TRAPOUT Modification History 20211104 fxc Remove references to the IA-form table that was never implemented; switch to ZL_LOGMSG for writing report; 20230323 fxc Fixed the problem of displaying subroutines over and over. When a subroutine is reported as 'needed by this main member' the first time, it is placed on an exclude-list and subsequently skipped. The exclude-list is wiped for every new main member; 20230411 fxc better logging; 20230517 fxc adjust HELP; 20230518 fxc Save log only if requested; if not savelog, force monitor; 20230530 fxc better comments; better logging: 20230723 fxc modernize logging; 20230729 fxc clip long lines; 20230810 fxc set msglim based on screen width; 20230829 fxc correct setting of logpref; 20230907 fxc write output to REXXIA.LIST; 20230908 fxc set log lrecl to 255; 20240210 fxc identify input dsn on output display; 20240308 fxc chg dollar-sign to @ everywhere; 20240415 fxc DUMP_QUEUE quiet; */ arg argline address TSO /* REXXSKEL ver.20020513 */ arg parms "((" opts signal on syntax signal on novalue boilerplate = "POST FCCMDUPD" /* ref'd in HELP */ call TOOLKIT_INIT /* conventional start-up -*/ rc = Trace("O"); rc = Trace(tv) info = parms /* to enable parsing */ call A_INIT /* Initialization -*/ call BB_MBRLIST /* Create report -*/ if sw.0savelog then, call ZB_SAVELOG /* Write LOG -*/ if \sw.nested then call DUMP_QUEUE 'quiet' /* -*/ exit /*@ REXXIA */ /* Initialization . ----------------------------------------------------------------- */ A_INIT: /*@ */ if branch then call BRANCH address TSO call AA_SETUP_LOG /* -*/ ignore = "TRAPOUT" parse value '3f'x '3f3f'x 'ef'x 'efef'x with , x3f x3f3f xef xefef . parse value "" with, realmem tags subrouts missing, iaexec. iaplib. iaslib. parse value KEYWD( "WRITE" ) 'REXXIA.LIST' with, outds . parse var info dsn info /* isolate dsname */ if Left(dsn,1) = "'" then, /* quoted */ dsn = Strip(dsn,,"'") /* unquoted */ else, /* unqualified */ dsn = Userid()"."dsn /* fully-qualified */ sw.0Detail = SWITCH( "DETAIL" ) sw.0ExclBP = SWITCH( "EXCLBP" ) /* exclude boilerplate */ if sw.0ExclBP then , ignore = ignore boilerplate /* incl BP in ignore list */ return /*@ A_INIT */ /* Prep LOG dataset . ----------------------------------------------------------------- */ AA_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 ? */ vb4k.0 = "NEW CATALOG UNIT(SYSDA) SPACE(1 5) TRACKS", "RECFM( V B ) LRECL( 255 ) BLKSIZE( 0 )" logdsn = "@LOG."exec_name"."subid".LIST" logpref = exec_name "("Branch( "ID" )")" call ZL_LOGMSG( logpref, exec_name "started by" Userid() yyyymmdd hhmmss ) call ZL_LOGMSG( logpref "Running from" FIND_ORIGIN() ) call ZL_LOGMSG( logpref "Arg:" argline ) return /*@ AA_SETUP_LOG */ /* For each member, find the 'Impact Analysis' section and parse it to find all SYSPROC and SYSEXEC, as well as any ISPPLIB or ISPSLIB or ISPCLIB that are not marked as 'embedded'. . ----------------------------------------------------------------- */ BB_MBRLIST: /*@ */ bb_tv = Trace() /* setting at entry */ if branch then call BRANCH address TSO "NEWSTACK" "MEMBERS '"dsn"' ((STACK LINE ALIAS " pull mbrlist "DELSTACK" logpref = exec_name "("Branch( "ID" )")" call ZL_LOGMSG( logpref "Members:" mbrlist ) if sw.0Detail then say, "Dataset" dsn "has" Words(mbrlist) "members." parse value '' with, orig_mbrs excllist "NEWSTACK" do while mbrlist <> "" /* every member */ parse var mbrlist mbr mbrlist parse var mbr mbr "(*)" /* in case it's an ALIAS */ orig_mbrs = orig_mbrs mbr /* Macro GETIA may queue one or more lines to the stack: DDN */ address ISPEXEC, "EDIT DATASET('"dsn"("mbr")') MACRO(GETIA)" if sw.0Detail then say, "GETIA delivered" queued() "DDNs for member" mbr if queued() = 0 then iterate /* nothing to process */ do queued() pull line /* from GETIA */ parse var line tag tagval /* DDN elem1 elem2 ... */ call ZL_LOGMSG( logpref, "Mbr:" Left( mbr,8 ) "Elements:" tagval ) w1 = "" do Words(ignore) /* drop these */ parse value ignore w1 with w1 ignore pt = WordPos(w1,tagval) if pt > 0 then , tagval = DelWord(tagval ,pt,1) end /* ignore */ ignore = ignore w1 if tag = "IAEXEC" then do iaexec.mbr = tagval do Words(tagval) parse var tagval w1 tagval if WordPos(w1,tags) = 0 then, /* don't replicate */ tags = tags w1 /* subroutines used anywhere */ end /* tagval */ end /* IAEXEC */ else, if tag = "IAPLIB" then, iaplib.mbr = tagval else, if tag = "IASLIB" then, iaslib.mbr = tagval end /* queued */ end /* mbrlist */ "DELSTACK" /* Compile a list of subroutines used by */ subrouts = STRSORT(tags) rc=Trace("O"); rc=Trace(bb_tv) /* Compare orig_mbrs to subrouts to find any missing members */ w1 = '' do Words(subrouts) /* every subroutine */ parse value subrouts w1 with w1 subrouts if WordPos(w1,orig_mbrs) = 0 then, missing = missing w1 /* add it */ end /* subrouts */ subrouts = subrouts w1 call ZL_LOGMSG( logpref "Subroutines:" subrouts ) if sw.0Detail then say, "Subrouts:" subrouts if sw.0Detail then say, "Missing:" missing if missing <> "" then do call ZL_LOGMSG( logpref, "The following elements are needed by routines", "in '"dsn"' and were not found:" ) call ZL_LOGMSG( logpref missing ) end rc=Trace("O"); rc=Trace(bb_tv) address TSO "NEWSTACK" alloc.0 = "NEW CATALOG UNIT(SYSDA) SPACE( 2 ) TRACKS", "RECFM( V B ) LRECL( 255 ) BLKSIZE( 0 )" alloc.1 = "SHR" /* if it already exists... */ tempstat = Sysdsn( outds ) = "OK" /* 1=exists, 0=missing */ "ALLOC FI( @TMP ) DA( "outds" ) REU" alloc.tempstat call BBD_DISPLAY_STRUCTURE /* -*/ push " " push "Impact analysis for '"dsn"'" "EXECIO" queued() "DISKW @TMP (FINIS " "FREE FI( @TMP ) " "DELSTACK" address ISPEXEC "VIEW DATASET( "outds" ) " return /*@ BB_MBRLIST */ /* Display subroutines indented to show the structure . ----------------------------------------------------------------- */ BBD_DISPLAY_STRUCTURE: /*@ */ if branch then call BRANCH address TSO w1 = "" indent = 4 do Words(orig_mbrs) /* every member */ excllist = '' /* refresh per mbr */ parse value orig_mbrs w1 with w1 orig_mbrs backtrace = w1 call BBDL_NEXTLINE w1 0 , /* -*/ iaexec.w1 xef iaplib.w1 xef iaslib.w1 xef backtrace, xef excllist end /* orig_mbrs */ parse value orig_mbrs w1 with orig_mbrs return /*@ BBD_DISPLAY_STRUCTURE */ /* Indent next line to show structure. . NOTE that neither 'trace' nor 'backtrace' nor 'space' are globally recognized. 'Trace', 'backtrace', and 'space' are restored to their previous condition when BBDL returns to its caller. 'excllist' is refreshed only when the next main member is processed. . ----------------------------------------------------------------- */ BBDL_NEXTLINE: Procedure expose, /*@ */ missing iaexec. iaplib. iaslib. indent, excllist, log. log# msglim xef (tk_globalvars) if branch then call BRANCH address TSO parse arg mbr space execs (xef) panels (xef) skels (xef) trace, (xef) excllist if space = 0 then, slug = Copies(" ",space)Left(mbr,12)":" /* show the mbrname */ else, slug = Copies(" ",space)Left(" ",12)":" /* don't show mbrname */ logpref = exec_name "("Branch( "ID" )")" do Words(execs) parse var execs w1 execs if WordPos(w1,excllist) > 0 then iterate /* already displayed */ if WordPos(w1,trace) > 0 then iterate /* already displayed */ if WordPos(w1,missing) > 0 then, text = slug w1"*" /* mark it 'missing' */ else , text = slug w1 call ZL_LOGMSG( logpref text ) /* mark it 'missing' */ queue text backtrace = trace w1 excllist = excllist w1 /* exclude it hereafter */ CALL BBDL_NEXTLINE w1 space+indent, /* -*/ iaexec.w1 xef iaplib.w1 xef iaslib.w1 xef backtrace, xef excllist slug = Copies(" ",space)Left(" ",12)":" /* restore 'slug' */ end /* execs */ logpref = exec_name "("Branch( "ID" )")" do Words(panels) parse var panels w1 panels if WordPos(w1,trace) > 0 then iterate text = slug w1 call ZL_LOGMSG( logpref text ) queue text backtrace = trace w1 CALL BBDL_NEXTLINE w1 space+indent, /* -*/ iaexec.w1 xef iaplib.w1 xef iaslib.w1 xef backtrace, xef ' ' slug = Copies(" ",space)Left(" ",12)":" /* restore 'slug' */ end /* panels */ do Words(skels) parse var skels w1 skels if WordPos(w1,trace) > 0 then iterate text = slug w1 call ZL_LOGMSG( logpref text ) queue text backtrace = trace w1 CALL BBDL_NEXTLINE w1 space+indent, /* -*/ iaexec.w1 xef iaplib.w1 xef iaslib.w1 xef backtrace, xef ' ' slug = Copies(" ",space)Left(" ",12)":" /* restore 'slug' */ end /* skels */ return /*@ BBDL_NEXTLINE */ /* . ----------------------------------------------------------------- */ LOCAL_PREINIT: /*@ customize opts */ address TSO sw.0savelog = SWITCH( "LOG" ) 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 */ "ALLOC FI(@LOG) DA("logdsn") REU" vb4k.0 "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 */ /* Find where code was run from. It assumes cataloged data sets. Original by Doug Nadel With SWA code lifted from Gilbert Saint-flour's SWAREQ exec . ----------------------------------------------------------------- */ FIND_ORIGIN: Procedure /*@ */ answer="* UNKNOWN *" /* assume disaster */ Parse Source . . name dd ds . /* get known info */ Call listdsi(dd "FILE") /* get 1st ddname from file */ Numeric digits 10 /* allow up to 7FFFFFFF */ If name = "?" Then /* if sequential exec */ answer="'"ds"'" /* use info from parse source */ Else /* now test for members */ If sysdsn("'"sysdsname"("name")'")="OK" Then /* if in 1st ds */ answer="'"sysdsname"("name")'" /* go no further */ Else /* hooboy! Lets have some fun!*/ Do /* scan tiot for the ddname */ tiotptr=24+ptr(12+ptr(ptr(ptr(16)))) /* get ddname array */ tioelngh=c2d(stg(tiotptr,1)) /* nength of 1st entry */ Do Until tioelngh=0 | tioeddnm = dd /* scan until dd found */ tioeddnm=strip(stg(tiotptr+4,8)) /* get ddname from tiot */ If tioeddnm <> dd Then /* if not a match */ tiotptr=tiotptr+tioelngh /* advance to next entry */ tioelngh=c2d(stg(tiotptr,1)) /* length of next entry */ End If dd=tioeddnm Then, /* if we found it, loop through the data sets doing an swareq for each one to get the dsname */ Do Until tioelngh=0 | stg(4+tiotptr,1)<> " " tioejfcb=stg(tiotptr+12,3) jfcb=swareq(tioejfcb) /* convert SVA to 31-bit addr */ dsn=strip(stg(jfcb,44)) /* dsname JFCBDSNM */ vol=storage(d2x(jfcb+118),6) /* volser JFCBVOLS (not used) */ If sysdsn("'"dsn"("name")'")='OK' Then, /* found it? */ Leave /* we is some happy campers! */ tiotptr=tiotptr+tioelngh /* get next entry */ tioelngh=c2d(stg(tiotptr,1)) /* get entry length */ End answer="'"dsn"("name")'" /* assume we found it */ End Return answer /*@ FIND_ORIGIN */ /* . ----------------------------------------------------------------- */ ptr: Return c2d(storage(d2x(Arg(1)),4)) /*@ */ /* . ----------------------------------------------------------------- */ stg: Return storage(d2x(Arg(1)),Arg(2)) /*@ */ /* . ----------------------------------------------------------------- */ SWAREQ: Procedure /*@ */ If right(c2x(Arg(1)),1) \= 'F' Then /* SWA=BELOW ? */ Return c2d(Arg(1))+16 /* yes, return sva+16 */ sva = c2d(Arg(1)) /* convert to decimal */ tcb = c2d(storage(21c,4)) /* TCB PSATOLD */ tcb = ptr(540) /* TCB PSATOLD */ jscb = ptr(tcb+180) /* JSCB TCBJSCB */ qmpl = ptr(jscb+244) /* QMPL JSCBQMPI */ qmat = ptr(qmpl+24) /* QMAT QMADD */ Do While sva>65536 qmat = ptr(qmat+12) /* next QMAT QMAT+12 */ sva=sva-65536 /* 010006F -> 000006F */ End return ptr(qmat+sva+1)+16 /*@ SWAREQ */ /* . ----------------------------------------------------------------- */ HELP: /*@ */ address TSO;"CLEAR" if helpmsg <> "" then say helpmsg ex_nam = Left(exec_name,8) /* predictable size */ say " " say " "ex_nam" produce a cascading report showing for each member the " say " subroutines and other non-embedded assets needed for " say " proper operation. It does this by examining the 'Impact " say " Analysis' section of REXXSKEL-based code to derive the " say " software elements used by each member of . " say " " say " Members without a properly-formed Impact Analysis section " say " will be ignored. " say " " say " The impact analysis report is written to the LOG file, but" say " not echoed to the terminal unless MONITOR is on. The " say " output dataset is presented in VIEW. " say " " say " Syntax: "ex_nam" dsn " say " WRITE outds (Defaults)" say " DETAIL " say " EXCLBP " say " (( LOG " say " (more...) " "NEWSTACK"; pull ; "CLEAR" ; "DELSTACK" say " " say " dsn names the dataset containing REXX code to be " say " examined to develop the Impact Analysis report. " say " " say " outds names the dataset to receive the output report. If " say " not specified, it defaults to REXXIA.LIST. " say " " say " DETAIL if specified, provides additional information " say " regarding material returned from GETIA. " say " " say " EXCLBP causes standard routines " say " "boilerplate " " say " to be excluded from the report. " say " " say " LOG if specified, causes the log file to be saved at " say " termination. By default, it is purged. " say " " "NEWSTACK"; pull ; "CLEAR" ; "DELSTACK" say " Debugging tools provided include: " say " " say " MONITOR: displays key information throughout processing. " 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" (( MONITOR 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 */ /* 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")" 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 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 */ 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 = "exec_name tv helpmsg sw. zerrhm zerralrm ", "zerrsm zerrlm tk_init_stacks branch monitor ", "noupdt" call LOCAL_PREINIT /* for more opts -*/ return /*@ TOOLKIT_INIT */