diff --git a/site_ansto/instrument/config/environment/magneticField/sct_bruker_BEC1.tcl b/site_ansto/instrument/config/environment/magneticField/sct_bruker_BEC1.tcl index 08703d96..b86fd0cd 100644 --- a/site_ansto/instrument/config/environment/magneticField/sct_bruker_BEC1.tcl +++ b/site_ansto/instrument/config/environment/magneticField/sct_bruker_BEC1.tcl @@ -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_ # 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