version 20091209_3. Not tested. Takes the exception handling inside catch blocks one step further. Has additional args argument for optional message in case of a real error and uses the new catch method throughout all subroutines.

r2840 | axm | 2009-12-09 18:43:23 +1100 (Wed, 09 Dec 2009) | 2 lines

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

@@ -1,42 +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>
@@ -96,6 +57,47 @@ proc handle_exception {status message} {
 #   action for drivable when paused is lazy instead of pause to avoid
 #   stopping the histogram server.
 
+##
+# @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 args} {
+  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 $args"
+    }
+    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"
+    }
+  }
+}
+
+
 # Default parameters for the device
 namespace eval ::scobj::bruker_BEC1 {
     # The BEC1 cannot take commands faster than 1 per 50 milliseconds - increase to 100 or 200
@@ -151,7 +153,7 @@ namespace eval ::scobj::bruker_BEC1 {
 # @param tc_root string variable holding the path to the object's base node in sics
 # @return 0, always
 proc bruker_BEC1_init {sct_controller tc_root} {
-  if [ catch {
+  set catch_status [ catch {
     # set the communication protocol: terminator <CR>, bps 9600 baud, 7 data bits +
     # 1 stop bit + odd parity bit
     # puts "setting serial communication parameters"
@@ -185,9 +187,8 @@ proc bruker_BEC1_init {sct_controller tc_root} {
 #    }
     # Set the default tolerances for the setpoint magentic field strength
     hset $tc_root/emon/tolerance $::scobj::bruker_BEC1::bruker_BEC1_tolerance
-} message ] {
+  } message ]
-    return -code error "in bruker_BEC1_init: $message"
+  handle_exception $catch_status $message
-  }
 }
 
 ############# Reading polled nodes ###################################
@@ -203,7 +204,7 @@ proc bruker_BEC1_init {sct_controller tc_root} {
 #                     the command belongs to
 # @return nextState  The next function to call after this one (typically 'rdValue')
 proc getValue {tc_root nextState cmd expectedLen} {
-  if [ catch {
+  set catch_status [ catch {
     set ::scobj::bruker_BEC1::bruker_BEC1_lastQueryCmd "$cmd"
     set tNow [clock clicks -milliseconds]
     #set diff1 [expr $tNow - $::scobj::bruker_BEC1::bruker_BEC1_timeLastCommand]
@@ -215,10 +216,9 @@ proc getValue {tc_root nextState cmd expectedLen} {
      # puts "sct send !$cmd!"
     set ::scobj::bruker_BEC1::bruker_BEC1_timeLastCommand $tNow
     #puts "diff1:$diff1, diff2:$diff2 $cmd"
-  } message ] {
-    return -code error "in getValue: $message. Last query command: $::scobj::bruker_BEC1::bruker_BEC1_lastQueryCmd"
-  }
     return $nextState
+  } message ]
+  handle_exception $catch_status $message "in getValue(). Last query command: $::scobj::bruker_BEC1::bruker_BEC1_lastQueryCmd"
 }
 
 ##
@@ -252,7 +252,7 @@ proc getValue {tc_root nextState cmd expectedLen} {
             #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/
             return idle
-puts "Rejected !$data! as reply to $::scobj::bruker_BEC1::bruker_BEC1_lastQueryCmd"
+            #puts "Rejected !$data! as reply to $::scobj::bruker_BEC1::bruker_BEC1_lastQueryCmd"
           }
           set orgdata $data
           set data [ExtractValue $data $::scobj::bruker_BEC1::bruker_BEC1_lastQueryCmd]
@@ -305,7 +305,7 @@ puts "Rejected !$data! as reply to $::scobj::bruker_BEC1::bruker_BEC1_lastQueryC
       }
       return idle
     } message ]
-    handle_exception $catch_status "in rdValue: $message. Last query command: $::scobj::bruker_BEC1::bruker_BEC1_lastQueryCmd"
+    handle_exception $catch_status $message "in rdValue(). Last query command: $::scobj::bruker_BEC1::bruker_BEC1_lastQueryCmd"
 }
 
 
@@ -388,7 +388,7 @@ proc inTolerance {expectedLength} {
       # puts "inTolerance 4 $::scobj::bruker_BEC1::bruker_BEC1_sct_obj_name data:$data"
       return idle
     } message ]
