/* 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                    */