- Updated drivers for delta tau, dornier choppers

- Fixed scan mode issue in hdbutil.tcl
- Added driver for the FOCUS Pfeiffer vacuum thing

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
@@ -215,6 +229,7 @@ proc astchopcheckphase {chopper} {
     chocosct queue /sics/choco/asyst progress read
     set p2 [hval /sics/choco/${chopper}/dphas]
     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 p1 [hval /sics/choco/${ch1}/aspee]
-    set p2 [hval /sics/choco/chopper2/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 
+}

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, March 2009
-# 
-#
-# Mark Koennecke, December 2008
 #---------------------------------------------------------------
 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
+    hsetprop /sics/${name}/hardupperlim read "sendpmaclim I${num}13"
-    configurePMACPar $name hardupperlim "Q${num}08" $sct
+    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 \
+    set parlist [list scale_factor  hardposition  maxspeed \
-		 commandspeed maxaccel offset axisstatus axiserror status]
+		 commandspeed maxaccel offset axisstatus axiserror status poshwlimitactive \
+		  neghwlimitactive liftaircushion hardlowerlim hardupperlim]
     foreach par $parlist {
 	$sct queue /sics/$name/$par progress read
     } 
 }
-#===============================================================================
-# Old stuff
-#===============================================================================

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

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  <initValue>\n"
+            append result "$prefix    $val\n"
+            append result "$prefix  </initValue>\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} {
+#    append result [makeInitValue $path $type $prefix]
-	set test [catch {hgetprop $path transfer} msg]
-	set tst [catch {hval $path} val]
-	if {$test != 0 &&  $tst == 0} {
-	    append result "$prefix  <initValue>\n"
-            append result "$prefix    $val\n"
-            append result "$prefix  </initValue>\n"
-	}
-    }
     append result  "$prefix</component>\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 {
+proc scan args {
-    if {[llength $argv] < 1} {
+    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} {
+	    if {[llength $args] > 1} {
-		return [counter setmode [lindex $argv 1]]
+		return [counter setmode [lindex $args 1]]
 	    } else {
 		return [counter getmode]
 	    }

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 <lf>
+# Pfeiffer: <ACK> or <NACK> <cr><lf>
+# It gets involved when a parameter is requested. Then it looks 
+# like this:
+# Host: command <lf> 
+# Pfeiffer: <ACK>or <NACK> <cr><lf>
+# Host: <ENQ>
+# Pfeiffer: something,value <cr><lf>
+#
+# 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 "<ENQ>"
+    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