/* REXX    COMPSTAT   sets ISPF member stats to the date of the
                      compiler listing.

           Cloned from PLIXREF

     Impact Analysis
.    SYSEXEC   RUNDATA
.    SYSEXEC   SHORTPG

     Modification History
     20040108 fxc cloned from PLIXREF
     20040315 fxc id=CSTATS
     20040727 fxc don't SHORTPG if ASIS; don't RESET; don't END unless
                  batch;
     20231130 fxc only check 5 bytes to identify the compiler;
     20240104 fxc add RUNDATA to I/A section;
     20240308 fxc chg dollar-sign to @ everywhere;
     20240503 fxc adjust HELP;
     20240728 fxc panel name for error msg;
     20241107 fxc allow 8-character userids;
     20250829 fxc correct for HLASM;
     20250831 fxc catch non-macro execution;
     20250918 fxc SPACEOUT;

*/
address ISREDIT
"MACRO (opts)"
if rc = 20 then do                     /* ISREDIT not available      */
   address TSO
   parse source  .  .  exec_name .
   ex_nam = Left( exec_name,8 )        /* predictable size           */
   helpmsg = ex_nam "is an EDIT macro"
   call HELP                           /*                           -*/
   end
if Left( Strip( opts ),1 ) = "?" then call HELP    /*               -*/
call A_INIT                            /*                           -*/
upper opts
parse var opts "TRACE" tv .
parse value tv "N" with tv .
rc = Trace( "O" ); rc = Trace( tv )

"(dataset) = DATASET"
"(memname) = MEMBER"
"(init) = LINENUM .zlast"              /* how many initial lines ?   */
"F P'^' FIRST"                         /* first non-blank            */
"(text) = LINE .zcsr"
if Left( text,5 ) = opt       then,    /* Optimizer                  */
   call O_SET_DATE                     /*                           -*/
else,
if Left( text,5 ) = ent       then do  /* Enterprise                 */
   if sw.0_Asis = 0 then do            /* OK to change               */
      "SHORTPG"
      "SAVE"
      end                              /* not ASIS                   */
   call E_SET_DATE                     /*                           -*/
   end                                 /* Enterprise                 */
else,
if WordPos( 'Assembler',text ) > 0 then,        /* HLASM             */
   call H_SET_DATE                     /*                           -*/
else,
   do                                  /* Unknown                    */
   zerrhm = "ISR00000"
   zerralrm = "YES"
   zerrsm = "Unknown compiler"
   zerrlm = "The header information on this listing cannot be ",
            "mapped to a recognized compiler."
   if sw.0_Batch = 0 then,
      address ISPEXEC "SETMSG MSG( ISRZ002 )"
   return                              /* halt processing            */
   end                                 /* Unknown                    */

"(size) = LINENUM .zlast"              /* how many final lines ?     */

call X_SET_STATS                       /*                           -*/
if sw.0_Batch then "END"
exit                                   /*@ COMPSTAT                  */
/*
.  ----------------------------------------------------------------- */
A_INIT:                                /*@                           */
   address TSO

/* opt = "15668-910"
   ent = "15655-H31" */
   opt = "15668"
   ent = "15655"
   if opts = "" then do
      "NEWSTACK"
      "RUNDATA READ TBLKEY COMPSTAT"   /* may set OPTS               */
      do queued()
         pull tag  tagval
         if tag = "<ERROR>" then do
            say tag tagval
            "DELSTACK"
            return
            end                        /* error                      */
         @z  = Value( tag,tagval )     /* assign tagval to tag       */
      end                              /* queued                     */
      "DELSTACK"
      end
   sw. = 0
   sw.0_Batch   = sysvar( "SYSENV" ) = "BACK"
   sw.0_Asis    = WordPos( "ASIS",opts ) > 0

return                                 /*@ A_INIT                    */
/*
   Parse date from the top line.  Set 'changed', 'created', and 'time'.
.  ----------------------------------------------------------------- */
E_SET_DATE:                            /*@                           */
   address TSO

   parse var text 97 credate  time .
   if Pos( '.',credate ) > 0 then,
      changed = Translate( credate , "/" , "." )
   if Pos( '-',credate ) > 0 then,
      changed = Translate( credate , "/" , "-" )
   created = changed

