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

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_<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
+    sct send $cmd$::scobj::bruker_BEC1::bruker_BEC1_term
-     # puts "sct send !$cmd!"
+    # 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
+    } 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"
-    }
-    # puts "Leaving inTolerance idx:$CtrlLoopIdx"
       return idle
+    } message ]
+    handle_exception $catch_status $message
+    # puts "Leaving inTolerance idx:$CtrlLoopIdx"
 }
 
 
@@ -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 {
+#   broadcast "DEBUG: in drivestatus. Last write command: $::scobj::bruker_BEC1::bruker_BEC1_lastWriteCmd"
     if [sct driving] {
-        set retval busy
+      return busy
     } else {
-        set retval idle
+      return idle
     }
-    } message ] {
-      return -code error "in drivestatus: $message. Last write command: $::scobj::bruker_BEC1::bruker_BEC1_lastWriteCmd"
-    }
-    return $retval
   }
 
 ##
@@ -1128,8 +1157,10 @@ 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 CR "\r"
-       #set LF "\n"
+      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