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.
Begin experiment snippet:
# 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)\} \{"
append new_proc "global p;"
append new_proc "set p($name,start) \[clock clicks -milliseconds\];"
append new_proc "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]]} {
append new_proc "p_stop_time $name;"
}
append new_proc "[lindex $tmp($name,body) $i];"
}
rename $name old_$name
eval $new_proc
puts [info args $name]
puts [info body $name]
puts "complete=[info complete $name]"
}End experiment snippet
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
# 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: (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
pop_buffer 55 1.018182 56
e_enter 5 9.200000 46PWQ 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.