From f4e26c7e08e3b020e4cdffe82bd47068855715a5 Mon Sep 17 00:00:00 2001
From: Arndt Meiers <axm@ansto.gov.au>
Date: Wed, 9 Dec 2009 18:37:03 +1100
Subject: [PATCH] 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
---
 .../magneticField/sct_bruker_BEC1.tcl         | 63 +++++--------------
 1 file changed, 14 insertions(+), 49 deletions(-)

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 b86fd0cd..fa700a1b 100644
--- a/site_ansto/instrument/config/environment/magneticField/sct_bruker_BEC1.tcl
+++ b/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"
+    }
   }
 
 ##