/* REXX    QIO        Find and count all the files by type (input,
                      output, update).

     Modification History
     20041227 fxc tight semicolon blocks word recognition;
     20050103 fxc exclude non-names as filenames
     20050713 fxc allow {XYZ} as file initial (!);
     20080131 fxc ignore commas in ENV( ... );
     20090326 fxc enable ADD;
     20240503 fxc only examine 5 bytes to determine compiler;

*/
address ISREDIT
"MACRO (opts)"
signal on syntax
upper opts
parse var opts "TRACE" tv .
parse value tv "N" with tv .
parse value "1        0     0    0 0 0" with,
             lastckpt sw.   ct.    .
parse value ""          with,
            filelist.    filelist  slug     .
rc = Trace("O"); rc = Trace(tv)
sw.0Monitor = WordPos("MONITOR",opts) > 0
sw.0Reset   = WordPos("ADD",opts) = 0

call C_CHECK_LRECL                     /*                           -*/
if sw.0Reset then do
"RESET"
"X ALL"
   end
"F ALL ' FILE '    "
"F ALL ' FILE;'    "
"F NX ' FILE'        FIRST"            /* init                       */
do forever
   if rc > 0 then leave                /* not found                  */
   "(text) = LINE .zcsr"               /* acquire text               */
   "(l#)   = LINENUM .zcsr"
   ln_stack = l#                       /* init to primary line #     */
   text = Strip(Substr(text,txton,txtlen))
   upper text
   if WordPos("DECLARE",text) = 0 &,
      WordPos("DCL",text) = 0 then do
      call A_FIND_DCL                  /*                           -*/
      end
   if Pos(";",text) = 0 then do
      call B_FIND_SCOLON               /*                           -*/
      end
   lastckpt = l#
   if sw.0Monitor then say,
      "Last checkpoint was" l#

   slug  = Space(text,1)
   slug  = Translate( slug , " " , ";")  ";"
   dclpt = Wordpos("DCL",slug) + WordPos("DECLARE",slug)
   filept = Wordpos("FILE",slug)
   call ZE_CLEAN_ENV                   /* drop commas from ENV(...) -*/

   if dclpt = 1 & filept = 3 then do
      upper slug
      endcomm  = Pos("*/",slug)
      strtcomm = Pos("/*",slug)
      do while endcomm+strtcomm > 0
         call ZC_ZAPCOMM               /* excise comments           -*/
      end
      filept = Wordpos("FILE",slug)

      part = SubWord(slug,3)           /* exclude 2 words            */

      do forever                       /*                            */
         commapt = Pos(",",part)
         if commapt = 0 then
            commapt = Pos(";",part)
         if filept = 3 then do
            mode = "ANY"               /* default                    */
            filename = Word(slug,2)
            filename = Strip( filename,,")" )
            filename = Strip( filename,,"(" )
            if length(filename) > 8 then filename = ""
            pill = Left(Translate(filename),1)
            if Pos(pill,"ABCDEFGHIJLKMNOPQRSTUVWXYZ@#$") = 0 then,
               filename = ""
            /* Examine words 3-n as far as the first comma/semicolon */
            /* Covers "DCL X INPUT FILE, Y STREAM FILE OUTPUT; */
            if Wordpos("INPUT" ,Left(part,commapt)) > 0 then do
               mode = "INPUT"
               end ; else ,
            if Wordpos("OUTPUT" ,Left(part,commapt)) > 0 then do
               mode = "OUTPUT"
               end ; else ,
            if Wordpos("PRINT" ,Left(part,commapt)) > 0 then do
               mode = "OUTPUT"
               end ; else ,
            if Wordpos("VARIABLE" ,Left(part,commapt)) > 0 then do
               mode = "VAR"
               end ; else ,
            if Wordpos("UPDATE" ,Left(part,commapt)) > 0 then do
               mode = "UPDATE"
               end
            if filename <> "" then,
            if WordPos(filename,filelist.mode) = 0 then do
               ct.mode = ct.mode   + 1
               filelist.mode = filelist.mode filename
               if sw.0Monitor then say,
                  filename "logged as" mode
               end ; else nop          /* unknown filename           */
            else call D_EXCLUDE        /*                           -*/

            if Pos(",",part) > 0 then do /* excise                   */
               /* part is "INPUT FILE, Y STRE....                    */
               /* Pos("," , part) is -11-                            */
               part = DelStr( part , 1 , Pos(",",part) )
               /* part is now " Y STREAM FILE OUTPUT;"               */
               slug = SubWord(slug,1,1) Strip(part)
               /* slug is now "DCL Y STREAM FILE OUTPUT;"            */
               iterate
               end
            end
         else call D_EXCLUDE           /*                           -*/
         leave
      end                              /* forever                    */

      ln_stack = ""                    /* leave everything exposed   */
      end                              /* DCLPT                      */
   else do                             /* dclpt is zero              */
      call D_EXCLUDE                   /*                           -*/
      end                              /* dclpt is zero              */

   slug = ""
   "F NX ' FILE'  NEXT"                /* next                       */
