Using updated dmc2280_util functions.

You can now provide file name on command line.

r1100 | ffr | 2006-09-01 14:52:09 +1000 (Fri, 01 Sep 2006) | 3 lines
This commit is contained in:
Ferdi Franceschini
2006-09-01 14:52:09 +10:00
committed by Douglas Clowes
parent 1fb33a1d2e
commit 7c7b1ec7bb

View File

@@ -1,14 +1,18 @@
#!/usr/bin/env tclsh #!/usr/bin/env tclsh
# $Revision: 1.2 $ # $Revision: 1.3 $
# $Date: 2006-08-31 06:29:04 $ # $Date: 2006-09-01 04:52:09 $
# Author: Ferdi Franceschini (ffr@ansto.gov.au) # Author: Ferdi Franceschini (ffr@ansto.gov.au)
# Last revision by $Author: ffr $ # Last revision by $Author: ffr $
# Load troubleshooting setup # Load troubleshooting setup
source dmc2280_util.tcl source common/dmc2280_util.tcl
source troubleshoot_setup.tcl source troubleshoot_setup.tcl
if { $argc > 0 } {
set configFileName [lindex $argv 0]
}
namespace eval sics_config { namespace eval sics_config {
proc loadConfig {fName} { proc loadConfig {fName} {
variable ContList variable ContList
@@ -30,21 +34,21 @@ proc loadConfig {fName} {
foreach c $ContList {upvar #0 $c cont; puts "$c IP:port = $cont(host):$cont(port)"} foreach c $ContList {upvar #0 $c cont; puts "$c IP:port = $cont(host):$cont(port)"}
} }
proc subExists {cont sub} { proc subExists {contName sub} {
global channel upvar #0 $contName controller
if [catch {sendCmd $channel($cont) "LS $sub,0"} errMsg] { if [catch {::dmc_sendCmd $contName "LS $sub,0"} errMsg] {
error "Subroutine $sub does not exist on controller $cont" error "Subroutine $sub does not exist on controller $contName"
} }
receive $channel($cont) ::dmc_receive $contName
} }
# Returns -1 if thread is not running, line number if it is # Returns -1 if thread is not running, line number if it is
proc checkThread {cont thnum} { proc checkThread {contName thnum} {
global channel upvar #0 $contName controller
sendCmd $channel($cont) "MG _XQ$thnum" ::dmc_sendCmd $contName "MG _XQ$thnum"
set reply [receive $channel($cont) ] set reply [::dmc_receive $contName ]
if {$reply == -1} { if {$reply == -1} {
error "Thread $thnum not running on controller $cont\n 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 If the broken thread is 0, then it is probably a loop in the #AUTO subroutine\n
which is not being reached." which is not being reached."
} }
@@ -60,9 +64,12 @@ proc checkThread {cont thnum} {
set ldFrame(entry) $ldFrameName.ldEntry set ldFrame(entry) $ldFrameName.ldEntry
proc ::guiLoadC {} {::sics_config::loadConfig [eval $::sics_config::ldFrame(entry) get]} proc ::guiLoadC {} {
::sics_config::loadConfig [eval $::sics_config::ldFrame(entry) get]
}
proc ::guiConnect {w cont} { proc ::guiConnect {w cont} {
::sics_config::connect $cont ::dmc_connect $cont
$w configure -activebackground green $w configure -activebackground green
$w configure -background green $w configure -background green
} }