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 } ;## initialise 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 ---- Identifier: timer Version: 0.3.0 Title: A timer package. Creator: Mark G. Saye Description: Provides easy access to Tcl's built-in clock with millisecond accuracy. It facilitates the writing of stopwatch and countdown timer applications. Rights: BSD URL: http://www.speakeasy.org/~msaye/tcl/timer/ Available: 2003-12-09 Architecture: tcl Type: Software Subject: timer Language: en ---- [Category Package] - [Category Performance]