Updated 2014-03-03 21:44:40 by AMG

PSE: Frameworks for writing profilers, stopwatches, ...

See bottom of page for "short form"
 ## ********************************************************
 ##
 ## Description: timers.tcl Version 1.0
 ## Provides timing routines for measuring the performance
 ## of Tcl code.
 ##
 ## Comments:
 ## I tried using various forms of "calibration" to
 ## "improve" the quality of the reported values, the net
 ## result was that the "bare" calls are as accurate as the
 ## calibrated versions -- these calls are VERY fast!
 ## Accuracy is at least 1% of the reported time.
 ##
 ## ********************************************************

 ;#barecode

 package provide timers 1.0

 ;## i like to use the ::TIMEIT flag to switch timing
 ;## code on and off.  0 for false, 1 for true.
 if { ! [ info exists ::TIMEIT ] } {
    set ::TIMEIT 1
    }

 ;## initialize the default start tag as a safety feature
 ;## in case someone calls __t::end before __t::start.
 namespace eval __t { set S 0 }

 ;## short circuit efficiently if debugging is off
 if { ! $::TIMEIT } {
    proc __t::start { args } {}
    proc __t::end   { args } {}
    proc __t::mark  { args } {}
    return {}
    }

 ;## so we can stand alone and still be useful!
 if { ! [ llength [ info commands myName ] ] } {
    proc myName {} { return [ lindex [info level -1] 0 ] }
    }
 if { ! [ llength [ info commands addLogEntry ] ] } {
    proc addLogEntry { args } { puts $args }
    }

 ;#end


 ## ********************************************************
 ##
 ## Name: __t::start
 ##
 ## Description:
 ## Set the start point for timing.  As many start points
 ## as are needed may be defined using the optional "tag"
 ## argument.
 ##
 ## Parameters:
 ## tag - an optional modifcation to the name of the timer
 ##
 ## Usage:
 ##       proc timeit {} {
 ##            __t::start
 ##            __t::end "null timing loop"
 ##       }
 ##
 ## Comments:
 ##

 proc __t::start { { tag "" } } {
      set ms [ clock clicks -milliseconds ]
      set us [ clock clicks ]
      set ::__t::S$tag [ list $us $ms ]
 }
 ## ********************************************************

 ## ********************************************************
 ##
 ## Name: __t::end
 ##
 ## Description:
 ## Set a timing endpoint and issue a report.
 ##
 ## Parameters:
 ## msg - a message to be interpolated into the report
 ## tag - used to identify a start point
 ## logfile - optional third argument to addLogEntry, q.v.
 ##
 ## Usage:
 ##         proc timeit {} {
 ##              __t::start
 ##              __t::end "null timing loop"
 ##         }
 ##
 ## Comments:
 ## The $msg argument will be used in the log entry.
 ## None of the arguments is required.
 ## Use the command __t::mark if you just want the value back.
 ## This command does not return anything.

 proc __t::end { { msg "" } { tag "" } { logfile "" } } {
      set ut [ clock clicks ]
      set mt [ clock clicks -milliseconds ]
      set ust [ lindex [ set ::__t::S$tag ] 0 ]
      set mst [ lindex [ set ::__t::S$tag ] 1 ]
      set udt [ expr { ($ut-$ust)/1000000.0 } ]
      set mdt [ expr { ($mt-$mst)/1000.0    } ]
      set dt $udt
      if { $dt < 0 || $dt > 1 } { set dt $mdt }
      set caller [ uplevel myName ]
      ;## caught because we probably don't want to let a
      ;## timing code exception cause a blip.
      catch {
         addLogEntry "$msg $dt sec." "0" $caller "" $logfile
         }
      __t::start $tag
 }
 ## ********************************************************

 ## ********************************************************
 ##
 ## Name: __t::mark
 ##
 ## Description:
 ## Set a timing endpoint and return the last dt.
 ##
 ## Parameters:
 ## tag - an optional modifcation to the name of the timer
 ##
 ## Usage:
 ##         proc timeit {} {
 ##              __t::start
 ##              return "null call took [ __t::mark ] seconds"
 ##         }
 ##
 ## Comments:
 ## This is the benchmarking call.  Note that __t::start
 ## MUST be called explicitly to reset the timer.

 proc __t::mark { { tag "" } } {
      set ut [ clock clicks ]
      set mt [ clock clicks -milliseconds ]
      set ust [ lindex [ set ::__t::S$tag ] 0 ]
      set mst [ lindex [ set ::__t::S$tag ] 1 ]
      set udt [ expr { ($ut-$ust)/1000000.0 } ]
      set mdt [ expr { ($mt-$mst)/1000.0    } ]
      set dt $udt
      if { $dt < 0 || $dt > 1 } { set dt $mdt }
      return $dt
 }
 ## ********************************************************

And here is the short form of all this from comp.lang.tcl:
 proc dt { ustart mstart } {
     set ut [ clock clicks ]
     set mt [ clock clicks -milliseconds ]
     set udt [ expr { ($ut-$ustart)/1000000.0 } ]
     set mdt [ expr { ($mt-$mstart)/1000.0    } ]
     if { $udt < 0 || $udt > 1 } { return $mdt }
     return $udt
 }

For more on this subject, see Don Libes' Stopwatch project at http://expect.nist.gov/stopwatch (link broken 2013-04-02)

See also: