Expanded TCL interpreter in TCL

Question

I have implemented many TCL extensions for a specific tool in the domain of formal methods (extensions are implemented in C but I do not want solution to rely on this fact). Thus, the users of my tool can use TCL for prototyping algorithms. Many of them are just linear list of commands (they are powerfull), e.g.:

my_read_file f
my_do_something a b c
my_do_something_else a b c

Now, I am interested in timing. It is possible to change the script to get:

puts [time [my_read_file f] 1] 
puts [time [my_do_something a b c] 1] 
puts [time [my_do_something_else a b c] 1] 

Instead of this I want to define procedure xsource that executes a TCL script and get/write timing for all my commands. Some kind of a profiler. I wrote a naive implementation where the main idea is as follows:

 set f [open [lindex $argv 0] r]
 set inputLine ""
 while {[gets $f line] >= 0} {
   set d [expr [string length $line] - 1]
   if { $d >= 0 } {
     if { [string index $line 0] != "#" } {
       if {[string index $line $d] == "\\"} {
         set inputLine "$inputLine [string trimright [string range $line 0 [expr $d - 1]]]"
       } else {
         set inputLine "$inputLine $line"
         set inputLine [string trimleft $inputLine]
         puts $inputLine
         puts [time {eval $inputLine} 1]
       }
       set inputLine ""
     }
   }
 }

It works for linear list of commands and even allows comments and commands over multiple lines. But it fails if the user uses if statements, loops, and definition of procedures. Can you propose a better approach? It must be pure TCL script with as few extensions as possible.

Answer 1

One way of doing what you're asking for is to use execution traces. Here's a script that can do just that:

package require Tcl 8.5

# The machinery for tracking command execution times; prints the time taken
# upon termination of the command. More info is available too (e.g., did the
# command have an exception) but isn't printed here.
variable timerStack {}
proc timerEnter {cmd op} {
    variable timerStack
    lappend timerStack [clock microseconds]
}
proc timerLeave {cmd code result op} {
    variable timerStack
    set now [clock microseconds]
    set then [lindex $timerStack end]
    set timerStack [lrange $timerStack 0 end-1]
    # Remove this length check to print everything out; could be a lot!
    # Alternatively, modify the comparison to print more stack frames.
    if {[llength $timerStack] < 1} {
        puts "[expr {$now-$then}]: $cmd"
    }
}

# Add the magic!
trace add execution source enterstep timerEnter
trace add execution source leavestep timerLeave
# And invoke the magic, magically
source [set argv [lassign $argv argv0];set argv0]
# Alternatively, if you don't want argument rewriting, just do:
# source yourScript.tcl

Then you'd call it like this (assuming you've put it in a file called timer.tcl):

tclsh8.5 timer.tcl yourScript.tcl

Be aware that this script has a considerable amount of overhead, as it inhibits many optimization strategies that are normally used. That won't matter too much for uses where you're doing the real meat in your own C code, but when it's lots of loops in Tcl then you'll notice a lot.