2007-09-08 Sarnold: I felt the need of a command-line debugger for some console scripts I wrote on Linux. Visiting the wiki brought me a sort of challenge: create a debugger in pure-Tcl, which, I would like to, would be easy to use, ideally:
tcldebug myapp.tcl args...
where myapp.tcl is an unmodified Tcl application.
Well, I could not win the challenge, and myapp.tcl has to be modified (just adding one line) to be inspected for. Indeed, my debugger tries to put traces on procs and variables, and just as any debugger, these procs and variables need to have been created before the user put traces.
Now, let the code speak...
Instead of the classical
tclsh myapp.tcl ?args...?
just type:
tclsh tcldebug myapp.tcl ?args...?
And insert in myapp.tcl:
catch {tcldebug::debug}after all your procs definitions.
#!/usr/bin/env tclsh
proc __debug {} {
namespace eval ::tcldebug {
variable break ""
variable log ""
variable enter ""
variable step ""
variable argv
variable argv0
set argv $::argv
set argv0 $::argv0
proc var {name key} {
if {$key eq ""} {return $name}
return $name\($key\)
}
proc Log {name1 name2 op} {
switch -- $op {
read - write {
eputs "$op [var $name1 $name2]=[uplevel 1 set [var $name1 $name2]]"
}
unset {
eputs "unset [var $name1 $name2]"
if {[Unlog [var $name1 $name2]]<0} {
Unlog $name1
}
}
default {error "unknown $op"}
}
}
proc Unlog {name} {
variable log
set i [lsearch -exact $log $name]
if {$i<0} {return -1}
set log [lreplace $log $i $i]
catch {
trace remove variable $name {read write unset} ::tcldebug::Log
}
return 0
}
proc Store {list elt} {
if {[lsearch -exact $list $elt]>=0} {return $list}
lappend list $elt
return $list
}
proc Break {name1 name2 op} {
switch -- $op {
read - write {
eputs "$op [var $name1 $name2]=[uplevel 1 set [var $name1 $name2]]"
uplevel 1 ::tcldebug::debug
}
unset {
eputs "unset [var $name1 $name2]"
if {[Unbreak [var $name1 $name2]]<0} {
Unbreak $name1
}
}
default {error "unknown $op"}
}
}
proc Unbreak {name} {
variable break
set i [lsearch -exact $break $name]
if {$i<0} {return -1}
set break [lreplace $break $i $i]
catch {
trace remove variable $name {read write unset} ::tcldebug::Break
}
return 0
}
proc Enter {cmdstring op} {
switch -- $op {
enter {
eputs "entering [lindex $cmdstring 0]"
uplevel 1 ::tcldebug::debug [list $cmdstring]
}
default {error "unknown $op"}
}
}
proc Unenter {name} {
variable enter
set i [lsearch -exact $enter $name]
if {$i<0} {return -1}
set enter [lreplace $enter $i $i]
catch {
trace remove execution $name enter ::tcldebug::Enter
}
return 0
}
proc Step {cmdstring op} {
switch -- $op {
enterstep {
eputs $cmdstring
uplevel 1 ::tcldebug::debug [list $cmdstring]
}
default {error "unknown $op"}
}
}
proc Unstep {name} {
variable step
set i [lsearch -exact $step $name]
if {$i<0} {return -1}
set step [lreplace $step $i $i]
catch {
trace remove execution $name enterstep ::tcldebug::Step
}
return 0
}
proc assert {expr {message ""}} {
if {[uplevel 1 expr $expr]} {return}
if {$message eq ""} {set message "assertion failed: $expr"}
error $message
}
proc p {varname} {
if {[uplevel 1 array exists $varname]} {
uplevel 1 parray $varname
return
}
if {[uplevel 1 info exists $varname]} {
eputs "$varname = [uplevel 1 set $varname]"
} else {
eputs "variable $varname does not exist"
}
}
proc Prompt {} {
return {TclDebugger by S.Arnold. v0.1 2007-09-09}
}
proc eputs {str} {puts stderr $str}
proc Interact {{cmdstring ""}} {
debug $cmdstring
}
proc debug {{cmdstring ""}} {
set help {Commands are:
h or ? prints this message
a or > prints the command being executed
p prints the current level proc
e or ! evals a command
= prints the content of each variable name
var watchs the modifications of some variables
log logs all modifications to stderr
break adds breakpoint for writes
info prints all variables being watched for
clear clears logging and breaks
cmd
enter set a break point for the entering of a command
step steps through the command
clear clear break points (using glob patterns)
c continue execution
r restarts the program
x or q exit the debugger}
set help [Prompt]\n$help
while 1 {
puts -nonewline stderr "dbg> "
flush stderr
gets stdin line
switch -- [lindex $line 0] {
h - ? {eputs $help}
e - ! {
if {[catch {eputs [uplevel 1 [lrange $line 1 end]]} msg]} {
eputs "error: $msg"
}
}
a - > {eputs $cmdstring}
p {
eputs [uplevel 1 info level 0]
}
= {
foreach var [lrange $line 1 end] {uplevel 1 ::tcldebug::p $var}
}
var {
assert {[llength $line]<=3} "bad syntax, $line has more than 3 tokens"
foreach {subcmd value} [lrange $line 1 end] {break}
switch -- $subcmd {
log {
variable log
set log [Store $log $value]
uplevel 1 [list trace add variable $value {read write unset} ::tcldebug::Log]
}
break {
variable break
set break [Store $break $value]
uplevel 1 [list trace add variable $value {read write unset} ::tcldebug::Break]
}
info {
foreach {n t} {log Logged break "Breaks at"} {
variable $n
eputs "=== $t: ==="
eputs [set $n]
eputs "----"
}
}
clear {
foreach {v t cmd} {log Logged Unlog break "Breaks at" Unbreak} {
eputs "clearing $t..."
variable $v
foreach i [set $v] {
if {[string match $value $i]]} {
eputs $i
# unlogs or unbreaks the variable
::tcldebug::$cmd $i
}
}
}
}
default {
error "no such subcommand: $subcmd"
}
}
}
cmd {
assert {[llength $line]<=3} "bad syntax, $line has more than 3 tokens"
foreach {subcmd value} [lrange $line 1 end] {break}
switch -- $subcmd {
enter {
variable enter
set enter [Store $enter $value]
trace add execution $value enter ::tcldebug::Enter
}
step {
variable step
set step [Store $step $value]
trace add execution $value enterstep ::tcldebug::Step
}
info {
foreach {n t} {enter Enters step Stepping} {
variable $n
eputs "=== $t: ==="
eputs [set $n]
eputs "----"
}
}
clear {
foreach {v t cmd} {enter Enters Unenter step Stepping Unstep} {
eputs "clearing $t..."
variable $v
foreach i [set $v] {
if {[string match $value $i]} {
eputs $i
# 'unenters' or 'unstep' the command
::tcldebug::$cmd $i
}
}
}
}
default {
error "no such subcommand: $subcmd"
}
}
}
c {
return
}
r {
variable argv0
variable argv
eval exec [list [info nameofexecutable] $argv0] $argv
exit
}
x - q {
exit
}
}
}
}
proc prepare {} {
global argv argv0
# Start the program!
set argv0 [lindex $argv 0]
set argv [lrange $argv 1 end]
# Prompts
puts stderr [tcldebug::Prompt]
puts stderr "type h to the prompt to get help"
if {![file exists $argv0]} {
set argv0 [auto_execok $argv0]
}
# steps toplevel execution
variable step
set step [Store $step ::tcldebug::main]
trace add execution ::tcldebug::main enterstep ::tcldebug::Step
}
proc main {} {
uplevel 1 [list source $::argv0]
}
}
}
__debug
tcldebug::prepare
tcldebug::main2008-06-28 Sarnold: Let us revitalize this project. The debugger can now debug dynamically unmodified code, including toplevel execution. To disable toplevel stepping, just invoke the debugger command "cmd clear *". Have fun!
Does anybody want multi-thread aware debugging ? Integration with Eclipse DLTK? Please post here and I will try to improve tcldebug.
vai - 2011-02-07 00:27:27
Hello Sir,
I want to know the usage of command line tcl debugger created by you. Will you please put more details of how to use it? How to use all the functions of debugger?
Thanks
Lorance - 2011-08-27 20:31:47
I made a few changes to your script. It is up at GitHub and I call Tagma Debugger. I made quite a few changes, added a manpage and fixed the but above with stepping into the debugger. (I disable the trace until after Log or Break have finished.)