return                                 /*@ E_SET_DATE                */
/*
   Parse date from the top line.  Set 'changed', 'created', and 'time'.
.  ----------------------------------------------------------------- */
H_SET_DATE:                            /*@                           */
   address ISREDIT

   "F 'HLASM' WORD"
   if rc <> 0 then exit                /* Oops....                   */
   "(text) = LINE .zcsr"
   text = Reverse( text )
   parse var text rtime rdate .
   parse value Reverse( rtime rdate ) with,
                     created time .
   time    = Translate( time   , ":" , "." )
   changed = created                   /* match the date             */

return                                 /*@ H_SET_DATE                */
/*
   Parse date from the top line.  Set 'changed', 'created', and 'time'.
.  ----------------------------------------------------------------- */
O_SET_DATE:                            /*@                           */
   address TSO

   mth.     = "???"
   mth.JAN  = "Jan"
   mth.FEB  = "Feb"
   mth.MAR  = "Mar"
   mth.APR  = "Apr"
   mth.MAY  = "May"
   mth.JUN  = "Jun"
   mth.JUL  = "Jul"
   mth.AUG  = "Aug"
   mth.SEP  = "Sep"
   mth.OCT  = "Oct"
   mth.NOV  = "Nov"
   mth.DEC  = "Dec"

   parse var text 90 dd mmm yy   time .
   mmm = Left( mmm,3 )
   cent = yy < 75 ; cc = 19 + cent
   chgdate = Date( "S",dd mth.mmm cc""yy, "N" )
   changed = Translate( "CcYy/Mm/Dd" , chgdate , "CcYyMmDd" )
   created = changed

return                                 /*@ O_SET_DATE                */
/*
   Create ISPF statistics for this compiler listing.
.  ----------------------------------------------------------------- */
X_SET_STATS:                           /*@                           */
   address ISPEXEC

   "CONTROL ERRORS RETURN"
   parse value "CSTATS  01 00"  with ,
                id      vv mm  .
   parse value init+0   size+0  with ,
               init     size   .
   "LMINIT    DATAID( BASEID ) DATASET( '"dataset"' )"
   "LMMSTATS  DATAID( "baseid" )" "MEMBER( "memname" )" "USER8( "id" )",
             "VERSION( "vv" )" "MODLEVEL( "mm" )" "MODDATE4( "changed" )",
             "MODTIME( "time" )" "CREATED4( "created" )",
             "CURSIZE( "size" )",
             "INITSIZE( "init" )"
   if rc > 0 then do
      zerrsm = "Stats Error"
      zerrlm = "Unable to modify to the ISPF Stats. RC = "rc
      if sw.0_Batch = 0 then,
         "SETMSG MSG( ISRZ002 )"
      end                              /* rc > 0                     */

   "LMFREE     DATAID( "baseid" )"

return                                 /*@ X_SET_STATS               */
/*
.  ----------------------------------------------------------------- */
HELP:                                  /*@                           */
address TSO;"CLEAR"
if helpmsg <> "" then say helpmsg
parse source  sys_id  how_invokt  exec_name  .
ex_nam = Left( exec_name,8 )           /* predictable size           */

say "                                                                          "
say "  "ex_nam"      resets the ISPF member statistics to the date shown in the"
say "                header lines of a compiler listing.  This routine is not  "
say "                designed to work on anything other than a compiler        "
say "                listing.                                                  "
say "                                                                          "
say "  Syntax:   "ex_nam"  <no parms>                                          "
say "                                                                          "
"NEWSTACK"; pull; "CLEAR"; "DELSTACK"
say "                                                                          "
say "   Debugging tools provided include:                                      "
say "                                                                          "
say "        TRACE tv: will use value following TRACE to place the execution in"
say "                  REXX TRACE Mode.                                        "
say "                                                                          "
say "                                                                          "
say "   Debugging tools can be accessed in the following manner:               "
say "                                                                          "
say "        TSO" ex_nam "    parameters    debug-options                      "
say "                                                                          "
say "   For example:                                                           "
say "                                                                          "
say "        " ex_nam " (( trace ?r                                         "

address ISPEXEC "CONTROL DISPLAY REFRESH"
exit                                   /*@ HELP                      */