Arjen Markus (23 august 2004) Execution traces are a wonderful thing if you want to interactively debug your Tcl program or create a trace of "every" command it is running.
I used the technique described in Steppin' out to create a basic debugger (it is not meant to be the ultimate in interactive debuggers for Tcl, by no means - very nice ones exist already!), but I intend it to be a basic out-of-the-box facility.
Here is the (not completely completed) script
(A trace tool can be implemented in a similar way ...)
# debug.tcl --
# Script providing basic debugging facilities
#
namespace eval ::Tracedebug:: {
variable go
variable breakpoints {}
variable dcmd
variable dname
variable silent 0
}
# dbg_enter --
# Callback for enterstep event
#
# Arguments:
# cmd Expanded command line
# op Operation
# Result:
# None
# Side effect:
# Sets dname
#
#
proc ::Tracedebug::dbg_enter {cmd op} {
variable dname
variable silent
variable breakpoints
if { [lsearch $breakpoints [lindex $cmd 0]] >= 0 } {
set silent 0
}
if { ! $silent } {
puts "Next: $cmd"
set dname [lindex $cmd 0]
dbg
}
}
# dbg_leave --
# Callback for leavestep event
#
# Arguments:
# cmd Expanded command line
# code Return code
# result Result of the command
# op Operation
# Result:
# None
#
#
proc ::Tracedebug::dbg_leave {cmd code result op} {
variable dname
variable silent
if { ! $silent } {
set dname [lindex $cmd 0]
if { $code == 1 } {
puts "ERROR: $result"
} else {
puts "Result: $result"
}
}
}
# printHelp --
# Print short help information
#
# Arguments:
# None
# Result:
# None
# Side effect:
# Prints help
#
proc ::Tracedebug::printHelp {} {
puts "Tcl debugger:
?/h - print help information
b name - set a breakpoint in procedure name
c - continue
db ?name? - remove the (current) breakpoint
e - print error information
l - list the body of the current procedure
lb - list current breakpoints
n - next step (or return)
p name - print a variable
t - print a stack trace
v name ?cond? - set a trace on the variable (possibly with a
particular condition)"
}
# printStack --
# Print the stack
#
# Arguments:
# None
# Result:
# None
# Side effect:
# Prints stack
#
proc ::Tracedebug::printStack {} {
set nolevels [info level]
set level [expr {$nolevels-3}]
set number 1
while { $level > 0 } {
puts "$number: [info level $level]"
incr number
incr level -1
}
puts "(global level)"
}
# printBody --
# Print the body of the current routine
#
# Arguments:
# None
# Result:
# None
# Side effect:
# Prints body
#
proc ::Tracedebug::printBody {} {
set nolevels [info level]
set level [expr {$nolevels-3}]
set procname [lindex [info level $level] 0]
set number 1
foreach line [split [info body $procname] "\n"] {
puts "[format "%3d" $number]: $line"
incr number
}
}
# setBreak --
# Set a breakpoint in the given routine
#
# Arguments:
# None
# Result:
# None
# Side effect:
# Prints help
#
proc ::Tracedebug::setBreak {} {
variable breakpoints
if { [llength $dcmd] == 2 } {
lappend breakpoints [lindex $dcmd 1]
} else {
lappend breakpoints [lindex [info level 3] 1]
}
}
# readCmd --
# Read the user's command
#
# Arguments:
# None
# Result:
# None
# Side effect:
# Sets dcmd
#
#
proc ::Tracedebug::readCmd {} {
variable dcmd
puts -nonewline ">> "
flush stdout
set dcmd [gets stdin]
}
# guiReadCmd --
# Read the user's command via a simple GUI
#
# Arguments:
# None
# Result:
# None
# Side effect:
# Sets go and dcmd
#
#
proc ::Tracedebug::guiReadCmd {} {
variable go
variable dcmd
vwait ::Tracedebug::go
puts ">> $dcmd"
update
}
# createCmdWindow --
# Create a toplevel window to enter commands
#
# Arguments:
# None
# Result:
# None
# Side effect:
# Toplevel window created
#
#
proc ::Tracedebug::createCmdWindow {} {
variable go
variable dcmd
toplevel .debug
wm title .debug "Debug"
label .debug.label -text "Debug:"
entry .debug.entry -textvariable ::Tracedebug::dcmd -width 15
button .debug.go -text "Go" -width 10 \
-command {set ::Tracedebug::go 1}
button .debug.next -text "Next" -width 10 \
-command {set ::Tracedebug::dcmd "n"
set ::Tracedebug::go 1}
button .debug.cont -text "Continue" -width 10 \
-command {set ::Tracedebug::dcmd "c"
set ::Tracedebug::go 1}
button .debug.quit -text "Quit" -width 10 \
-command {set ::Tracedebug::dcmd "q"
set ::Tracedebug::go 1}
grid .debug.label .debug.entry - .debug.go -sticky news
grid .debug.next .debug.cont .debug.quit
}
# dbg --
# Handle the user input in debug mode
#
# Arguments:
# None
# Result:
# None
# Side effect:
# Whatever the user does
#
#
proc ::Tracedebug::dbg {} {
variable go
variable dcmd
variable dname
variable silent
while {1} {
#
# Wait for the user to enter a command
#
readCmd
#
# Handle the command:
# ?/h - print help information
# b name - set breakpoint
# c - continue (remove this breakpoint)
# e - print error information
# l - list the body of the current procedure
# n - next step
# p name - print a variable
# t - print a stack trace
# v name ?cond? - set a trace on the variable (possibly with a
# particular condition)
#
switch -- [lindex $dcmd 0] {
"?" -
"h" {printHelp}
"b" {setBreak [lindex $dcmd 1]}
"c" {
#trace remove execution $dname enterstep ::Tracedebug::dbg_enter
#trace remove execution $dname leavestep ::Tracedebug::dbg_leave
set silent 1 ;# Much TODO
break
}
"e" {
puts "Errorinfo: $::errorInfo"
puts "Errorcode: $::errorCode"
}
"l" {printBody}
"" -
"n" {
break
}
"p" {
catch {
uplevel 2 "puts \$[lindex $dcmd 1]"
}
}
"q" -
"quit" {exit}
"t" {printStack}
"v" {traceVar}
default {
# Ignore for the moment
puts "Unknown debug command: $dcmd"
}
}
}
}
# main --
# Get the thing going
#
trace add execution source enterstep ::Tracedebug::dbg_enter
trace add execution source leavestep ::Tracedebug::dbg_leave
#
# Create a console - if necessary
#
catch {
console show
rename ::Tracedebug::readCmd {}
rename ::Tracedebug::guiReadCmd ::Tracedebug::readCmd
::Tracedebug::createCmdWindow
} msg
puts $msg
puts [trace info execution source]
puts $::argv
set argv0 [lindex $::argv 0]
set argv [lrange $::argv 1 end]
source $argv0