George Peter Staplin Dec 28, 2005 - I wanted the ability to profile my whole program without wrapping many commands with time, so I created a version of proc that logs the time. The cost of the logging and tracing[L1 ] increases the time, but it seems to be a good way to find hot spots in a program.
# 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
}
Category Performance | Category Debugging | Category Dev. Tools | Category Development