# By George Peter Staplin
# Dec 2005
array set ::debug_state {}
proc debug_callback {args} {
global debug_state
set proc [lindex [lindex $args 0] 0]
set type [lindex $args end]
if {"enter" eq $type} {
set debug_state($proc) [clock clicks]
} else {
set end [clock clicks]
set fd [open $::debug_log_file a]
#catches to stop failure during recursive calls - !todo: proper handling of recursion
catch {puts $fd "$proc took: [expr {$end - $::debug_state($proc)}]"}
close $fd
catch {unset debug_state($proc)}
}
}
proc debug_trace cmd {
trace add execution $cmd enter debug_callback
trace add execution $cmd leave debug_callback
}
set ::debug_log_file debug.log
rename proc _proc
_proc proc {name arglist body} {
if {![string match ::* $name]} {
#not already an 'absolute' namespace path
#qualify it so that traces can find it
set name [uplevel 1 namespace current]::[set name]
}
_proc $name $arglist $body
debug_trace $name
}Possible future improvements might include keeping a log of the entire runtime, and then averaging the runtime by the number of calls. I however didn't need that for my usage, because I was killing the program with ^C. :)
JMN 2005-12-30 - Added kludgy 'catch' statements around ::debug_state array access so that recursive calls to a proc don't stop the program. Also replaced the _proc procedure with a version that works for creating procedures in 'other' namespaces. e.g The following script would fail before:
namespace eval ::a {}
namespace eval ::b {proc ::a::myproc {} {return a-myproc}} OLD VERSION: _proc proc {name arglist body} {
set ns [uplevel 1 namespace current]
set p [set ns]::[set name]
_proc $p $arglist $body
debug_trace $p
}George Peter Staplin Dec 30, 2005 - Thank you JMN. You have given me some ideas for improvements that would handle recursion in a better manner. I will most likely post a followup to this code based on your improvements later.Barney Blankenship June 15, 2006 - Thanks George, and JMN, here is my contribution:
#=================================================================
# TIME PROFILER
# by [Barney Blankenship] (based on work by [George Peter Staplin])
#
# Insert this snippet above the function definitions you want
# to have profiled.
#
# TO INITIALIZE OR CLEAR/RESET THE PROFILER...
# global TimeProfilerMode
# if { [info exists TimeProfilerMode] } {
# global ProfilerArray
# array unset ProfilerArray
# }
#
# TO PRODUCE THE OUTPUT (currently hard-coded to "TimingDump.txt"
# file output "append" in the current working directory)...
# global TimeProfilerMode
# if { [info exists TimeProfilerMode] } {
# TimeProfilerDump description
# }
# (description: text string shown at the top of the output)
#
# PROFILING DATA COLLECTION
# (This describes what is included in the output)
# Provides total elapsed time in milliseconds between reset and dump.
# Provides function call statistics...
# for each function defined after this snippet, provide...
# Number of times called
# Average milliseconds per call
# Maximum milliseconds call time
# Minimum milliseconds call time
# Total milliseconds used
# Ratio of above to total elapsed time (XX.XXX percent)
# In addition, the function call statistics are sorted
# in descending values of Ratio (above).
#
# Note that nested functions and functions that use
# recursion are provided for and timed properly.
#
# TO DISABLE PROFILING WITHOUT REMOVING THE PROFILER
# Comment out the "set TimeProfilerMode 0" below...
#=================================================================
global TimeProfilerMode
set TimeProfilerMode 0
if { [info exists TimeProfilerMode] } {
proc TimeProfiler {args} {
global ProfilerArray
# Intialize the elapsed time counters if needed...
if { ![info exists ProfilerArray(ElapsedClicks)] } {
set ProfilerArray(ElapsedClicks) [expr double([clock clicks])]
set ProfilerArray(Elapsedms) [expr double([clock clicks -milliseconds])]
}
set fun [lindex [lindex $args 0] 0]
if { [lindex $args end] == "enter" } {
# Initalize the count of functions if needed...
if { ![info exists ProfilerArray(funcount)] } {
set ProfilerArray(funcount) 0
}
# See if this function is here for the first time...
for { set fi 0 } { $fi < $ProfilerArray(funcount) } { incr fi } {
if { [string equal $ProfilerArray($fi) $fun] } {
break
}
}
if { $fi == $ProfilerArray(funcount) } {
# Yes, function first time visit, add...
set ProfilerArray($fi) $fun
set ProfilerArray(funcount) [expr $fi + 1]
}
# Intialize the "EnterStack" if needed...
if { ![info exists ProfilerArray(ES0)] } {
set esi 1
} else {
set esi [expr $ProfilerArray(ES0) + 1]
}
# Append a "enter clicks" and "enter function name index" to the EnterStack...
set ProfilerArray(ES0) $esi
set ProfilerArray(ES$esi) [clock clicks]
# Note: the above is last thing done so timing start is closest to
# function operation start as possible.
} else {
# Right away stop timing...
set deltaclicks [clock clicks]
# Do not bother if TimeProfilerDump wiped the ProfilerArray
# just prior to this "leave"...
if { [info exists ProfilerArray(ES0)] } {
# Pull an "enter clicks" off the EnterStack...
set esi $ProfilerArray(ES0)
set deltaclicks [expr $deltaclicks - $ProfilerArray(ES$esi)]
incr esi -1
set ProfilerArray(ES0) $esi
# Correct for recursion and nesting...
if { $esi } {
# Add our elapsed clicks to the previous stacked values to compensate...
for { set fix $esi } { $fix > 0 } { incr fix -1 } {
set ProfilerArray(ES$fix) [expr $ProfilerArray(ES$fix) + $deltaclicks]
}
}
# Intialize the delta clicks array if needed...
if { ![info exists ProfilerArray($fun,0)] } {
set cai 1
} else {
set cai [expr $ProfilerArray($fun,0) + 1]
}
# Add another "delta clicks" reading...
set ProfilerArray($fun,0) $cai
set ProfilerArray($fun,$cai) $deltaclicks
}
}
}
proc TimeProfilerDump {description} {
global ProfilerArray
# Stop timing elapsed time and calculate conversion factor for clicks to ms...
set EndClicks [expr {double([clock clicks]) - $ProfilerArray(ElapsedClicks)}]
set Endms [expr {double([clock clicks -milliseconds]) - $ProfilerArray(Elapsedms)}]
set msPerClick [expr $Endms / $EndClicks]
# Visit each function and generate the statistics for it...
for { set fi 0 ; set PerfList "" } { $fi < $ProfilerArray(funcount) } { incr fi } {
set fun $ProfilerArray($fi)
if { ![info exists ProfilerArray($fun,0)] } {
continue
}
for { set max -1.0 ; set min -1.0 ; set ctotal 0.0 ; set cai 1 } { $cai <= $ProfilerArray($fun,0) } { incr cai } {
set clicks $ProfilerArray($fun,$cai)
set ctotal [expr {$ctotal + double($clicks)}]
if { $max < 0 || $max < $clicks } {
set max $clicks
}
if { $min < 0 || $clicks < $min } {
set min $clicks
}
}
set cavg [expr {$ctotal / double($ProfilerArray($fun,0))}]
set ProfilerArray($fun,avgms) [expr $cavg * $msPerClick]
set ProfilerArray($fun,totalms) [expr $ctotal * $msPerClick]
set ProfilerArray($fun,ratio) [expr {double($ctotal / $EndClicks) * 100.0}]
set ProfilerArray($fun,max) [expr $max * $msPerClick]
set ProfilerArray($fun,min) [expr $min * $msPerClick]
# Append to the sorting list the pairs of ratio values and function indexes...
lappend PerfList [list $ProfilerArray($fun,ratio) $fi]
}
# Sort the profile data by Ratio...
set PerfList [lsort -real -decreasing -index 0 $PerfList]
# Finally, generate the results...
set fd [open "TimingDump.txt" a]
puts $fd "\n===================================================================="
puts $fd [format " T I M I N G D U M P <%s>" $description]
puts $fd [format "\n Elapsed time: %.0f ms" $Endms]
puts $fd [format "\n %s" [clock format [clock seconds]]]
puts $fd "===================================================================="
for { set li 0 } { $li < [llength $PerfList] } { incr li } {
set fun $ProfilerArray([lindex [lindex $PerfList $li] 1])
puts $fd [format ">>>>> FUNCTION: %s" $fun]
puts $fd [format " CALLS: %d" $ProfilerArray($fun,0)]
puts $fd [format " AVG TIME: %.3f ms" $ProfilerArray($fun,avgms)]
puts $fd [format " MAX TIME: %.3f ms" $ProfilerArray($fun,max)]
puts $fd [format " MIN TIME: %.3f ms" $ProfilerArray($fun,min)]
puts $fd [format " TOTAL TIME: %.3f ms" $ProfilerArray($fun,totalms)]
puts $fd [format " RATIO: %.3f%c\n" $ProfilerArray($fun,ratio) 37]
}
close $fd
# Reset the world...
array unset ProfilerArray
}
#=================================================================
# Overload "proc" so that functions defined after
# this point have added trace handlers for entry and exit.
# [George Peter Staplin]
#=================================================================
rename proc _proc
_proc proc {name arglist body} {
#===================================
# Allow multiple namespace use [JMN]
if { ![string match ::* $name] } {
# Not already an 'absolute' namespace path,
# qualify it so that traces can find it...
set name [uplevel 1 namespace current]::[set name]
}
#===================================
_proc $name $arglist $body
trace add execution $name enter TimeProfiler
trace add execution $name leave TimeProfiler
}
}Here is the time profiler output on the Piechart Disk program scan of G: drive on my PC...
====================================================================
T I M I N G D U M P <Piecart Disk: G:/>
Elapsed time: 33062 ms
Fri Jun 16 11:38:28 PM Hawaiian Standard Time 2006
====================================================================
>>>>> FUNCTION: ReadDirectory
CALLS: 2281
AVG TIME: 10.929 ms
MAX TIME: 3527.845 ms
MIN TIME: 0.144 ms
TOTAL TIME: 24929.068 ms
RATIO: 75.401%
>>>>> FUNCTION: PackAndSort
CALLS: 2270
AVG TIME: 1.372 ms
MAX TIME: 501.295 ms
MIN TIME: 0.166 ms
TOTAL TIME: 3114.665 ms
RATIO: 9.421%
>>>>> FUNCTION: GetGlob
CALLS: 2281
AVG TIME: 1.175 ms
MAX TIME: 84.923 ms
MIN TIME: 0.325 ms
TOTAL TIME: 2679.374 ms
RATIO: 8.104%
>>>>> FUNCTION: Dolsort
CALLS: 2270
AVG TIME: 0.572 ms
MAX TIME: 205.545 ms
MIN TIME: 0.024 ms
TOTAL TIME: 1297.803 ms
RATIO: 3.925%
>>>>> FUNCTION: DirDataMagic
CALLS: 1
AVG TIME: 494.874 ms
MAX TIME: 494.874 ms
MIN TIME: 494.874 ms
TOTAL TIME: 494.874 ms
RATIO: 1.497%
>>>>> FUNCTION: PlotPiechart
CALLS: 1
AVG TIME: 181.087 ms
MAX TIME: 181.087 ms
MIN TIME: 181.087 ms
TOTAL TIME: 181.087 ms
RATIO: 0.548%
>>>>> FUNCTION: ScanProgressTask
CALLS: 31
AVG TIME: 5.067 ms
MAX TIME: 17.719 ms
MIN TIME: 4.329 ms
TOTAL TIME: 157.068 ms
RATIO: 0.475%
>>>>> FUNCTION: OneSecondProgress
CALLS: 4553
AVG TIME: 0.025 ms
MAX TIME: 1.853 ms
MIN TIME: 0.019 ms
TOTAL TIME: 113.268 ms
RATIO: 0.343%
>>>>> FUNCTION: ListDirectory
CALLS: 1
AVG TIME: 89.746 ms
MAX TIME: 89.746 ms
MIN TIME: 89.746 ms
TOTAL TIME: 89.746 ms
RATIO: 0.271%
>>>>> FUNCTION: FormatBytes
CALLS: 40
AVG TIME: 0.068 ms
MAX TIME: 0.122 ms
MIN TIME: 0.023 ms
TOTAL TIME: 2.729 ms
RATIO: 0.008%
>>>>> FUNCTION: FormatCommas
CALLS: 31
AVG TIME: 0.046 ms
MAX TIME: 0.086 ms
MIN TIME: 0.039 ms
TOTAL TIME: 1.438 ms
RATIO: 0.004%
>>>>> FUNCTION: GetColor
CALLS: 6
AVG TIME: 0.061 ms
MAX TIME: 0.168 ms
MIN TIME: 0.028 ms
TOTAL TIME: 0.366 ms
RATIO: 0.001%Barney Blankenship June 17 2006 Added MAX and MIN function call time measurements, updated the Time Profiler snippet and example output here.
Barney Blankenship June 18, 2006 Oh My God! The new beta at ActiveState causes piechart.tcl to run 116% faster. I must somehow find a way to wrap with it!