Version 20091016, This is the version that has been running on Platypus from mid October to at least mid December 2009. Although users have been happy, we discovered some bits of code that may cause problems under certain circumstances such as the drivestatus return values and the handling of exceptions. We are waiting with the roll-out of the latest version until we will be able to test it and together with the migration to the new power supply controller. Only tested with serial communication because of the TCP/IP port bug in the old controller.

r2836 | axm | 2009-12-09 18:37:03 +1100 (Wed, 09 Dec 2009) | 2 lines

site_ansto/instrument/config/environment/magneticField/sct_bruker_BEC1.tcl

@@ -1,43 +1,3 @@
-##
-# @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.
@@ -235,7 +195,7 @@ proc getValue {tc_root nextState cmd expectedLen} {
         # Discard if it is not the reply to our query
         return idle
       }
-    set catch_status [ catch {
+    if [ catch {
       # Continue as normal
       switch -glob -- $data {
         "ASCERR:*" {
@@ -299,9 +259,10 @@ puts "Rejected !$data! as reply to $::scobj::bruker_BEC1::bruker_BEC1_lastQueryC
           }
         }
       }
-      return idle
-    } message ]
-    handle_exception $catch_status $message
+    } message ] {
+      return -code error "in rdValue: $message. Last query command: $::scobj::bruker_BEC1::bruker_BEC1_lastQueryCmd"
+    }
+    return idle
 }
 
 
@@ -323,7 +284,7 @@ proc inTolerance {expectedLength} {
       # Discard if it is not the reply to our query
       return idle
     }
-    set catch_status [ catch {
+    if [ catch {
       set oldval [sct oldval]
        # puts "inTolerance(): data=$data   oldval=$oldval"
       switch -glob -- $data {
@@ -382,10 +343,11 @@ puts "Rejected !$data! as reply to $::scobj::bruker_BEC1::bruker_BEC1_lastQueryC
         }
       }
       # puts "inTolerance 4 $::scobj::bruker_BEC1::bruker_BEC1_sct_obj_name data:$data"
-      return idle
-    } message ]
-    handle_exception $catch_status $message
+    } message ] {
+      return -code error "in inTolerance: $message. Last query command: $::scobj::bruker_BEC1::bruker_BEC1_lastQueryCmd"
+    }
     # puts "Leaving inTolerance idx:$CtrlLoopIdx"
+  return idle
 }
 
 
@@ -509,12 +471,15 @@ 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} {
-#   broadcast "DEBUG: in drivestatus. Last write command: $::scobj::bruker_BEC1::bruker_BEC1_lastWriteCmd"
+    if [ catch {
     if [sct driving] {
       return busy
     } else {
       return idle
     }
+    } message ] {
+      return -code error "in drivestatus: $message. Last write command: $::scobj::bruker_BEC1::bruker_BEC1_lastWriteCmd"
+    }
   }
 
 ##