(another) command profiler

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::end

Output:

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