version 20091209_1 (ffr). Not tested. Introduces new handling of exceptions in some key subroutines - added by ffr based on the version 20091016, not 20091201.
r2838 | axm | 2009-12-09 18:40:39 +1100 (Wed, 09 Dec 2009) | 2 lines
This commit is contained in:
Arndt Meiers
committed by
Douglas Clowes
Douglas Clowes
parent
814fa32408
commit
8b6c89ebc1
@@ -1,3 +1,43 @@
|
||||
##
|
||||
# @brief Handle exceptions caught by a 'catch' command.
|
||||
# Note: You must use 'error' not 'return -code error' to
|
||||
# raise errors from within a catch block.
|
||||
#
|
||||
# @param status, the status returned by the 'catch' command.
|
||||
# @param message, the message set by the 'catch' command.
|
||||
#
|
||||
# Call this as the last command in the command block or
|
||||
# for loop which encloses the 'catch'
|
||||
proc handle_exception {status message} {
|
||||
switch $status {
|
||||
0 {
|
||||
# TCL_OK, This is raised when you just drop out of the
|
||||
# bottom of a 'catch' command.
|
||||
return -code ok
|
||||
}
|
||||
1 {
|
||||
# TCL_ERROR
|
||||
return -code error "([info level -1]) $message"
|
||||
}
|
||||
2 {
|
||||
# TCL_RETURN
|
||||
return -code return "$message"
|
||||
}
|
||||
3 {
|
||||
# TCL_BREAK
|
||||
return -code break
|
||||
}
|
||||
4 {
|
||||
# TCL_CONTINUE
|
||||
return -code continue
|
||||
}
|
||||
default {
|
||||
# Propogate user defined return codes with message
|
||||
return -code $status "$message"
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Define procs in ::scobj::xxx namespace
|
||||
# MakeSICSObj $obj SCT_<class>
|
||||
# The MakeSICSObj cmd adds a /sics/$obj node. NOTE the /sics node is not browsable.
|
||||
@@ -13,7 +53,7 @@
|
||||
#
|
||||
# @author: Arndt Meier, ANSTO, 2009-08-31
|
||||
# @brief: driver for Bruker 1-Tesla magnet power supply (in TCL)
|
||||
# @version: 20091127 for sics2_4
|
||||
# @version: 20091002 for sics2_4
|
||||
#
|
||||
# known bugs: betaa stage - version 1.1.0
|
||||
# ----------------------------------------------------------------------------*/
|
||||
@@ -51,11 +91,6 @@
|
||||
# did not have the expected effect so far.
|
||||
# - Fixed the StateMachineStatusByteTxt bug - now decodes the
|
||||
# status byte correctly into its corresponding error text.
|
||||
# - Removed terminator variable - obsolete as this is done when the scriptcontext
|
||||
# object is created.
|
||||
# - proc drivestatus now sets a retval variable that is returned. Default
|
||||
# action for drivable when paused is lazy instead of pause to avoid
|
||||
# stopping the histogram server.
|
||||
|
||||
# Default parameters for the device
|
||||
namespace eval ::scobj::bruker_BEC1 {
|
||||
@@ -74,7 +109,7 @@ namespace eval ::scobj::bruker_BEC1 {
|
||||
# provide a global variable holding the path to the nodes
|
||||
set bruker_BEC1_path2nodes "/sample/ma1"
|
||||
# terminator string for serial communication
|
||||
#set bruker_BEC1_term "" !obsolete. Done in the call to the scriptcontext constructor
|
||||
set bruker_BEC1_term ""
|
||||
# variables that are identical to node names but are needed internally as well
|
||||
# temperature tolerance in Ampere
|
||||
set bruker_BEC1_tolerance 0.1
|
||||
@@ -172,8 +207,8 @@ proc getValue {tc_root nextState cmd expectedLen} {
|
||||
set tNow [clock clicks -milliseconds]
|
||||
}
|
||||
#set diff2 [expr $tNow - $::scobj::bruker_BEC1::bruker_BEC1_timeLastCommand]
|
||||
sct send $cmd
|
||||
# puts "sct send !$cmd!"
|
||||
sct send $cmd$::scobj::bruker_BEC1::bruker_BEC1_term
|
||||
# puts "sct send !$cmd$::scobj::bruker_BEC1::bruker_BEC1_term!"
|
||||
set ::scobj::bruker_BEC1::bruker_BEC1_timeLastCommand $tNow
|
||||
#puts "diff1:$diff1, diff2:$diff2 $cmd"
|
||||
} message ] {
|
||||
@@ -200,7 +235,7 @@ proc getValue {tc_root nextState cmd expectedLen} {
|
||||
# Discard if it is not the reply to our query
|
||||
return idle
|
||||
}
|
||||
if [ catch {
|
||||
set catch_status [ catch {
|
||||
# Continue as normal
|
||||
switch -glob -- $data {
|
||||
"ASCERR:*" {
|
||||
@@ -264,10 +299,9 @@ puts "Rejected !$data! as reply to $::scobj::bruker_BEC1::bruker_BEC1_lastQueryC
|
||||
}
|
||||
}
|
||||
}
|
||||
} message ] {
|
||||
return -code error "in rdValue: $message. Last query command: $::scobj::bruker_BEC1::bruker_BEC1_lastQueryCmd"
|
||||
}
|
||||
return idle
|
||||
return idle
|
||||
} message ]
|
||||
handle_exception $catch_status $message
|
||||
}
|
||||
|
||||
|
||||
@@ -283,13 +317,13 @@ puts "Rejected !$data! as reply to $::scobj::bruker_BEC1::bruker_BEC1_lastQueryC
|
||||
proc inTolerance {expectedLength} {
|
||||
set tc_root $::scobj::bruker_BEC1::bruker_BEC1_path2nodes
|
||||
set data [sct result]
|
||||
#puts "inT result !$data!"
|
||||
# puts "inT result !$data!"
|
||||
# Do we get the answer to the question we asked?! Occasionally the BEC1 is sending info on its own.
|
||||
if { 0 != [string compare -length 4 $data $::scobj::bruker_BEC1::bruker_BEC1_lastQueryCmd]} {
|
||||
# Discard if it is not the reply to our query
|
||||
return idle
|
||||
}
|
||||
if [ catch {
|
||||
set catch_status [ catch {
|
||||
set oldval [sct oldval]
|
||||
# puts "inTolerance(): data=$data oldval=$oldval"
|
||||
switch -glob -- $data {
|
||||
@@ -303,7 +337,7 @@ proc inTolerance {expectedLength} {
|
||||
# Discard - this it is not the reply to our query because this is what happened:
|
||||
#ERROR: in rdValue: in analyseStatusByte(): in decodeErrByte(): syntax error in expression "0xHF": extra tokens at end of expression. errByte: HF, errList: 08 {Inrush procedure error} 01 {Current limit exceeded}
|
||||
# . statusByteString: STA/0CHF/-0.0002T. Last query command: STA/
|
||||
#puts "Rejected !$data! as reply to $::scobj::bruker_BEC1::bruker_BEC1_lastQueryCmd"
|
||||
puts "Rejected !$data! as reply to $::scobj::bruker_BEC1::bruker_BEC1_lastQueryCmd"
|
||||
return idle
|
||||
}
|
||||
set data [ExtractValue $data $::scobj::bruker_BEC1::bruker_BEC1_lastQueryCmd]
|
||||
@@ -348,11 +382,10 @@ proc inTolerance {expectedLength} {
|
||||
}
|
||||
}
|
||||
# puts "inTolerance 4 $::scobj::bruker_BEC1::bruker_BEC1_sct_obj_name data:$data"
|
||||
} message ] {
|
||||
return -code error "in inTolerance: $message. Last query command: $::scobj::bruker_BEC1::bruker_BEC1_lastQueryCmd"
|
||||
}
|
||||
return idle
|
||||
} message ]
|
||||
handle_exception $catch_status $message
|
||||
# puts "Leaving inTolerance idx:$CtrlLoopIdx"
|
||||
return idle
|
||||
}
|
||||
|
||||
|
||||
@@ -374,7 +407,7 @@ proc setValue {tc_root nextState cmd } {
|
||||
while {[expr $tNow - $::scobj::bruker_BEC1::bruker_BEC1_timeLastCommand] < $::scobj::bruker_BEC1::bruker_BEC1_MIN_TIME_BETWEEN_COMMANDS} {
|
||||
set tNow [clock clicks -milliseconds]
|
||||
}
|
||||
sct send "$cmd$par"
|
||||
sct send "$cmd$par$::scobj::bruker_BEC1::bruker_BEC1_term"
|
||||
set ::scobj::bruker_BEC1::bruker_BEC1_timeLastCommand $tNow
|
||||
if { 0 == [string compare -length 4 $cmd "RST=0"] } {
|
||||
# Reset error messages - also update the node displaying the last error
|
||||
@@ -419,13 +452,13 @@ proc setDesiredField {tc_root nextState cmd} {
|
||||
set nodename $tc_root/sensor/setpoint
|
||||
hsetprop $nodename driving 1
|
||||
}
|
||||
#puts "setDesiredField(wrStatus=$wrStatus): sct send $cmd$par"
|
||||
#puts "setDesiredField(wrStatus=$wrStatus): sct send $cmd$par$::scobj::bruker_BEC1::bruker_BEC1_term"
|
||||
set tNow [clock clicks -milliseconds]
|
||||
#set diff1 [expr $tNow - $::scobj::bruker_BEC1::bruker_BEC1_timeLastCommand]
|
||||
while {[expr $tNow - $::scobj::bruker_BEC1::bruker_BEC1_timeLastCommand] < $::scobj::bruker_BEC1::bruker_BEC1_MIN_TIME_BETWEEN_COMMANDS} {
|
||||
set tNow [clock clicks -milliseconds]
|
||||
}
|
||||
sct send "$cmd$par"
|
||||
sct send "$cmd$par$::scobj::bruker_BEC1::bruker_BEC1_term"
|
||||
} message ] {
|
||||
return -code error "in setDesiredField: $message. Last write command: $::scobj::bruker_BEC1::bruker_BEC1_lastWriteCmd"
|
||||
}
|
||||
@@ -453,13 +486,13 @@ proc setDesiredCurrent {tc_root nextState cmd} {
|
||||
set nodename $tc_root/sensor/NominalOutpCurrent
|
||||
hsetprop $nodename driving 1
|
||||
}
|
||||
#puts "setDesiredCurrent(wrStatus=$wrStatus): sct send $cmd$par"
|
||||
#puts "setDesiredCurrent(wrStatus=$wrStatus): sct send $cmd$par$::scobj::bruker_BEC1::bruker_BEC1_term"
|
||||
set tNow [clock clicks -milliseconds]
|
||||
#set diff1 [expr $tNow - $::scobj::bruker_BEC1::bruker_BEC1_timeLastCommand]
|
||||
while {[expr $tNow - $::scobj::bruker_BEC1::bruker_BEC1_timeLastCommand] < $::scobj::bruker_BEC1::bruker_BEC1_MIN_TIME_BETWEEN_COMMANDS} {
|
||||
set tNow [clock clicks -milliseconds]
|
||||
}
|
||||
sct send "$cmd$par"
|
||||
sct send "$cmd$par$::scobj::bruker_BEC1::bruker_BEC1_term"
|
||||
set ::scobj::bruker_BEC1::bruker_BEC1_timeLastCommand $tNow
|
||||
} message ] {
|
||||
return -code error "in setDesiredCurrent: $message. Last write command: $::scobj::bruker_BEC1::bruker_BEC1_lastWriteCmd"
|
||||
@@ -476,16 +509,12 @@ proc setDesiredCurrent {tc_root nextState cmd} {
|
||||
# NOTE: The drive adapter initially sets the writestatus to "start" and will
|
||||
# only call this when writestatus!="start"
|
||||
proc drivestatus {tc_root} {
|
||||
if [ catch {
|
||||
if [sct driving] {
|
||||
set retval busy
|
||||
} else {
|
||||
set retval idle
|
||||
}
|
||||
} message ] {
|
||||
return -code error "in drivestatus: $message. Last write command: $::scobj::bruker_BEC1::bruker_BEC1_lastWriteCmd"
|
||||
# broadcast "DEBUG: in drivestatus. Last write command: $::scobj::bruker_BEC1::bruker_BEC1_lastWriteCmd"
|
||||
if [sct driving] {
|
||||
return busy
|
||||
} else {
|
||||
return idle
|
||||
}
|
||||
return $retval
|
||||
}
|
||||
|
||||
##
|
||||
@@ -1128,9 +1157,11 @@ proc mk_sct_bruker_BEC1 {sct_controller klass tempobj tol} {
|
||||
set ::scobj::bruker_BEC1::bruker_BEC1_sct_obj_name $tempobj
|
||||
|
||||
# terminator string for serial communication
|
||||
#set CR "\r"
|
||||
#set LF "\n"
|
||||
|
||||
set CR "\r"
|
||||
set LF "\n"
|
||||
#set ::scobj::bruker_BEC1::bruker_BEC1_term $CR
|
||||
set ::scobj::bruker_BEC1::bruker_BEC1_term ""
|
||||
|
||||
set ::scobj::bruker_BEC1::bruker_BEC1_tolerance $tol
|
||||
set ::scobj::bruker_BEC1::bruker_BEC1_driveTolerance [expr $tol * $::scobj::bruker_BEC1::bruker_BEC1_tolerance]
|
||||
|
||||
@@ -1231,7 +1262,7 @@ proc mk_sct_bruker_BEC1 {sct_controller klass tempobj tol} {
|
||||
helpNotes4user $scobj_hpath "emon" "monMode"
|
||||
|
||||
hfactory $scobj_hpath/emon/errhandler plain spy text
|
||||
hset $scobj_hpath/emon/errhandler "lazy"
|
||||
hset $scobj_hpath/emon/errhandler "pause"
|
||||
helpNotes4user $scobj_hpath "emon" "errhandler"
|
||||
|
||||
hfactory $scobj_hpath/pwrCtrl/LSB_Err plain spy text
|
||||
@@ -1303,7 +1334,7 @@ proc mk_sct_bruker_BEC1 {sct_controller klass tempobj tol} {
|
||||
|
||||
# initialise the device
|
||||
bruker_BEC1_init $sct_controller $scobj_hpath
|
||||
puts "Bruker BEC1 power supply for 1-Tesla magnet ready at /sample/$tempobj (Driver 20091127)"
|
||||
puts "Bruker BEC1 power supply for 1-Tesla magnet ready at /sample/$tempobj (Driver 20091002_beta)"
|
||||
} message ] {
|
||||
return -code error "in mk_sct_bruker_BEC1 $message"
|
||||
}
|
||||
@@ -1322,15 +1353,8 @@ proc mk_sct_bruker_BEC1 {sct_controller klass tempobj tol} {
|
||||
# @param tol magnetic field strength tolerance in Tesla (default 0.1T)
|
||||
# @return nothing (well, the sct object)
|
||||
proc add_bruker_BEC1 {name IP port {_tol 0.1} } {
|
||||
# Don't create a magnet controller for the script validator, this may cause the
|
||||
# the BEC1 to lock up.
|
||||
# NOTE: This is placed outside the catch block because "return" raises an exception
|
||||
if [SplitReply [environment_simulation]] {
|
||||
return
|
||||
}
|
||||
if [ catch {
|
||||
puts "\nadd_bruker_BEC1: makesctcontroller $name std ${IP}:$port for Bruker BEC1 1-Tesla magnet power supply"
|
||||
# Command terminator for Bruker unit is only carriage return without linefeed '\r'
|
||||
makesctcontroller sct_bruker_BEC1_$name std ${IP}:$port "\r"
|
||||
mk_sct_bruker_BEC1 sct_bruker_BEC1_$name environment $name $_tol
|
||||
makesctemon $name /sics/$name/emon/monMode /sics/$name/emon/isInTolerance /sics/$name/emon/errhandler
|
||||
|
||||
Reference in New Issue
Block a user