如何实现对tcl脚本的类GDB调试

debug TCL script with free tools

面临的问题

tcl脚本被广泛使用于EDA工具中，像Cadence， Synopys和mentor的工具脚本都是tcl脚本，可以在里面嵌入tcl脚本以实现比较复杂的设计流程和自动化工作。
目前tcl的调试主要依靠插入打印信息，这样需要叠代的次数比较，代码里会充满了打印语句也不太美观。

可选方案

在网上尝试了几种方案，最好的是activestate的Komodo，它是一个IDE，可以直接GUI下的各种调试手段，无奈它是一个收费软件，可以免费尝试21天。所以作者把目光投向了一些其他免费的方案。
GUI下的调试手段还是比较友好的，所以找到了DDT, 这个工具虽然支持的功能很简单，但都非常实用，唯一不足就是速度太慢了，所以又尝试了类似工具RamDebugger.
另外一个工具是一个简单的脚本stepsource.tcl, 它也可以实现类似的功能，只是没有GUI，但速度飞快，作者本人更喜欢使用它。
下面就简单介绍一下他们的安装和使用

DDT

介绍

可以支持Tcl8.5或更高版本的动态调试。它主要提供了step， breakpoint, variable display功能。它有一个简单的界面如下：
ddt_gui

安装

tkcon

它依赖于tkcon, 所以需要先安装tkcon.
下载地址: 如下

BTW：也可以用git clone https://github.com/wjoye/tkcon.git来下载补丁版本。

下载后可以在自己home目录下新建一个.tcllib目录，然后把下载的tkcon解压缩到里面。
tcllib

然后设置环境变量export TCLLIBPATH="/home/harriszh/.tcllib"
下面是测试是否安装好的方法：

tclsh
% package require tkcon
2.7
% tkcon show

会调出tkcon的窗口

ddt

使用git下载ddt源码：

git clone https://github.com/Drolla/ddt.git

可以将它放到某个地方，比如作者放到了/home/harriszh/bin/
然后在bash下设置如下别名, 就可以调起ddt。

alias ddt="curdir=$(pwd); cd /home/harriszh/bin/ddt/ddt_debugger && ./ddt_debugger.tcl && cd ${curdir}"

如果是csh, 则需要

alias ddt="curdir=`pwd`; cd /home/harriszh/bin/ddt/ddt_debugger && ./ddt_debugger.tcl && cd ${curdir}"

使用

通过File->load来加载要调试的tcl文件

如果这个脚本依赖输入参数，那么可以通过config->Define initilization variables and script来提供调用参数

或者可以直接在脚本的最上面写上

set argc 5
set argv {1010 -- out 10 100}

所有的功能都在Debug菜单下，和一般调试器相似， F5是run/continue, F8是设置breakpoints， shift-F5是stop， F7F7是增加watch

在运行时，右半边窗口会列出所有变量

缺点

运行速度非常慢
当脚本有问题时，容易hang， refresh都没用

总结

非常友好的GUI和使用方法。但因为速度问题使得作者寻找其他解决方案，如stepsource

stepsource

介绍

提供按行执行tcl脚本的功能

安装

把下面文件保存为stepsource.tcl

