/* REXX PLIFLOW Show the operational structure of a PL/I program. Modification History 20030110 fxc shift text to uppercase 20080124 fxc rc(1) at exit; 20231206 fxc seek ':' for source written in lowercase; save initial state and restore before ending; */ address ISREDIT "MACRO (opts)" upper opts parse var opts "TRACE" tv . parse value tv "N" with tv . rc = Trace("O"); rc = Trace(tv) monitor = Wordpos("MONITOR",opts) > 0 /* */ call A_INIT /* -*/ "( numset,numstate ) = NUMBER" /* get initial state */ "( leftcol,rtcol ) = BOUNDS " "NUMBER OFF" "( lrecl ) = DATA_WIDTH " call M_MAIN /* -*/ "NUMBER = (numset numstate) " "CURSOR = 1 1 " /* Top */ exit 1 /*@ PLIFLOW */ /* . ----------------------------------------------------------------- */ A_INIT: /*@ */ address ISREDIT parse value "" with , sublist , . symbolset = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789@#_$›.!?" "(lastline) = LINENUM .zl" /* bottom */ push '61'x '5c'x '6b'x '7d'x '7f'x '4d'x pull slash star comma singleq doubleq bananal return /*@ A_INIT */ /* . ----------------------------------------------------------------- */ M_MAIN: /*@ */ address ISREDIT /* "F P'^' 73 80" /* in the sequence field */ if rc = 0 then do "RENUM" "UNNUM" end /* clear the sequence area */ "(dtachg) = DATA_CHANGED" if dtachg = "YES" then do "AUTOSAVE PROMPT" zerrsm = "Data changed" zerrlm = "A RENUM+UNNUM command altered the data. If saved,", "stats will be refreshed." zerrhm = "ISR00000" zerralrm = "YES" address ISPEXEC "SETMSG MSG(ISRZ002)" end */ "RESET" frstornxt = "FIRST" do forever "SEEK 'PROC' " frstornxt /* */ if rc > 0 then leave frstornxt = "NEXT" "(ii) = CURSOR" "(text) = LINE" ii /* get the text */ text = Substr( text,2 ) /* snip control char */ upper text if text = "" then iterate if Pos(":",text) > 0 then do parse var text front ":" back If Pos("PROC",back) = 0 then iterate /* not a PROC stmt */ if Right(Word(text,1) ,1) <> ":" then, /* separated colon */ if Words(front) = 1 then do /* presumed LABEL */ text = Strip(front,"T")":" back end end if Right(Word(text,1) ,1) = ":" then do parse var text label ":" . /* must be 1st word... */ upper label if Verify(label,symbolset) > 0 then iterate /* not a label */ if monitor then say, /* */ "Label" label "found in >>"Strip(text)"<<" if Wordpos(label,sublist) = 0 then do sublist = sublist label /* add to list of subrtns */ if monitor then say label ii end /* label not in sublist */ end /* 1st word ends with colon */ end /* forever */ sublist = Translate( sublist , "" , ":" ) /* sublist is all the labels */ if monitor then do; say "All the labels:"; say sublist; end rc = trace('o'); rc = trace(tv) "X ALL" sublist = STRSORT(sublist) /* sort labels */ upper sublist /* all uppercase */ do ii = 1 to Words(sublist) /* for every subroutine */ subr = Word(sublist,ii) /* isolate */ loc = "FIRST" do forever "F" subr "WORD" loc loc = "NEXT" if rc > 0 then leave found = 0 "(text) = LINE .zcsr" upper text /* all uppercase */ do while Pos(subr,text) > 0 parse var text front (subr) back sepr = Left(Space(back,0),1) /* first non-blank following */ if Pos(sepr,"(*:;") > 0 then found = '1' else do front = Reverse(front) found = Wordpos("LLAC",front) = 1 end /* sepr ^= banana */ if found then text = "" /* halt the loop */ else text = back /* do it again */ end /* Pos(subr */ if \found then "XSTATUS .zcsr = X" end end /* ii */ return /*@ M_MAIN */