added profiling and test file

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
+                                 }
+ }
+