diff options
Diffstat (limited to 'profiler.tcl')
| -rw-r--r-- | profiler.tcl | 207 |
1 files changed, 207 insertions, 0 deletions
diff --git a/profiler.tcl b/profiler.tcl new file mode 100644 index 0000000..554cb84 --- /dev/null +++ b/profiler.tcl @@ -0,0 +1,207 @@ +#!/bin/sh +# vim:set ft=tcl: \ +exec tclsh "$0" "$@" +#================================================================= + # 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 + } + } + |