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功能。它有一个简单的界面如下：

安装

tkcon

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

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

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

然后设置环境变量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 $stepcommandreturn}^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 listEndif ![info exists listStart] {set listStart 1set 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 $levelif {$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 linea        list array valuesb        run until next breakpointb ?        list breakpointsb <line#>    set breakpointb -<line#>    unset breakpointb -        unset all breakpointsc        list changed variable valuese        run to end of current procedureg        list global variablesh        helpl        list all instrumented linesl <line#> [<line#>]     list line numbersv        list variable valuesx        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} resultputs $::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 1catch {if {[info level] < $::stepsource::watchLevel} {unset ::stepsource::watchLevelset 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 $currentProcedureset stepCommand $::stepsource::varDefaultStepCommand $stepCommandwhile {$stepCommand != {}} {puts $::stepsource::outChannel "\n-----------------------------------"puts $::stepsource::outChannel $::stepsource::lineArray($linenumber)\nputs -nonewline $::stepsource::outChannel >set stepCommand [gets $::stepsource::inChannel]StepCommand $stepCommandif {([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 $filenamenamespace eval ::stepsource {if {[info procs original_unknown] == {}} {rename ::unknown original_unknownproc ::unknown {args} {if [string is integer -strict $args] {::stepsource::StepNumber $args} else {set ::stepsource::unk_args $argsuplevel 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 0catch {set oldMtime $mtimes($filename)}array unset lineArrayset lineCount 1foreach 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 $arrayaddset 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 $arrayaddregsub {\{} $line "\{$lineCount\;" lineset $sF "[set $sF]$noNumberLine\t$line\n"set noNumberLine {}incr lineCount} else {set noNumberLine $noNumberLine\t$line\n}}close $fif {$noNumberLine != {}} {set $sF "[set $sF]$noNumberLine"}}}set ::stepsource::sourceProcs {}uplevel 1 eval \$\{::stepsource::$::stepsource::filename\}}}# end namespace eval ::stepsourceproc ::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>就可以进行调试模式
它的命令如下：

启动后界面发下

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

RamDebugger

安装

RamDebugger需要下面四个库：

tcllib

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

tklib

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

Img

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

tktreectrl

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

RamDebugger

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

使用

建议打开变量状态框，如上面图右侧
方案是点击下面红框的选项

基本功能和其他相似，也是run/stop, add breakpoints, step/next等功能

比较

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

总结

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