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 an example of output:
+------------------------+--------------+--------+--------------+--------------+ |PROCNAME | EXCLUSIVETOT| CALLNUM| AVGPERCALL| CUMULTOT| +------------------------+--------------+--------+--------------+--------------+ |::forward_layer | 6633136| 49781| 133| (*)20469849| |::sigmoid | 3495841| 99561| 35| 6343186| |::feed | 3160806| 24891| 126| (*)38391370| |::forward | 2029711| 24891| 81| (*)26240393| |::setInput | 1481314| 24891| 59| 2259207| |::learn | 892549| 992| 899| (*)40720117| |::getOutput | 822401| 24990| 32| 1506781| |::training | 60521| 1| 60521| (*)0| |::print | 2519| 2| 1259| 2595| |TOPLEVEL | 922| 1| 922| NOT AVAILABLE| |::reset | 155| 1| 155| 176| |::create | 144| 1| 144| 235| +------------------------+--------------+--------+--------------+--------------+ (*) = Incomplete result, program inside that function.
That's the code (at the end of this page there is a little test script):
# 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 {}
# Unset the specified var and returns the old content
proc ::etprof::getunset varName {
upvar $varName var
set t $var
unset var
return $t
}
proc ::etprof::lpop listVar {
upvar $listVar list
set retval [lindex $list end]
set list [lrange [::etprof::getunset list] 0 end-1]
return $retval
}
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
}
# End of slow operations
switch -- [lindex $args end] {
enter {
# 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]
set callerns [uplevel 1 namespace current]
set caller [::etprof::fullyQualifiedName $caller $callerns]
}
set depth [incr ::etprof::depth($name)]
::etprof::enterHandler $name $caller $elapsed
if {$depth == 1} {
lappend ::etprof::cumulative_timers [clock clicks]
}
}
leave {
if {$::etprof::depth($name) == 1} {
set t [lpop ::etprof::cumulative_timers]
set cum_elapsed [expr {[clock clicks]-$t}]
incr ::etprof::cumulative($name) $cum_elapsed
}
::etprof::leaveHandler $name $elapsed
incr ::etprof::depth($name) -1
}
}
# This should be the last command of this procedure
set ::etprof::timer [clock clicks]
}
proc ::etprof::enterHandler {name caller elapsed} {
# The caller may not exists in the arrays because may be a built-in
# like [eval].
if {[info exists ::etprof::exclusive($caller)]} {
incr ::etprof::exclusive($caller) $elapsed
}
incr ::etprof::calls($name)
}
proc ::etprof::leaveHandler {name elapsed} {
# The program is leaving the function. Add the current time value
# to it. And reset the value.
incr ::etprof::exclusive($name) $elapsed
}
# That comes from the TclLib's profiler, seems working but
# I wonder if there is a better (faster) way to get the fully-qualified
# names.
proc ::etprof::fullyQualifiedName {name ns} {
if { ![string equal $ns "::"] } {
if { ![string match "::*" $name] } {
set name "${ns}::${name}"
}
}
if { ![string match "::*" $name] } {
set name "::$name"
}
return $name
}
# 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]]
set name [::etprof::fullyQualifiedName $name $ns]
# 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]
::etprof::initProcInfo $name
return
}
proc ::etprof::initProcInfo name {
set ::etprof::calls($name) 0
set ::etprof::exclusive($name) 0
set ::etprof::cumulative($name) 0
set ::etprof::depth($name) 0
}
proc ::etprof::init {} {
rename ::proc ::_oldProc
interp alias {} proc {} ::etprof::profProc
set ::etprof::timer [clock clicks]
set ::etprof::hits 0
array set ::etprof::exclusive {}
array set ::etprof::cumulative {}
array set ::etprof::calls {}
set ::etprof::cumulative_timers {}
::etprof::initProcInfo TOPLEVEL
set ::etprof::calls(TOPLEVEL) 1
set ::etprof::cumulative(TOPLEVEL) {NOT AVAILABLE}
return
}
proc ::etprof::printInfoLine {name exTot callsNum avgExPerCall cumulTot {sep |}} {
puts [format "$sep%-24.24s$sep%14.14s$sep%8.8s$sep%14.14s$sep%14.14s$sep" \
$name $exTot $callsNum $avgExPerCall $cumulTot]
}
proc ::etprof::printInfoSeparator {} {
set hline [string repeat - 30]
::etprof::printInfoLine $hline $hline $hline $hline $hline +
}
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]
::etprof::printInfoSeparator
::etprof::printInfoLine PROCNAME EXCLUSIVETOT CALLNUM AVGPERCALL CUMULTOT
::etprof::printInfoSeparator
foreach i $info {
foreach {name exclusiveTime} $i break
set cumulativeTime $::etprof::cumulative($name)
set calls $::etprof::calls($name)
if {$calls} {
set avgTimePerCall [expr {int($exclusiveTime/$calls)}]
} else {
set avgTimePerCall 0
}
if {$::etprof::depth($name)} {
set cumulativeTime "(*)$cumulativeTime"
}
::etprof::printInfoLine $name $exclusiveTime $calls $avgTimePerCall $cumulativeTime
}
::etprof::printInfoSeparator
puts "(*) = Incomplete result, program inside that function."
}
::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 etprof.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):
+------------------------+--------------+--------+--------------+--------------+ |PROCNAME | EXCLUSIVETOT| CALLNUM| AVGPERCALL| CUMULTOT| +------------------------+--------------+--------+--------------+--------------+ |::a | 2003829| 1| 2003829| 3023540| |::c | 1019194| 2| 509597| 1019408| |TOPLEVEL | 372| 1| 372| NOT AVAILABLE| |::b | 45| 1| 45| 510095| +------------------------+--------------+--------+--------------+--------------+
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.