Updated 2011-12-26 17:05:49 by RLE

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. (answer: instead of puts'ing each line to a file, append it to a string. Then, eval the string.).

In reply to the ';answer' above: This is what I had first attempted and each proc created does look correct, but for unkown reasons it interferes with some applications that no longer function properly, whereas when I use the file write method and then source it it has worked in all apps that I have used it in. Like I said, I am missing some kind of clue somewhere in doing this. pwq I suspect the answer lies in the fact that "puts" appends a new line after every string, whereas your example code snippet does not.

Oh good grief! Thank you pwq, you are right. I had thought that appending an ";" for each line would be the equivalent, ala "it's all one line to the compiler anyway". Whatever the case, the new code appears to work.

postscript: I think I just figured out why simply adding a semicolon to each line can not work. --> #comment line;

That is; the end of a comment line was never recognized without the line break.

slebetman It's not just that, code like:
  array set age {
    Tom  24
    Jack 32
    Jill 21

will get horribly mangled into:
  array set age {;Tom 24;Jack 32;Jill 21;}

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)

 proc p_stop_time {name} {
   global p
   set t [expr {[clock clicks -milliseconds]-$p($name,start)}]
   # this is a kludge for granularity, Wasn't sure how to handle it
   # so we just add 1ms
   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]} {
     # 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))] \
   flush $p(fd)

 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"
     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 
     set new_proc "proc ::$name \{$tmp($name,args)\} \{\n"
     append new_proc "global p\n"
     append new_proc "set p($name,start) \[clock clicks -milliseconds\]\n"
     append new_proc "incr p($name,count)\n"
     for {set i 1} {$i < [llength $tmp($name,body)]} {incr i} {
       if {[string match *return* [lindex $tmp($name,body) $i]]} {
         append new_proc "p_stop_time $name\n"
       append new_proc "[lindex $tmp($name,body) $i]\n"
     rename $name old_$name
     eval $new_proc
   return 1

# this is inserted to get things started

 if {![init_performance]} {
   puts "no performance logging"

An example of the output log it creates: (doesn't format so well on the wiki)
Proc iterations Avg (ms) Accumulated (ms)
in 50 3.340000 167
out 8 2.250000 18
netEventHandler 55 2.945455 162
op_buffer 55 1.018182 56
e_enter 5 9.200000 46

PWQ an alternative would be to rename proc and return and use these to create aliases for the orginal proc to do the accounting, this preserving the original proc text in tack.

The use of aliases could hide some of the replaced proc names etc.

The above may need tcl 8.5 so that return could unwind appropriate number of levels (ie return -cdode return -levels 2) in replacement proc.

Roy Keene I use a slightly different approach. I create a dynamic wrapper using the "unknown" proc (although a static wrapper would have been possible too) [1]
 proc test_proc1 {arg} {
         puts "heh: [test_proc2 $arg jim]"
 proc test_proc2 {bob joe} {
         puts "whee: $joe $bob"
         return joe
 proc unknown args {
   set oldcmd [lindex $args 0]
   set realcmd "${oldcmd}_real"
   if {([info proc $realcmd]=="" && [info command $realcmd]=="") || [string match "*_real" $oldcmd]} {
     return [error "Unknown command: $oldcmd \[$realcmd\]"]
   if {![info exists TOTALEXECTIME($oldcmd)]} { set TOTALEXECTIME($oldcmd) 0 }
   if {![info exists EXECCNT($oldcmd)]} { set EXECCNT($oldcmd) 0 }
   set times [time {
     set ret [uplevel 1 [lreplace $args 0 0 $realcmd]]
   set usectime [lindex $times 0]
   incr TOTALEXECTIME($oldcmd) $usectime
   incr EXECCNT($oldcmd)
   puts stderr "$args\[$EXECCNT($oldcmd)\]: $usectime usec (total=$TOTALEXECTIME($oldcmd) usec)"
   return $ret
 foreach jproc [join [list [info procs]]] {
   if {$jproc=="unknown" || [string match "*_real" $jproc]} { continue }
   rename $jproc ${jproc}_real
 test_proc1 sally
 test_proc2 bobby wally