diff --git a/tcl/astrium.tcl b/tcl/astrium.tcl
index 8c7385e9..29bd114e 100644
--- a/tcl/astrium.tcl
+++ b/tcl/astrium.tcl
@@ -17,6 +17,19 @@
# chopperlonglist must be aligned.
#
# Mark Koennecke, February 2009
+#
+# If something goes wrong with this, the following things ought
+# to be checked:
+# - Is the standard Tcl scan command been properly renamed to stscan?
+# - Is a communication possible with the chopper via telnet?
+# This may not be the case because of other SICS servers blocking
+# things or the old driver being active and capturing the terminal
+# server port in SerPortServer. Scriptcontext then fails silently.
+# But may be we will fix the latter.
+# - The other thing which happens is that the parameter list of
+# the chopper differs in little ways between instances.
+#
+# Mark Koennecke, April 2009
#--------------------------------------------------------------
MakeSICSObj choco AstriumChopper
#-------------------------------------------------------------
@@ -34,14 +47,14 @@ proc astriumchopperputerror {txt} {
# separated by ;
#---------------------------------------------------------------
proc astriumsplitreply {chopper reply} {
- set parlist [split $reply ";"]
+ set parlist [split [string trim $reply] ";"]
foreach par $parlist {
catch {stscan $par "%s %s" token val} count
if {[string first ERROR $count] < 0 && $count == 2} {
set val [string trim $val]
set token [string trim $token]
catch {hupdate /sics/choco/${chopper}/${token} $val}
- hdelprop /sics/choco/${chopper}/${token} geterror
+ catch {hdelprop /sics/choco/${chopper}/${token} geterror}
} else {
#-------- special fix for dphas and averl
if {[string first dphas $par] >= 0} {
@@ -123,7 +136,7 @@ proc astriumMakeChopperParameters {} {
hfactory /sics/choco/${chopper} plain spy none
foreach par $chopperparlist {
set path /sics/choco/${chopper}/${par}
- hfactory $path plain user text
+ hfactory $path plain internal text
chocosct connect $path
}
}
@@ -131,9 +144,9 @@ proc astriumMakeChopperParameters {} {
hsetprop /sics/choco/asyst read astchopread
hsetprop /sics/choco/asyst astchoppar readastriumchopperpar
hfactory /sics/choco/stop plain user int
-# chocosct poll /sics/choco/asyst 60
+ chocosct poll /sics/choco/asyst 60
#--------- This is for debugging
- chocosct poll /sics/choco/asyst 10
+# chocosct poll /sics/choco/asyst 10
}
#=================== write support ==============================
proc astchopwrite {prefix} {
@@ -201,6 +214,7 @@ proc astchopcheckspeed {chopper} {
set p2 /sics/choco/${chopper}/aspee
set tst [astchopcompare $p1 $p2 50]
if {$tst == 1 } {
+ wait 1
return idle
} else {
return busy
@@ -214,7 +228,8 @@ proc astchopcheckphase {chopper} {
}
chocosct queue /sics/choco/asyst progress read
set p2 [hval /sics/choco/${chopper}/dphas]
- if {abs($p2) < .03} {
+ if {abs($p2) < .03} {
+ wait 1
return idle
} else {
return busy
@@ -222,23 +237,27 @@ proc astchopcheckphase {chopper} {
}
#---------------------------------------------------------------------
proc astchopcheckratio {} {
+ global choppers
set stop [hval /sics/choco/stop]
if {$stop == 1} {
return fault
}
+ set ch1 [lindex $choppers 0]
+ set ch2 [lindex $choppers 1]
chocosct queue /sics/choco/asyst progress read
- set p1 [hval /sics/choco/chopper1/aspee]
- set p2 [hval /sics/choco/chopper2/aspee]
+ set p1 [hval /sics/choco/${ch1}/aspee]
+ set p2 [hval /sics/choco/${ch2}/aspee]
set target [sct target]
if {$p2 < 10} {
return busy
}
- if {abs($p1/$ps - $target*1.) < .3} {
+ if {abs($p1/$p2 - $target*1.) < .3} {
set tst 1
} else {
set tst 0
}
if {$tst == 1 } {
+ wait 1
return idle
} else {
return busy
@@ -377,7 +396,7 @@ proc chosta {} {
append line [format "%-20s " ""]
set count 1
foreach ch $choppers {
- append line [format "%-20s " "Chopper $count"]
+ append line [format "%-20s " $ch]
incr count
}
append result $line "\n"
@@ -398,7 +417,9 @@ proc chosta {} {
return $result
}
#======================= Configuration Section ==========================
-set amor 1
+set amor 0
+set poldi 1
+set focus 0
if {$amor == 1} {
set choppers [list chopper1 chopper2]
@@ -410,13 +431,63 @@ if {$amor == 1} {
set chopperheader "AMOR Chopper Status"
makesctcontroller chocosct std psts224:3014 "\r\n" 60
# makesctcontroller chocosct std localhost:8080 "\r\n" 60
- chocosct debug 0
+ chocosct debug -1
set maxspeed 5000
set minphase 0
astriumMakeChopperParameters
astMakeChopperSpeed1 chopperspeed
-# astMakeChopperRatio chratio
astMakeChopperPhase2 chopper2phase
Publish chosta Spy
}
+#----------------------------- POLDI -----------------------------------------
+if {$poldi == 1} {
+
+ proc poldiastchopphaselimit {} {
+ set val [sct target]
+ if {$val < 80 || $val > 100} {
+ error "chopper phase out of range"
+ }
+ return OK
+ }
+
+ set choppers [list chopper]
+ set chopperparlist [list amode aspee nspee nphas dphas averl ratio vibra t_cho \
+ flowr vakum valve sumsi spver state]
+ set chopperlonglist [list "Chopper Mode" "Actual Speed" "Set Speed" "Phase" "Phase Error" \
+ "Loss Current" Ratio Vibration Temperature "Water Flow" Vakuum \
+ Valve Sumsi]
+ set chopperheader "POLDI Chopper Status"
+ makesctcontroller chocosct std psts240:3005 "\r\n" 60
+# makesctcontroller chocosct std localhost:8080 "\r\n" 60
+ chocosct debug -1
+ set maxspeed 15000
+ set minphase 80
+ astriumMakeChopperParameters
+ astMakeChopperSpeed1 chopperspeed
+ astMakeChopperPhase1 chopperphase
+ hsetprop /sics/choco/chopper/phase checklimit poldiastchopphaselimit
+ Publish chosta Spy
+}
+#----------------------------- FOCUS -----------------------------------------------------
+if {$focus == 1} {
+ set choppers [list fermi disk]
+ set chopperparlist [list state amode aspee nspee nphas dphas averl ratio vibra t_cho \
+ durch vakum valve sumsi]
+ set chopperlonglist [list "Chopper State" "Chopper Mode" "Actual Speed" "Set Speed" \
+ "Phase" "Phase Error" \
+ "Loss Current" Ratio Vibration Temperature "Water Flow" \
+ Vakuum Valve Sumsi]
+ set chopperheader "FOCUS Chopper Status"
+ makesctcontroller chocosct std psts227:3008 "\r\n" 60
+# makesctcontroller chocosct std localhost:8080 "\r\n" 60
+ chocosct debug 0
+ set maxspeed 20000
+ set minphase 0
+ astriumMakeChopperParameters
+ astMakeChopperSpeed1 fermispeed
+ astMakeChopperSpeed2 diskspeed
+ astMakeChopperRatio ratio
+ astMakeChopperPhase2 phase
+ Publish chosta Spy
+}
diff --git a/tcl/deltatau.tcl b/tcl/deltatau.tcl
index 872d4c7c..94f17097 100644
--- a/tcl/deltatau.tcl
+++ b/tcl/deltatau.tcl
@@ -7,6 +7,8 @@
# sendpmacread code -- pmacreadreply
# -- For setting standard parameters
# sendpmacwrite code -- pmacreadreply
+# -- For reading limits
+# sendpmaclim -- readpmaclim
# -- For reading the status
# pmacsendaxer --- pmacrcvaxerr -- pmacrcvpos -- pmacrcvstat
# This means we check for an axis error first, then update the position,
@@ -18,10 +20,7 @@
#
# copyright: see file COPYRIGHT
#
-# TODO: after axiserror: terminate, when OK, again error where from
-#
-#
-# Mark Koennecke, December 2008
+# Mark Koennecke, December 2008, March 2009
#---------------------------------------------------------------
proc translatePMACError {key} {
set pmacerr(ERR001) "Command not allowed while executing"
@@ -61,6 +60,7 @@ proc translateAxisError {key} {
10 {return "MCU lim reached"}
11 {return "following error triggered"}
12 {return "EMERGENCY STOP ACTIVATED"}
+ 13 {return "Driver electronics error"}
default { return "Unknown axis error $key"}
}
}
@@ -80,7 +80,9 @@ proc evaluateAxisStatus {key} {
9 -
10 -
11 {return run}
- -4 {error "emergency status activated"}
+ -6 {error "Controller aborted"}
+ -5 {error "Axis is deactivated"}
+ -4 {error "emergency stop activated, please release"}
-3 {error "Axis inhibited"}
- 1
-2 {error "Incoming command is blocked"}
@@ -112,6 +114,22 @@ proc pmacreadreply {} {
}
return idle
}
+#----------------------------------------------------------------------
+proc sendpmaclim {code} {
+ sct send $code
+ return pmacreadlim
+}
+#-----------------------------------------------------------------------
+proc pmacreadlim {motname} {
+ set status [catch {checkpmacresult} data]
+ if {$status != 0} {
+ sct geterror $data
+ } else {
+ set scale [hval /sics/${motname}/scale_factor]
+ sct update [expr $data * $scale]
+ }
+ return idle
+}
#------------------------------------------------------------------------
proc sendpmacwrite {code} {
set value [sct target]
@@ -228,7 +246,7 @@ proc configurePMACStatus {motname num sct} {
proc pmacsendhardpos {motname num} {
hupdate /sics/$motname/status run
set value [sct target]
- sct send "Q${num}01=$value M${num}=1"
+ sct send [format "P%2.2d23=0 Q%2.2d01=%12.4f M%2.2d=1" $num $num $value $num]
return rcvhardpos
}
#-------------------------------------------------------------------------
@@ -295,8 +313,16 @@ proc pmacrefrun {motorname sct num} {
#--------------------------------------------------------------------------
proc MakeDeltaTau {name sct num} {
MakeSecMotor $name
- configurePMACPar $name hardlowerlim "Q${num}09" $sct
- configurePMACPar $name hardupperlim "Q${num}08" $sct
+ hsetprop /sics/${name}/hardupperlim read "sendpmaclim I${num}13"
+ hsetprop /sics/${name}/hardupperlim pmacreadlim "pmacreadlim $name"
+ $sct poll /sics/${name}/hardupperlim 180
+ hsetprop /sics/${name}/hardlowerlim read "sendpmaclim I${num}14"
+ hsetprop /sics/${name}/hardlowerlim pmacreadlim "pmacreadlim $name"
+ $sct poll /sics/${name}/hardlowerlim 180
+
+# configurePMACPar $name hardlowerlim "Q${num}09" $sct
+# configurePMACPar $name hardupperlim "Q${num}08" $sct
+
configurePMACPar $name hardposition "Q${num}10" $sct
configurePMAChardwrite $name $num $sct
hfactory /sics/$name/numinmcu plain internal int
@@ -309,15 +335,16 @@ proc MakeDeltaTau {name sct num} {
makePMACPar $name offset "Q${num}07" $sct mugger
makePMACPar $name axisstatus "P${num}00" $sct internal
makePMACPar $name axiserror "P${num}01" $sct internal
+ makePMACPar $name poshwlimitactive "M${num}21" $sct internal
+ makePMACPar $name neghwlimitactive "M${num}22" $sct internal
+ makePMACPar $name liftaircushion "M${num}96" $sct internal
configurePMACStatus $name $num $sct
$name makescriptfunc halt "pmacHalt $sct $num" user
$name makescriptfunc refrun "pmacrefrun $name $sct $num" user
- set parlist [list hardlowerlim hardupperlim hardposition scale_factor maxspeed \
- commandspeed maxaccel offset axisstatus axiserror status]
+ set parlist [list scale_factor hardposition maxspeed \
+ commandspeed maxaccel offset axisstatus axiserror status poshwlimitactive \
+ neghwlimitactive liftaircushion hardlowerlim hardupperlim]
foreach par $parlist {
$sct queue /sics/$name/$par progress read
}
}
-#===============================================================================
-# Old stuff
-#===============================================================================
diff --git a/tcl/el737sec.tcl b/tcl/el737sec.tcl
index 785247fe..7316d75d 100644
--- a/tcl/el737sec.tcl
+++ b/tcl/el737sec.tcl
@@ -9,6 +9,7 @@
# start: el737sendstart - el737cmdreply
# pause,cont, stop: el737sendcmd - el737cmdreply
# status: el737readstatus - el737status
+# \ el737statval - el737statread
# values: el737readvalues - el737val
# threshold write: el737threshsend - el737threshrcv - el737cmdreply
#
@@ -62,7 +63,7 @@ proc sctroot {} {
#----------------------------------------------------
proc el737sendstart {} {
set obj [sctroot]
- set mode [string trim [hval $obj/mode]]
+ set mode [string tolower [string trim [hval $obj/mode]]]
set preset [string trim [hval $obj/preset]]
hdelprop [sct] geterror
switch $mode {
@@ -105,6 +106,17 @@ proc el737readstatus {} {
sct send RS
return el737status
}
+#-------------------------------------------------
+proc el737statval {} {
+ el737readvalues
+ return el737statread
+}
+#-------------------------------------------------
+proc el737statread {} {
+ el737val
+ sct update idle
+ return idle
+}
#--------------------------------------------------
proc el737status {} {
set reply [sct result]
@@ -119,7 +131,7 @@ proc el737status {} {
set con [sct controller]
switch [string trim $reply] {
0 {
- sct update idle
+ return el737statval
}
1 -
2 {
@@ -170,13 +182,13 @@ proc el737val {} {
set root [sctroot]
if {[llength $l] > 5} {
set l2 [lrange $l 1 end]
- sct update [join $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]
- sct update [join $l2]
+ hupdate ${root}/values [join $l2]
set time [lindex $l $last]
hupdate ${root}/time $time
}
@@ -229,6 +241,7 @@ proc el737thresh {} {
if {$status != 0} {
sct geterror $err
sct print "ERROR: $err"
+ return idle
}
stscan $reply "%f" val
sct update $val
@@ -255,6 +268,8 @@ proc MakeSecEL737 {name netaddr} {
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
@@ -264,7 +279,7 @@ proc MakeSecEL737 {name netaddr} {
$conname write $path
hfactory /sics/${name}/thresholdcounter plain mugger int
- hseprop /sics/${name}/thresholdcounter __save true
+ hsetprop /sics/${name}/thresholdcounter __save true
set path /sics/${name}/threshold
hfactory $path plain mugger float
hsetprop $path write el737threshsend
diff --git a/tcl/hdbutil.tcl b/tcl/hdbutil.tcl
index 50086b52..1ff6ec7d 100644
--- a/tcl/hdbutil.tcl
+++ b/tcl/hdbutil.tcl
@@ -88,6 +88,20 @@ proc hcommand {path script} {
proc getdataType {path} {
return [lindex [split [hinfo $path] ,] 0]
}
+#---------------------------------------------------------------------
+proc makeInitValue {path type prefix} {
+ append result ""
+ if {[string compare $type none] != 0 && [string compare $type func] != 0} {
+ set test [catch {hgetprop $path transfer} msg]
+ set tst [catch {hval $path} val]
+ if {$test != 0 && $tst == 0} {
+ append result "$prefix \n"
+ append result "$prefix $val\n"
+ append result "$prefix \n"
+ }
+ }
+ return $result
+}
#----------------------------------------------------------------------
proc make_nodes {path result indent} {
set nodename [file tail $path];
@@ -105,15 +119,7 @@ proc make_nodes {path result indent} {
foreach x [hlist $path] {
set result [make_nodes [string map {// /} "$path/$x"] $result $newIndent]
}
- if {[string compare $type none] != 0 && [string compare $type func] != 0} {
- set test [catch {hgetprop $path transfer} msg]
- set tst [catch {hval $path} val]
- if {$test != 0 && $tst == 0} {
- append result "$prefix \n"
- append result "$prefix $val\n"
- append result "$prefix \n"
- }
- }
+# append result [makeInitValue $path $type $prefix]
append result "$prefix\n"
}
return $result
@@ -890,16 +896,16 @@ proc scaninfo {} {
append result "," [lindex $vl 2]
append result "," [SplitReply [xxxscan getfile]]
append result "," [SplitReply [sample]]
- append result "," sicstime
+ append result "," [sicstime]
append result "," [SplitReply [lastscancommand]]
return $result
}
#-------------------------------------------------------------
-proc scan argv {
- if {[llength $argv] < 1} {
+proc scan args {
+ if {[llength $args] < 1} {
error "Need keyword for scan"
}
- set key [string trim [lindex $argv 0]]
+ set key [string trim [lindex $args 0]]
switch $key {
uuinterest { return [xxxscan uuinterest] }
pinterest {}
@@ -907,8 +913,8 @@ proc scan argv {
return "scan.Counts = $cts"
}
mode {
- if {[llength $argv] > 1} {
- return [counter setmode [lindex $argv 1]]
+ if {[llength $args] > 1} {
+ return [counter setmode [lindex $args 1]]
} else {
return [counter getmode]
}
diff --git a/tcl/pfeiffer.tcl b/tcl/pfeiffer.tcl
new file mode 100644
index 00000000..76db404d
--- /dev/null
+++ b/tcl/pfeiffer.tcl
@@ -0,0 +1,138 @@
+#---------------------------------------------------------
+# This is a new asynchronous driver for the Pfeiffer
+# Vacuum measurement device. This driver has been redone
+# in order to better integrate it into the Hipadaba tree
+# at FOCUS.
+#
+# The pfeiffer device is somewhat shitty in that it cannot
+# be switched on all the time. What is implemented now is
+# this: the looser has to switch the thing on via the state
+# field. After that values are read any 2 minutes. After 20
+# minutes the thing switches itself off again.
+#
+# Then there is a funny protocol. A normal command is easy:
+# Host: command
+# Pfeiffer: or
+# It gets involved when a parameter is requested. Then it looks
+# like this:
+# Host: command
+# Pfeiffer: or
+# Host:
+# Pfeiffer: something,value
+#
+# The script chains:
+# pfiffstate - pfiffstatereply
+# pfiffreadsensor - pfiffenq - pfiffreply
+#
+# copyright: see file COPYRIGHT
+#
+# Mark Koennecke, March 2009
+#---------------------------------------------------------
+MakeSICSObj pfiff Vacuum
+#makesctcontroller pfiffsct pfeiffer localhost:8080
+makesctcontroller pfiffsct pfeiffer $ts:3009
+#pfiffsct debug -1
+set pfiffpar [list Antitrumpet Be-filter Flightpath Sample-Chamber]
+
+#-----------------------------------------------------
+proc pfiffstate {} {
+ set val [sct target]
+ if {[string compare $val on] == 0} {
+ sct send "SEN_,2,2,2,2,0,0"
+ sct utime devon
+ } else {
+ sct send "SEN_,1,1,1,1,0,0"
+ }
+ return pfiffstatereply
+}
+#----------------------------------------------------
+proc pfiffstatereply {} {
+ sct update [sct target]
+ return idle
+}
+#------------------------------------------------------
+# This tests for the state being off
+# This also tests if the device has been on for more
+# then 20 minutes. If so it is switched off
+#------------------------------------------------------
+proc pfiffreadsensor {num} {
+ set test [hval /sics/pfiff/state]
+ if {[string compare $test off] == 0} {
+ sct update "sensor off"
+ return idle
+ }
+ set time [hgetpropval /sics/pfiff/state devon]
+ if {[clock seconds] > $time + 20*60} {
+ hset /sics/pfiff/state off
+ return idle
+ }
+ if {$num < 5} {
+ sct send [format "PR%1.1d" $num]
+ return pfiffenq
+ } else {
+ return idle
+ }
+}
+#-------------------------------------------------------
+proc pfiffenq {} {
+ sct send ""
+ return pfiffreply
+}
+#-------------------------------------------------------
+proc pfiffreply {} {
+ set reply [sct result]
+ if {[string first ERR $reply] >= 0 ||
+ [string first ASCER $reply] >= 0} {
+ sct geterror $reply
+ return idle
+ }
+ set l [split $reply ,]
+ sct update [lindex $l 1]
+ hdelprop [sct] geterror
+ return idle
+}
+#--------------------------------------------------------
+proc pfiffidle {} {
+ return idle
+}
+#---------------------------------------------------------
+set count 1
+foreach p $pfiffpar {
+ hfactory /sics/pfiff/$p plain internal text
+ hsetprop /sics/pfiff/$p read "pfiffreadsensor $count"
+ hsetprop /sics/pfiff/$p pfiffenq pfiffenq
+ hsetprop /sics/pfiff/$p pfiffreply pfiffreply
+ pfiffsct poll /sics/pfiff/$p 120
+ incr count
+}
+
+hfactory /sics/pfiff/state plain user text
+hupdate /sics/pfiff/state off
+hsetprop /sics/pfiff/state values on,off
+hsetprop /sics/pfiff/state write pfiffstate
+hsetprop /sics/pfiff/state pfiffstatereply pfiffstatereply
+pfiffsct write /sics/pfiff/state
+#------------------------------------------------------
+proc pfiffread {num} {
+ global pfiffpar
+ set par [lindex $pfiffpar [expr $num -1]]
+ return [hval /sics/pfiff/$par]
+}
+#--------------------------------------------------------
+proc vac {} {
+ global pfiffpar
+ set test [pfiffread 1]
+ if {[string first off $test] > 0} {
+ hset /sics/pfiff/state on
+ foreach p $pfiffpar {
+ pfiffsct queue /sics/pfiff/$p progress read
+ }
+ return "Switched Pfeiffer on, try to read again in a couple of seconds"
+ }
+ append result "Antitrumpet : " [pfiffread 1] "\n"
+ append result "Berylium filter : " [pfiffread 2] "\n"
+ append result "Flightpath : " [pfiffread 3] "\n"
+ append result "Sample chamber : " [pfiffread 4] "\n"
+ return $result
+}
+Publish vac Spy
\ No newline at end of file