dmc2280_util.tcl:

dmc send and receive commands now take a socket as a parameter.  channel and controller arrays can be used to lookup the socket by IP address or controller name.

troubleshoot.tcl:
Uses new dmc send and receive commands.  Also loads motorinfo.tcl so that encoder readings can be read.

r1128 | ffr | 2006-10-09 13:12:08 +1000 (Mon, 09 Oct 2006) | 6 lines
This commit is contained in:
Ferdi Franceschini
2006-10-09 13:12:08 +10:00
committed by Douglas Clowes
parent 97680fc917
commit 48772a1cc6
2 changed files with 41 additions and 24 deletions

View File

@@ -1,13 +1,14 @@
#!/usr/bin/env tclsh
# $Revision: 1.5 $
# $Date: 2006-09-06 03:49:08 $
# $Revision: 1.6 $
# $Date: 2006-10-09 03:12:08 $
# Author: Ferdi Franceschini (ffr@ansto.gov.au)
# Last revision by $Author: ffr $
# Load troubleshooting setup
source dmc2280_util.tcl
source troubleshoot_setup.tcl
source motorinfo.tcl
if { $argc > 0 } {
set configFileName [lindex $argv 0]
@@ -36,21 +37,19 @@ proc loadConfig {fName} {
proc subExists {contName sub} {
upvar #0 $contName controller
if [catch {::dmc_sendCmd $contName "LS $sub,0"} errMsg] {
if [catch {::dmc_sendCmd $controller(socket) "LS $sub,0"} errMsg] {
error "Subroutine $sub does not exist on controller $contName"
}
::dmc_receive $contName
::dmc_receive $controller(socket)
}
# Returns -1 if thread is not running, line number if it is
proc checkThread {contName thnum} {
upvar #0 $contName controller
::dmc_sendCmd $contName "MG _XQ$thnum"
set reply [::dmc_receive $contName ]
::dmc_sendCmd $controller(socket) "MG _XQ$thnum"
set reply [::dmc_receive $controller(socket) ]
if {$reply == -1} {
error "Thread $thnum not running on controller $contName\n
If the broken thread is 0, then it is probably a loop in the #AUTO subroutine\n
which is not being reached."
error "Thread $thnum not running on controller $contName"
}
return $reply
}
@@ -103,11 +102,12 @@ proc checkThread {contName thnum} {
proc mkGui {} {
variable ContList
lappend Headings $ContList
frame .t -bg black
table .t $ContList
pack .t
testgui
}
proc table {w headings args} {
frame $w -bg black
set r 0
foreach name $headings {