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

======

[aplsimple] 2022-12-24:

I've modified a bit the profiler by Federico, the modifications are mostly about

   * wrapping with two commands (''::PR start'' and ''::PR end'')
   * allowing ''::PR start'' to take a list of profiled commands
   * sorting output lines

The modified profiler is used by [alited, a lite editor%|%alited], its last version is available in [https://chiselapp.com/user/aplsimple/repository/alited/download%|%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 _________________________ #

======

<<categories>> Performance