From d33a957d0105ca1df951d2e9d5ed5c58bcb5b302 Mon Sep 17 00:00:00 2001 From: Douglas Clowes Date: Wed, 20 Jul 2011 14:45:17 +1000 Subject: [PATCH] differentiate rdValue and rdData and add experimental treewalk r3232 | dcl | 2011-07-20 14:45:17 +1000 (Wed, 20 Jul 2011) | 1 line --- .../config/environment/sct_keithley_2700.tcl | 322 ++++++++++++++---- 1 file changed, 252 insertions(+), 70 deletions(-) diff --git a/site_ansto/instrument/config/environment/sct_keithley_2700.tcl b/site_ansto/instrument/config/environment/sct_keithley_2700.tcl index 2e0187e1..97c57daf 100644 --- a/site_ansto/instrument/config/environment/sct_keithley_2700.tcl +++ b/site_ansto/instrument/config/environment/sct_keithley_2700.tcl @@ -20,49 +20,232 @@ namespace eval ::scobj::k2700 { return $nextState } - proc setParm {tc_root nextState cmd} { - debug_log "setParm root=$tc_root sct=[sct] cmd=$cmd target=[sct target]" + proc rdParm {tc_root} { + debug_log "rdParm tc_root=$tc_root sct=[sct]" + set data [sct result] + if {[ catch { + debug_log "rdParm $tc_root [sct] result=$data" + } catch_message ]} { + debug_log "rdParm $tc_root failure" + } + if {[string equal -nocase -length 7 $data "ASCERR:"]} { + sct geterror "$data" + set nextState idle + } elseif {[string equal -nocase -length 1 $data "?"]} { + sct geterror "Error: $data" + set nextState idle + } else { + if { [hpropexists [sct] geterror] } { + hdelprop [sct] geterror + } + debug_log "rdParm Read: $data" + if {$data != [sct oldval]} { + sct oldval $data + sct update $data + sct utime readtime + debug_log "rdParm new data for $tc_root [sct] result=$data" + } + } + return idle + } + + proc rdText {tc_root} { + debug_log "rdText tc_root=$tc_root sct=[sct]" + set data [sct result] + if {[ catch { + debug_log "rdText $tc_root [sct] result=$data" + } catch_message ]} { + debug_log "rdText $tc_root failure" + } + if {[string equal -nocase -length 7 $data "ASCERR:"]} { + sct geterror "$data" + set nextState idle + } elseif {[string equal -nocase -length 1 $data "?"]} { + sct geterror "Error: $data" + set nextState idle + } else { + if { [hpropexists [sct] geterror] } { + hdelprop [sct] geterror + } + debug_log "rdText Read: $data" + if {$data != [sct oldval]} { + sct oldval $data + sct update $data + sct utime readtime + debug_log "rdText new data for $tc_root [sct] result=$data" + } + } + return idle + } + + proc rdValue {tc_root} { + debug_log "rdValue tc_root=$tc_root sct=[sct]" + set data [sct result] + if {[ catch { + debug_log "rdValue $tc_root [sct] result=$data" + } catch_message ]} { + debug_log "rdValue $tc_root failure" + } + if {[string equal -nocase -length 7 $data "ASCERR:"]} { + sct geterror "$data" + set nextState idle + } elseif {[string equal -nocase -length 1 $data "?"]} { + sct geterror "Error: $data" + set nextState idle + } else { + if { [hpropexists [sct] geterror] } { + hdelprop [sct] geterror + } + if {$data != [sct oldval]} { + sct oldval $data + sct update $data + sct utime readtime + debug_log "rdValue new data for $tc_root [sct] result=$data" + } + } + return idle + } + + proc rdData {tc_root} { + debug_log "rdData tc_root=$tc_root sct=[sct]" + set data [sct result] + if {[ catch { + debug_log "rdData $tc_root [sct] result=$data" + } catch_message ]} { + debug_log "rdData $tc_root failure" + } + if {[string equal -nocase -length 7 $data "ASCERR:"]} { + sct geterror "$data" + set nextState idle + } elseif {[string equal -nocase -length 1 $data "?"]} { + sct geterror "Error: $data" + set nextState idle + } else { + if { [hpropexists [sct] geterror] } { + hdelprop [sct] geterror + } + set flds [split "$data" ","] + scan [lindex $flds 0] "%f%s" value units + debug_log "rdData Read: $value $units from $data" + if {$value != [sct oldval]} { + sct oldval $value + sct update $value + sct utime readtime + sct units $units + debug_log "rdData new data for $tc_root [sct] result=$value" + } + } + return idle + } + + proc wrParm {tc_root nextState cmd} { + debug_log "wrParm root=$tc_root sct=[sct] cmd=$cmd target=[sct target]" set par "[sct target]" sct send "$cmd $par" - debug_log "setParm send: $cmd $par;*IDN?" + debug_log "wrParm send: $cmd $par;*IDN?" if {$par != [sct oldval]} { sct oldval $par sct update $par sct utime readtime - debug_log "setParm new data for $tc_root [sct] result=$par" + debug_log "wrParm new data for $tc_root [sct] result=$par" } return $nextState } - proc setText {tc_root nextState cmd} { - debug_log "setText root=$tc_root sct=[sct] cmd=$cmd target=[sct target]" + proc wrText {tc_root nextState cmd} { + debug_log "wrText root=$tc_root sct=[sct] cmd=$cmd target=[sct target]" set par "[sct target]" sct send "$cmd \"$par\";*IDN?" - debug_log "setText send: $cmd \"$par\"" + debug_log "wrText send: $cmd \"$par\"" if {$par != [sct oldval]} { sct oldval $par sct update $par sct utime readtime - debug_log "setText new data for $tc_root [sct] result=$par" + debug_log "wrText new data for $tc_root [sct] result=$par" } return $nextState } # issue a command with a value in the target property of the variable - proc setValue {tc_root nextState cmd} { - debug_log "setValue root=$tc_root sct=[sct] cmd=$cmd target=[sct target]" + proc wrValue {tc_root nextState cmd} { + debug_log "wrValue root=$tc_root sct=[sct] cmd=$cmd target=[sct target]" set par "[sct target]" sct send "$cmd $par;*IDN?" - debug_log "setValue send: $cmd $par" + debug_log "wrValue send: $cmd $par" if {$par != [sct oldval]} { sct oldval $par sct update $par sct utime readtime - debug_log "setValue new data for $tc_root [sct] result=$par" + debug_log "wrValue new data for $tc_root [sct] result=$par" } return $nextState } + proc wrFunc {tc_root nextState cmd} { + debug_log "wrFunc root=$tc_root sct=[sct] cmd=$cmd target=[sct target]" + set par "[sct target]" + if {[hpropexists [sct] values]} { + set target {} + set values [split [SplitReply [hgetprop [sct] values]] ","] + foreach value $values { + sct print "Testing $par against $value" + if {[string toupper "$par"] == [string toupper "$value"]} { + set target "$par" + break + } + } + if {"$target" == ""} { + return -code error "Invalid value: \"$par\"" + } + } + sct send "$cmd '$par';*IDN?" + debug_log "wrFunc send: $cmd '$par'" + if {$par != [sct oldval]} { + sct oldval $par + sct update $par + sct utime readtime + debug_log "wrFunc new data for $tc_root [sct] result=$par" + } + return $nextState + } + + proc wrNode {tc_root cmd level} { + set space [string repeat " " $level] + set val [hval $tc_root] + if {"$val" == ""} { + set line "$tc_root ([hinfo $tc_root])" + } else { + set line "$tc_root ([hinfo $tc_root]) = $val" + } + sct print "$space* $line" + if {"[string tolower "$cmd"]" == "-prop"} { + set props [hlistprop $tc_root] + #sct print "<<$props>>" + foreach prop $props { + #sct print "prop: $prop" + set flds [split $prop "="] + #sct print "flds: $flds" + if {[llength $flds] > 1} { + set fld0 [lindex $flds 0] + #sct print "fld0: $fld0" + if {[hpropexists $tc_root $fld0]} { + sct print "$space - [hgetprop $tc_root $fld0]" + } + } + } + } + foreach node [hlist $tc_root] { + wrNode $tc_root/$node "$cmd" [expr {$level + 1}] + } + } + + proc wrTree {tc_root nextState cmd} { + debug_log "wrTree root=$tc_root sct=[sct] cmd=$cmd target=[sct target]" + sct print "$tc_root" + wrNode $tc_root "[sct target]" 1 + return idle + } + proc chkWrite {tc_root} { set data [sct result] debug_log "chkWrite resp=$data sct=[sct] tc_root=$tc_root" @@ -84,8 +267,8 @@ debug_log "chkWrite new data for $tc_root [sct] result=$data" proc setPoint {tc_root nextState cmd} { set catch_status [ catch { -debug_log "setPoint $tc_root $nextState $cmd sct=[sct]" -debug_log "setPoint: sct=[sct] target=[sct target] writestatus=[sct writestatus]" + debug_log "setPoint $tc_root $nextState $cmd sct=[sct]" + debug_log "setPoint: sct=[sct] target=[sct target] writestatus=[sct writestatus]" sct print "setPoint: sct=[sct] target=[sct target] writestatus=[sct writestatus]" set err_msg "" @@ -96,12 +279,17 @@ debug_log "setPoint: sct=[sct] target=[sct target] writestatus=[sct writestatus] } set par "[sct target]" - if {$par != [sct oldval]} { - sct oldval $par - sct update $par - sct utime readtime -debug_log "setPoint new data for $tc_root [sct] result=$par" - } + if {[sct writestatus] == "start"} { + # Called by drive adapter + hset $tc_root/status "busy" + hsetprop $tc_root/setpoint driving 1 + } + if {$par != [sct oldval]} { + sct oldval $par + sct update $par + sct utime readtime + debug_log "setPoint new data for $tc_root [sct] result=$par" + } hset $tc_root/status "busy" sct print "status: busy" hset $tc_root/drive_state "START" @@ -114,38 +302,6 @@ debug_log "setPoint new data for $tc_root [sct] result=$par" return $nextState } - proc rdValue {tc_root} { - debug_log "rdValue tc_root=$tc_root sct=[sct]" - set data [sct result] - if {[ catch { - debug_log "rdValue $tc_root [sct] result=$data" - } catch_message ]} { - debug_log "rdValue $tc_root failure" - } - if {[string equal -nocase -length 7 $data "ASCERR:"]} { - sct geterror "$data" - set nextState idle - } elseif {[string equal -nocase -length 1 $data "?"]} { - sct geterror "Error: $data" - set nextState idle - } else { - if { [hpropexists [sct] geterror] } { - hdelprop [sct] geterror - } - set flds [split "$data" ","] - scan [lindex $flds 0] "%f%s" value units - debug_log "Read: $value $units from $data" - if {$value != [sct oldval]} { - sct oldval $value - sct update $value - sct utime readtime - sct units $units - debug_log "rdValue new data for $tc_root [sct] result=$value" - } - } - return idle - } - # This is the command phase of the state machine that drives the controller. # For each state, it sends the appropriate command to get values from, or set # values in the controller in a sequence intended to transition the controller @@ -233,7 +389,26 @@ debug_log "setPoint new data for $tc_root [sct] result=$par" hsetprop [sct] chnl [sct result] set nextState read } elseif {$my_state == "STATE_FIELD"} { - hset $tc_root/Setpoint "$data" + set my_driving [SplitReply [hgetprop $tc_root/setpoint driving]] + if { $my_driving } { + set my_sp [hval $tc_root/setpoint] + set my_pv [hval $tc_root/display/value] + set my_tol [SplitReply [hgetprop $tc_root/setpoint tolerance]] + if {$my_sp - $my_tol < $my_sp + $my_tol} { + set my_lo_tol [expr {$my_sp - $my_tol}] + } else { + set my_lo_tol [expr {$my_sp + $my_tol}] + } + if {$my_sp - $my_tol > $my_sp + $my_tol} { + set my_hi_tol [expr {$my_sp - $my_tol}] + } else { + set my_hi_tol [expr {$my_sp + $my_tol}] + } + debug_log "rdState Testing: ($my_lo_tol <= $my_pv <= $my_hi_tol) = [expr {($my_lo_tol <= $my_pv && $my_pv <= $my_hi_tol)}]" + if {($my_lo_tol <= $my_pv && $my_pv <= $my_hi_tol)} { + hsetprop $tc_root/setpoint driving 0 + } + } hsetprop $tc_root/device_state my_state "STATE_FIELD" set nextState idle } @@ -284,6 +459,7 @@ debug_log "checktol $tc_root $currtime $timecheck" return busy } else { sct print "drivestatus: idle" + hset $tc_root/status "idle" return idle } } @@ -316,7 +492,7 @@ sct print "halt $tc_root" # @param rdCmd actual device query command to be sent to the device # @param rdFunc nextState Function to be called after the getValue function, typically rdValue() # @param wrCmd actual device write command to be sent to the device -# @param wrFunc Function to be called to send the wrCmd to the device, typically setValue() +# @param wrFunc Function to be called to send the wrCmd to the device, typically wrValue() # @param allowedValues allowed values for the node data - does not permit other # @param klass Nexus class name (?) # @return OK @@ -382,7 +558,7 @@ debug_log "Registering node $nodeName for write callback" return OK } - proc mk_sct_keithley_2700 {sct_controller klass tempobj} { + proc mk_sct_keithley_2700 {sct_controller klass tempobj tol} { set catch_status [ catch { # set ns ::scobj::k2700 set ns "[namespace current]" @@ -392,16 +568,17 @@ debug_log "Registering node $nodeName for write callback" sicslist setatt $tempobj long_name $tempobj set scobj_hpath /sics/$tempobj - # Group Node R W D type perm rdCmd rdFunc wrCmd wrFunc allowed + # Group Node R W D type perm rdCmd rdFunc wrCmd wrFunc allowed set deviceCommand {\ - Control Math 0 1 0 text user {} {} {CALC1:FORM} {setParm} {MXB}\ - Control MMF 0 1 0 float user {} {} {CALC1:KMAT:MMF} {setValue} {}\ - Control MBF 0 1 0 float user {} {} {CALC1:KMAT:MBF} {setValue} {}\ - Control MUN 0 1 0 text user {} {} {CALC1:KMAT:MUN} {setText} {}\ - Control Stat 0 1 0 text user {} {} {CALC1:STAT} {setParm} {ON,OFF}\ - Display Value 1 0 0 text internal {FETCH?} {rdValue} {} {} {}\ - {} Setpoint 0 0 0 text internal {} {} {} {} {}\ - Display X 0 0 0 text internal {} {} {} {} {}\ + Control Function 1 1 0 text user {SENS:FUNC?} {rdText} {SENS:FUNC} {wrFunc} {VOLT:DC,VOLT:AC,CURR:DC,CURR:AC,RES,FRES,CONT,FREQ,PER}\ + Control Math 1 1 0 text user {CALC1:FORM?} {rdParm} {CALC1:FORM} {wrParm} {MXB}\ + Control MMF 1 1 0 float user {CALC1:KMAT:MMF?} {rdValue} {CALC1:KMAT:MMF} {wrValue} {}\ + Control MBF 1 1 0 float user {CALC1:KMAT:MBF?} {rdValue} {CALC1:KMAT:MBF} {wrValue} {}\ + Control MUN 1 1 0 text user {CALC1:KMAT:MUN?} {rdText} {CALC1:KMAT:MUN} {wrText} {}\ + Control Stat 1 1 0 text user {CALC1:STAT?} {rdParm} {CALC1:STAT} {wrParm} {ON,OFF}\ + Display Value 1 0 0 text internal {FETCH?} {rdData} {} {} {}\ + {} Setpoint 0 1 1 text user {} {} {} {setPoint} {}\ + Display Tree 0 1 0 text user {} {} {} {wrTree} {}\ } hfactory $scobj_hpath/Control plain spy none @@ -432,6 +609,8 @@ debug_log "Registering node $nodeName for write callback" hfactory $scobj_hpath/device_lasterror plain user text hset $scobj_hpath/device_lasterror "" + hsetprop $scobj_hpath/setpoint tolerance $tol + if {[SplitReply [environment_simulation]]=="false"} { $sct_controller poll $scobj_hpath/device_state 1 halt read } @@ -454,7 +633,10 @@ debug_log "Registering node $nodeName for write callback" hsetprop $scobj_hpath/$snsr/value sdsinfo ::nexus::scobj::sdsinfo } hsetprop $scobj_hpath privilege spy -# ::scobj::hinitprops $tempobj setpoint + ::scobj::hinitprops $tempobj setpoint + if {[SplitReply [environment_simulation]]=="false"} { + ansto_makesctdrive ${tempobj}_driveable $scobj_hpath/setpoint $scobj_hpath/display/value $sct_controller + } } catch_message ] if {$catch_status != 0} { return -code error $catch_message @@ -469,14 +651,14 @@ debug_log "Registering node $nodeName for write callback" # @param name, the name of the multimeter (eg mm1) # @param IP, the IP address of the device, this can be a hostname, (eg ca1-kowari) # @param port, the IP protocol port number of the device -proc add_k2700 {name IP port terminator} { +proc add_k2700 {name IP port terminator {_tol 1.0}} { set fd [open "/tmp/k2700.log" a] if {[SplitReply [environment_simulation]]=="false"} { - puts $fd "makesctcontroller sct_k2700 oxford ${IP}:$port" - makesctcontroller sct_k2700 oxford ${IP}:$port $terminator + puts $fd "makesctcontroller sct_k2700 std ${IP}:$port" + makesctcontroller sct_k2700 std ${IP}:$port $terminator } - puts $fd "mk_sct_keithley_2700 sct_k2700 environment $name" - mk_sct_keithley_2700 sct_k2700 environment $name + puts $fd "mk_sct_keithley_2700 sct_k2700 environment $name $_tol" + mk_sct_keithley_2700 sct_k2700 environment $name $_tol close $fd }