From c096594d4352a5296e681d16be1a9f22a190097e Mon Sep 17 00:00:00 2001 From: koennecke Date: Fri, 15 May 2009 13:26:35 +0000 Subject: [PATCH] - Fixed various Tcl drivers at startup - Added a sinqhttp driver for the second generation HM object --- tcl/deltatau.tcl | 34 ++++++----- tcl/el737sec.tcl | 9 ++- tcl/hdbutil.tcl | 2 +- tcl/pfeiffer.tcl | 12 ++-- tcl/sinqhttp.tcl | 147 +++++++++++++++++++++++++++++++++++++++++++++++ 5 files changed, 182 insertions(+), 22 deletions(-) create mode 100644 tcl/sinqhttp.tcl diff --git a/tcl/deltatau.tcl b/tcl/deltatau.tcl index 94f17097..59ed3f95 100644 --- a/tcl/deltatau.tcl +++ b/tcl/deltatau.tcl @@ -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 } diff --git a/tcl/el737sec.tcl b/tcl/el737sec.tcl index 7316d75d..0d7280ad 100644 --- a/tcl/el737sec.tcl +++ b/tcl/el737sec.tcl @@ -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 } diff --git a/tcl/hdbutil.tcl b/tcl/hdbutil.tcl index 1ff6ec7d..58aa23e9 100644 --- a/tcl/hdbutil.tcl +++ b/tcl/hdbutil.tcl @@ -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 diff --git a/tcl/pfeiffer.tcl b/tcl/pfeiffer.tcl index 76db404d..6143b752 100644 --- a/tcl/pfeiffer.tcl +++ b/tcl/pfeiffer.tcl @@ -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 \ No newline at end of file +Publish vac User diff --git a/tcl/sinqhttp.tcl b/tcl/sinqhttp.tcl new file mode 100644 index 00000000..675a643e --- /dev/null +++ b/tcl/sinqhttp.tcl @@ -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 +}