end                                    /* forever                    */
                                       rc = Trace("O"); rc = Trace(tv)

call R_REPORT                          /*                           -*/

"UP MAX"

exit(1)                                /*@ QIO                       */
/*
   The text doesn't have a DCL.  Read backwards until the DCL is
   found.
.  ----------------------------------------------------------------- */
A_FIND_DCL:                            /*@                           */
   address ISREDIT

   origtxt = text
   slug = text                         /* save text                  */
   pl# = l#
   if pl# - lastckpt > 20 then,
      lastckpt = pl# - 20
   do until WordPos("DECLARE",slug) > 0 |,
            WordPos("DCL",slug) > 0    /* until found                */
      pl# = pl# - 1                    /* prev line                  */
      if pl# < lastckpt then leave     /*                            */
      "(xst) = XSTATUS" pl#
      if xst = "X" then do
         "XSTATUS" pl# "= NX"
         ln_stack = pl# ln_stack
         end
      "(text) = LINE" pl#              /* acquire text               */
      text = Strip(Substr(text,txton,txtlen))
      if Pos(";",text) > 0 then do
         parse var text . ";" text
         slug = text slug              /* prepend                    */
         leave                         /* force a halt               */
         end
      slug = text slug                 /* prepend                    */
      upper slug
   end                                 /* until                      */
   text = slug                         /* restore                    */

   if WordPos("DECLARE",slug) = 0 |,
      WordPos("DCL",slug) = 0 then do  /* forced out                 */
      parse value "; ;" with slug text
      if sw.0Monitor then say,
         "No DCL found for <<"origtxt">> back to" pl#
      call D_EXCLUDE                   /*                           -*/
      end                              /* forced out                 */

return                                 /*@ A_FIND_DCL                */
/*
   The text doesn't have a semicolon.  Read forward until a semicolon
   is found.
.  ----------------------------------------------------------------- */
B_FIND_SCOLON:                         /*@                           */
   address ISREDIT

   if sw.0Monitor then say,
      "Searching for ';' from" l#
   slug = Strip(text)                  /* save text                  */
   do until Pos(";",slug) > 0          /* until found                */
      l# = l# + 1                      /* prev line                  */
      "(xst) = XSTATUS" l#
      if xst = "X" then do
         "XSTATUS" l#  "= NX"
         ln_stack = ln_stack l#
         end
      "(text) = LINE" l#               /* acquire text               */
      text = Strip(Substr(text,txton,txtlen))
      if Pos(";",text) > 0 then,
         text = Substr( text , 1 , Pos(";",text) )
      slug = slug Strip(text)          /* append                     */
      upper slug
   end                                 /* until                      */
   text = slug                         /* reload                     */

return                                 /*@ B_FIND_SCOLON             */
/*
.  ----------------------------------------------------------------- */
C_CHECK_LRECL:                         /*@                           */
   address ISREDIT

   "(lr)  = LRECL"
   if lr = 80 then do                  /* source                     */
      parse value "2 71" with txton txtlen .
      return                           /*                            */
      end

   "F '1' 1 "                          /*                            */
   if rc > 0 then,                     /* source                     */
      parse value "2 71" with txton txtlen .
   else do                             /* what is it?                */
      "(text) = LINE .zcsr"            /* acquire text               */
      parse var text 2 data .
      if Left( data,5 ) = "5655-" then,   /* Enterprise              */
         parse value "33 71 " with txton txtlen .
      else,
      if Left( data,5 ) = "5668-" then,   /* Optimizer               */
         parse value "20 71 " with txton txtlen .
      else do
         say "Unknown text type"
         parse value "1" lr   with txton txtlen .
         end
      end

return                                 /*@ C_CHECK_LRECL             */
/*
.  ----------------------------------------------------------------- */
D_EXCLUDE:                             /*@                           */
   address ISREDIT

   do Words(ln_stack)
      parse var ln_stack   l#  ln_stack
      "XSTATUS" l# "= X"
   end                                 /* words in ln_stack          */

