Troubleshooter, runs basic checks on motion control.
r1079 | ffr | 2006-08-25 12:39:50 +1000 (Fri, 25 Aug 2006) | 2 lines
This commit is contained in:
Ferdi Franceschini
committed by
Douglas Clowes
Douglas Clowes
parent
d93db3605c
commit
e1dc2842d0
159
site_ansto/instrument/troubleShoot.tcl
Executable file
159
site_ansto/instrument/troubleShoot.tcl
Executable file
@@ -0,0 +1,159 @@
|
||||
#!/usr/bin/env tclsh
|
||||
|
||||
# $Revision: 1.1 $
|
||||
# $Date: 2006-08-25 02:39:50 $
|
||||
# Author: Ferdi Franceschini (ffr@ansto.gov.au)
|
||||
# Last revision by $Author: ffr $
|
||||
|
||||
# Load troubleshooting setup
|
||||
source troubleshoot_setup.tcl
|
||||
|
||||
namespace eval sics_config {
|
||||
proc loadConfig {fName} {
|
||||
variable ContList
|
||||
if [info exists ContList] {unset ContList}
|
||||
# Temporarily define unknown proc to skip undefined procs
|
||||
rename ::unknown _unknown
|
||||
proc ::unknown {args} {}
|
||||
if [catch {uplevel #0 source $fName} errMsg] {
|
||||
rename ::unknown ""
|
||||
rename _unknown ::unknown
|
||||
error $errMsg
|
||||
} else {
|
||||
rename ::unknown ""
|
||||
rename _unknown ::unknown
|
||||
}
|
||||
if [catch {set ContList [uplevel #0 info vars dmc2280_controller*]} result] {error $result}
|
||||
if {[llength $ContList] == 0} {error "Error: There are no dmc2280_controllerN(host/port) arrays in the $fName configuration file"}
|
||||
#Add the controller to the sics_config namespace
|
||||
foreach c $ContList {upvar #0 $c cont; puts "$c IP:port = $cont(host):$cont(port)"}
|
||||
}
|
||||
|
||||
|
||||
# Open a communications channel to a dmc2280 motor controller
|
||||
# contName: controller name, eg dmc2280_controller1
|
||||
# The host and port in the SICS configuration file will be used by default
|
||||
proc connect {contName {host ""} {port ""}} {
|
||||
global channel
|
||||
upvar #0 $contName controller
|
||||
|
||||
if {$host == ""} {set host $controller(host)}
|
||||
if {$port == ""} {set port $controller(port)}
|
||||
|
||||
if [catch {socket $host $port} con] {
|
||||
error "Failed to connect to $contName IP($host) port($port)\n\
|
||||
$con\n
|
||||
Is the motor controller switched on? Are the network cables plugged in?"
|
||||
}
|
||||
set channel($contName) $con
|
||||
fconfigure $channel($contName) -buffering line -translation crlf -blocking true
|
||||
}
|
||||
|
||||
# Send a dmc2280 command
|
||||
proc sendCmd {chan cmd} {
|
||||
puts $chan $cmd
|
||||
set status [read $chan 1]
|
||||
if {$status == "?"} {
|
||||
error "error: dmc command $cmd failed"
|
||||
} else {
|
||||
return $status
|
||||
}
|
||||
}
|
||||
|
||||
# Receive a dmc2280 command
|
||||
proc receive {chan} {
|
||||
gets $chan line
|
||||
# Consume the following colon
|
||||
read $chan 1
|
||||
return $line
|
||||
}
|
||||
|
||||
proc subExists {cont sub} {
|
||||
global channel
|
||||
if [catch {sendCmd $channel($cont) "LS $sub,0"} errMsg] {
|
||||
error "Subroutine $sub does not exist on controller $cont"
|
||||
}
|
||||
receive $channel($cont)
|
||||
}
|
||||
|
||||
# Returns -1 if thread is not running, line number if it is
|
||||
proc checkThread {cont thnum} {
|
||||
global channel
|
||||
sendCmd $channel($cont) "MG _XQ$thnum"
|
||||
set reply [receive $channel($cont) ]
|
||||
if {$reply == -1} {
|
||||
error "Thread $thnum not running on controller $cont\n
|
||||
If the broken thread is 0, then it is probably a loop in the #AUTO subroutine\n
|
||||
which is not being reached."
|
||||
}
|
||||
return $reply
|
||||
}
|
||||
|
||||
# GUI STUFF
|
||||
package require Tk
|
||||
variable ContList
|
||||
global ldFrame
|
||||
set ldFrameName ".loadFile"
|
||||
set ldFrame(button) $ldFrameName.ldConf
|
||||
set ldFrame(entry) $ldFrameName.ldEntry
|
||||
|
||||
|
||||
proc ::guiLoadC {} {::sics_config::loadConfig [eval $::sics_config::ldFrame(entry) get]}
|
||||
proc ::guiConnect {w cont} {
|
||||
::sics_config::connect $cont
|
||||
$w configure -activebackground green
|
||||
$w configure -background green
|
||||
}
|
||||
|
||||
proc ::guiCheckSubs {w cont} {
|
||||
global contSubs
|
||||
foreach sub $contSubs($cont) {
|
||||
::sics_config::subExists $cont $sub
|
||||
}
|
||||
$w configure -activebackground green
|
||||
$w configure -background green
|
||||
}
|
||||
|
||||
proc ::guiCheckThreads {w cont} {
|
||||
global contThreads
|
||||
foreach thr $contThreads($cont) {
|
||||
::sics_config::checkThread $cont $thr
|
||||
}
|
||||
$w configure -activebackground green
|
||||
$w configure -background green
|
||||
}
|
||||
|
||||
frame $ldFrameName
|
||||
pack $ldFrameName
|
||||
button $ldFrame(button) -text "Load config" -command {guiLoadC; ::sics_config::mkGui}
|
||||
entry $ldFrame(entry) -textvariable configFileName -width -1
|
||||
pack $ldFrame(button) -side left
|
||||
pack $ldFrame(entry) -side left
|
||||
|
||||
|
||||
proc mkGui {} {
|
||||
variable ContList
|
||||
lappend Headings $ContList
|
||||
table .t $ContList
|
||||
pack .t
|
||||
}
|
||||
proc table {w headings args} {
|
||||
frame $w -bg black
|
||||
set r 0
|
||||
|
||||
foreach name $headings {
|
||||
lappend Header [label $w.$name -text $name]
|
||||
}
|
||||
foreach name $headings {
|
||||
lappend Connect [button $w.connect$name -text connect -command "guiConnect $w.connect$name $name"]
|
||||
lappend CheckSubs [button $w.chkSubs$name -text "Check subs" -command "guiCheckSubs $w.chkSubs$name $name"]
|
||||
lappend CheckThreads [button $w.chkThrs$name -text "Check threads" -command "guiCheckThreads $w.chkThrs$name $name"]
|
||||
}
|
||||
eval grid $Header -sticky news -padx 1 -pady 1
|
||||
eval grid $Connect -sticky news -padx 1 -pady 1
|
||||
eval grid $CheckSubs -sticky news -padx 1 -pady 1
|
||||
eval grid $CheckThreads -sticky news -padx 1 -pady 1
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
Reference in New Issue
Block a user