315 lines
7.9 KiB
Tcl
315 lines
7.9 KiB
Tcl
#-----------------------------------------------------
|
|
# This is a second generation counter driver for
|
|
# the PSI EL737 counter boxes using scriptcontext
|
|
# communication.
|
|
#
|
|
# copyright: see file COPYRIGHT
|
|
#
|
|
# Scriptchains:
|
|
# start: el737sendstart - el737cmdreply
|
|
# pause,cont, stop: el737sendcmd - el737cmdreply
|
|
# status: el737readstatus - el737status
|
|
# \ el737statval - el737statread
|
|
# values: el737readvalues - el737val
|
|
# threshold write: el737threshsend - el737threshrcv - el737cmdreply
|
|
#
|
|
# Mark Koennecke, February 2009
|
|
#-----------------------------------------------------
|
|
proc el737error {reply} {
|
|
if {[string first ERR $reply] >= 0} {
|
|
error $reply
|
|
}
|
|
if {[string first ? $reply] < 0} {
|
|
return ok
|
|
}
|
|
if {[string first "?OV" $reply] >= 0} {
|
|
error overflow
|
|
}
|
|
if {[string first "?1" $reply] >= 0} {
|
|
error "out of range"
|
|
}
|
|
if {[string first "?2" $reply] >= 0} {
|
|
error "bad command"
|
|
}
|
|
if {[string first "?3" $reply] >= 0} {
|
|
error "bad parameter"
|
|
}
|
|
if {[string first "?4" $reply] >= 0} {
|
|
error "bad counter"
|
|
}
|
|
if {[string first "?5" $reply] >= 0} {
|
|
error "parameter missing"
|
|
}
|
|
if {[string first "?6" $reply] >= 0} {
|
|
error "to many counts"
|
|
}
|
|
return ok
|
|
}
|
|
#---------------------------------------------------
|
|
proc el737cmdreply {} {
|
|
set reply [sct result]
|
|
set status [catch {el737error $reply} err]
|
|
if {$status != 0} {
|
|
sct geterror $err
|
|
set data [sct send]
|
|
if {[string first overflow $err] >= 0} {
|
|
clientput "WARNING: trying to fix $err on command = $data"
|
|
sct send $data
|
|
return el737cmdreply
|
|
} else {
|
|
clientput "ERROR: $err, command = $data"
|
|
}
|
|
}
|
|
return idle
|
|
}
|
|
#---------------------------------------------------
|
|
proc sctroot {} {
|
|
set path [sct]
|
|
return [file dirname $path]
|
|
}
|
|
#----------------------------------------------------
|
|
proc el737sendstart {} {
|
|
set obj [sctroot]
|
|
set mode [string tolower [string trim [hval $obj/mode]]]
|
|
set preset [string trim [hval $obj/preset]]
|
|
hdelprop [sct] geterror
|
|
switch $mode {
|
|
timer {
|
|
set cmd [format "TP %.2f" $preset]
|
|
}
|
|
default {
|
|
set cmd [format "MP %d" [expr int($preset)]]
|
|
}
|
|
}
|
|
sct send $cmd
|
|
set con [sct controller]
|
|
$con queue $obj/status progress read
|
|
return el737cmdreply
|
|
}
|
|
#----------------------------------------------------
|
|
proc el737sendcmd {cmd} {
|
|
hdelprop [sct] geterror
|
|
sct send $cmd
|
|
return el737cmdreply
|
|
}
|
|
#---------------------------------------------------
|
|
proc el737control {} {
|
|
set target [sct target]
|
|
switch $target {
|
|
1000 {return [el737sendstart] }
|
|
1001 {return [el737sendcmd S] }
|
|
1002 {return [el737sendcmd PS] }
|
|
1003 {return [el737sendcmd CO] }
|
|
default {
|
|
sct print "ERROR: bad start target $target given to control"
|
|
return idle
|
|
}
|
|
}
|
|
|
|
}
|
|
#----------------------------------------------------
|
|
proc el737readstatus {} {
|
|
hdelprop [sct] geterror
|
|
sct send RS
|
|
return el737status
|
|
}
|
|
#-------------------------------------------------
|
|
proc el737statval {} {
|
|
el737readvalues
|
|
return el737statread
|
|
}
|
|
#-------------------------------------------------
|
|
proc el737statread {} {
|
|
el737val
|
|
sct update idle
|
|
return idle
|
|
}
|
|
#--------------------------------------------------
|
|
proc el737status {} {
|
|
set reply [sct result]
|
|
set status [catch {el737error $reply} err]
|
|
if {$status != 0} {
|
|
sct geterror $err
|
|
sct update error
|
|
sct print "ERROR: $err"
|
|
return idle
|
|
}
|
|
set path [sct]
|
|
set con [sct controller]
|
|
switch [string trim $reply] {
|
|
0 {
|
|
return el737statval
|
|
}
|
|
1 -
|
|
2 {
|
|
sct update run
|
|
$con queue $path progress read
|
|
}
|
|
5 -
|
|
6 {
|
|
sct update nobeam
|
|
$con queue $path progress read
|
|
}
|
|
default {
|
|
sct update pause
|
|
$con queue $path progress read
|
|
}
|
|
}
|
|
set count [sct moncount]
|
|
if {$count >= 10} {
|
|
set root [sctroot]
|
|
$con queue $root/values progress read
|
|
sct moncount 0
|
|
} else {
|
|
incr count
|
|
sct moncount $count
|
|
}
|
|
return idle
|
|
}
|
|
#------------------------------------------------
|
|
proc el737readvalues {} {
|
|
hdelprop [sct] geterror
|
|
sct send RA
|
|
return el737val
|
|
}
|
|
#--------------------------------------------------
|
|
proc swapFirst {l} {
|
|
set m1 [lindex $l 0]
|
|
set cts [lindex $l 1]
|
|
lappend res $cts $m1
|
|
for {set i 2} {$i < [llength $l]} {incr i} {
|
|
lappend res [lindex $l $i]
|
|
}
|
|
return $res
|
|
}
|
|
#---------------------------------------------------
|
|
# There are two types of reponses to the RA command:
|
|
# the old form with 5 values and the new one
|
|
# with 9 values
|
|
#---------------------------------------------------
|
|
proc el737val {} {
|
|
set reply [sct result]
|
|
set status [catch {el737error $reply} err]
|
|
if {$status != 0} {
|
|
sct geterror $err
|
|
sct print "ERROR: $err"
|
|
return idle
|
|
}
|
|
set l [split $reply]
|
|
set root [sctroot]
|
|
if {[llength $l] > 5} {
|
|
set l2 [lrange $l 1 end]
|
|
set l2 [swapFirst $l2]
|
|
hupdate ${root}/values [join $l2]
|
|
set time [lindex $l 0]
|
|
hupdate ${root}/time $time
|
|
} else {
|
|
set last [expr [llength $l] - 1]
|
|
set l2 [lrange $l 0 $last]
|
|
set l2 [swapFirst $l2]
|
|
hupdate ${root}/values [join $l2]
|
|
set time [lindex $l $last]
|
|
hupdate ${root}/time $time
|
|
}
|
|
set mode [hval ${root}/mode]
|
|
switch $mode {
|
|
timer {
|
|
hupdate ${root}/control $time
|
|
}
|
|
default {
|
|
set mon [lindex $l2 1]
|
|
hupdate ${root}/control $time
|
|
}
|
|
}
|
|
return idle
|
|
}
|
|
#----------------------------------------------
|
|
proc el737threshsend {} {
|
|
set val [string trim [sct target]]
|
|
set root [sctroot]
|
|
set cter [string trim [hval $root/thresholdcounter]]
|
|
sct send [format "DL %1.1d %f" $cter $val]
|
|
return el737threshrecv
|
|
}
|
|
#---------------------------------------------
|
|
proc el737threshrecv {} {
|
|
set reply [sct result]
|
|
set status [catch {el737error $reply} err]
|
|
if {$status != 0} {
|
|
sct geterror $err
|
|
sct print "ERROR: $err"
|
|
}
|
|
set root [sctroot]
|
|
set cter [string trim [hval $root/thresholdcounter]]
|
|
sct send [format "DR %1.1d" $cter]
|
|
set sctcon [sct controller]
|
|
$sctcon queue [sct] progress read
|
|
return el737cmdreply
|
|
}
|
|
#---------------------------------------------
|
|
proc el737threshread {} {
|
|
set root [sctroot]
|
|
set cter [string trim [hval $root/thresholdcounter]]
|
|
sct send [format "DL %1.1d" $cter]
|
|
return el737thresh
|
|
}
|
|
#----------------------------------------------
|
|
proc el737thresh {} {
|
|
set reply [sct result]
|
|
set status [catch {el737error $reply} err]
|
|
if {$status != 0} {
|
|
sct geterror $err
|
|
sct print "ERROR: $err"
|
|
return idle
|
|
}
|
|
stscan $reply "%f" val
|
|
sct update $val
|
|
return idle
|
|
}
|
|
#----------------------------------------------
|
|
proc el737func {controller path} {
|
|
$controller queue $path write
|
|
}
|
|
#============================================
|
|
proc MakeSecEL737 {name netaddr} {
|
|
MakeSecCounter $name 8
|
|
set conname ${name}sct
|
|
makesctcontroller $conname std $netaddr "\r" 10
|
|
$conname send "RMT 1"
|
|
$conname send "RMT 1"
|
|
$conname send "ECHO 2"
|
|
|
|
set path /sics/${name}/values
|
|
hsetprop $path read el737readvalues
|
|
hsetprop $path el737val el737val
|
|
$conname poll $path 60
|
|
|
|
set path /sics/${name}/status
|
|
hsetprop $path read el737readstatus
|
|
hsetprop $path el737status el737status
|
|
hsetprop $path el737statval el737statval
|
|
hsetprop $path el737statread el737statread
|
|
hsetprop $path moncount 0
|
|
$conname poll $path 60
|
|
|
|
set path /sics/${name}/control
|
|
hsetprop $path write el737control
|
|
hsetprop $path el737cmdreply el737cmdreply
|
|
$conname write $path
|
|
|
|
hfactory /sics/${name}/thresholdcounter plain mugger int
|
|
hsetprop /sics/${name}/thresholdcounter __save true
|
|
set path /sics/${name}/threshold
|
|
hfactory $path plain mugger float
|
|
hsetprop $path write el737threshsend
|
|
hsetprop $path el737threshrcv el737threshrcv
|
|
hsetprop $path el737cmdreply el737cmdreply
|
|
$conname write $path
|
|
hsetprop $path read el737threshread
|
|
hsetprop $path el737thresh el737thresh
|
|
# $conname poll $path 60
|
|
|
|
$conname debug -1
|
|
|
|
}
|