SS 14Mar2004 - A trivial exclusive time procedures profiler for Tcl using traces I wrote because my feeling is that TclLib's profiler exsclusiveRunTime info is broken (see the end of this page for an example).
Just source the following code at the start of your Tcl application and run the app. It will print live profiling information at runtime every 50000 hits to the handler. If your program does not do a lot of user-defined procedure calls you can force the output information calling ::etprof::printLiveInfo.
That's the code (at the end of this page there is a little test script and an example output):
# etprof - trivial exsclusive time profiler
# I wrote this because my feeling is that exclusiveRunTime info
# of the TclLib's profiler is broken.
#
# Usage: source it as first line in your application
# and check the standard output for profiling information
# at runtime.
#
# Copyright (C) 2004 Salvatore Sanfilippo
package require Tcl 8.4
namespace eval ::etprof {}
proc ::etprof::TraceHandler {name cmd args} {
# We need to misure the elapsed time as early as possible.
set elapsed [expr {[clock clicks]-$::etprof::timer}]
# At this point the timer is not active, so we can do potentially
# slow operations like to show some profiling info at run-time.
if {[incr ::etprof::hits] >= 50000} {
set ::etprof::hits 0
::etprof::printLiveInfo
}
# Try to guess the caller function. If we are at toplevel
# set it to TOPLEVEL, in the hope there isn't another function
# with this name.
if {[info level] == 1} {
set caller TOPLEVEL
} else {
# Otherwise use [info level] to get the caller name.
set caller [lindex [info level -1] 0]
}
switch -- [lindex $args end] {
enter {::etprof::enterHandler $name $caller $elapsed}
leave {::etprof::leaveHandler $name $caller $elapsed}
}
# This should be the last command of this procedure
set ::etprof::timer [clock clicks]
}
proc ::etprof::enterHandler {name caller elapsed} {
# The program is entering another function. Add the
# current timer value to the caller and reinitialize the counter.
set name [namespace tail $name]
if {[catch {incr ::etprof::exclusive($caller) $elapsed}]} {
set ::etprof::exclusive($caller) $elapsed
}
}
proc ::etprof::leaveHandler {name caller elapsed} {
# The program is leaving the function. Add the current time value
# to it. And reset the value.
set name [namespace tail $name]
if {[catch {incr ::etprof::exclusive($name) $elapsed}]} {
set ::etprof::exclusive($name) $elapsed
}
}
# That comes from the TclLib's profiler, seems working but
# I wonder if there is a better way to get the fully-qualified
# name of the procedure to create without pattern matching.
proc ::etprof::profProc {name arglist body} {
# Get the fully qualified name of the proc
set ns [uplevel [list namespace current]]
# If the proc call did not happen at the global context and it did not
# have an absolute namespace qualifier, we have to prepend the current
# namespace to the command name
if { ![string equal $ns "::"] } {
if { ![string match "::*" $name] } {
set name "${ns}::${name}"
}
}
if { ![string match "::*" $name] } {
set name "::$name"
}
uplevel 1 [list ::_oldProc $name $arglist $body]
trace add execution $name {enter leave} \
[list ::etprof::TraceHandler $name]
return
}
proc ::etprof::init {} {
rename ::proc ::_oldProc
interp alias {} proc {} ::etprof::profProc
set ::etprof::timer [clock clicks]
set ::etprof::hits 0
array set ::etprof::exclusive {}
return
}
proc ::etprof::printLiveInfo {} {
set info {}
foreach {key val} [array get ::etprof::exclusive] {
lappend info [list $key $val]
}
set info [lsort -decreasing -index 1 -integer $info]
puts "\nProfiling information:"
puts "-----------------------"
foreach i $info {
puts $i
}
puts "-----------------------\n"
}
::etprof::initThat's a test for the profiler. From the output it seems working (I also tested it with a neural network simulator and the output is what I expected).
source profiler.tcl
proc a {} {
after 1000
b
after 1000
c
}
proc b {} {
c
}
proc c {} {
after 500
}
a
::etprof::printLiveInfoThe test output is the following (with Tcl8.4 under Linux/Intel):
Profiling information: ----------------------- a 2016697 c 1019788 TOPLEVEL 259 b 45 -----------------------
Instead, the following test uses the TclLib's profiler:
package require profiler
::profiler::init
proc a {} {
after 1000
b
after 1000
c
}
proc b {} {
c
}
proc c {} {
after 500
}
a
puts [::profiler::sortFunctions exclusiveRuntime]And the output is:
{::b 510291} {::c 1020049} {::a 3034000}Did I miss something? It seems perfectly broken.