-    handle_exception $catch_status "in inTolerance: $message. Last query command: $::scobj::bruker_BEC1::bruker_BEC1_lastQueryCmd"
+    handle_exception $catch_status $message "in inTolerance(). Last query command: $::scobj::bruker_BEC1::bruker_BEC1_lastQueryCmd"
     # puts "Leaving inTolerance idx:$CtrlLoopIdx"
 }
 
@@ -404,7 +404,7 @@ proc inTolerance {expectedLength} {
 proc setValue {tc_root nextState cmd } {
   # tc_root is not being used - however, don't remove so we can use the
   # same calling mask as for setPoint() or other $wrFunc
-  if [ catch {
+  set catch_status [ catch {
     set par [sct target]
     set ::scobj::bruker_BEC1::bruker_BEC1_lastWriteCmd "$cmd$par"
     set tNow [clock clicks -milliseconds]
@@ -420,10 +420,9 @@ proc setValue {tc_root nextState cmd } {
       hset $::scobj::bruker_BEC1::bruker_BEC1_path2nodes/emon/lastErrorMsg  $::scobj::bruker_BEC1::bruker_BEC1_errMsg
       hset $::scobj::bruker_BEC1::bruker_BEC1_path2nodes/emon/lastErrorMsg2 $::scobj::bruker_BEC1::bruker_BEC1_errMsg2
     }
-  } message ] {
-    return -code error "in setValue: $message. While sending command: $::scobj::bruker_BEC1::bruker_BEC1_lastWriteCmd"
-  }
     return $nextState
+  } message ]
+  handle_exception $catch_status $message "in setValue(). While sending command: $::scobj::bruker_BEC1::bruker_BEC1_lastWriteCmd"
 }
 
 
@@ -443,7 +442,7 @@ proc noResponse {} {
 # @param cmd       string variable containing the device command to change the setpoint
 # @return nextState
 proc setDesiredField {tc_root nextState cmd} {
-  if [ catch {
+  set catch_status [ catch {
       #puts "executing setDesiredField ($tc_root $nextState $cmd)"
       set ns ::scobj::lh45
       set par [sct target]
@@ -463,10 +462,9 @@ proc setDesiredField {tc_root nextState cmd} {
       set tNow [clock clicks -milliseconds]
     }
     sct send "$cmd$par"
-  } message ] {
-    return -code error "in setDesiredField: $message. Last write command: $::scobj::bruker_BEC1::bruker_BEC1_lastWriteCmd"
-  }
     return $nextState
+  } message ]
+  handle_exception $catch_status $message "in setDesiredField(). Last write command: $::scobj::bruker_BEC1::bruker_BEC1_lastWriteCmd"
 }
 
 
@@ -477,8 +475,8 @@ proc setDesiredField {tc_root nextState cmd} {
 # @param cmd       string variable containing the device command to change the setpoint
 # @return nextState
 proc setDesiredCurrent {tc_root nextState cmd} {
-  if [ catch {
+  set catch_status [ catch {
-      #puts "executing setDesiredCurrent ($tc_root $nextState $cmd)"
+    # puts "executing setDesiredCurrent ($tc_root $nextState $cmd)"
     set ns ::scobj::lh45
     set par [sct target]
 
@@ -498,10 +496,9 @@ proc setDesiredCurrent {tc_root nextState cmd} {
     }
     sct send "$cmd$par"
     set ::scobj::bruker_BEC1::bruker_BEC1_timeLastCommand $tNow
-  } message ] {
-    return -code error "in setDesiredCurrent: $message. Last write command: $::scobj::bruker_BEC1::bruker_BEC1_lastWriteCmd"
-  }
     return $nextState
+  } message ]
+  handle_exception $catch_status $message "in setDesiredCurrent(). Last write command: $::scobj::bruker_BEC1::bruker_BEC1_lastWriteCmd"
 }
 
 
@@ -512,19 +509,18 @@ 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} {
+proc drivestatus {tc_root} {
   #   broadcast "DEBUG: in drivestatus. Last write command: $::scobj::bruker_BEC1::bruker_BEC1_lastWriteCmd"
-    if [ catch {
+  set catch_status [ 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"
-    }
     return $retval
-  }
+  } message ]
+  handle_exception $catch_status $message "in drivestatus(). Last write command: $::scobj::bruker_BEC1::bruker_BEC1_lastWriteCmd"
+}
 
 ##
 # @brief Stops driving at current magnetic field strenght.
@@ -551,7 +547,7 @@ proc ExtractValue {response lastQueryCmd} {
   # A typical argument may look like this: "CHF/-0.0002T" or "FLD/ 0.0000Tref"
   # However, with STA/0000C100 and ETH/95EC3E29 we have to be careful not to
   # strip a letter that is part of a hex number.
-  if [ catch {
+  set catch_status [ catch {
     set extractedValue 0
     set queryStringLength [string length $lastQueryCmd]
     set responseStringLength [string length $response]
@@ -591,10 +587,9 @@ proc ExtractValue {response lastQueryCmd} {
       #}
     }
     #puts "ExtractValue(): response:$response, extractedValue:$extractedValue"
-  } message ] {
-    return -code error "in ExtractValue(): $message. Last device response: $response"
-  }
     return $extractedValue
+  } message ]
+  handle_exception $catch_status $message "in ExtractValue(). Last device response: $response"
 }
 
 
@@ -665,7 +660,7 @@ proc decodeErrByte {errByte errList} {
   set errorText ""
   set delim ", "
   #puts "decodeErrByte: errByte:$errByte"
-  if [ catch {
+  set catch_status [ catch {
     # convert to decimal for calculations
     set decErrByte [expr 0x$errByte]
     foreach {hexVal errText} $errList {
@@ -682,13 +677,12 @@ proc decodeErrByte {errByte errList} {
         set decErrByte [expr $decErrByte - $decVal]
       }
     }
-  } message ] {
-    return -code error "in decodeErrByte(): $message. errByte: $errByte, errList: $errList"
-  }
     if {2 > [string length $errText]} {
       set $errorText "Unknown error"
     }
     return $errorText
+  } message ]
+  handle_exception $catch_status $message "in decodeErrByte(). errByte: $errByte, errList: $errList"
 }
 
 ##
@@ -699,7 +693,7 @@ proc decodeErrByte {errByte errList} {
 proc extractStatusByte {statusByteString whichByte} {
 # A typical argument may look like this:
 # "STA/0000C100"
-  if [ catch {
+  set catch_status [ catch {
     set statusByte "UNKNOWN"
     set statusByteStringLength [string length $statusByteString]
         set offset [expr $whichByte*2]
@@ -707,10 +701,9 @@ proc extractStatusByte {statusByteString whichByte} {
 	incr offset 4
     set statusByte [string range $statusByteString $offset [expr $offset+1]]
     #puts "ExtractValue(): response:$response, extractedValue:$extractedValue"
-  } message ] {
-    return -code error "in extractStatusByte(): $message. statusByteString: $statusByteString, whichByte: $whichByte"
-  }
     return $statusByte
+  } message ]
+  handle_exception $catch_status $message "in extractStatusByte(). statusByteString: $statusByteString, whichByte: $whichByte"
 }
 
 
@@ -718,7 +711,7 @@ proc extractStatusByte {statusByteString whichByte} {
 proc analyseStatusByte {statusByteString} {
 # A typical argument may look like this:
 # "STA/0000C100"
-  if [ catch {
+  set catch_status [ catch {
     #puts "statusByteString:$statusByteString"
     set LSB_ErrByteTxt            "Ok"
     set MSB_ErrByteTxt            "Ok"
@@ -801,10 +794,9 @@ proc analyseStatusByte {statusByteString} {
     hset $::scobj::bruker_BEC1::bruker_BEC1_path2nodes/pwrCtrl/MSB_Err            "x$tmp_MSB_ErrByte: $MSB_ErrByteTxt"
     hset $::scobj::bruker_BEC1::bruker_BEC1_path2nodes/pwrCtrl/PwrSupplyStatus    "x$tmp_PwrSupplyStatusByte: $PwrSupplyStatusByteTxt"
     hset $::scobj::bruker_BEC1::bruker_BEC1_path2nodes/pwrCtrl/StateMachineStatus "x$tmp_StateMachineStatusByte: $StateMachineStatusByteTxt"
-  } message ] {
-    return -code error "in analyseStatusByte(): $message. statusByteString: $statusByteString"
-  }
     return "Ok"
+  } message ]
+  handle_exception $catch_status $message "in analyseStatusByte(). statusByteString: $statusByteString"
 }
 
 
@@ -860,7 +852,7 @@ proc getValFromString {s element separator} {
 # @param   tc_root   string variable holding the path to the object's base node in sics
 # @return  retVal    returns 1 if in tolerance, 0 else.
 proc checktol {tc_root} {
-  if [ catch {
+  set catch_status [ catch {
     set retVal 0
     set sensorValue $tc_root/sensor/DesiredCurrent
     set NominalOutpCurrent [hval $sensorValue]
@@ -876,10 +868,9 @@ proc checktol {tc_root} {
       hset $tc_root/emon/isInTolerance "inTolerance"
       set retVal 1
     }
-  } message ] {
-    return -code error "in checktol: $message. Last query command: $::scobj::bruker_BEC1::bruker_BEC1_lastQueryCmd"
-  }
     return $retVal
+  } message ]
+  handle_exception $catch_status $message "in checktol(). Last query command: $::scobj::bruker_BEC1::bruker_BEC1_lastQueryCmd"
 }
 
 
@@ -918,7 +909,7 @@ proc check {tc_root whichParameter} {
 # The help text provided is taken from the user manual - it is as good or bad
 # as the manual
 proc helpNotes4user {scobj_hpath cmdGroup varName} {
-  if [ catch {
+  set catch_status [ catch {
   set nodeName "$scobj_hpath/$cmdGroup/$varName"
   # We presume that SICServer is running on Linux but Gumtree on Windows.
   # Hence multi-line help texts should use CRLF instead of only LF
@@ -1076,9 +1067,8 @@ proc helpNotes4user {scobj_hpath cmdGroup varName} {
   #set sLen [string bytelength $helptext]
   #puts "helptext ($sLen bytes) $helptext"
   hsetprop $nodeName help $helptext
-  } message ] {
+  } message ]
-    return -code error "in helpNotes4user: $message"
+  handle_exception $catch_status $message  "in helpNotes4user(). varName=$varName."
-  }
 }
 
 ##
@@ -1105,7 +1095,7 @@ proc createNode {scobj_hpath sct_controller cmdGroup varName readable writable\
   pollEnabled drivable replyLen dataType permission rdCmd rdFunc wrCmd\
   wrFunc allowedValues klass} {
    #puts "createing node for: $scobj_hpath $cmdGroup $varName $readable $writable $pollEnabled $drivable $dataType $permission $rdCmd $rdFunc $wrCmd $wrFunc"
-  if [ catch {
+  set catch_status [ catch {
     set ns ::scobj::bruker_BEC1
     set nodeName "$scobj_hpath/$cmdGroup/$varName"
     if {1 > [string length $cmdGroup]} {
@@ -1145,11 +1135,10 @@ proc createNode {scobj_hpath sct_controller cmdGroup varName readable writable\
       hsetprop $nodeName checkstatus ${ns}::drivestatus $scobj_hpath
       hsetprop $nodeName halt ${ns}::halt $scobj_hpath
     }
-  } message ] {
-    return -code error "in createNode $message"
-  }
     helpNotes4user $scobj_hpath $cmdGroup $varName
     return OK
+  } message ]
+  handle_exception $catch_status $message "in createNode(). varName=$varName"
 }
 
 
@@ -1161,7 +1150,7 @@ proc createNode {scobj_hpath sct_controller cmdGroup varName readable writable\
 # @param tol            magentic field strength tolerance in Tesla (typ. 1)
 # @return               nothing (well, the sct object)
 proc mk_sct_bruker_BEC1 {sct_controller klass tempobj tol} {
-    if [ catch {
+  set catch_status [ catch {
       set ns ::scobj::bruker_BEC1
       set ::scobj::bruker_BEC1::bruker_BEC1_sct_obj_name $tempobj
 
@@ -1341,10 +1330,9 @@ 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 20091009_beta)"
+      puts "Bruker BEC1 power supply for 1-Tesla magnet ready at /sample/$tempobj (Driver 20091209)"
-    } message ] {
+    } message ]
-      return -code error "in mk_sct_bruker_BEC1 $message"
+    handle_exception $catch_status $message "In subroutine mk_sct_bruker_BEC1()."
-    }
   }
   namespace export mk_sct_bruker_BEC1
   # endproc mk_sct_bruker_BEC1 sct_controller klass tempobj tol bruker_BEC1_LSmodel
@@ -1366,15 +1354,14 @@ proc add_bruker_BEC1 {name IP port {_tol 0.1}  } {
   if [SplitReply [environment_simulation]] {
     return
   }
-  if [ catch {
+  set catch_status [ 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
-  } message ] {
+  } message ]
-    return -code error "in add_bruker_BEC1: $message"
+  handle_exception $catch_status $message "In subroutine add_bruker_BEC1()."
-  }
 }
 
 namespace import ::scobj::bruker_BEC1::*