在TCL扩展TCL解释器

时间:2011-10-31 21:30:30

标签: tcl

我已经为正式方法领域的特定工具实现了许多TCL扩展(扩展在C中实现,但我不希望解决方案依赖于这个事实)。因此,我的工具的用户可以使用TCL进行原型设计算法。其中许多只是命令的线性列表(它们很强大),例如:

my_read_file f
my_do_something a b c
my_do_something_else a b c

现在,我对时机感兴趣。可以将脚本更改为:

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] 

而不是我想要定义执行TCL脚本的过程xsource以及所有命令的获取/写入时间。某种形式的探查器。我写了一个天真的实现,其主要思想如下:

 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 ""
     }
   }
 }

它适用于线性命令列表,甚至允许多行注释和命令。但是如果用户使用if语句,循环和过程定义,它就会失败。你能提出更好的方法吗?它必须是纯TCL脚本,尽可能少的扩展。

3 个答案:

答案 0 :(得分:5)

执行您要求的一种方法是使用execution traces。这是一个可以做到这一点的脚本:

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

然后你会这样称呼它(假设你把它放在一个名为timer.tcl的文件中):

tclsh8.5 timer.tcl yourScript.tcl

请注意,此脚本会产生大量开销,因为它会禁止通常使用的许多优化策略。对于你在自己的C代码中使用真正的内容的用途来说,这并不重要,但是当它在Tcl中有很多循环时,你会注意到很多。

答案 1 :(得分:2)

您可以包装要测量的命令。并且将包装器命名为与原始包装器完全相同(之前重命名原始触发器)。之后,当执行检测命令时,它实际执行包装器,包装器执行原始过程并测量执行时间。以下示例(Tcl 8.5)。

proc instrument {procs} {
  set skip_procs {proc rename instrument puts time subst uplevel return}
  foreach p $procs {
    if {$p ni $skip_procs} {
      uplevel [subst -nocommands {
        rename $p __$p
        proc $p {args} {
          puts "$p: [time {set r [__$p {*}\$args]}]"
          return \$r
        }
      }]
    }
  }
}

proc my_proc {a} {
  set r 1
  for {set i 1} {$i <= $a} {incr i} {
    set r [expr {$r * $i}]
  }
  return $r
}

proc my_another_proc {a b} {
  set r 0
  for {set i $a} {$i <= $b} {incr i} {
    incr r $i
  }
  return $r
}

instrument [info commands my_*]

puts "100 = [my_proc 100]"
puts "200 = [my_proc 100]"
puts "100 - 200 = [my_another_proc 100 200]"

答案 2 :(得分:1)

您可能需要查看命令“info complete”。从最常见的Tcl语法标记的角度来看,它可以告诉您到目前为止累积的内容是否完整。它将处理可能分布在多个物理线路上的命令输入。