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:
committed by
Douglas Clowes
parent
97680fc917
commit
48772a1cc6
@@ -1,13 +1,16 @@
|
||||
# $Revision: 1.3 $
|
||||
# $Date: 2006-09-01 04:52:58 $
|
||||
# $Revision: 1.4 $
|
||||
# $Date: 2006-10-09 03:12:08 $
|
||||
# Author: Ferdi Franceschini (ffr@ansto.gov.au)
|
||||
# Last revision by $Author: ffr $
|
||||
|
||||
# globals controller, channel
|
||||
|
||||
# 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 dmc_connect {contName {host ""} {port ""}} {
|
||||
upvar #0 $contName controller
|
||||
upvar #0 $contName controller;
|
||||
global channel;
|
||||
|
||||
if {$host == ""} {set host $controller(host)}
|
||||
if {$port == ""} {set port $controller(port)}
|
||||
@@ -15,24 +18,36 @@ proc dmc_connect {contName {host ""} {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?"
|
||||
Is the motor controller switched on? Are the network cables plugged in?\n
|
||||
NOTE: You can only have a maximum of eight connections per motor controller.\n
|
||||
If there are other programs (eg SICS) connected to the controller then all\n
|
||||
of the available connections may have been used up."
|
||||
}
|
||||
set controller(socket) $con
|
||||
fconfigure $controller(socket) -buffering line -translation crlf -blocking true
|
||||
set channel($contName) $con
|
||||
set channel($con) $contName
|
||||
set channel($controller(host)) $con
|
||||
fconfigure $con -buffering line -translation crlf -blocking true
|
||||
}
|
||||
|
||||
proc dmc_close {dmc_socket} {
|
||||
close $dmc_socket;
|
||||
}
|
||||
|
||||
# Send a dmc2280 command
|
||||
proc dmc_sendCmd {contName cmd} {
|
||||
proc dmc_sendCmd {dmc_socket cmd} {
|
||||
global channel
|
||||
set contName $channel($dmc_socket);
|
||||
upvar #0 $contName controller
|
||||
puts $controller(socket) $cmd
|
||||
set status [read $controller(socket) 1]
|
||||
puts $dmc_socket $cmd
|
||||
set status [read $dmc_socket 1]
|
||||
if {$status == "?"} {
|
||||
puts $controller(socket) "TC 1"
|
||||
set status [read $controller(socket) 1]
|
||||
puts $dmc_socket "TC 1"
|
||||
set status [read $dmc_socket 1]
|
||||
if {$status == "?"} {
|
||||
error "error: dmc command $cmd failed"
|
||||
} else {
|
||||
set dmcError [dmc_receive $controller(socket)]
|
||||
set dmcError [dmc_receive $dmc_socket]
|
||||
set errInfo "DM2280 controller $contName
|
||||
host $controller(host)
|
||||
port $controller(port)"
|
||||
@@ -44,11 +59,13 @@ proc dmc_sendCmd {contName cmd} {
|
||||
}
|
||||
|
||||
# Receive a dmc2280 command
|
||||
proc dmc_receive {contName} {
|
||||
proc dmc_receive {dmc_socket} {
|
||||
global channel
|
||||
set contName $channel($dmc_socket);
|
||||
upvar #0 $contName controller
|
||||
gets $controller(socket) line
|
||||
gets $dmc_socket line
|
||||
# Consume the following colon
|
||||
read $controller(socket) 1
|
||||
read $dmc_socket 1
|
||||
return $line
|
||||
}
|
||||
|
||||
|
||||
@@ -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 {
|
||||
|
||||
Reference in New Issue
Block a user