## ********************************************************
##
## 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:
