linse/sics
0
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

differentiate rdValue and rdData and add experimental treewalk

Browse Source 
r3232 | dcl | 2011-07-20 14:45:17 +1000 (Wed, 20 Jul 2011) | 1 line
This commit is contained in:
Douglas Clowes
2011-07-20 14:45:17 +10:00
parent cffc765197
commit d33a957d01
1 changed files with 252 additions and 70 deletions
Download Patch File Download Diff File Expand all files Collapse all files

322
site_ansto/instrument/config/environment/sct_keithley_2700.tcl
View File

@@ -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
}