/* REXX PLILBLS Find all labels and display all occurrences of those labels. Impact Analysis . SYSEXEC STRSORT . SYSEXEC SEGMENT (macro) . (alias) ENTRIES . (alias) ENC Modification History 20040831 fxc fixed to work for the Enterprise Compiler; 20040927 fxc discriminate between source and list 20041019 fxc VPUT LBLLIST overwrites LBLLIST of SEGMENT; 20050118 fxc account for MARGINI (shifts source over 1 byte); 20060324 fxc position cursor in the command line; 20231128 fxc only examine 5 bytes to identify the compiler; 20240503 fxc default TRACE to N; 20250920 fxc SPACEOUT; */ address ISREDIT "MACRO (opts)" address ISPEXEC "CONTROL ERRORS RETURN" call A_INIT /* -*/ rc = Trace( "O" ); rc = trace( tv ) call B_POSITION /* -*/ if sw.0ErrorFound then return /* bail out */ if sw.0mon then say lastline-topline+1 "lines to be examined." call C_LOCATE_LABELS /* */ if sw.0mon then say Words( lbllist ) "labels" call D_EXPOSE_LABELS /* */ /* For ENTRIES NOCALLS, all the PROC and END statements are visible */ if sw.0Comm then, call E_EXPOSE_COMMENTS /* -*/ foundlbls = STRSORT( foundlbls ) /* sort the labels */ if sw.0rpt then, call R_REPORT /* -*/ lbllist = foundlbls /* restore */ address ISPEXEC "VPUT LBLLIST SHARED" "UP MAX" exit(1) /*@ PLILBLS */ /* . ----------------------------------------------------------------- */ A_INIT: /*@ */ address ISPEXEC parse source srcline parse var srcline . . ex_nam . /* macro name */ zerralrm = "NO" zerrhm = "ISR00000" parse value "0 0 0 0 0 0 0 0 0 0 0" with, sw. . parse value "" with, end_on_line. found_on_line. used_on_line., tv lbllist . upper opts opts = Strip( opts,'T','5d'x ) if WordPos( "?",opts ) > 0 then call HELP /* -*/ sw.0mon = Wordpos( "MONITOR",opts ) > 0 sw.0rpt = Wordpos( "REPORT" ,opts ) > 0 sw.0Comm = Wordpos( "COMMENT",opts ) > 0 sw.0noc = Wordpos( "NOCALLS",opts ) > 0 |, Wordpos( "ENC" ,opts ex_nam ) > 0 sw.0ent = Wordpos( "ENTRIES",opts ex_nam ) > 0 |, Wordpos( "ENC" ,opts ex_nam ) > 0 parse var opts "TRACE" tv . parse value tv "N" with tv . alfa = "ABCDEFGHIJKLMNOPQRSTUVWXYZ@$#%abcdefghijklmnopqrstuvwxyz" badchars = "=(" return /*@ A_INIT */ /* If DATA_WIDTH is 133, it's a compiler listing so look for a '1' in column-1. If DATA_WIDTH is 80, it's source. . ----------------------------------------------------------------- */ B_POSITION: /*@ */ address ISREDIT "(dw) = DATA_WIDTH" /* LRECL */ if dw = 80 then, do "F FIRST P'^'" end else, if dw = 72 then, /* numbered source */ do "F FIRST P'^' 1 72 " end else, if dw = 133 then, do "SEGMENT LABELS" address ISPEXEC "VGET LBLLIST SHARED" parse var lbllist ".SRC" src_start . src_end . "LABEL" src_start "= .SB" "LABEL" src_end-1 "= .SE" lastline = src_end-1 "F FIRST '1' 1 .SB .SE" "(text) = LINE" .zcsr if Left( text,5 ) = "15668" then, /* Optimizer */ call BO_OPT_LISTING /* */ else, if Left( text,5 ) = "15655" then, /* compiler listing */ call BE_ENT_LISTING /* */ return /* processing complete */ end else do zerrsm = "What is this stuff?" zerrlm = "LRECL isn't either 80 (source) or 133 (list). ", "I don't know how to process it." address ISPEXEC "SETMSG MSG( ISRZ002 )" exit end /* not 80 or 133 ! */ "LABEL .zcsr = .SB" /* source code */ "(topline,lc) = CURSOR" "F p'^' LAST" /* locate last line */ "LABEL .zcsr = .SE" "(lastline,lc) = CURSOR" lbnd = 2 /* left boundary */ rbnd = lbnd + 70 return /*@ B_POSITION */ /* . ----------------------------------------------------------------- */ BE_ENT_LISTING: /*@ */ address ISREDIT "F 'Line.File' 6 .SB .SE" if rc <> 0 then do zerrsm = "Parse error" zerrlm = "Didn't find STMT header" address ISPEXEC "SETMSG MSG( ISRZ002 )" sw.0ErrorFound = 1 return end "F P'#' 9 .SB .SE" if rc <> 0 then do zerrsm = "Parse error" zerrlm = "Didn't find first statement" address ISPEXEC "SETMSG MSG( ISRZ002 )" sw.0ErrorFound = 1 return end "(text) = LINE" .zcsr if Substr( text,32,1 ) = "|" then, lbnd = 33 /* left boundary */ else, lbnd = 32 /* left boundary */ rbnd = lbnd + 70 return /*@ BE_ENT_LISTING */ /* . ----------------------------------------------------------------- */ BO_OPT_LISTING: /*@ */ address ISREDIT lastline = src_end-1 "(lastline,lc) = CURSOR" "F 'STMT LEV NT' 6 .SB .SE" if rc <> 0 then do zerrsm = "Parse error" zerrlm = "Didn't find STMT header" address ISPEXEC "SETMSG MSG( ISRZ002 )" sw.0ErrorFound = 1 return end "F P' # ' 8 .SB .SE" if rc <> 0 then do zerrsm = "Parse error" zerrlm = "Didn't find first statement" address ISPEXEC "SETMSG MSG( ISRZ002 )" sw.0ErrorFound = 1 return end "(text) = LINE" .zcsr if Substr( text,19,1 ) = "|" then, lbnd = 20 /* left boundary */ else, lbnd = 19 /* left boundary */ rbnd = lbnd + 70 return /*@ BO_OPT_LISTING */ /* . ----------------------------------------------------------------- */ C_LOCATE_LABELS: /*@ */ address ISREDIT firstornext = "FIRST" do forever "F .SB .SE ':'" firstornext lbnd rbnd if rc > 0 then leave /* not found */ firstornext = "NEXT" "(text) = LINE" .zcsr parse var text =(lbnd) text =(rbnd) /* snip ASA char */ parse var text front ":" rest if Words( front ) > 1 then iterate lbl = Strip( front ) if Pos( Left( lbl,1 ),alfa ) = 0 then iterate if Pos( Left( lbl,1 ),badchars ) > 0 then iterate "(lx,lc) = CURSOR" ; currln = lx do while Pos( ";",rest ) = 0 /* find whole statement */ currln = currln + 1 "(extra) = LINE" currln parse var extra =(lbnd) extra =(rbnd) rest = Space( rest extra,1 ) end /* find whole statement */ upper rest /* shift to uppercase */ rest = Strip( rest ) if sw.0ent & Left( rest,4 ) <> "PROC" then iterate upper lbl /* shift to uppercase */ if sw.0mon then say lbl lbllist = lbllist lbl /* add to the list */ lx = lx + 0 /* strip zeroes */ found_on_line.lbl = found_on_line.lbl lx end /* forever */ return /*@ C_LOCATE_LABELS */ /* . ----------------------------------------------------------------- */ D_EXPOSE_LABELS: /*@ */ d_tv = trace() /* what setting at entry ? */ address ISREDIT "X ALL" foundlbls = lbllist /* save a copy */ do while lbllist <> "" rc = Trace( "O" ); rc = trace( d_tv ) parse var lbllist lbl lbllist if sw.0mon then say lbl loc = "FIRST" do forever "SEEK .SB .SE" loc lbl lbnd rbnd if rc > 0 then leave /* didn't find */ "(xstat) = XSTATUS .zcsr" /* X or NX ? */ "XSTATUS .zcsr = NX" /* show this line */ loc = "NEXT" "(thisline,col) = CURSOR" /* where are we ? */ "(text) = LINE" thisline /* acquire source line */ thisline = thisline + 0 /* strip zeroes */ if Wordpos( thisline,found_on_line.lbl ) > 0 then do "XSTATUS .zcsr = NX" /* show this line */ "F ';'" "XSTATUS .zcsr = NX" /* show this line */ iterate /* keep 'found on' line */ end upper text /* shift to uppercase */ parse var text =(lbnd) front (lbl) back =(rbnd) if Left( Strip( back ),1 ) = "( " then do if sw.0noc then, "XSTATUS .zcsr =" xstat "CURSOR = .zcsr" rbnd /* prevent reprocessing */ iterate /* subroutine call */ end revfront = Reverse( front ) parse var revfront word1 word2 . if word1 = "OT" then, if word2 = "OG" then do used_on_line.lbl = used_on_line.lbl thisline if sw.0noc then "XSTATUS .zcsr =" xstat "CURSOR = .zcsr" rbnd /* prevent reprocessing */ iterate /* keep 'GO TO' */ end if Wordpos( word1,Reverse( "CALL GOTO LEAVE" ) ) > 0 then do used_on_line.lbl = used_on_line.lbl thisline if sw.0noc then do "XSTATUS .zcsr =" xstat "CURSOR = .zcsr" rbnd /* prevent reprocessing */ iterate /* keep CALL GOTO LEAVE */ end "F ';'" /* end of CALL */ "CURSOR = .zcsr" rbnd /* prevent reprocessing */ iterate /* keep CALL GOTO LEAVE */ end if Wordpos( ";DNE",revfront ) > 0 |, Wordpos( "DNE",revfront ) > 0 then do end_on_line.lbl = end_on_line.lbl thisline "CURSOR = .zcsr" rbnd /* prevent reprocessing */ iterate end "XSTATUS .zcsr =" xstat /* maybe exclude this line */ "CURSOR = .zcsr" rbnd /* prevent reprocessing */ end /* forever */ end /* lbllist */ return /*@ D_EXPOSE_LABELS */ /* Expose all the code between an END and the following PROC. . ----------------------------------------------------------------- */ E_EXPOSE_COMMENTS: /*@ */ address ISREDIT loc = "LAST" /* start from the bottom */ do forever "F NX 'PROC' WORD" loc if rc > 0 then leave loc = "PREV" do forever /* find prior END */ "LABEL .zcsr = .XB" "CURSOR = .zcsr" 1 /* prevent reprocessing */ "F P'^' NX" loc /* prior shown-line */ if rc > 0 then leave /* top of source? */ "(text) = LINE" .zcsr /* acquire text */ parse var text =(lbnd) text =(rbnd) if WordPos( "END" ,text ) > 0 |, WordPos( "END;",text ) > 0 then, do "LABEL .zcsr = .XA" "RESET .XA .XB" /* expose all lines */ "CURSOR = .zcsr" 1 /* prevent reprocessing */ leave end end /* forever */ end /* forever */ return /*@ E_EXPOSE_COMMENTS */ /* . ----------------------------------------------------------------- */ R_REPORT: /*@ */ r_tv = trace() /* what setting at entry ? */ address ISREDIT do while foundlbls <> "" rc = Trace( "O" ); rc = trace( r_tv ) parse var foundlbls lbl foundlbls /* isolate */ text = Left( lbl,24 ) "Found on" Strip( found_on_line.lbl ) if end_on_line.lbl <> "" then, text = text " END on" Strip( end_on_line.lbl ) if Length( text ) > 70 then do do while Length( text ) > 70 lbpos = LastPos( " ",text,70 ) savedtxt = Substr( text,lbpos+1 ) text = Left( text,lbpos ) "LINE_BEFORE .SB = NOTELINE '"text"'" text = Copies( " ",33 ) savedtxt end /* while length > 70 */ end "LINE_BEFORE .SB = NOTELINE '"text"'" text = Left( " ",24 ) " Used on" Strip( used_on_line.lbl ) if Length( text ) > 70 then do do while Length( text ) > 70 lbpos = LastPos( " ",text,70 ) savedtxt = Substr( text,lbpos+1 ) text = Left( text,lbpos ) "LINE_BEFORE .SB = NOTELINE '"text"'" text = Copies( " ",33 ) savedtxt end /* while length > 70 */ end "LINE_BEFORE .SB = NOTELINE '"text"'" end /* foundlbls */ return /*@ R_REPORT */ /* . ----------------------------------------------------------------- */ HELP: /*@ */ address TSO;"CLEAR" parse source sys_id how_invokt exec_name DD_nm DS_nm, as_invokt cmd_env addr_spc usr_tokn ex_nam = Left( exec_name,8 ) /* predictable size */ say " " say " "ex_nam" displays all the labels in a PL/I program. Options can " say " be used to restrict the display to classes of usage. " say " " say " Syntax: "ex_nam" " say " " say " " say " " say " " say " " say " MONITOR displays key information throughout processing. " say " " say " REPORT places a summary report of where-found/where-used " say " at the top of the source. " say " " say " NOCALLS excludes the invocation points and shows only the " say " target labels. " say " " say " COMMENT exposes all the code between a visible END statement" say " and the PROC immediately following. " say " " say " ENTRIES excludes ordinary labels; shows only PROCEDURE " say " entry points. " say " " say " TRACE tv will use the value following TRACE to place " say " the execution in REXX TRACE Mode. " say " " if sysvar( "SYSISPF" ) = "ACTIVE" then, address ISPEXEC "CONTROL DISPLAY REFRESH" exit /*@ HELP */