Lakeshore 370 AC "Resistance Bridge" Temperature Controller
r3343 | dcl | 2012-01-16 17:39:14 +1100 (Mon, 16 Jan 2012) | 1 line
This commit is contained in:
Douglas Clowes
@@ -0,0 +1,921 @@
|
||||
# vim: ts=8 sw=2 sta sts=2 et ai si
|
||||
# This is a template driver for a 336 temperaure controller from Lake Shore
|
||||
#
|
||||
# Author: Douglas Clowes
|
||||
# Date: September 2011
|
||||
#
|
||||
if { "[lindex [split [info nameofexecutable] "/"] end]" == "tclsh"} {
|
||||
set catch_status [ catch {
|
||||
puts "TCLSH"
|
||||
proc environment_simulation {} { return "" }
|
||||
proc SplitReply {str} { return "" }
|
||||
proc makesctcontroller {args} { }
|
||||
proc MakeSICSObj {args} { }
|
||||
proc sicslist {args} { }
|
||||
proc hfactory {args} { }
|
||||
proc hdelprop {args} { }
|
||||
proc hsetprop {args} { }
|
||||
proc hpropexists {args} { }
|
||||
proc hset {args} { }
|
||||
proc hget {args} { }
|
||||
proc hval {args} { }
|
||||
proc sct {args} { }
|
||||
proc debug_log {args} { }
|
||||
proc pathname {args} { }
|
||||
proc basename {args} { }
|
||||
proc channel {args} { }
|
||||
proc ns {args} { }
|
||||
} catch_message ]
|
||||
if {$catch_status != 0} {
|
||||
puts "error in main $catch_message"
|
||||
return -code error "in main $catch_message"
|
||||
}
|
||||
}
|
||||
|
||||
set vendor "lakeshore"
|
||||
set device "370"
|
||||
|
||||
namespace eval ::scobj::[set vendor]_[set device] {
|
||||
# All of this takes place in a namespace based on the vendor and device
|
||||
# Debug prints and vendor/device save
|
||||
puts "Namespace: [namespace current]"
|
||||
puts "Vendor:[set vendor]"
|
||||
puts "Device:[set device]"
|
||||
set [namespace current]::vendor [set ::vendor]
|
||||
set [namespace current]::device [set ::device]
|
||||
set [namespace current]::ven_dev "[set ::vendor]_[set ::device]"
|
||||
puts "[namespace current]::vendor [set [namespace current]::vendor]"
|
||||
puts "[namespace current]::device [set [namespace current]::device]"
|
||||
puts "[namespace current]::ven_dev [set [namespace current]::ven_dev]"
|
||||
|
||||
proc debug_log {debug_level arg_string} {
|
||||
# write a timestamped string message to a log file for debugging
|
||||
set debug_threshold 0
|
||||
if {$debug_level >= $debug_threshold} {
|
||||
set fd [open "[set [namespace current]::log_file]" "a"]
|
||||
set line "[clock format [clock seconds] -format "%T"] $arg_string"
|
||||
puts $fd "$line"
|
||||
puts "debug_log $line"
|
||||
close $fd
|
||||
}
|
||||
}
|
||||
|
||||
proc ns {} {
|
||||
return "[namespace current]"
|
||||
}
|
||||
proc channel {arg} {
|
||||
# strip the trailing digits from the arg and return them as a string
|
||||
set result 0
|
||||
for { set i 0 } { $i < [string length $arg] } { incr i } {
|
||||
if { ! [string match {[0-9]} [string index $arg end-$i]] } {
|
||||
break
|
||||
}
|
||||
set result [string range "$arg" end-$i end]
|
||||
}
|
||||
debug_log 1 "Extract channel $result from argument $arg"
|
||||
return $result
|
||||
}
|
||||
proc basename {node} {
|
||||
set point [string last "/" $node]
|
||||
if { $point < 0 } {
|
||||
return $node
|
||||
} else {
|
||||
incr point
|
||||
return "[string range $node $point end]"
|
||||
}
|
||||
}
|
||||
proc pathname {node} {
|
||||
set point [string last "/" $node]
|
||||
if { $point < 0 } {
|
||||
return ""
|
||||
} else {
|
||||
incr point -1
|
||||
return "[string range $node 0 $point]"
|
||||
}
|
||||
return "[join [lrange [split $node '/'] 0 end-1] '/']"
|
||||
}
|
||||
|
||||
proc setValue {tc_root nextState cmd} {
|
||||
# send a command to set a value
|
||||
debug_log 1 "setValue tc_root=$tc_root sct=[sct] $cmd [sct target]"
|
||||
if { [hpropexists [sct] geterror] } {
|
||||
hdelprop [sct] geterror
|
||||
}
|
||||
set par [sct target]
|
||||
if { "$cmd" == "SETP" } {
|
||||
set command "$cmd $par;$cmd?"
|
||||
} elseif { "$cmd" == "ALMRST" } {
|
||||
set command "$cmd;*IDN?"
|
||||
} elseif { "$cmd" == "MNMXRST" } {
|
||||
set command "$cmd;*IDN?"
|
||||
} elseif { "$cmd" == "RAMP" } {
|
||||
set parts [split "[sct target]" ","]
|
||||
if { [llength $parts] != 2 } {
|
||||
sct geterror "RAMP needs two parameters in \"[sct target]\""
|
||||
return -code error "[sct geterror]"
|
||||
}
|
||||
set ramp_enable "[lindex $parts 0]"
|
||||
if { "$ramp_enable" != 0 && "$ramp_enable" != 1 } {
|
||||
sct geterror "RAMP enable should be 0 or 1 in \"[sct target]\""
|
||||
return -code error "[sct geterror]"
|
||||
}
|
||||
set ramp_rate "[lindex $parts 1]"
|
||||
if { "$ramp_enable" != 0 && ( "$ramp_rate" < 0.001 || "$ramp_rate" > 10 ) } {
|
||||
sct geterror "RAMP rate should be between 0.001 and 10 in \"[sct target]\""
|
||||
return -code error "[sct geterror]"
|
||||
}
|
||||
set cmd "RAMP $ramp_enable,$ramp_rate;RAMP?"
|
||||
} elseif { "$cmd" == "CSET" } {
|
||||
set channel "[hval [pathname [sct]]/sensor_channel]"
|
||||
set filter "[hval [pathname [sct]]/filter_enable]"
|
||||
set units "[hval [pathname [sct]]/units]"
|
||||
set delay "[hval [pathname [sct]]/delay]"
|
||||
set current "[hval [pathname [sct]]/current_or_power]"
|
||||
set htr_limit "[hval [pathname [sct]]/htr_limit]"
|
||||
set htr_resistance "[hval [pathname [sct]]/htr_resistance]"
|
||||
set parts [split "[sct target]" ","]
|
||||
if { [llength $parts] > 0 && [string length [lindex $parts 0]] > 0 } {
|
||||
set channel "[lindex $parts 0]"
|
||||
}
|
||||
if { [llength $parts] > 1 && [string length [lindex $parts 1]] > 0 } {
|
||||
set filter "[lindex $parts 1]"
|
||||
}
|
||||
if { [llength $parts] > 2 && [string length [lindex $parts 2]] > 0 } {
|
||||
set units "[lindex $parts 2]"
|
||||
}
|
||||
if { [llength $parts] > 3 && [string length [lindex $parts 3]] > 0 } {
|
||||
set delay "[lindex $parts 3]"
|
||||
}
|
||||
if { [llength $parts] > 4 && [string length [lindex $parts 4]] > 0 } {
|
||||
set current "[lindex $parts 4]"
|
||||
}
|
||||
if { [llength $parts] > 5 && [string length [lindex $parts 5]] > 0 } {
|
||||
set htr_limit "[lindex $parts 5]"
|
||||
}
|
||||
if { [llength $parts] > 6 && [string length [lindex $parts 6]] > 0 } {
|
||||
set htr_resistance "[lindex $parts 6]"
|
||||
}
|
||||
set command "CSET $channel,$filter,$units,$delay,$current,$htr_limit,$htr_resistance;CSET?"
|
||||
} elseif { [string equal -nocase -length 4 "[basename [pathname [sct]]]" "CHAN"] } {
|
||||
set cmd "$cmd [channel [pathname [sct]]],$par;$cmd? [channel [pathname [sct]]]"
|
||||
} elseif { [string equal -nocase -length 6 "[basename [pathname [sct]]]" "ANALOG"] } {
|
||||
set cmd "$cmd [channel [pathname [sct]]],$par;$cmd? [channel [pathname [sct]]]"
|
||||
} else {
|
||||
set command "$cmd $par;*IDN?"
|
||||
}
|
||||
if { $par != [sct oldval] } {
|
||||
sct oldval $par
|
||||
sct update $par
|
||||
sct utime readtime
|
||||
debug_log 1 "setValue new data for $tc_root [sct] result=$par"
|
||||
}
|
||||
debug_log 1 "setValue sct send \"$command\""
|
||||
sct send "$command"
|
||||
return $nextState
|
||||
}
|
||||
|
||||
proc chkWrite {tc_root} {
|
||||
# process the response to the write
|
||||
# - not all devices will respond to writes
|
||||
set data [sct result]
|
||||
debug_log 1 "chkWrite tc_root=$tc_root sct=[sct] resp=$data"
|
||||
if {[string equal -nocase -length 7 $data "ASCERR:"]} {
|
||||
# the protocol driver has reported an error
|
||||
sct geterror "$data"
|
||||
} elseif {[string equal -nocase -length 1 $data "?"]} {
|
||||
# the device has reported an error
|
||||
sct geterror "Error: $data"
|
||||
} else {
|
||||
# the write was successful, record the data
|
||||
set data [sct target]
|
||||
if {$data != [sct oldval]} {
|
||||
sct oldval $data
|
||||
sct update $data
|
||||
sct utime readtime
|
||||
debug_log 1 "chkWrite new data for $tc_root [sct] result=$data"
|
||||
}
|
||||
}
|
||||
return idle
|
||||
}
|
||||
|
||||
proc noResponse {tc_root} {
|
||||
set data "[sct result]"
|
||||
debug_log 1 "noResponse tc_root=$tc_root sct=[sct] resp=$data"
|
||||
return idle
|
||||
}
|
||||
|
||||
proc getValue {tc_root nextState cmd} {
|
||||
# send a command to request a value
|
||||
debug_log 1 "getValue tc_root=$tc_root sct=[sct] $cmd"
|
||||
if { [hpropexists [sct] geterror] } {
|
||||
hdelprop [sct] geterror
|
||||
}
|
||||
if { [string equal -nocase -length 4 "$cmd" "RAMP"] } {
|
||||
} elseif { [string equal -nocase -length 4 "$cmd" "SETP"] } {
|
||||
} elseif { [string equal -nocase -length 6 "[basename [pathname [sct]]]" "ANALOG"] } {
|
||||
set cmd "$cmd [channel [basename [sct]]]"
|
||||
} elseif { [string equal -nocase -length 4 "[basename [pathname [sct]]]" "CHAN"] } {
|
||||
set cmd "$cmd [channel [pathname [sct]]]"
|
||||
} elseif { [string equal -nocase -length 5 "[basename [pathname [sct]]]" "CURVE"] } {
|
||||
set cmd "$cmd [channel [pathname [sct]]]"
|
||||
}
|
||||
debug_log 1 "getValue sct send $cmd"
|
||||
sct send "$cmd"
|
||||
return $nextState
|
||||
}
|
||||
|
||||
proc rdValue {tc_root} {
|
||||
# process the received response to the read request
|
||||
debug_log 1 "rdValue tc_root=$tc_root sct=[sct] result=[sct result]"
|
||||
set data [sct result]
|
||||
if {[string equal -nocase -length 7 $data "ASCERR:"]} {
|
||||
# the protocol driver has reported an error
|
||||
sct geterror "$data"
|
||||
} elseif {[string equal -nocase -length 1 $data "?"]} {
|
||||
# the device has reported an error
|
||||
sct geterror "Error: $data"
|
||||
} else {
|
||||
if { [string equal -nocase [basename [sct]] "RAMP"] } {
|
||||
set parts [split "[sct result]" ","]
|
||||
if { [llength $parts] < 2 } {
|
||||
sct geterror "RAMP parts missing from [sct result]"
|
||||
return -code error "[sct geterror]"
|
||||
}
|
||||
set ramp_enable [lindex $parts 0]
|
||||
set ramp_rate [lindex $parts 1]
|
||||
if { $ramp_enable != 0 && $ramp_enable != 1 } {
|
||||
sct geterror "RAMP bad enable from [sct result]"
|
||||
return -code error "[sct geterror]"
|
||||
}
|
||||
if { $ramp_rate < 0.001 || $ramp_rate > 10 } {
|
||||
if { $ramp_enable == 1 } {
|
||||
sct geterror "RAMP bad rate from [sct result]"
|
||||
return -code error "[sct geterror]"
|
||||
}
|
||||
set ramp_rate 1
|
||||
}
|
||||
if { [hval [pathname [sct]]/ramp_enable] != $ramp_enable } {
|
||||
hset [pathname [sct]]/ramp_enable $ramp_enable
|
||||
}
|
||||
if { [hval [pathname [sct]]/ramp_rate] != $ramp_rate } {
|
||||
hset [pathname [sct]]/ramp_rate $ramp_rate
|
||||
}
|
||||
if { [sct result] != [sct oldval] } {
|
||||
debug_log 1 "[sct] changed to new:$data, from old:[sct oldval]"
|
||||
sct oldval [sct result]
|
||||
sct update [sct result]
|
||||
sct utime readtime
|
||||
}
|
||||
return "idle"
|
||||
}
|
||||
if { [string equal -nocase [basename [sct]] "CSET"] } {
|
||||
set parts [split "[sct result]" ","]
|
||||
if { [llength $parts] < 7 } {
|
||||
sct geterror "CSET parts missing from [sct result]"
|
||||
return -code error "[sct geterror]"
|
||||
}
|
||||
if { [lindex $parts 0] < 1 || [lindex $parts 0] > 16 } {
|
||||
sct geterror "CSET bad channel from [sct result]"
|
||||
return -code error "[sct geterror]"
|
||||
}
|
||||
if { [lindex $parts 1] != 0 && [lindex $parts 1] != 1 } {
|
||||
sct geterror "CSET bad filter enable from [sct result]"
|
||||
return -code error "[sct geterror]"
|
||||
}
|
||||
if { [lindex $parts 2] != 1 && [lindex $parts 2] != 2 } {
|
||||
sct geterror "CSET bad units from [sct result]"
|
||||
return -code error "[sct geterror]"
|
||||
}
|
||||
if { [lindex $parts 3] < 1 || [lindex $parts 3] > 255 } {
|
||||
sct geterror "CSET bad delay from [sct result]"
|
||||
return -code error "[sct geterror]"
|
||||
}
|
||||
if { [lindex $parts 4] != 1 && [lindex $parts 4] != 2 } {
|
||||
sct geterror "CSET bad current/power from [sct result]"
|
||||
return -code error "[sct geterror]"
|
||||
}
|
||||
if { [lindex $parts 5] < 1 || [lindex $parts 5] > 8 } {
|
||||
sct geterror "CSET bad heater limit from [sct result]"
|
||||
return -code error "[sct geterror]"
|
||||
}
|
||||
if { [lindex $parts 6] < 1 || [lindex $parts 6] > 100000 } {
|
||||
sct geterror "CSET bad heater resistance from [sct result]"
|
||||
return -code error "[sct geterror]"
|
||||
}
|
||||
if { [hval [pathname [sct]]/sensor_channel] != [lindex $parts 0] } {
|
||||
hset [pathname [sct]]/sensor_channel [lindex $parts 0]
|
||||
}
|
||||
if { [hval [pathname [sct]]/filter_enable] != [lindex $parts 1] } {
|
||||
hset [pathname [sct]]/filter_enable [lindex $parts 1]
|
||||
}
|
||||
if { [hval [pathname [sct]]/units] != [lindex $parts 2] } {
|
||||
hset [pathname [sct]]/units [lindex $parts 2]
|
||||
}
|
||||
if { [hval [pathname [sct]]/delay] != [lindex $parts 3] } {
|
||||
hset [pathname [sct]]/delay [lindex $parts 3]
|
||||
}
|
||||
if { [hval [pathname [sct]]/current_or_power] != [lindex $parts 4] } {
|
||||
hset [pathname [sct]]/current_or_power [lindex $parts 4]
|
||||
}
|
||||
if { [hval [pathname [sct]]/htr_limit] != [lindex $parts 5] } {
|
||||
hset [pathname [sct]]/htr_limit [lindex $parts 5]
|
||||
}
|
||||
if { [hval [pathname [sct]]/htr_resistance] != [lindex $parts 6] } {
|
||||
hset [pathname [sct]]/htr_resistance [lindex $parts 6]
|
||||
}
|
||||
if { [sct result] != [sct oldval] } {
|
||||
debug_log 1 "[sct] changed to new:$data, from old:[sct oldval]"
|
||||
sct oldval [sct result]
|
||||
sct update [sct result]
|
||||
sct utime readtime
|
||||
}
|
||||
return "idle"
|
||||
}
|
||||
if {$data != [sct oldval]} {
|
||||
debug_log 1 "[sct] changed to new:$data, from old:[sct oldval]"
|
||||
sct oldval $data
|
||||
sct update $data
|
||||
sct utime readtime
|
||||
}
|
||||
}
|
||||
return "idle"
|
||||
}
|
||||
|
||||
proc getTemp {tc_root nextState cmd} {
|
||||
debug_log 1 "getTemp tc_root=$tc_root sct=[sct] $cmd"
|
||||
if { ! [hpropexists [sct] my_state] } {
|
||||
sct my_state 0
|
||||
}
|
||||
if { [sct my_state] == 0 } {
|
||||
set command "CSET?"
|
||||
} else {
|
||||
set command "RDGK? [sct channel]"
|
||||
}
|
||||
debug_log 1 "getTemp sct send $command"
|
||||
sct send "$command"
|
||||
return "$nextState"
|
||||
}
|
||||
|
||||
proc rdTemp {tc_root} {
|
||||
debug_log 1 "rdTemp tc_root=$tc_root sct=[sct] result=[sct result]"
|
||||
if { [sct my_state] == 0 } {
|
||||
set response "[split [sct result] ","]"
|
||||
sct channel [lindex $response 0]
|
||||
sct filter [lindex $response 1]
|
||||
sct my_state 1
|
||||
return "read"
|
||||
} else {
|
||||
set data "[sct result]"
|
||||
if {$data != [sct oldval]} {
|
||||
debug_log 1 "[sct] changed to new:$data, from old:[sct oldval]"
|
||||
sct oldval $data
|
||||
sct update $data
|
||||
sct utime readtime
|
||||
}
|
||||
sct my_state 0
|
||||
return "idle"
|
||||
}
|
||||
}
|
||||
|
||||
proc gtLoop {tc_root nextState cmd} {
|
||||
debug_log 1 "gtLoop tc_root=$tc_root sct=[sct] nextState=$nextState cmd=$cmd"
|
||||
debug_log 1 "gtLoop tc_root=$tc_root pathname=[pathname [sct]] basename=[basename [sct]]"
|
||||
if { ! [hpropexists [sct] my_state] } {
|
||||
debug_log 1 "gtLoop setting my_state to zero because it doesn't exist"
|
||||
sct my_state 0
|
||||
}
|
||||
if { [sct my_state] == 0 } {
|
||||
set command "RAMP?"
|
||||
} else {
|
||||
set command "SETP?"
|
||||
}
|
||||
debug_log 1 "gtLoop sct=[sct] command=$command"
|
||||
sct send "$command"
|
||||
return "$nextState"
|
||||
return idle
|
||||
}
|
||||
|
||||
proc rdLoop {tc_root} {
|
||||
debug_log 1 "rdLoop tc_root=$tc_root sct=[sct] result=[sct result]"
|
||||
debug_log 1 "rdLoop tc_root=$tc_root pathname=[pathname [sct]] basename=[basename [sct]]"
|
||||
set nextState "read"
|
||||
if { [sct my_state] == 0 } {
|
||||
debug_log 1 "rdLoop sct=[sct] RAMP - result=[sct result]"
|
||||
set nextState "read"
|
||||
} else {
|
||||
debug_log 1 "rdLoop sct=[sct] SETP - result=[sct result]"
|
||||
set nextState "idle"
|
||||
sct my_state -1
|
||||
}
|
||||
sct my_state "[expr {[sct my_state] + 1}]"
|
||||
return $nextState
|
||||
}
|
||||
|
||||
proc wrLoop {tc_root nextState cmd} {
|
||||
debug_log 1 "wrLoop tc_root=$tc_root sct=[sct] nextState=$nextState cmd=$cmd"
|
||||
if { ! [hpropexists [sct] my_state] } {
|
||||
debug_log 1 "wrLoop setting my_state to zero because it doesn't exist"
|
||||
sct my_state 0
|
||||
}
|
||||
if { [sct writestatus] == "start" } {
|
||||
debug_log 1 "wrLoop setting my_state to zero because writestatus is [sct writestatus]"
|
||||
sct my_state 0
|
||||
}
|
||||
debug_log 1 "wrLoop target=[sct target] writestatus=[sct writestatus] my_state=[sct my_state]"
|
||||
if { [sct my_state] == 0 } {
|
||||
set my_rate [hval [sct]/ramp_rate]
|
||||
if { $my_rate > 0.0 } {
|
||||
set command "RAMP 0,0;RAMP?"
|
||||
} else {
|
||||
set command "RAMP 1,$my_rate;RAMP?"
|
||||
}
|
||||
} else {
|
||||
set command "SETP [hval [sct]/setpoint];SETP?"
|
||||
}
|
||||
debug_log 1 "wrLoop sct=[sct] command=$command"
|
||||
sct send "$command"
|
||||
return "$nextState"
|
||||
}
|
||||
|
||||
proc ckLoop {tc_root} {
|
||||
debug_log 1 "ckLoop tc_root=$tc_root sct=[sct] result=[sct result]"
|
||||
debug_log 1 "ckLoop target=[sct target] writestatus=[sct writestatus] my_state=[sct my_state]"
|
||||
set nextState "write"
|
||||
if { [sct my_state] == 0 } {
|
||||
debug_log 1 "ckLoop sct=[sct] RAMP - result=[sct result]"
|
||||
rdValue $tc_root
|
||||
set nextState "write"
|
||||
} else {
|
||||
debug_log 1 "ckLoop sct=[sct] SETP - result=[sct result]"
|
||||
rdValue $tc_root
|
||||
sct my_state -1
|
||||
set nextState "idle"
|
||||
}
|
||||
sct my_state "[expr {[sct my_state] + 1}]"
|
||||
return $nextState
|
||||
}
|
||||
|
||||
##
|
||||
# @brief getState() sends commands/requests to the device under control
|
||||
#
|
||||
# @param tc_root the path to the device_state node
|
||||
# @param nextState the next sct state (rdState)
|
||||
# @param cmd empty argument
|
||||
#
|
||||
# @return the next sct state (rdState)
|
||||
#
|
||||
proc getState {tc_root nextState cmd} {
|
||||
if { [hpropexists [sct] geterror] } {
|
||||
hdelprop [sct] geterror
|
||||
}
|
||||
debug_log 1 "getState $tc_root sct=[sct] state=[hval [sct]] substate=[sct substate] next=$nextState"
|
||||
set my_state [hval [sct]]
|
||||
set my_substate [sct substate]
|
||||
if {$my_state == "STATE_INIT"} {
|
||||
if { $my_substate == 0 } {
|
||||
set command "*IDN?"
|
||||
} elseif { $my_substate == 1 } {
|
||||
set command "*TST?"
|
||||
}
|
||||
} elseif { $my_state == "STATE_CURVE"} {
|
||||
if { $my_substate == 0 } {
|
||||
set my_substate 1000
|
||||
sct substate $my_substate
|
||||
}
|
||||
if { ($my_substate % 1000) == 0 } {
|
||||
set command "CRVHDR? [expr {int($my_substate / 1000)}]"
|
||||
} else {
|
||||
set command "CRVPT? [expr {int($my_substate / 1000)}],[expr {($my_substate % 1000)}]"
|
||||
}
|
||||
} elseif { $my_state == "STATE_IDLE"} {
|
||||
if { $my_substate == 0 } {
|
||||
set command "*ESE?"
|
||||
} elseif { $my_substate == 1 } {
|
||||
set command "*ESR?"
|
||||
} elseif { $my_substate == 2 } {
|
||||
set command "*STB?"
|
||||
}
|
||||
}
|
||||
debug_log 1 "getState sct send $command"
|
||||
sct send $command
|
||||
return "$nextState"
|
||||
}
|
||||
|
||||
##
|
||||
# @brief rdState() handles events from the device under control
|
||||
#
|
||||
# @param tc_root the path to the device_state node
|
||||
#
|
||||
proc rdState {tc_root} {
|
||||
if { [hpropexists [sct] geterror] } {
|
||||
hdelprop [sct] geterror
|
||||
}
|
||||
debug_log 1 "rdState $tc_root sct=[sct] state=[hval [sct]] substate=[sct substate] response=\"[sct result]\""
|
||||
set nextState "read"
|
||||
set my_state [hval [sct]]
|
||||
set my_substate [sct substate]
|
||||
if {$my_state == "STATE_INIT"} {
|
||||
if { $my_substate == 0 } { # IDN
|
||||
sct identity [sct result]
|
||||
incr my_substate
|
||||
} elseif { $my_substate == 1 } {
|
||||
sct selftest [sct result]
|
||||
incr my_substate
|
||||
}
|
||||
if { $my_substate > 1 } {
|
||||
#hset [sct] "STATE_IDLE"
|
||||
hset [sct] "STATE_CURVE"
|
||||
set my_substate 0
|
||||
}
|
||||
} elseif { $my_state == "STATE_CURVE"} {
|
||||
if { ($my_substate % 1000) == 0 } {
|
||||
debug_log 1 "Curve: [expr {$my_substate / 1000}] Header: [sct result]"
|
||||
} else {
|
||||
debug_log 1 "Curve: [expr {$my_substate / 1000}] Point: [expr {$my_substate % 1000}] Value: [sct result]"
|
||||
set rslt [scan "[sct result]" "%f,%f" units temperature]
|
||||
debug_log 1 "Curve: [expr {$my_substate / 1000}] Point: [expr {$my_substate % 1000}] Result: $rslt Units: $units Temp: $temperature"
|
||||
if { $units == 0.0 && $temperature == 0.0 } {
|
||||
set my_substate [expr { (($my_substate / 1000)) * 1000 + 999}]
|
||||
}
|
||||
}
|
||||
if { ($my_substate % 1000) >= 200 } {
|
||||
if { ($my_substate / 1000) >= 20 } {
|
||||
hset [sct] "STATE_IDLE"
|
||||
set my_substate 0
|
||||
} else {
|
||||
set my_substate [expr { (($my_substate / 1000) + 1) * 1000 }]
|
||||
}
|
||||
} else {
|
||||
set my_substate [expr { $my_substate + 1 }]
|
||||
}
|
||||
} elseif { $my_state == "STATE_IDLE"} {
|
||||
if { $my_substate == 0 } { # ESE
|
||||
sct the_ese [sct result]
|
||||
incr my_substate
|
||||
} elseif { $my_substate == 1 } { # ESR
|
||||
sct the_esr [sct result]
|
||||
incr my_substate
|
||||
} elseif { $my_substate == 2 } { # STB
|
||||
sct the_stb [sct result]
|
||||
incr my_substate
|
||||
}
|
||||
if { $my_substate > 2 } {
|
||||
set my_substate 0
|
||||
set nextState "idle"
|
||||
}
|
||||
}
|
||||
sct substate $my_substate
|
||||
if { $my_state != [hval [sct]] } {
|
||||
debug_log 1 "device_state $my_state to [hval [sct]]"
|
||||
}
|
||||
return "$nextState"
|
||||
}
|
||||
|
||||
proc loadCurve_XXX {fname} {
|
||||
sct print "loading curve [sct target] into [sct]"
|
||||
set lines [list]
|
||||
if {[file exists "[sct target]"] && [file readable "[sct target]"]} {
|
||||
sct print "opening [file normalize "[sct target]"]"
|
||||
set f [open "[sct target]"]
|
||||
while {1} {
|
||||
set line [gets $f]
|
||||
if {[eof $f]} {
|
||||
close $f
|
||||
break
|
||||
}
|
||||
# TODO - parse lines and build database
|
||||
}
|
||||
close $f
|
||||
}
|
||||
}
|
||||
|
||||
proc loadCurve_34A {fname} {
|
||||
sct print "loading curve [sct target] into [sct]"
|
||||
set profile_index 0
|
||||
set lines [list]
|
||||
if {[file exists "[sct target]"] && [file readable "[sct target]"]} {
|
||||
sct print "opening [file normalize "[sct target]"]"
|
||||
set f [open "[sct target]"]
|
||||
while {1} {
|
||||
set line [gets $f]
|
||||
if {[eof $f]} {
|
||||
#close $f
|
||||
break
|
||||
}
|
||||
if { [string equal -nocase -length 5 "$line" "Name:"] } {
|
||||
sct profile_name "[string range "$line" 6 end]"
|
||||
} elseif { [string equal -nocase -length 14 "$line" "Serial number:"] } {
|
||||
sct profile_number "[string range "$line" 15 end]"
|
||||
} elseif { [string equal -nocase -length 7 "$line" "Format:"] } {
|
||||
sct profile_format [lindex [split "$line"] 1]
|
||||
} elseif { [string equal -nocase -length 6 "$line" "Limit:"] } {
|
||||
sct profile_limit [lindex [split "$line"] 1]
|
||||
} elseif { [string equal -nocase -length 12 "$line" "Coefficient:"] } {
|
||||
sct profile_coeff [lindex [split "$line"] 1]
|
||||
} elseif { [string equal -nocase -length 6 "$line" "Point "] } {
|
||||
set rslt [scan "$line" "Point %d: %f,%f" idx r t]
|
||||
if { $rslt != 3 } {
|
||||
debug_log 1 "Profile error ($rslt) for: $line"
|
||||
} else {
|
||||
incr profile_index 1
|
||||
sct profile_line_[format "%03d" $profile_index] "[list $idx $r $t]"
|
||||
debug_log 1 "Profile line $profile_index: [sct profile_line_[format "%03d" $profile_index]]"
|
||||
}
|
||||
} else {
|
||||
debug_log 1 "Profile error unknown for: $line"
|
||||
}
|
||||
}
|
||||
close $f
|
||||
}
|
||||
}
|
||||
|
||||
proc ldCurve { tc_root nextState cmd } {
|
||||
if { ! [hpropexists [sct] index] } {
|
||||
sct index 0
|
||||
}
|
||||
if { [hpropexists [sct] geterror] } {
|
||||
hdelprop [sct] geterror
|
||||
}
|
||||
if { "[sct index]" <= 0 } {
|
||||
loadCurve_34A "[sct target]"
|
||||
# TODO send curve header
|
||||
debug_log 1 "Curve header: "
|
||||
sct index [expr {[sct index] + 1}]
|
||||
return write
|
||||
} else {
|
||||
# write curve to device
|
||||
if { [hpropexists [sct] profile_line_[format "%03d" [sct index]]] } {
|
||||
set profile_line [sct profile_line_[format "%03d" [sct index]]]
|
||||
debug_log 1 "Profile line $profile_line"
|
||||
}
|
||||
return "$nextState"
|
||||
}
|
||||
return "$nextState"
|
||||
}
|
||||
|
||||
proc ackCurve {tc_root} {
|
||||
sct index [expr {[sct index] + 1}]
|
||||
if { [hpropexists [sct] profile_line_[format "%03d" [sct index]]] } {
|
||||
return "write"
|
||||
}
|
||||
sct index 0
|
||||
return idle
|
||||
}
|
||||
|
||||
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 1 "wrTree root=$tc_root sct=[sct] cmd=$cmd target=[sct target]"
|
||||
sct print "$tc_root"
|
||||
wrNode $tc_root "[sct target]" 1
|
||||
return idle
|
||||
}
|
||||
|
||||
##
|
||||
# @brief createNode() creates a node for the given nodename with the properties given
|
||||
#
|
||||
# @param scobj_hpath string variable holding the path to the object's base node in sics (/sample/tc1)
|
||||
# @param sct_controller name of the scriptcontext object (typically sct_xxx_yyy)
|
||||
# @param cmdGroup subdirectory (below /sample/tc*/) in which the node is to be created
|
||||
# @param varName name of the actual node typically representing one device command
|
||||
# @param readable set to 1 if the node represents a query command, 0 if it is not
|
||||
# @param writable set to 1 if the node represents a request for a change in settings sent to the device
|
||||
# @param drivable if set to 1 it prepares the node to provide a drivable interface
|
||||
# @param dataType data type of the node, must be one of none, int, float, text
|
||||
# @param permission defines what user group may read/write to this node (is one of spy, user, manager)
|
||||
# @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 allowedValues allowed values for the node data - does not permit other
|
||||
# @param klass Nexus class name (?)
|
||||
# @return OK
|
||||
proc createNode {scobj_hpath sct_controller\
|
||||
cmdGroup varName\
|
||||
readable writable drivable\
|
||||
dataType permission\
|
||||
rdCmd rdFunc\
|
||||
wrCmd wrFunc\
|
||||
allowedValues klass} {
|
||||
|
||||
set catch_status [ catch {
|
||||
set ns "[namespace current]"
|
||||
set nodeName "$scobj_hpath/$cmdGroup/$varName"
|
||||
if {1 > [string length $cmdGroup]} {
|
||||
set nodeName "$scobj_hpath/$varName"
|
||||
}
|
||||
debug_log 1 "Creating node $nodeName"
|
||||
hfactory $nodeName plain $permission $dataType
|
||||
if {$readable > 0} {
|
||||
# the node is readable so set it up to be polled using the rdFunc
|
||||
# rdFunc is getValueFunc.rdValueFunc with both explicit functions
|
||||
# or rdValueFunc where "getValue" is the implied getValueFunc
|
||||
set parts [split "$rdFunc" "."]
|
||||
if { [llength $parts] == 2 } {
|
||||
set func_name [lindex $parts 0]
|
||||
set next_state [lindex $parts 1]
|
||||
} else {
|
||||
set func_name "getValue"
|
||||
set next_state [lindex $parts 0]
|
||||
}
|
||||
hsetprop $nodeName read ${ns}::$func_name $scobj_hpath $next_state $rdCmd
|
||||
hsetprop $nodeName $next_state ${ns}::$next_state $scobj_hpath
|
||||
# set the poll rate as a period in seconds
|
||||
# TODO allow directly settable value in seconds
|
||||
set poll_period 5
|
||||
if { $readable >= 0 && $readable <= 300 } {
|
||||
set poll_period [expr {int($readable)}]
|
||||
}
|
||||
debug_log 1 "Registering node $nodeName for poll at $poll_period seconds"
|
||||
$sct_controller poll $nodeName $poll_period
|
||||
}
|
||||
if {$writable == 1} {
|
||||
# the node is writable so set it up to invoke a callback when written
|
||||
# rdFunc is putValueFunc.chkWriteFunc with both explicit functions
|
||||
# or putValueFunc where "noResponse" is the implied chkWriteFunc
|
||||
set parts [split "$wrFunc" "."]
|
||||
if { [llength $parts] == 2 } {
|
||||
set func_name [lindex $parts 0]
|
||||
set next_state [lindex $parts 1]
|
||||
} else {
|
||||
set func_name [lindex $parts 0]
|
||||
set next_state "noResponse"
|
||||
}
|
||||
hsetprop $nodeName write ${ns}::$func_name $scobj_hpath $next_state $wrCmd
|
||||
hsetprop $nodeName $next_state ${ns}::$next_state $scobj_hpath
|
||||
hsetprop $nodeName writestatus UNKNOWN
|
||||
debug_log 1 "Registering node $nodeName for write callback"
|
||||
$sct_controller write $nodeName
|
||||
}
|
||||
# Initialise the previous value to test against
|
||||
switch -exact $dataType {
|
||||
"none" { }
|
||||
"int" { hsetprop $nodeName oldval -1 }
|
||||
"float" { hsetprop $nodeName oldval -1.0 }
|
||||
default { hsetprop $nodeName oldval UNKNOWN }
|
||||
}
|
||||
# Set the allowed values property
|
||||
if {1 < [string length $allowedValues]} {
|
||||
hsetprop $nodeName values $allowedValues
|
||||
}
|
||||
# Drive adapter interface
|
||||
# TODO make it a separate function and pass in all this stuff
|
||||
if {$drivable == 1} {
|
||||
hsetprop $nodeName check ${ns}::check $scobj_hpath
|
||||
hsetprop $nodeName driving 0
|
||||
hsetprop $nodeName checklimits ${ns}::check $scobj_hpath
|
||||
hsetprop $nodeName checkstatus ${ns}::drivestatus $scobj_hpath
|
||||
hsetprop $nodeName halt ${ns}::halt $scobj_hpath
|
||||
} else {
|
||||
hsetprop $nodeName driving 0
|
||||
}
|
||||
} catch_message ]
|
||||
if {$catch_status != 0} {
|
||||
debug_log 5 "error in [ns]::createNode $catch_message"
|
||||
return -code error "in [ns]::createNode $catch_message"
|
||||
}
|
||||
return OK
|
||||
}
|
||||
|
||||
proc mk_sct_driver {sct_controller klass name tol} {
|
||||
set [ns]::log_file "/tmp/[set [ns]::ven_dev]_${name}.log"
|
||||
debug_log 1 "mk_sct_driver $sct_controller $klass $name $tol"
|
||||
set catch_status [ catch {
|
||||
|
||||
MakeSICSObj $name SCT_OBJECT
|
||||
sicslist setatt $name klass $klass
|
||||
sicslist setatt $name long_name $name
|
||||
|
||||
set scobj_hpath /sics/$name
|
||||
|
||||
hfactory $scobj_hpath/Loop1 plain spy none
|
||||
hfactory $scobj_hpath/Heater plain spy none
|
||||
hfactory $scobj_hpath/Chan1 plain spy none
|
||||
hfactory $scobj_hpath/Curve1 plain spy none
|
||||
hfactory $scobj_hpath/Analog1 plain spy none
|
||||
hfactory $scobj_hpath/Analog2 plain spy none
|
||||
hfactory $scobj_hpath/Sensor plain spy none
|
||||
|
||||
set deviceCommand {\
|
||||
Sensor value 1 0 0 float user {RDGK?} {rdValue} {} {} {}\
|
||||
{} setpoint 1 1 0 float user {SETP?} {rdValue} {SETP} {setValue} {}\
|
||||
{} device_state 1 0 0 text user {NULL} {getState.rdState} {} {} {}\
|
||||
{} alarm_reset 0 1 0 text user {} {} {ALMRST} {setValue} {}\
|
||||
{} device_reset 0 1 0 text user {} {} {*RST} {setValue} {}\
|
||||
{} mnmx_reset 0 1 0 text user {} {} {MNMXRST} {setValue} {}\
|
||||
{} Tree 0 1 0 text user {} {} {} {wrTree} {}\
|
||||
Loop1 ramp 1 1 0 text user {RAMP?} {rdValue} {RAMP} {setValue} {}\
|
||||
Loop1 ramp_enable 0 0 0 float user {} {} {} {} {}\
|
||||
Loop1 ramp_rate 0 0 0 float user {} {} {} {} {}\
|
||||
Loop1 setpoint 1 1 0 float user {SETP?} {rdValue} {SETP} {setValue} {}\
|
||||
Loop1 cset 1 1 0 text user {CSET?} {rdValue} {CSET} {setValue} {}\
|
||||
Loop1 sensor_channel 0 0 0 int user {} {} {} {} {}\
|
||||
Loop1 filter_enable 0 0 0 int user {} {} {} {} {}\
|
||||
Loop1 units 0 0 0 int user {} {} {} {} {}\
|
||||
Loop1 delay 0 0 0 int user {} {} {} {} {}\
|
||||
Loop1 current_or_power 0 0 0 int user {} {} {} {} {}\
|
||||
Loop1 htr_limit 0 0 0 int user {} {} {} {} {}\
|
||||
Loop1 htr_resistance 0 0 0 float user {} {} {} {} {}\
|
||||
Analog1 analog 1 1 0 text user {ANALOG?} {rdValue} {ANALOG} {setValue} {}\
|
||||
Analog1 aout 1 0 0 float user {AOUT?} {rdValue} {} {} {}\
|
||||
Analog2 analog 1 1 0 text user {ANALOG?} {rdValue} {ANALOG} {setValue} {}\
|
||||
Analog2 aout 1 0 0 float user {AOUT?} {rdValue} {} {} {}\
|
||||
Heater htr 1 0 0 float user {HTR?} {rdValue} {} {} {}\
|
||||
Heater htrrng 1 1 0 int user {HTRRNG?} {rdValue} {HTRRNG} {setValue} {}\
|
||||
Heater htrst 1 0 0 int user {HTRST?} {rdValue} {} {} {}\
|
||||
Chan1 alarm 1 1 0 text user {ALARM?} {rdValue} {ALARM} {setValue} {}\
|
||||
Chan1 alarmst 1 0 0 text user {ALARMST?} {rdValue} {} {} {}\
|
||||
Chan1 filter 1 1 0 text user {FILTER?} {rdValue} {FILTER} {setValue} {}\
|
||||
Chan1 inset 1 1 0 text user {INSET?} {rdValue} {INSET} {setValue} {}\
|
||||
Chan1 ldat 1 0 0 float user {LDAT?} {rdValue} {} {} {}\
|
||||
Chan1 linear 1 1 0 text user {LINEAR?} {rdValue} {LINEAR} {setValue} {}\
|
||||
Chan1 mdat 1 0 0 text user {MDAT?} {rdValue} {} {} {}\
|
||||
Chan1 mnmx 1 1 0 text user {MNMX?} {rdValue} {MNMX} {setValue} {}\
|
||||
Chan1 rdgk 1 0 0 float user {RDGK?} {rdValue} {} {} {}\
|
||||
Chan1 rdgpwr 1 0 0 float user {RDGPWR?} {rdValue} {} {} {}\
|
||||
Chan1 rdgr 1 0 0 float user {RDGR?} {rdValue} {} {} {}\
|
||||
Chan1 rdgrng 1 1 0 text user {RDGRNG?} {rdValue} {RDGRNG} {setValue} {}\
|
||||
Chan1 rdgst 1 0 0 int user {RDGST?} {rdValue} {} {} {}\
|
||||
Curve1 header 1 0 0 text user {CRVHDR?} {rdValue} {} {} {}\
|
||||
Curve1 profile 0 1 0 text user {} {} {XX} {ldCurve.ackCurve} {}\
|
||||
}
|
||||
|
||||
foreach {cmdGroup varName\
|
||||
readable writable drivable\
|
||||
dataType permission\
|
||||
rdCmd rdFunc\
|
||||
wrCmd wrFunc\
|
||||
allowedValues} $deviceCommand {
|
||||
createNode $scobj_hpath $sct_controller\
|
||||
$cmdGroup $varName\
|
||||
$readable $writable $drivable\
|
||||
$dataType $permission\
|
||||
$rdCmd $rdFunc\
|
||||
$wrCmd $wrFunc\
|
||||
$allowedValues $klass
|
||||
}
|
||||
|
||||
hset $scobj_hpath/device_state "STATE_INIT"
|
||||
hsetprop $scobj_hpath/device_state substate 0
|
||||
|
||||
} catch_message ]
|
||||
if {$catch_status != 0} {
|
||||
debug_log 5 "error in [ns]::mk_sct_driver $catch_message"
|
||||
return -code error "in [ns]::mk_sct_driver $catch_message"
|
||||
}
|
||||
}
|
||||
|
||||
proc add_[set vendor]_[set device] {name IP port {_tol 5.0}} {
|
||||
###puts "Namespace: [ns]"
|
||||
###puts "::vendor $::vendor"
|
||||
###puts "::device $::device"
|
||||
###puts "[ns]::vendor [set [ns]::vendor]"
|
||||
###puts "[ns]::device [set [ns]::device]"
|
||||
###puts "[ns]::ven_dev [set [ns]::ven_dev]"
|
||||
set [ns]::log_file "/tmp/[set [ns]::ven_dev]_[set name].log"
|
||||
debug_log 1 "add_[set [ns]::vendor]_[set [ns]::device] ${name} ${IP} ${port} ${_tol}"
|
||||
if {[SplitReply [environment_simulation]]=="false"} {
|
||||
debug_log 1 "makesctcontroller sct_${name} std ${IP}:${port}"
|
||||
makesctcontroller sct_${name} std ${IP}:${port} "\r\n"
|
||||
}
|
||||
debug_log 1 "mk_sct_driver sct_${name} environment ${name} ${_tol}"
|
||||
mk_sct_driver sct_${name} environment ${name} ${_tol}
|
||||
}
|
||||
|
||||
|
||||
namespace export add_[set vendor]_[set device]
|
||||
}
|
||||
|
||||
namespace import ::scobj::[set vendor]_[set device]::*
|
||||
|
||||
# add_lakeshore_370 "tc371" 127.0.0.1 7371 2.0
|
||||
|
||||
|
||||
Reference in New Issue
Block a user