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

- Fixed various Tcl drivers at startup

Browse Source 
- Added a sinqhttp driver for the second generation HM object
This commit is contained in:
koennecke
2009-05-15 13:26:35 +00:00
parent a6123932a6
commit c096594d43
5 changed files with 182 additions and 22 deletions
Download Patch File Download Diff File Expand all files Collapse all files

34
tcl/deltatau.tcl
View File

@ -66,6 +66,10 @@ proc translateAxisError {key} {
}
#---------------------------------------------------------------------
proc evaluateAxisStatus {key} {
#----- Tcl does not like negative numbers as keys.
if {$key < 0} {
set key [expr 50 + abs($key)]
}
switch $key {
0 -
14 {return idle}
@ -80,12 +84,12 @@ proc evaluateAxisStatus {key} {
9 -
10 -
11 {return run}
-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"}
56 {error "Controller aborted"}
55 {error "Axis is deactivated"}
54 {error "emergency stop activated, please release"}
53 {error "Axis inhibited"}
51 -
52 {error "Incoming command is blocked"}
}
}
#-----------------------------------------------------------------------
@ -173,7 +177,7 @@ proc pmacsendaxerr {num} {
proc pmacrcvaxerr {motname num} {
set status [catch {checkpmacresult} data]
if {$status != 0} {
sct print "ERROR: $data"
clientput "ERROR: $data"
sct update error
sct geterror $data
return idle
@ -182,10 +186,10 @@ proc pmacrcvaxerr {motname num} {
if {$data != 0 } {
set err [translateAxisError $data]
if {[string first following $err] >= 0} {
sct print "WARNING: $err"
clientput "WARNING: $err"
sct update poserror
} else {
sct print "ERROR: $err"
clientput "ERROR: $err"
sct update error
}
return idle
@ -198,7 +202,7 @@ proc pmacrcvaxerr {motname num} {
proc pmacrcvpos {motname num} {
set status [catch {checkpmacresult} data]
if {$status != 0} {
sct print "ERROR: $data"
clientput "ERROR: $data"
sct geterror $data
sct update error
return idle
@ -211,7 +215,7 @@ proc pmacrcvpos {motname num} {
proc pmacrcvstat {motname num sct} {
set status [catch {checkpmacresult} data]
if {$status != 0} {
sct print "ERROR: $data"
clientput "ERROR: $data"
sct update error
return idle
}
@ -253,7 +257,7 @@ proc pmacsendhardpos {motname num} {
proc pmacrcvhardpos {num} {
set status [catch {checkpmacresult} data]
if {$status != 0} {
sct print "ERROR: $data"
clientput "ERROR: $data"
sct seterror $data
return idle
}
@ -264,13 +268,13 @@ proc pmacrcvhardpos {num} {
proc pmacrcvhardax {motname num sct} {
set status [catch {checkpmacresult} data]
if {$status != 0} {
sct print "ERROR: $data"
clientput "ERROR: $data"
sct seterror $data
return idle
}
set status [catch {evaluateAxisStatus $data} msg]
if {$status != 0} {
sct print "ERROR: $msg"
clientput "ERROR: $msg"
sct seterror $msg
return idle
}
@ -303,6 +307,7 @@ proc pmacrefrun {motorname sct num} {
$sct send "M${num}=9"
hupdate /sics/${motorname}/status run
set motstat run
wait 3
while {[string compare $motstat run] == 0} {
$sct queue $path progress read
wait 1
@ -344,6 +349,7 @@ proc MakeDeltaTau {name sct num} {
set parlist [list scale_factor hardposition maxspeed \
commandspeed maxaccel offset axisstatus axiserror status poshwlimitactive \
neghwlimitactive liftaircushion hardlowerlim hardupperlim]
$sct send [format "M%2.2d14=0" $num]
foreach par $parlist {
$sct queue /sics/$name/$par progress read
}

9
tcl/el737sec.tcl
View File

@ -51,7 +51,14 @@ proc el737cmdreply {} {
set status [catch {el737error $reply} err]
if {$status != 0} {
sct geterror $err
sct print "ERROR: $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
}

2
tcl/hdbutil.tcl
View File

@ -852,7 +852,7 @@ proc sscan args {
#--------- do scan parameters
append scanvars $var ","
append scanstarts $start ","
set step [expr double($end - $start)/double($np)]
set step [expr double($end - $start)/double($np-1)]
append scansteps $step ","
}
#------------- set lastcommand text

12
tcl/pfeiffer.tcl
View File

@ -38,10 +38,10 @@ 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 send "SEN ,2,2,2,2,0,0"
sct utime devon
} else {
sct send "SEN_,1,1,1,1,0,0"
sct send "SEN ,1,1,1,1,0,0"
}
return pfiffstatereply
}
@ -106,7 +106,7 @@ foreach p $pfiffpar {
incr count
}
hfactory /sics/pfiff/state plain user text
hfactory /sics/pfiff/state plain spy text
hupdate /sics/pfiff/state off
hsetprop /sics/pfiff/state values on,off
hsetprop /sics/pfiff/state write pfiffstate
@ -121,8 +121,8 @@ proc pfiffread {num} {
#--------------------------------------------------------
proc vac {} {
global pfiffpar
set test [pfiffread 1]
if {[string first off $test] > 0} {
set test [hval /sics/pfiff/state]
if {[string first off $test] >= 0} {
hset /sics/pfiff/state on
foreach p $pfiffpar {
pfiffsct queue /sics/pfiff/$p progress read
@ -135,4 +135,4 @@ proc vac {} {
append result "Sample chamber : " [pfiffread 4] "\n"
return $result
}
Publish vac Spy
Publish vac User

147
tcl/sinqhttp.tcl Normal file
View File

@ -0,0 +1,147 @@
#--------------------------------------------------------
# This is an asynchronous scriptcontext driven driver for
# the SINQ style http based histogram memory.
#
# script chains:
# -- control
# hmhttpcontrol - hmhttpreply
# -- data
# hmhttpdata - hmhttpreply
# -- status
# hmhttpstatus - hmhttpevalstatus -- hmhttpstatusdata
#
# copyright: see file COPYRIGHT
#
# Mark Koennecke, May 2009
#---------------------------------------------------------
proc hmhttpsend {url} {
sct send $url
return hmhttpreply
}
#--------------------------------------------------------
proc hmhttptest {data} {
if {[string first ASCERR $data] >= 0} {
error $data
}
if {[string first ERROR $data] >= 0} {
error $data
}
return $data
}
#--------------------------------------------------------
proc hmhttpreply {} {
set reply [sct result]
set status [catch {hmhttptest $reply} data]
if {$status != 0} {
sct geterror $data
clientput $data
} else {
hdelprop [sct] geterror
}
return idle
}
#---------------------------------------------------------
proc hmhttpcontrol {} {
set target [sct target]
switch $target {
1000 {
set ret [hmhttpsend "/admin/startdaq.egi"]
set path [file dirname [sct]]
[sct controller] queue $path/status progress read
return $ret
}
1001 {return [hmhttpsend "/admin/stopdaq.egi"] }
1002 {return [hmhttpsend "/admin/pausedaq.egi"] }
1003 {return [hmhttpsend "/admin/continuedaq.egi"]}
1005 {
set path [file dirname [sct]]
set script [hval $path/initscript]
set confdata [eval $script]
return [hmhttpsend "post:/admin/configure.egi:$confdata"]
}
default {
sct print "ERROR: bad start target $target given to control"
return idle
}
}
}
#---------------------------------------------------------
proc hmhttpdata {name} {
set len [hval /sics/${name}/datalength]
set path "/sics/${name}/data"
set com [format "node:%s:/admin/readhmdata.egi?bank=0&start=0&end=%d" $path $len]
sct send $com
return hmhttpdatareply
}
#--------------------------------------------------------
proc hmhttpdatareply {} {
set status [catch {hmhttpreply} txt]
if {$status == 0} {
set path [file dirname [sct]]
hdelprop $path/data geterror
}
return idle
}
#--------------------------------------------------------
proc hmhttpstatus {} {
sct send /admin/textstatus.egi
return hmhttpevalstatus
}
#-------------------------------------------------------
proc hmhttpstatusdata {} {
catch {hmhttpdatareply}
sct update idle
return idle
}
#---------------------------------------------------------
proc hmhttpevalstatus {name} {
set reply [sct result]
set status [catch {hmhttptest $reply} data]
if {$status != 0} {
sct geterror $data
clientput $data
sct update error
return idle
}
hdelprop [sct] geterror
set lines [split $data \n]
foreach line $lines {
set ld [split $line :]
sct [string trim [lindex $ld 0]] [string trim [lindex $ld 1]]
}
set daq [sct DAQ]
set old [hval [sct]]
if {$daq == 1} {
sct update run
[sct controller] queue [sct] progress read
return idle
} else {
if {[string compare $old idle] != 0} {
hmhttpdata $name
return hmhttpstatusdata
} else {
return idle
}
}
}
#---------------------------------------------------------
proc MakeHTTPHM {name rank host initscript {tof NULL} } {
sicsdatafactory new ${name}transfer
makesctcontroller ${name}sct sinqhttp $host ${name}transfer 600 spy 007
MakeSecHM $name $rank $tof
hsetprop /sics/${name}/control write hmhttpcontrol
hsetprop /sics/${name}/control hmhttpreply hmhttpreply
${name}sct write /sics/${name}/control
hsetprop /sics/${name}/data read hmhttpdata $name
hsetprop /sics/${name}/data hmhttpdatareply hmhttpdatareply
${name}sct poll /sics/${name}/data 120
hsetprop /sics/${name}/status read hmhttpstatus
hsetprop /sics/${name}/status hmhttpevalstatus hmhttpevalstatus $name
hsetprop /sics/${name}/status hmhttpstatusdata hmhttpstatusdata
${name}sct poll /sics/${name}/status 60
hfactory /sics/${name}/initscript plain mugger text
hset /sics/${name}/initscript $initscript
}