return                                 /*@ D_EXCLUDE                 */
/*
.  ----------------------------------------------------------------- */
R_REPORT:                              /*@                           */
   address ISREDIT

   indent = 12
   rmarg  = 70

   if filelist.input <> "" then do
      filelist.input = STRSORT(filelist.input )
      ct = Left(ct.input "Input :",indent) filelist.input
      do while Length(ct) > rmarg
         pt = Lastpos(" ",ct,rmarg)
         parse var ct slug =(pt) ct
         "LINE_BEFORE 1 = NOTELINE (slug)"
         ct = Left(" ",indent) Strip(ct)
      end                              /* > rmarg                    */
      "LINE_BEFORE 1 = NOTELINE (ct)"
   end                                 /* INPUT                      */

   if filelist.output <> "" then do
      filelist.output = STRSORT(filelist.output)
      ct = Left(ct.output "Output:",indent) filelist.output
      do while Length(ct) > rmarg
         pt = Lastpos(" ",ct,rmarg)
         parse var ct slug =(pt) ct
         "LINE_BEFORE 1 = NOTELINE (slug)"
         ct = Left(" ",indent) Strip(ct)
      end                              /* > rmarg                    */
      "LINE_BEFORE 1 = NOTELINE (ct)"
   end                                 /* OUTPUT                     */

   if filelist.update <> "" then do
      filelist.update = STRSORT(filelist.update)
      ct = Left(ct.update "Update:",indent) filelist.update
      do while Length(ct) > rmarg
         pt = Lastpos(" ",ct,rmarg)
         parse var ct slug =(pt) ct
         "LINE_BEFORE 1 = NOTELINE (slug)"
         ct = Left(" ",indent) Strip(ct)
      end                              /* > rmarg                    */
      "LINE_BEFORE 1 = NOTELINE (ct)"
   end                                 /* UPDATE                     */

   if filelist.any <> "" then do
      filelist.any = STRSORT(filelist.any   )
      ct = Left(ct.any "Any:",indent) filelist.any
      do while Length(ct) > rmarg
         pt = Lastpos(" ",ct,rmarg)
         parse var ct slug =(pt) ct
         "LINE_BEFORE 1 = NOTELINE (slug)"
         ct = Left(" ",indent) Strip(ct)
      end                              /* > rmarg                    */
      "LINE_BEFORE 1 = NOTELINE (ct)"
   end                                 /* ANY                        */

   if filelist.var <> "" then do
      filelist.var = STRSORT(filelist.var   )
      ct = Left(ct.var "Variable:",indent) filelist.var
      do while Length(ct) > rmarg
         pt = Lastpos(" ",ct,rmarg)
         parse var ct slug =(pt) ct
         "LINE_BEFORE 1 = NOTELINE (slug)"
         ct = Left(" ",indent) Strip(ct)
      end                              /* > rmarg                    */
      "LINE_BEFORE 1 = NOTELINE (ct)"
   end                                 /* VAR                        */

return                                 /*@ R_REPORT                  */
/*
   Only present this routine with a complete statement.
.  ----------------------------------------------------------------- */
ZC_ZAPCOMM:                            /*@                           */

   endcomm  = Pos("*/",slug)
   strtcomm = Pos("/*",slug)
   if endcomm > 0 then,
      if strtcomm > 0 then,
         if endcomm > strtcomm  then do  /* internal complete comment */
            slug = Delstr(slug, strtcomm, endcomm-strtcomm+2)
            end                        /*                            */
         else do                       /* incomplete at start        */
            slug = Delstr(slug,1,endcomm +1)
            end                        /*                            */
      else,                            /* incomplete at end          */
         slug = Delstr(slug,1,endcomm +1)
   else,                               /*                            */
   if strtcomm > 0 then,               /* comment-start only         */
      slug = Delstr(slug, strtcomm)

   slug = Space(slug,1)                /* squeeze                    */

   qtpt = Pos( "'" , slug )
   if qtpt > 0 then do
      qtpt2 = Pos( "'" , slug , qtpt+1) /* second quote              */
      if qtpt2 > 0 then do             /* two quotes                 */
         slug = Delstr(slug , qtpt , qtpt2-qtpt+1 )
         end
      end                              /* qtpt present               */

return                                 /*@ ZC_ZAPCOMM                */
/*
.  ----------------------------------------------------------------- */
ZE_CLEAN_ENV:                          /*@                           */
   address ISREDIT

   stack = ""
   ept = 1
   do forever
      ept = Pos( "ENV(",slug,ept )     /* find ENV(                  */
      if ept = 0 then return
      do zz = ept to Length( slug )
         pill = Substr( slug,zz,1 )
         if Pos( pill,"(' ,)" ) = 0 then iterate
         if pill = ")" then ,
         if Left( stack,1 ) = "(" then,
            stack = Substr( stack,2 ); else,
            say "Unexpected close-paren at" zz "in" slug
         else,
         if pill = "(" then,
            stack = "("stack
         else,
         if pill = "'" then ,
         if Left( stack,1 ) = "'" then,
            stack = Substr( stack,2 ); else,
            stack = "'"stack
         else,
         if pill = "," then,
            slug = Overlay( " ",slug,zz,1 )
         else,
         if pill = " " then,
         if stack = "" then leave      /* found the end of ENV(      */
      end                              /* zz                         */
      ept = zz
   end                                 /* forever                    */

return                                 /*@ ZE_CLEAN_ENV              */
/*
.  ----------------------------------------------------------------- */
SYNTAX:                                /*@                           */
   errormsg = exec_name "encountered REXX error" rc "in line" sigl":",
                        errortext(rc)
   say errormsg
   zsigl = sigl
   if sourceline() <> "0" then
      say sourceline(zsigl)
   rc = trace("O")
   rc =  trace("?R")
   nop
exit                                   /*@ SYNTAX                    */