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

add Pelican

Browse Source 
r3108 | jgn | 2011-04-20 12:29:55 +1000 (Wed, 20 Apr 2011) | 1 line
This commit is contained in:
Jing Chen
2011-04-20 12:29:55 +10:00
committed by Douglas Clowes
parent 1fa3d21486
commit 22b22ffa25
66 changed files with 10293 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

321
site_ansto/instrument/pelican/config/tasmad/sicscommon/el737sec.tcl Normal file
View File

@@ -0,0 +1,321 @@
#-----------------------------------------------------
# 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
catch {hupdate $obj/status run}
catch {hupdate $obj/values 0 0 0 0 0 0 0 0}
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]
hupdate [sctroot]/RS $reply
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
}
hupdate [sctroot]/RA $reply
set l [split $reply]
set root [sctroot]
if {[llength $l] > 5} {
set l2 [lrange $l 1 end]
set l2 [swapFirst $l2]
catch {hupdate ${root}/values [join $l2]}
catch {set time [lindex $l 0]}
catch {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
hfactory /sics/${name}/RS plain internal int
hfactory /sics/${name}/RA plain internal intvarar 8
$conname debug -1
}