[Mike Tuxford]: This is a little experiment of mine that is similar to the time
command but instead keeps track of proc times during actual usage.

This rewrites procs dynamically. Currently I am doing this by
writing a tmp file and then sourcing it, I seem to be missing
a clue how to go about this without the tmp file creation.

The code should be inserted after procs are created but before
any have run.

 # this is a -*-Tcl-*- file. This line is for emacs.
 ####################
 # NOTE: "procs,watched" is the list of proc names you want to watch
 array set p {
   "procs,watched" ""
   "log,file" "/tmp/peformance.log"
 }
 
 proc p_start_time {name} {
   global p
   set p($name,start) [clock clicks -milliseconds]
   incr p($name,count)
   return
 }
 
 proc p_stop_time {name} {
   global p
   set t [expr {[clock clicks -milliseconds]-$p($name,start)}]
   if {$t == 0} {
     incr p($name,accum) 1
   } else {
     incr p($name,accum) $t
   }
   seek $p(fd) 0
   puts $p(fd) [format "%15s %-10s  %-10s %-21s" "Proc" "iterations" "Avg (ms)" "Accumulated (ms)"]
   foreach in $p(procs,watched) {
     # sanity check for typos in $p(procs,watched)
     if {![string equal [info procs $in] $in]} {
       continue
     }
     # we skip procs that haven't been used
     if {$p($in,count) > 0} {
       puts $p(fd) [format "%15s %10d  %-10f %-21d" \
         $in $p($in,count) [expr double($p($in,accum))/double($p($in,count))] \
         $p($in,accum)]
     }
   }
   flush $p(fd)
   return
 }
 
 proc init_performance {} {
   global p
   # if no procs to watch bail out
   if {![info exists p(procs,watched)] || \
       [llength $p(procs,watched)] == 0} {
     return 0
   }
   # make sure we can open our log
   if {[catch {open $p(log,file) w+} p(fd)]} {
     puts "performance: $p(fd)"
     return 0
   }
   # create our new procs
   foreach name $p(procs,watched) {
     # backward compatible
     if {![string equal [info procs $name] $name]} {
       puts "performance: proc \"$name\" does not exist, skipping"
       continue
     }
     set tmp($name,body) [split [list [info body $name]] \n]
     set tmp($name,args) [info args $name]
     set p($name,count) 0
     set p($name,accum) 0
 
     # create a tmp file (/tmp/ is writable or we wouldn't get this far)
     set fd [open /tmp/proc.$name w]
     # add the proc starting lines
     puts $fd "proc $name \{$tmp($name,args)\} \{"
     puts $fd "global p"
     puts $fd "set p($name,start) \[clock clicks -milliseconds\]"
     puts $fd "incr p($name,count)"
     # add the proc body, inserting a line before all returns
     for {set i 1} {$i < [llength $tmp($name,body)]} {incr i} {
       if {[string match *return* [lindex $tmp($name,body) $i]]} {
         puts $fd "p_stop_time $name"
       }
       puts $fd [lindex $tmp($name,body) $i]
     }
     close $fd
     rename $name old_$name
     source /tmp/proc.$name
     file delete /tmp/proc.$name
   }
   return 1
 }


# this is inserted to get things started
 if {![init_performance]} {
   puts "no performance logging"
 }

An example of the output log it creates:
            Proc iterations  Avg (ms)   Accumulated (ms)     
              in         50  3.340000   167                  
             out          8  2.250000   18                   
 netEventHandler         55  2.945455   162                  
      pop_buffer         55  1.018182   56                   
         e_enter          5  9.200000   46                   

----