/* 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;
     20250920 fxc SPACEOUT;

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

   "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 ) /* next non-blank       */
            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                    */