FF 2008-07-15 - Today I was in the need of a profiler. The only profilers I can found here are proc profilers, not good for me, since the code I want to profile is made up of two procs.
Here's a tcl command profiler. You choose which commands you want to profile. Usage example:
source profiler.tcl
profiler::add {file set glob incr expr}
profiler::begin
# code here
profiler::endOutput:
--------- PROFILER STATS --------------------------------------------- Total time: 4341.784 ms (49.30% overhead+non-profiled commands) command: min max avg total ncalls expr 000000002053 000000006310 000000003764 000000037647 000010 1.76% file 000000000212 000000017706 000000001608 000002058703 001280 96.18% glob 000000000772 000000004913 000000001687 000000016873 000010 0.79% incr 000000001025 000000002968 000000001104 000000011048 000010 0.52% set 000000000725 000000003484 000000001251 000000016271 000013 0.76% ----------------------------------------------------------------------
Note: you can profile every command, except lappend, clock, list :-)
FF although, I don't believe this helps much. a better try would be a checkpoint-based profiler
namespace eval ::profiler {
variable cnt
variable sum
variable min
variable max
variable cmdlist {}
variable tmstart 0
variable tmend 0
variable tmp
proc add {cmdlist_a} {
variable cmdlist
set cmdlist [concat $cmdlist $cmdlist_a]
set cmdlist [lsort -unique $cmdlist]
}
proc enter {cmd op} {
variable db
lappend db [list [clock microseconds] 1 $cmd]
}
proc leave {cmd code result op} {
variable db
lappend db [list [clock microseconds] 0 $cmd]
}
proc begin {args} {
variable cmdlist
variable tmstart
foreach cmd $cmdlist {
trace add execution $cmd enter ::profiler::enter
trace add execution $cmd leave ::profiler::leave
}
set tmstart [clock microseconds]
}
proc end {args} {
variable cmdlist
variable tmstart
variable tmend
variable db
set tmend [clock microseconds]
foreach cmd $cmdlist {
trace remove execution $cmd enter ::profiler::enter
trace remove execution $cmd leave ::profiler::leave
}
puts "--------- PROFILER STATS ---------------------------------------------"
array set tmp {}
array set cnt {}
array set sum {}
array set min {}
array set max {}
set totaltime 0
foreach i $db {
lassign $i clk enter cmdline
set cmd [lindex $cmdline 0]
if {![info exists cnt($cmd)]} {set cnt($cmd) 0}
if {![info exists sum($cmd)]} {set sum($cmd) 0}
if {![info exists min($cmd)]} {set min($cmd) 0}
if {![info exists max($cmd)]} {set max($cmd) 0}
if {$enter} {
lappend tmp($cmd) $clk
} else {
set delta [expr {$clk-[lindex $tmp($cmd) end]}]
if {[llength $tmp($cmd)] == 1} {
unset tmp($cmd)
} else {
set tmp($cmd) [lrange $tmp($cmd) 0 end-1]
}
incr cnt($cmd) 1
incr sum($cmd) $delta
incr totaltime $delta
if {$min($cmd) == 0 || $delta < $min($cmd)} {set min($cmd) $delta}
if {$max($cmd) == 0 || $delta > $max($cmd)} {set max($cmd) $delta}
}
}
set db {}
puts "Total time: [expr {($tmend-$tmstart)/1000.0}] ms ([format %.2f%% [expr {$totaltime*100.0/($tmend-$tmstart)}]] overhead+non-profiled commands)"
puts "command: min max avg total ncalls"
foreach cmd $cmdlist {
set avg [expr {int(1.0*$sum($cmd)/$cnt($cmd))}]
set percent [expr {$sum($cmd)*100.0/($totaltime)}]
puts [format "%-12s %.12d %.12d %.12d %.12d %.06d %.2f%%" \
$cmd $min($cmd) $max($cmd) $avg $sum($cmd) $cnt($cmd) $percent]
}
puts "----------------------------------------------------------------------"
}
}
aplsimple 2022-12-24:
I've modified a bit the profiler by Federico, the modifications are mostly about
The modified profiler is used by alited, its last version is available in Chiselapp .
#######################################################################
# Name: cp_profiler.tcl
# Author: Federico Ferri (+ Alex Plotnikov as a wrapper)
# Date: 12/22/2022
# Brief: Wraps the Tcl profiler originally made by Federico Ferri.
# License: MIT.
#######################################################################
namespace eval ::PR {
namespace export start end
namespace ensemble create
}
# ________________________ profiler _________________________ #
namespace eval ::PR::profiler {
variable cnt
variable sum
variable min
variable max
variable cmdlist {}
variable tmstart 0
variable tmend 0
variable tmp
proc add {cmdlist_a} {
variable cmdlist
set cmdlist [concat $cmdlist $cmdlist_a]
set cmdlist [lsort -unique $cmdlist]
}
proc enter {cmd op} {
variable db
lappend db [list [clock microseconds] 1 $cmd]
}
proc leave {cmd code result op} {
variable db
lappend db [list [clock microseconds] 0 $cmd]
}
proc begin {args} {
variable cmdlist
variable tmstart
foreach cmd $cmdlist {
trace add execution $cmd enter ::PR::profiler::enter
trace add execution $cmd leave ::PR::profiler::leave
}
set tmstart [clock microseconds]
}
proc end {args} {
variable cmdlist
variable tmstart
variable tmend
variable db
variable cnt
variable sum
set tmend [clock microseconds]
foreach cmd $cmdlist {
trace remove execution $cmd enter ::PR::profiler::enter
trace remove execution $cmd leave ::PR::profiler::leave
}
set under [string repeat - 99]
puts $under
if {![llength $cmdlist]} {
puts {Nothing to profile. Provide a list of command(s) for "::PR start ?command ...?"}
puts $under
return
}
array set tmp {}
array set cnt {}
array set sum {}
array set min {}
array set max {}
set totaltime 0
foreach i $db {
lassign $i clk enter cmdline
set cmd [lindex $cmdline 0]
if {![info exists cnt($cmd)]} {set cnt($cmd) 0}
if {![info exists sum($cmd)]} {set sum($cmd) 0}
if {![info exists min($cmd)]} {set min($cmd) 0}
if {![info exists max($cmd)]} {set max($cmd) 0}
if {$enter} {
lappend tmp($cmd) $clk
} else {
set delta [expr {$clk-[lindex $tmp($cmd) end]}]
if {[llength $tmp($cmd)] == 1} {
unset tmp($cmd)
} else {
set tmp($cmd) [lrange $tmp($cmd) 0 end-1]
}
incr cnt($cmd) 1
incr sum($cmd) $delta
incr totaltime $delta
if {$min($cmd) == 0 || $delta < $min($cmd)} {set min($cmd) $delta}
if {$max($cmd) == 0 || $delta > $max($cmd)} {set max($cmd) $delta}
}
}
set db {}
puts "Total time: [expr {($tmend-$tmstart)/1000.0}] ms ([format %.2f%% [expr {$totaltime*100.0/($tmend-$tmstart)}]] overhead+non-profiled commands)\n"
puts [format "%-30s %-12s %-12s %-12s %-12s %-8s %s" \
command min max avg total calls percent]
puts $under
for {set i [llength $cmdlist]} {$i} {} {
set cmd [lindex $cmdlist [incr i -1]]
if {![info exists cnt($cmd)]} {set cmdlist [lreplace $cmdlist $i $i]}
}
set cmdlist [lsort -decreasing -command ::PR::profiler::compare $cmdlist]
foreach cmd $cmdlist {
set avg [expr {int(1.0*$sum($cmd)/$cnt($cmd))}]
set percent [expr {$sum($cmd)*100.0/($totaltime)}]
puts [format "%-30s %-12s %-12s %-12s %-12s %-8s %.2f%%" \
$cmd $min($cmd) $max($cmd) $avg $sum($cmd) $cnt($cmd) $percent]
}
puts $under
}
#_______________________
proc compare {a b} {
# Compares numbers.
# a - 1st number
# b - 2nd number
variable sum
if {$sum($a) < $sum($b)} {
return -1
} elseif {$sum($a) > $sum($b)} {
return 1
}
return [string compare $a $b]
}
## ________________________ EONS profiler _________________________ ##
}
# ________________________ PR _________________________ #
# It's a wrapper for profiler.
# Use "PR start {commands}" to start profiling.
# Use "PR end" to end profiling and output results.
proc ::PR::start {args} {
# Starts profiling, with an optional list of commands to be profiled.
foreach cmd $args {::PR::profiler::add $cmd}
::PR::profiler::begin
}
#_______________________
proc ::PR::end {args} {
# Ends profiling.
::PR::profiler::end
}
# ________________________ EOF _________________________ #