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)
return
}
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]} {
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
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) [L1 ]
proc test_proc1 {arg} {
puts "heh: [test_proc2 $arg jim]"
}
proc test_proc2 {bob joe} {
puts "whee: $joe $bob"
return joe
}
proc unknown args {
global TOTALEXECTIME EXECCNT DEBUG
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