#!/usr/bin/tclsh
#===============================================================================
# FILE               :  stepsource.tcl
# USAGE              :  ./stepsource.tcl <options>
# DESCRIPTION        :  ---
# REQUIREMENT        :  ---
# AUTHOR             :  Harris Zhu (harriszh), harriszh@cadence.com
# Created On         :  2018-06-30 21:16
# Last Modified      :  2018-06-30 21:16
# Update Count       :  1
# REVISION           :  ---
#===============================================================================
 namespace eval ::stepsource {

 variable VERSION "1.0"

 proc StepCommand {stepcommand} {
    switch -regexp -- $stepcommand {
        ^\[0-9\]+$ {
            set ::stepsource::currentBreakPoint $stepcommand
            return
        }
        ^b\ *-*[0-9?]*$ {
            if {$stepcommand == "b -"} {set ::stepsource::breakPoints {} ; return}
            set bOption [lindex $stepcommand 1]
            if {$bOption == "?"} {puts $::stepsource::outChannel "breakpoints: $::stepsource::breakPoints" ; return}
            if {![string first - $bOption]} {
                set eraseBreakPoint [lsearch $::stepsource::breakPoints [expr abs($bOption)]]
                if {$eraseBreakPoint > -1} {
                    set ::stepsource::breakPoints [lreplace $::stepsource::breakPoints $eraseBreakPoint $eraseBreakPoint]
                }
                puts $::stepsource::outChannel "breakpoints: $::stepsource::breakPoints"
                return
            }
            set ::stepsource::breakPoints "$::stepsource::breakPoints $bOption"
            set ::stepsource::breakPoints [lsort -unique $::stepsource::breakPoints]
            if {$bOption == {}} {set ::stepsource::currentBreakPoint $bOption}
            return
        }
        ^l\ *[0-9]*\ *[0-9]*$ {
            regexp {l ([0-9]+) *([0-9]*)} $stepcommand trash listStart listEnd
            if ![info exists listStart] {
                set listStart 1
                set listEnd $::stepsource::lineCount
            } else {
                if {(![string is integer -strict $listEnd]) || ($listEnd < $listStart)} {set listEnd $listStart}
            }
            for {set i $listStart} {$i <= $listEnd} {incr i} {
                if ![info exists ::stepsource::lineArray($i)] {return}
                puts -nonewline $::stepsource::outChannel "$::stepsource::lineArray($i)"
            }
            return
        }
    }
    switch -- $stepcommand {
        a {
            foreach var [uplevel 3 info vars] {
                if ![uplevel 3 array exists [list $var]] {continue}
                puts $::stepsource::outChannel "-----------------------------------"
                uplevel 3 parray [list $var]
            }
        }
        c {
            foreach var [lsort [uplevel 3 info vars]] {
                if {$var == "errorInfo"} {continue}
                if ![uplevel 3 info exists [list $var]] {continue}
                if [uplevel 3 array exists [list $var]] {continue}
                set changeIcon "=="
                catch {if {$::stepsource::varValues($var) != [uplevel 3 set [list $var]]} {set changeIcon "->"}}
                if {![info exists ::stepsource::varValues($var)]} {set changeIcon "->"}
                if {$changeIcon == "->"} {puts $::stepsource::outChannel [format "%-30s %s %s" $var $changeIcon "[uplevel 3 set [list $var]]"]}
                set varrayadd $var ; lappend varrayadd [uplevel 3 set [list $var]] ; array set ::stepsource::currentValues $varrayadd
            }
            set ::stepsource::varDefault c
        }
        e {
            set level [expr [info level] - 1]
            set ::stepsource::watchLevel $level
            if {$level <= $::stepsource::highestLevel} {unset ::stepsource::watchLevel}
        }
        g {
            foreach var [lsort [info globals]] {
                if [array exists ::$var] {puts $::stepsource::outChannel [format "%-27s %s" $var Array:] ; continue}
                set changeIcon "=="
                catch {if {$::stepsource::varValues($var) != [set $var]} {set changeIcon "->"}}
                puts $::stepsource::outChannel [format "%-30s %s %s" $var $changeIcon "[set ::$var]"]
                set varrayadd $var ; lappend varrayadd [set ::$var] ; array set ::stepsource::currentValues $varrayadd
            }
        }
        h {
            puts $::stepsource::outChannel {\

 <line#>    run until line number
 <return>    run next line
 a        list array values
 b        run until next breakpoint
 b ?        list breakpoints
 b <line#>    set breakpoint
 b -<line#>    unset breakpoint
 b -        unset all breakpoints
 c        list changed variable values
 e        run to end of current procedure
 g        list global variables
 h        help
 l        list all instrumented lines
 l <line#> [<line#>]     list line numbers
 v        list variable values
 x        abort execution
 <anything else>    execute as tcl command
                }
        }
        v {
            foreach var [lsort [uplevel 3 info vars]] {
                if ![uplevel 3 info exists [list $var]] {continue}
                if [uplevel 3 array exists [list $var]] {puts $::stepsource::outChannel [format "%-27s %s" $var Array:] ; continue}
                set changeIcon "=="
                catch {if {$::stepsource::varValues($var) != [uplevel 3 set [list $var]]} {set changeIcon "->"}}
                if {![info exists ::stepsource::varValues($var)]} {set changeIcon "->"}
                puts $::stepsource::outChannel [format "%-30s %s %s" $var $changeIcon "[uplevel 3 set [list $var]]"]
                set varrayadd $var ; lappend varrayadd [uplevel 3 set [list $var]] ; array set ::stepsource::currentValues $varrayadd
            }
            set ::stepsource::varDefault v
        }
        x {
            error "abort"
        }
        {} {
            set ::stepsource::currentBreakPoint 0
        }
        default {
            catch {uplevel 3 $stepcommand} result
            puts $::stepsource::outChannel $result
        }
    }
 }

 proc StepNumber {linenumber} {
    set level [info level]
    if ![info exists ::stepsource::highestLevel] {set ::stepsource::highestLevel $level}
    if {$level < $::stepsource::highestLevel} {set $::stepsource::highestLevel $level}

    if ![info exists ::stepsource::currentBreakPoint] {set ::stepsource::currentBreakPoint 0}
    if {$::stepsource::currentBreakPoint > $::stepsource::lineCount} {set ::stepsource::currentBreakPoint $::stepsource::lineCount}
    set returnOK 1
    catch {
        if {[info level] < $::stepsource::watchLevel} {
            unset ::stepsource::watchLevel
            set returnOK 0
        } else {
            set ::stepsource::currentBreakPoint {}
        }
    }
    if {$::stepsource::currentBreakPoint == 0} {set returnOK 0}
    if {$linenumber == $::stepsource::currentBreakPoint} {unset ::stepsource::currentBreakPoint ; set returnOK 0}
    if {[lsearch -exact $::stepsource::breakPoints $linenumber] > -1} {set returnOK 0}

    if $returnOK {return}

    catch {
        set currentProcedure [lindex [info level -2] 0]
        if {[uplevel 2 info procs $currentProcedure] == {}} {set currentProcedure {}}
    }
    if ![info exists ::stepsource::lastProcedure] {set ::stepsource::lastProcedure {}}
    if ![info exists currentProcedure] {set currentProcedure {}}
    if {($level != $::stepsource::highestLevel) && ($::stepsource::lastProcedure != $currentProcedure)} {puts $::stepsource::outChannel "||||current procedure: $currentProcedure"}
    set ::stepsource::lastProcedure $currentProcedure

    set stepCommand $::stepsource::varDefault
    StepCommand $stepCommand
    while {$stepCommand != {}} {
        puts $::stepsource::outChannel "\n-----------------------------------"
        puts $::stepsource::outChannel $::stepsource::lineArray($linenumber)\n
        puts -nonewline $::stepsource::outChannel >
        set stepCommand [gets $::stepsource::inChannel]
        StepCommand $stepCommand
        if {([string is integer -strict $stepCommand]) || ($stepCommand == "b") || ($stepCommand == {}) || ($stepCommand == "e")} {
            catch {array set ::stepsource::varValues [array get ::stepsource::currentValues]}
            catch {array unset ::stepsource::currentValues}
            break
        }
    }
 }

 proc StepSource {filename} {
    namespace eval ::stepsource {}
    set ::stepsource::filename $filename
    namespace eval ::stepsource {
        if {[info procs original_unknown] == {}} {
            rename ::unknown original_unknown
            proc ::unknown {args} {
                if [string is integer -strict $args] {
                    ::stepsource::StepNumber $args
                } else {
                    set ::stepsource::unk_args $args
                    uplevel 1 ::stepsource::original_unknown $::stepsource::unk_args
                }
            }
        }
        if ![info exists inChannel] {set inChannel stdin}
        if ![info exists outChannel] {set outChannel stdout}
        if ![info exists breakPoints] {set breakPoints {}}
        if ![info exists varDefault] {set varDefault v}
        if ![info exists sourcedFiles] {set sourcedFiles {}}
        if {[lsearch -exact $sourcedFiles $filename] < 0} {lappend sourcedFiles $filename}
        if ![info exists ::stepsource::sourceProcs] {set ::stepsource::sourceProcs {}}
        set mtime [file mtime $filename]
        set oldMtime 0
        catch {set oldMtime $mtimes($filename)}
        array unset lineArray
        set lineCount 1
        foreach sF $sourcedFiles {
            set $sF {}
            set f [open $sF r]
            set noNumberLine {}
            while {![eof $f]} {
                set line [gets $f]
                set firstWord [string trim [string range [string trim $line] 0 [expr [string wordend [string trim $line] 0] - 1]]]
                set secondWord [string trim [string range [string trim $line] [string length $firstWord] [string wordend [string trim $line] [expr [string length $firstWord] + 1]]]]
                if ![regexp {(::[^ ]+)(\ |$)} $line trash firstNameSpace] {set firstNameSpace {}}
                if {$firstWord == ":"} {set firstWord $firstNameSpace}
                if {[string index $secondWord 0] == ":"} {set secondWord $firstNameSpace}
                if {$firstWord == "proc"} {lappend ::stepsource::sourceProcs $secondWord}
                if {([info commands $firstWord] != {}) || ([lsearch -exact $::stepsource::sourceProcs $firstWord] > -1)} {
                    set $sF "[set $sF]$noNumberLine[set lineCount]\;\t$line\n"
                    set arrayadd $lineCount ; lappend arrayadd $noNumberLine$lineCount\;\t$line\n ; array set lineArray $arrayadd
                    set noNumberLine {}
                    incr lineCount
                } elseif {($firstWord == "\{") && (([info commands $secondWord] != {}) || ([lsearch -exact $::stepsource::sourceProcs $secondWord] > -1))} {
                    set arrayadd $lineCount ; lappend arrayadd $noNumberLine$lineCount\;\t$line\n ; array set lineArray $arrayadd
                    regsub {\{} $line "\{$lineCount\;" line
                    set $sF "[set $sF]$noNumberLine\t$line\n"
                    set noNumberLine {}
                    incr lineCount
                } else {
                    set noNumberLine $noNumberLine\t$line\n
                }
            }
            close $f
            if {$noNumberLine != {}} {set $sF "[set $sF]$noNumberLine"}
        }
    }
    set ::stepsource::sourceProcs {}
    uplevel 1 eval \$\{::stepsource::$::stepsource::filename\}
 }

 }
 # end namespace eval ::stepsource

 proc ::ss {args} {
    catch {unset ::stepsource::watchLevel}
    catch {unset ::stepsource::currentBreakPoint}
    catch {array unset ::stepsource::varValues}
    uplevel 1 $args
 }

 package provide stepsource $::stepsource::VERSION

使用

在tclsh下先source stepsource.tcl, 然后::stepsource::StepSource <your_tcl_script>就可以进行调试模式
它的命令如下：

command	Usage
<line#>	run until line number
<return>	run next line
a	list array values
b	run until next breakpoint
b ?	list breakpoints
b <line#>	set breakpoint
b -<line#>	unset breakpoint
b -	unset all breakpoints
c	list changed variable values
e	run to end of current procedure
g	list global variables
h	help
l	list all instrumented lines
l <line#> [<line#>]	list line numbers
v	list variae values
x	abort execion
<anything else>	execute as tcl command

启动后界面发下
step_source_run
直接按回车键就可以执行下一行
可以输入puts $argv等任意tcl命令
输入b 53在第53行加入breakpoint
取消用b -53

RamDebugger

安装

RamDebugger需要下面四个库：

tcllib

tcllib下载地址：这里
用tclsh ./installer.tcl来启动安装界面
tcllib_install

tklib

tklib下载地址：这里
直接解压缩到$TCLLIBPATH里就好
tklib_install

Img

Img下载地址：这里
同tklib, 直接解压缩到$TCLLIBPATH
img_install

tktreectrl

tktreectrl下载地址：这里
解压缩后，在相应目录里执行./configure --prefix=/home/harriszh/.tcllib && make
在$TCLLIBPATH下新建目录treectrl2.4.1,
然后把library里的两个tcl文件， libtreectrl2.4.so 和pkgIndex.tcl拷到treectrl2.4.11就可以了
tktreectl_install

RamDebugger

下载文件源文件地址后解压缩
在解压缩后的目录里执行tclsh ./RamDebugger.tcl就可以看到下面界面

使用

建议打开变量状态框，如上面图右侧
方案是点击下面红框的选项
var_pane
基本功能和其他相似，也是run/stop, add breakpoints, step/next等功能
ramdebugger_debug

比较

功能和DDT相似，但速度快了很多，一样没法停止正在执行的程序。
工具本身依赖较多库，所以安装比较麻烦
如果要使用GUI来debug tcl，这个还是最优的免费解决方案

总结

作者比较使用了三个调试器后，最满意的还是stepsource, 安装,速度和功能都能满足需要，不依赖其他库，功能简洁又满足需求。

如何实现对tcl脚本的类GDB调试

debug TCL script with free tools

面临的问题

可选方案

DDT

介绍

安装

tkcon

ddt

使用

缺点

总结

stepsource

介绍

安装

使用

RamDebugger

安装

tcllib

tklib

Img

tktreectrl

RamDebugger

使用

比较

总结

harriszh

引用和评论

为什么要使用Makrdown