- Added table execution
- Driver for Delta Tau Motor controller
This commit is contained in:
323
tcl/deltatau.tcl
Normal file
323
tcl/deltatau.tcl
Normal file
@ -0,0 +1,323 @@
|
|||||||
|
#---------------------------------------------------------------
|
||||||
|
# These are the scripts for the delta-tau PMAC motor
|
||||||
|
# controller.
|
||||||
|
#
|
||||||
|
# !!!!!!!!! Script Chains !!!!!!!!!!!
|
||||||
|
# -- For reading parameters:
|
||||||
|
# sendpmacread code -- pmacreadreply
|
||||||
|
# -- For setting standard parameters
|
||||||
|
# sendpmacwrite code -- pmacreadreply
|
||||||
|
# -- For reading the status
|
||||||
|
# pmacsendaxer --- pmacrcvaxerr -- pmacrcvpos -- pmacrcvstat
|
||||||
|
# This means we check for an axis error first, then update the position,
|
||||||
|
# then check the axis status itself.
|
||||||
|
# -- For setting the position
|
||||||
|
# pmacsendhardpos -- pmacrcvhardpos -- pmacrcvhardax
|
||||||
|
# This means, we send the positioning command, read the reply and read the
|
||||||
|
# axisstatus until the axis has started
|
||||||
|
#
|
||||||
|
# copyright: see file COPYRIGHT
|
||||||
|
#
|
||||||
|
# TODO: after axiserror: terminate, when OK, again error where from
|
||||||
|
#
|
||||||
|
#
|
||||||
|
# Mark Koennecke, December 2008
|
||||||
|
#---------------------------------------------------------------
|
||||||
|
proc translatePMACError {key} {
|
||||||
|
set pmacerr(ERR001) "Command not allowed while executing"
|
||||||
|
set pmacerr(ERR002) "Password error"
|
||||||
|
set pmacerr(ERR003) "Unrecognized command"
|
||||||
|
set pmacerr(ERR004) "Illegal character"
|
||||||
|
set pmacerr(ERR005) "Command not allowed"
|
||||||
|
set pmacerr(ERR006) "No room in buffer for command"
|
||||||
|
set pmacerr(ERR007) "Buffer already in use"
|
||||||
|
set pmacerr(ERR008) "MACRO auxiliary communication error"
|
||||||
|
set pmacerr(ERR009) "Bad program in MCU"
|
||||||
|
set pmacerr(ERR010) "Both HW limits set"
|
||||||
|
set pmacerr(ERR011) "Previous move did not complete"
|
||||||
|
set pmacerr(ERR012) "A motor is open looped"
|
||||||
|
set pmacerr(ERR013) "A motor is not activated"
|
||||||
|
set pmacerr(ERR014) "No motors"
|
||||||
|
set pmacerr(ERR015) "No valid program in MCU"
|
||||||
|
set pmacerr(ERR016) "Bad program in MCU"
|
||||||
|
set pmacerr(ERR017) "Trying to resume after H or Q"
|
||||||
|
set pmacerr(ERR018) "Invalid operation during move"
|
||||||
|
set pmacerr(ERR019) "Illegal position change command during move"
|
||||||
|
return $pmacerr($key)
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------------
|
||||||
|
proc translateAxisError {key} {
|
||||||
|
switch [string trim $key] {
|
||||||
|
0 {return "no error"}
|
||||||
|
1 { return "limit violation"}
|
||||||
|
2 -
|
||||||
|
3 -
|
||||||
|
4 { return "jog error"}
|
||||||
|
5 {return "command not allowed"}
|
||||||
|
6 {return "watchdog triggered"}
|
||||||
|
7 {return "current limit reached"}
|
||||||
|
8 -
|
||||||
|
9 {return "Air cushion error"}
|
||||||
|
10 {return "MCU lim reached"}
|
||||||
|
11 {return "following error triggered"}
|
||||||
|
12 {return "EMERGENCY STOP ACTIVATED"}
|
||||||
|
default { return "Unknown axis error $key"}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#---------------------------------------------------------------------
|
||||||
|
proc evaluateAxisStatus {key} {
|
||||||
|
switch $key {
|
||||||
|
0 -
|
||||||
|
14 {return idle}
|
||||||
|
1 -
|
||||||
|
2 -
|
||||||
|
3 -
|
||||||
|
4 -
|
||||||
|
5 -
|
||||||
|
6 -
|
||||||
|
7 -
|
||||||
|
8 -
|
||||||
|
9 -
|
||||||
|
10 -
|
||||||
|
11 {return run}
|
||||||
|
-4 {error "emergency status activated"}
|
||||||
|
-3 {error "Axis inhibited"}
|
||||||
|
- 1
|
||||||
|
-2 {error "Incoming command is blocked"}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#-----------------------------------------------------------------------
|
||||||
|
proc checkpmacresult {} {
|
||||||
|
set data [sct result]
|
||||||
|
if {[string first ASCERR $data] >= 0} {
|
||||||
|
error $data
|
||||||
|
}
|
||||||
|
if {[string first ERR $data] >= 0} {
|
||||||
|
error [translatePMACError $data]
|
||||||
|
}
|
||||||
|
return [string trim $data]
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
proc sendpmacread {code} {
|
||||||
|
sct send $code
|
||||||
|
return pmacreadreply
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
proc pmacreadreply {} {
|
||||||
|
set status [catch {checkpmacresult} data]
|
||||||
|
if {$status != 0} {
|
||||||
|
sct geterror $data
|
||||||
|
} else {
|
||||||
|
sct update $data
|
||||||
|
}
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
proc sendpmacwrite {code} {
|
||||||
|
set value [sct target]
|
||||||
|
sct send "$code=$value"
|
||||||
|
return pmacwritereply
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
proc pmacwritereply {} {
|
||||||
|
set status [catch {checkpmacresult} data]
|
||||||
|
if {$status != 0} {
|
||||||
|
sct geterror $data
|
||||||
|
sct print "ERROR: $data"
|
||||||
|
} else {
|
||||||
|
set con [sct controller]
|
||||||
|
$con queue [sct] read read
|
||||||
|
}
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
#-------------------------------------------------------------------------
|
||||||
|
proc configurePMACPar {name par code sct} {
|
||||||
|
set path /sics/$name/$par
|
||||||
|
hsetprop $path read "sendpmacread $code"
|
||||||
|
hsetprop $path pmacreadreply pmacreadreply
|
||||||
|
$sct poll $path 30
|
||||||
|
hsetprop $path write "sendpmacwrite $code"
|
||||||
|
hsetprop $path pmacwritereply pmacwritereply
|
||||||
|
$sct write $path
|
||||||
|
}
|
||||||
|
#-------------------------------------------------------------------------
|
||||||
|
proc makePMACPar {name par code sct priv} {
|
||||||
|
set path /sics/$name/$par
|
||||||
|
hfactory $path plain $priv float
|
||||||
|
configurePMACPar $name $par $code $sct
|
||||||
|
}
|
||||||
|
#========================== status functions =============================
|
||||||
|
proc pmacsendaxerr {num} {
|
||||||
|
sct send "P${num}01"
|
||||||
|
return rcvaxerr
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
proc pmacrcvaxerr {motname num} {
|
||||||
|
set status [catch {checkpmacresult} data]
|
||||||
|
if {$status != 0} {
|
||||||
|
sct print "ERROR: $data"
|
||||||
|
sct update error
|
||||||
|
sct geterror $data
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
hupdate /sics/$motname/axiserror $data
|
||||||
|
if {$data != 0 } {
|
||||||
|
set err [translateAxisError $data]
|
||||||
|
if {[string first following $err] >= 0} {
|
||||||
|
sct print "WARNING: $err"
|
||||||
|
sct update poserror
|
||||||
|
} else {
|
||||||
|
sct print "ERROR: $err"
|
||||||
|
sct update error
|
||||||
|
}
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
hupdate /sics/$motname/axiserror $data
|
||||||
|
sct send "Q${num}10"
|
||||||
|
return rcvpos
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
proc pmacrcvpos {motname num} {
|
||||||
|
set status [catch {checkpmacresult} data]
|
||||||
|
if {$status != 0} {
|
||||||
|
sct print "ERROR: $data"
|
||||||
|
sct geterror $data
|
||||||
|
sct update error
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
hupdate /sics/$motname/hardposition $data
|
||||||
|
sct send "P${num}00"
|
||||||
|
return rcvstat
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
proc pmacrcvstat {motname num sct} {
|
||||||
|
set status [catch {checkpmacresult} data]
|
||||||
|
if {$status != 0} {
|
||||||
|
sct print "ERROR: $data"
|
||||||
|
sct update error
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
set status [catch {evaluateAxisStatus $data} msg]
|
||||||
|
if {$status != 0} {
|
||||||
|
sct update error
|
||||||
|
} else {
|
||||||
|
sct update $msg
|
||||||
|
switch $msg {
|
||||||
|
idle {
|
||||||
|
# force an update of the motor position
|
||||||
|
$sct queue /sics/$motname/hardposition progress read
|
||||||
|
}
|
||||||
|
run {
|
||||||
|
# force an update of ourselves, while running
|
||||||
|
$sct queue /sics/$motname/status progress read
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
#-------------------------------------------------------------------------
|
||||||
|
proc configurePMACStatus {motname num sct} {
|
||||||
|
set path /sics/$motname/status
|
||||||
|
hsetprop $path read "pmacsendaxerr $num"
|
||||||
|
hsetprop $path rcvaxerr "pmacrcvaxerr $motname $num"
|
||||||
|
hsetprop $path rcvpos "pmacrcvpos $motname $num"
|
||||||
|
hsetprop $path rcvstat "pmacrcvstat $motname $num $sct"
|
||||||
|
$sct poll $path 60
|
||||||
|
}
|
||||||
|
#======================= setting hard position ===========================
|
||||||
|
proc pmacsendhardpos {motname num} {
|
||||||
|
hupdate /sics/$motname/status run
|
||||||
|
set value [sct target]
|
||||||
|
sct send "Q${num}01=$value M${num}=1"
|
||||||
|
return rcvhardpos
|
||||||
|
}
|
||||||
|
#-------------------------------------------------------------------------
|
||||||
|
proc pmacrcvhardpos {num} {
|
||||||
|
set status [catch {checkpmacresult} data]
|
||||||
|
if {$status != 0} {
|
||||||
|
sct print "ERROR: $data"
|
||||||
|
sct seterror $data
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
sct send "P${num}00"
|
||||||
|
return rcvhardax
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
proc pmacrcvhardax {motname num sct} {
|
||||||
|
set status [catch {checkpmacresult} data]
|
||||||
|
if {$status != 0} {
|
||||||
|
sct print "ERROR: $data"
|
||||||
|
sct seterror $data
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
set status [catch {evaluateAxisStatus $data} msg]
|
||||||
|
if {$status != 0} {
|
||||||
|
sct print "ERROR: $msg"
|
||||||
|
sct seterror $msg
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
switch $msg {
|
||||||
|
idle {
|
||||||
|
sct send "P${num}00"
|
||||||
|
return rcvhardax
|
||||||
|
}
|
||||||
|
run {
|
||||||
|
$sct queue /sics/$motname/status progress read
|
||||||
|
return idle
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
proc configurePMAChardwrite {motname num sct} {
|
||||||
|
set path /sics/$motname/hardposition
|
||||||
|
hsetprop $path write "pmacsendhardpos $motname $num"
|
||||||
|
hsetprop $path rcvhardpos "pmacrcvhardpos $num"
|
||||||
|
hsetprop $path rcvhardax "pmacrcvhardax $motname $num $sct"
|
||||||
|
}
|
||||||
|
#======================= Halt =============================================
|
||||||
|
proc pmacHalt {sct num} {
|
||||||
|
$sct send "M${num}=8" halt
|
||||||
|
return OK
|
||||||
|
}
|
||||||
|
#==================== Reference Run =======================================
|
||||||
|
proc pmacrefrun {motorname sct num} {
|
||||||
|
set path /sics/${motorname}/status
|
||||||
|
$sct send "M${num}=9"
|
||||||
|
hupdate /sics/${motorname}/status run
|
||||||
|
set motstat run
|
||||||
|
while {[string compare $motstat run] == 0} {
|
||||||
|
$sct queue $path progress read
|
||||||
|
wait 1
|
||||||
|
set motstat [string trim [hval $path]]
|
||||||
|
}
|
||||||
|
return "Done"
|
||||||
|
}
|
||||||
|
#--------------------------------------------------------------------------
|
||||||
|
proc MakeDeltaTau {name sct num} {
|
||||||
|
MakeSecMotor $name
|
||||||
|
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
|
||||||
|
hupdate /sics/$name/numinmcu ${num}
|
||||||
|
makePMACPar $name scale_factor "Q${num}00" $sct mugger
|
||||||
|
makePMACPar $name maxspeed "Q${num}03" $sct mugger
|
||||||
|
makePMACPar $name commandspeed "Q${num}04" $sct mugger
|
||||||
|
makePMACPar $name maxaccel "Q${num}05" $sct mugger
|
||||||
|
makePMACPar $name commandedaccel "Q${num}06" $sct mugger
|
||||||
|
makePMACPar $name offset "Q${num}07" $sct mugger
|
||||||
|
makePMACPar $name axisstatus "P${num}00" $sct internal
|
||||||
|
makePMACPar $name axiserror "P${num}01" $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]
|
||||||
|
foreach par $parlist {
|
||||||
|
$sct queue /sics/$name/$par progress read
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#===============================================================================
|
||||||
|
# Old stuff
|
||||||
|
#===============================================================================
|
202
tcl/hdbutil.tcl
202
tcl/hdbutil.tcl
@ -10,6 +10,8 @@
|
|||||||
# Requirements:
|
# Requirements:
|
||||||
# * the internal scan command xxxscan
|
# * the internal scan command xxxscan
|
||||||
# * scan data to live /graphics/scan_data
|
# * scan data to live /graphics/scan_data
|
||||||
|
#
|
||||||
|
# Many updates, till November 2008, Mark Koennecke
|
||||||
#----------------------------------------------------------------------
|
#----------------------------------------------------------------------
|
||||||
if { [info exists hdbinit] == 0 } {
|
if { [info exists hdbinit] == 0 } {
|
||||||
set hdbinit 1
|
set hdbinit 1
|
||||||
@ -31,10 +33,14 @@ if { [info exists hdbinit] == 0 } {
|
|||||||
Publish makemumopos User
|
Publish makemumopos User
|
||||||
Publish dropmumo User
|
Publish dropmumo User
|
||||||
Publish hdbbatchpath User
|
Publish hdbbatchpath User
|
||||||
|
Publish cscan User
|
||||||
|
Publish sscan User
|
||||||
# Publish hmake Mugger
|
# Publish hmake Mugger
|
||||||
# Publish hmakescript Mugger
|
# Publish hmakescript Mugger
|
||||||
# Publish hlink Mugger
|
# Publish hlink Mugger
|
||||||
# Publish hcommand Mugger
|
# Publish hcommand Mugger
|
||||||
|
Publish hdbstorenexus User
|
||||||
|
Publish scaninfo Spy
|
||||||
}
|
}
|
||||||
#===================================================================
|
#===================================================================
|
||||||
# Configuration commands provided:
|
# Configuration commands provided:
|
||||||
@ -56,6 +62,7 @@ if { [info exists hdbinit] == 0 } {
|
|||||||
# makeevproxy rootpath hdbname devicename
|
# makeevproxy rootpath hdbname devicename
|
||||||
# makemumo rootpath mumoname
|
# makemumo rootpath mumoname
|
||||||
# makeexe
|
# makeexe
|
||||||
|
# confnxhdb path alias pass
|
||||||
#===================== hfactory adapters ==========================
|
#===================== hfactory adapters ==========================
|
||||||
proc hmake {path priv type {len 1}} {
|
proc hmake {path priv type {len 1}} {
|
||||||
hfactory $path plain $priv $type $len
|
hfactory $path plain $priv $type $len
|
||||||
@ -321,7 +328,7 @@ proc hdbscan {scanvars scanstart scanincr np mode preset} {
|
|||||||
set varlist [split $scanvars ,]
|
set varlist [split $scanvars ,]
|
||||||
set startlist [split $scanstart ,]
|
set startlist [split $scanstart ,]
|
||||||
set incrlist [split $scanincr ,]
|
set incrlist [split $scanincr ,]
|
||||||
hset $stdscangraph/scan_variable/name [lindex $varlist 0]
|
catch {hset $stdscangraph/scan_variable/name [lindex $varlist 0]}
|
||||||
set count 0
|
set count 0
|
||||||
foreach var $varlist {
|
foreach var $varlist {
|
||||||
if {[string first / $var] >= 0} {
|
if {[string first / $var] >= 0} {
|
||||||
@ -343,14 +350,14 @@ proc hdbscan {scanvars scanstart scanincr np mode preset} {
|
|||||||
proc hdbprepare {obj userdata } {
|
proc hdbprepare {obj userdata } {
|
||||||
global stdscangraph
|
global stdscangraph
|
||||||
stdscan prepare $obj userdata
|
stdscan prepare $obj userdata
|
||||||
hupdate $stdscangraph/dim
|
catch {hupdate $stdscangraph/dim}
|
||||||
}
|
}
|
||||||
#------------------------------------------------------------------------------
|
#------------------------------------------------------------------------------
|
||||||
proc hdbcollect {obj userobj np} {
|
proc hdbcollect {obj userobj np} {
|
||||||
global stdscangraph
|
global stdscangraph
|
||||||
stdscan collect $obj $userobj $np
|
stdscan collect $obj $userobj $np
|
||||||
hupdate $stdscangraph/scan_variable
|
catch {hupdate $stdscangraph/scan_variable}
|
||||||
hupdate $stdscangraph/counts
|
catch {hupdate $stdscangraph/counts}
|
||||||
}
|
}
|
||||||
#-----------------------------------------------------------------------------
|
#-----------------------------------------------------------------------------
|
||||||
proc gethdbscanvardata {no} {
|
proc gethdbscanvardata {no} {
|
||||||
@ -542,6 +549,7 @@ proc makestdadmin {} {
|
|||||||
hfactory /instrument/experiment/batchpath script "exe batchpath" \
|
hfactory /instrument/experiment/batchpath script "exe batchpath" \
|
||||||
"exe batchpath" text
|
"exe batchpath" text
|
||||||
hsetprop /instrument/experiment/batchpath priv user
|
hsetprop /instrument/experiment/batchpath priv user
|
||||||
|
sicspoll add /instrument/experiment/batchpath hdb 60
|
||||||
}
|
}
|
||||||
#----------------------------------------------------------
|
#----------------------------------------------------------
|
||||||
proc makecount {path} {
|
proc makecount {path} {
|
||||||
@ -688,3 +696,189 @@ proc makeexe {} {
|
|||||||
hfactory $path/execute/file/values script listbatchfiles hdbReadOnly text
|
hfactory $path/execute/file/values script listbatchfiles hdbReadOnly text
|
||||||
sicspoll add $path/execute/file/values hdb 60
|
sicspoll add $path/execute/file/values hdb 60
|
||||||
}
|
}
|
||||||
|
#------------------------------------------------------------------
|
||||||
|
proc confnxhdb {path alias pass} {
|
||||||
|
hsetprop $path nxalias $alias
|
||||||
|
hsetprop $path nxpass $pass
|
||||||
|
}
|
||||||
|
#----------------------------------------------------------------------
|
||||||
|
proc hdbstorenexus args {
|
||||||
|
if {[llength $args] < 2} {
|
||||||
|
error "hdbstorenexus called with insufficient number of arguments"
|
||||||
|
}
|
||||||
|
set path [lindex $args 0]
|
||||||
|
set pass [lindex $args 1]
|
||||||
|
set childlist [split [hlist $path] \n]
|
||||||
|
foreach child $childlist {
|
||||||
|
if {[string length $child] < 1} {
|
||||||
|
continue
|
||||||
|
}
|
||||||
|
set status [catch {hgetpropval $path/$child nxpass} passval]
|
||||||
|
if {$status == 0} {
|
||||||
|
set status [catch {hgetpropval $path/$child nxslab} slabval]
|
||||||
|
# ------- slabbed writing
|
||||||
|
if {$status == 0 && [string first $pass $passval] >= 0} {
|
||||||
|
set slabsizes [eval $slabval [lrange $args 2 end]]
|
||||||
|
nxscript puthdbslab $path/$child [lindex $slabsizes 0] [lindex $slabsizes 1]
|
||||||
|
}
|
||||||
|
#--------- normal writing
|
||||||
|
if {[string first $pass $passval] >= 0} {
|
||||||
|
nxscript puthdb $path/$child
|
||||||
|
}
|
||||||
|
}
|
||||||
|
eval hdbstorenexus $path/$child $pass [lrange $args 2 end]
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#===================== Syntactical sugar around hdbscan ===================
|
||||||
|
# center scan. A convenience scan for the one and only Daniel Clemens
|
||||||
|
# at TOPSI. Scans around a given center point. Requires the scan command
|
||||||
|
# for TOPSI to work.
|
||||||
|
#
|
||||||
|
# another convenience scan:
|
||||||
|
# sscan var1 start end var1 start end .... np preset
|
||||||
|
# scans var1, var2 from start to end with np steps and a preset of preset
|
||||||
|
#
|
||||||
|
# Mark Koennecke, August 1997
|
||||||
|
#
|
||||||
|
# Reworked for hdbscan, Mark Koennecke, November 2008
|
||||||
|
#-----------------------------------------------------------------------------
|
||||||
|
proc cscan { var center delta np preset } {
|
||||||
|
#------ start with some argument checking
|
||||||
|
set t [SICSType $var]
|
||||||
|
if { [string compare $t DRIV] != 0 } {
|
||||||
|
ClientPut [format "ERROR: %s is NOT drivable!" $var]
|
||||||
|
return
|
||||||
|
}
|
||||||
|
set t [SICSType $center]
|
||||||
|
if { [string compare $t NUM] != 0 } {
|
||||||
|
ClientPut [format "ERROR: %s is no number!" $center]
|
||||||
|
return
|
||||||
|
}
|
||||||
|
set t [SICSType $delta]
|
||||||
|
if { [string compare $t NUM] != 0 } {
|
||||||
|
ClientPut [format "ERROR: %s is no number!" $delta]
|
||||||
|
return
|
||||||
|
}
|
||||||
|
set t [SICSType $np]
|
||||||
|
if { [string compare $t NUM] != 0 } {
|
||||||
|
ClientPut [format "ERROR: %s is no number!" $np]
|
||||||
|
return
|
||||||
|
}
|
||||||
|
set t [SICSType $preset]
|
||||||
|
if { [string compare $t NUM] != 0 } {
|
||||||
|
ClientPut [format "ERROR: %s is no number!" $preset]
|
||||||
|
return
|
||||||
|
}
|
||||||
|
set mode [string trim [SplitReply [scan mode]]]
|
||||||
|
#-------- store command in lastscancommand
|
||||||
|
set txt [format "cscan %s %s %s %s %s" $var $center \
|
||||||
|
$delta $np $preset]
|
||||||
|
catch {lastscancommand $txt}
|
||||||
|
#--------- calculate start and do scan
|
||||||
|
set start [expr $center - $np * $delta]
|
||||||
|
set ret [catch {hdbscan $var $start $delta [expr ($np * 2) + 1] $mode $preset} msg]
|
||||||
|
if { $ret != 0} {
|
||||||
|
error $msg
|
||||||
|
} else {
|
||||||
|
return $msg
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#---------------------------------------------------------------------------
|
||||||
|
proc sscan args {
|
||||||
|
scan clear
|
||||||
|
#------- check arguments: the last two must be preset and np!
|
||||||
|
set l [llength $args]
|
||||||
|
if { $l < 5} {
|
||||||
|
ClientPut "ERROR: Insufficient number of arguments to sscan"
|
||||||
|
return
|
||||||
|
}
|
||||||
|
set preset [lindex $args [expr $l - 1]]
|
||||||
|
set np [lindex $args [expr $l - 2]]
|
||||||
|
set t [SICSType $preset]
|
||||||
|
ClientPut $t
|
||||||
|
ClientPut [string first $t "NUM"]
|
||||||
|
if { [string compare $t NUM] != 0 } {
|
||||||
|
ClientPut [format "ERROR: expected number for preset, got %s" \
|
||||||
|
$preset]
|
||||||
|
return
|
||||||
|
}
|
||||||
|
set t [SICSType $np]
|
||||||
|
if { [string compare $t NUM] != 0 } {
|
||||||
|
ClientPut [format "ERROR: expected number for np, got %s" \
|
||||||
|
$np]
|
||||||
|
return
|
||||||
|
}
|
||||||
|
#--------- do variables
|
||||||
|
set nvar [expr ($l - 2) / 3]
|
||||||
|
for { set i 0 } { $i < $nvar} { incr i } {
|
||||||
|
set var [lindex $args [expr $i * 3]]
|
||||||
|
set t [SICSType $var]
|
||||||
|
if {[string compare $t DRIV] != 0} {
|
||||||
|
ClientPut [format "ERROR: %s is not drivable" $var]
|
||||||
|
return
|
||||||
|
}
|
||||||
|
set start [lindex $args [expr ($i * 3) + 1]]
|
||||||
|
set t [SICSType $start]
|
||||||
|
if { [string compare $t NUM] != 0 } {
|
||||||
|
ClientPut [format "ERROR: expected number for start, got %s" \
|
||||||
|
$start]
|
||||||
|
return
|
||||||
|
}
|
||||||
|
set end [lindex $args [expr ($i * 3) + 2]]
|
||||||
|
set t [SICSType $end]
|
||||||
|
if { [string compare $t NUM] != 0 } {
|
||||||
|
ClientPut [format "ERROR: expected number for end, got %s" \
|
||||||
|
$end]
|
||||||
|
return
|
||||||
|
}
|
||||||
|
#--------- do scan parameters
|
||||||
|
append scanvars $var ","
|
||||||
|
append scanstarts $start ","
|
||||||
|
set step [expr double($end - $start)/double($np)]
|
||||||
|
append scansteps $step ","
|
||||||
|
}
|
||||||
|
#------------- set lastcommand text
|
||||||
|
set txt [format "sscan %s" [join $args]]
|
||||||
|
catch {lastscancommand $txt}
|
||||||
|
#------------- start scan
|
||||||
|
set scanvars [string trim $scanvars ,]
|
||||||
|
set scanstarts [string trim $scanstarts ,]
|
||||||
|
set scansteps [string trim $scansteps ,]
|
||||||
|
set mode [string trim [SplitReply [scan mode]]]
|
||||||
|
set ret [catch {hdbscan $scanvars $scanstarts $scansteps $np $mode $preset} msg]
|
||||||
|
if {$ret != 0} {
|
||||||
|
error $msg
|
||||||
|
} else {
|
||||||
|
return $msg
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------------------------
|
||||||
|
proc splitScanVar {txt} {
|
||||||
|
set l1 [split $txt =]
|
||||||
|
set var [lindex $l1 0]
|
||||||
|
set vl [split $var .]
|
||||||
|
lappend result [lindex $vl 1]
|
||||||
|
lappend result [string trim [lindex $l1 1]]
|
||||||
|
lappend result [string trim [lindex $l1 2]]
|
||||||
|
}
|
||||||
|
#-----------------------------------------------------------------------------
|
||||||
|
proc scaninfo {} {
|
||||||
|
set novar [string trim [SplitReply [xxxscan noscanvar]]]
|
||||||
|
if {$novar == 0} {
|
||||||
|
return "0,1,NONE,0.,0.,default.dat"
|
||||||
|
}
|
||||||
|
append result "scaninfo = "
|
||||||
|
append result [string trim [SplitReply [xxxscan np]]] "," $novar
|
||||||
|
for {set i 0} {$i < $novar} {incr i} {
|
||||||
|
set vl [splitScanVar [xxxscan getvarpar $i]]
|
||||||
|
append result ", " [lindex $vl 0]
|
||||||
|
}
|
||||||
|
set vl [splitScanVar [xxxscan getvarpar 0]]
|
||||||
|
append result "," [lindex $vl 1]
|
||||||
|
append result "," [lindex $vl 2]
|
||||||
|
append result "," [SplitReply [xxxscan getfile]]
|
||||||
|
append result "," [SplitReply [sample]]
|
||||||
|
append result "," sicstime
|
||||||
|
append result "," [SplitReply [lastscancommand]]
|
||||||
|
return $result
|
||||||
|
}
|
66
tcl/secsim.tcl
Normal file
66
tcl/secsim.tcl
Normal file
@ -0,0 +1,66 @@
|
|||||||
|
#---------------------------------------------------------------
|
||||||
|
# This is a second generation simulation motor.
|
||||||
|
#
|
||||||
|
# copyright: see file COPYRIGHT
|
||||||
|
#
|
||||||
|
# Mark Koennecke, December 2008
|
||||||
|
#----------------------------------------------------------------
|
||||||
|
proc simhardset {motname newval} {
|
||||||
|
hset /sics/$motname/starttime [clock sec]
|
||||||
|
}
|
||||||
|
#--------------------------------------------------------------
|
||||||
|
proc simhardget {motname} {
|
||||||
|
set stat [hval /sics/$motname/status]
|
||||||
|
set val [hval /sics/$motname/targetposition]
|
||||||
|
if {[string first run $stat] >= 0 \
|
||||||
|
|| [string first error $stat] >= 0 } {
|
||||||
|
return [expr $val -.777]
|
||||||
|
} else {
|
||||||
|
return $val
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#-------------------------------------------------------------
|
||||||
|
proc simhardfaultget {motname} {
|
||||||
|
set val [hval /sics/$motname/targetposition]
|
||||||
|
return [expr $val - .5]
|
||||||
|
}
|
||||||
|
#--------------------------------------------------------------
|
||||||
|
proc simstatusget {motname} {
|
||||||
|
set start [hval /sics/$motname/starttime]
|
||||||
|
if {$start < 0} {
|
||||||
|
return error
|
||||||
|
}
|
||||||
|
set delay [hval /sics/$motname/delay]
|
||||||
|
if {[clock sec] > $start + $delay} {
|
||||||
|
return idle
|
||||||
|
} else {
|
||||||
|
return run
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#-------------------------------------------------------------
|
||||||
|
proc simstatusfault {motname } {
|
||||||
|
clientput "ERROR: I am feeling faulty!"
|
||||||
|
return error
|
||||||
|
}
|
||||||
|
#--------------------------------------------------------------
|
||||||
|
proc simhalt {motname} {
|
||||||
|
hset /sics/$motname/starttime -100
|
||||||
|
}
|
||||||
|
#---------------------------------------------------------------
|
||||||
|
proc MakeSecSim {name lower upper delay} {
|
||||||
|
MakeSecMotor $name
|
||||||
|
hfactory /sics/$name/delay plain user text
|
||||||
|
hfactory /sics/$name/starttime plain user int
|
||||||
|
hset /sics/$name/delay $delay
|
||||||
|
hdel /sics/$name/hardposition
|
||||||
|
hfactory /sics/$name/hardposition script "simhardget $name" "simhardset $name" float
|
||||||
|
# hfactory /sics/$name/hardposition script "simhardfaultget $name" "simhardset $name" float
|
||||||
|
hdel /sics/$name/status
|
||||||
|
hfactory /sics/$name/status script "simstatusget $name" hdbReadOnly text
|
||||||
|
# hfactory /sics/$name/status script "simstatusfault $name" hdbReadOnly text
|
||||||
|
$name makescriptfunc halt "simhalt $name" user
|
||||||
|
hupdate /sics/$name/hardupperlim $upper
|
||||||
|
hupdate /sics/$name/softupperlim $upper
|
||||||
|
hupdate /sics/$name/hardlowerlim $lower
|
||||||
|
hupdate /sics/$name/softlowerlim $lower
|
||||||
|
}
|
317
tcl/table.tcl
Normal file
317
tcl/table.tcl
Normal file
@ -0,0 +1,317 @@
|
|||||||
|
#----------------------------------------------------------------------
|
||||||
|
# Support functions for table processing in SICS
|
||||||
|
#
|
||||||
|
# This includes a CSV processing module from someone else. See below.
|
||||||
|
#
|
||||||
|
# copyright: see file COPYRIGHT
|
||||||
|
#
|
||||||
|
# Mark Koennecke, November 2008
|
||||||
|
#----------------------------------------------------------------------
|
||||||
|
if { [info exists __tableheader] == 0 } {
|
||||||
|
set __tableheader NULL
|
||||||
|
Publish tableexe User
|
||||||
|
Publish loop User
|
||||||
|
}
|
||||||
|
#=====================================================================
|
||||||
|
# Csv tcl package version 2.0
|
||||||
|
# A tcl library to deal with CSV (comma separated value)
|
||||||
|
# files, generated and readable by some DOS/Windows programs
|
||||||
|
# Contain two functions:
|
||||||
|
# csv2list string ?separator?
|
||||||
|
# and
|
||||||
|
# list2csv list ?separator?
|
||||||
|
# which converts line from CSV file to list and vice versa.
|
||||||
|
#
|
||||||
|
# Both functions have optional "separator argument" becouse some silly
|
||||||
|
# Windows
|
||||||
|
# program might use semicomon as delimiter in COMMA separated values
|
||||||
|
# file.
|
||||||
|
#
|
||||||
|
# Copyright (c) SoftWeyr, 1997-99
|
||||||
|
# Many thanks to Robert Seeger <rseeger1@nycap.rr.com>
|
||||||
|
# for beta-testing and fixing my misprints
|
||||||
|
# This file is distributed under GNU Library Public License. Visit
|
||||||
|
# http://www.gnu.org/copyleft/gpl.html
|
||||||
|
# for details.
|
||||||
|
|
||||||
|
#
|
||||||
|
# Convert line, read from CSV file into proper TCL list
|
||||||
|
# Commas inside quoted strings are not considered list delimiters,
|
||||||
|
# Double quotes inside quoted strings are converted to single quotes
|
||||||
|
# Double quotes are stripped out and replaced with correct Tcl quoting
|
||||||
|
#
|
||||||
|
|
||||||
|
proc csv2list {str {separator ","}} {
|
||||||
|
#build a regexp>
|
||||||
|
set regexp [subst -nocommands \
|
||||||
|
{^[ \t\r\n]*("(([^"]|"")*)"|[^"$separator \t\r]*)}]
|
||||||
|
set regexp1 [subst -nocommands {$regexp[ \t\r\n]*$separator\(.*)$}]
|
||||||
|
set regexp2 [subst -nocommands {$regexp[ \t\r\n]*\$}]
|
||||||
|
set list {}
|
||||||
|
while {[regexp $regexp1 $str junk1 unquoted quoted\
|
||||||
|
junk2 str]} {
|
||||||
|
if {[string length $quoted]||$unquoted=="\"\""} {
|
||||||
|
regsub -all {""} $quoted \" unquoted
|
||||||
|
}
|
||||||
|
lappend list $unquoted
|
||||||
|
}
|
||||||
|
if {[regexp $regexp2 $str junk unquoted quoted]} {
|
||||||
|
if {[string length $quoted]||$unquoted=="\"\""} {
|
||||||
|
regsub -all {""} $quoted \" unquoted
|
||||||
|
}
|
||||||
|
lappend list $unquoted
|
||||||
|
if {[uplevel info exist csvtail]} {
|
||||||
|
uplevel set csvtail {""}
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
if {[uplevel info exist csvtail]} {
|
||||||
|
uplevel [list set csvtail $str]
|
||||||
|
} else {
|
||||||
|
return -code error -errorcode {CSV 1 "CSV parse error"}\
|
||||||
|
"CSV parse error: unparsed tail \"$str\""
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return $list
|
||||||
|
}
|
||||||
|
|
||||||
|
proc list2csv {list {separator ","}} {
|
||||||
|
set l {}
|
||||||
|
foreach elem $list {
|
||||||
|
if {[string match {} $elem]||
|
||||||
|
[regexp {^[+-]?([0-9]+|([0-9]+\.?[0-9]*|\.[0-9]+)([eE][+-]?[0-9]+)?)$}\
|
||||||
|
$elem]} {
|
||||||
|
lappend l $elem
|
||||||
|
} else {
|
||||||
|
regsub -all {"} $elem {""} selem
|
||||||
|
lappend l "\"$selem\""
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return [join $l $separator]
|
||||||
|
}
|
||||||
|
|
||||||
|
proc csvfile {f {separator ","}} {
|
||||||
|
set csvtail ""
|
||||||
|
set list {}
|
||||||
|
set buffer {}
|
||||||
|
while {[gets $f line]>=0} {
|
||||||
|
if {[string length $csvtail]} {
|
||||||
|
set line "$csvtail\n$line"
|
||||||
|
} elseif {![string length $line]} {
|
||||||
|
lappend list {}
|
||||||
|
continue
|
||||||
|
}
|
||||||
|
set rec [csv2list $line $separator]
|
||||||
|
set buffer [concat $buffer $rec]
|
||||||
|
if {![ string length $csvtail]} {
|
||||||
|
lappend list $buffer
|
||||||
|
set buffer {}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
if {[string length $csvtail]} {
|
||||||
|
return -code error -errorcode {CSV 2 "Multiline parse error"}\
|
||||||
|
"CSV file parse error"
|
||||||
|
}
|
||||||
|
return $list
|
||||||
|
}
|
||||||
|
|
||||||
|
proc csvstring {str {separator ","}} {
|
||||||
|
set csvtail ""
|
||||||
|
set list {}
|
||||||
|
set buffer {}
|
||||||
|
foreach line [split $str "\n"] {
|
||||||
|
if {[string length $csvtail]} {
|
||||||
|
set line "$csvtail\n$line"
|
||||||
|
} elseif {![string length $line]} {
|
||||||
|
lappend list {}
|
||||||
|
continue
|
||||||
|
}
|
||||||
|
set rec [csv2list $line $separator]
|
||||||
|
set buffer [concat $buffer $rec]
|
||||||
|
if {![ string length $csvtail]} {
|
||||||
|
lappend list $buffer
|
||||||
|
set buffer {}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
if {[string length $cvstail]} {
|
||||||
|
return -code error -errorcode {CSV 2 "Multiline parse error"}\
|
||||||
|
"CSV string parse error"
|
||||||
|
}
|
||||||
|
return $list
|
||||||
|
}
|
||||||
|
|
||||||
|
package provide Csv 2.1
|
||||||
|
#========================================================================
|
||||||
|
# The plan here is such: operations which happen fast or immediatly are
|
||||||
|
# done at once. Count commands or anything given as command is appended
|
||||||
|
# to a list for later execution. The idea is that this contains the
|
||||||
|
# actual measuring payload of the row.
|
||||||
|
# Drivables are immediatly started.
|
||||||
|
# After processing the rows, there is a success to wait for motors to arrive
|
||||||
|
# Then the commands for later execution are run. This frees the user of the
|
||||||
|
# the necessity to have the count or whatever command as the last thing in the row
|
||||||
|
#--------------------------------------------------------------------------------
|
||||||
|
proc testinterrupt {} {
|
||||||
|
set int [getint]
|
||||||
|
if {[string first continue $int] < 0} {
|
||||||
|
error "Interrupted"
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#--------------------------------------------------------------------------------
|
||||||
|
proc processtablerow {line} {
|
||||||
|
global __tableheader
|
||||||
|
set parlist [csv2list $line]
|
||||||
|
for {set i 0} {$i < [llength $__tableheader]} {incr i} {
|
||||||
|
set type [lindex $__tableheader $i]
|
||||||
|
set data [lindex $parlist $i]
|
||||||
|
#--------- first process special types
|
||||||
|
switch $type {
|
||||||
|
monitor {
|
||||||
|
lappend laterExe "count monitor $data"
|
||||||
|
continue
|
||||||
|
}
|
||||||
|
timer {
|
||||||
|
lappend laterExe "count timer $data"
|
||||||
|
continue
|
||||||
|
}
|
||||||
|
compar {
|
||||||
|
append command [join [lrange $parlist $i end]]
|
||||||
|
lappend laterExe $command
|
||||||
|
break
|
||||||
|
}
|
||||||
|
command {
|
||||||
|
lappend laterExe $data
|
||||||
|
continue
|
||||||
|
}
|
||||||
|
batch {
|
||||||
|
lappend laterExe "exe $data"
|
||||||
|
continue
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#----------- now look for drivables
|
||||||
|
set test [sicstype $type]
|
||||||
|
if {[string compare $test DRIV] == 0} {
|
||||||
|
set status [catch {run $type $data} msg]
|
||||||
|
if {$status != 0} {
|
||||||
|
clientput "ERROR: $msg for $type with $data"
|
||||||
|
}
|
||||||
|
continue
|
||||||
|
}
|
||||||
|
#------------- now look for special objects
|
||||||
|
set objtype [sicsdescriptor $type]
|
||||||
|
switch $objtype {
|
||||||
|
SicsVariable -
|
||||||
|
MulMot -
|
||||||
|
Macro {
|
||||||
|
set status [catch {eval $type $data} msg]
|
||||||
|
if {$status != 0} {
|
||||||
|
clientput "ERROR: $msg for $type with $data"
|
||||||
|
}
|
||||||
|
continue
|
||||||
|
}
|
||||||
|
default {
|
||||||
|
clientput "Skipping non recognized column $type with data $data"
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
set status [catch {success} msg]
|
||||||
|
if {$status != 0} {
|
||||||
|
clientput "ERROR: $msg while waiting for motors to arrive"
|
||||||
|
}
|
||||||
|
testinterrupt
|
||||||
|
foreach command $laterExe {
|
||||||
|
eval $command
|
||||||
|
testinterrupt
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
proc tableexe {tablefile} {
|
||||||
|
global __tableheader
|
||||||
|
if {[string first NULL $__tableheader] < 0} {
|
||||||
|
error "Tableexe already running, terminated"
|
||||||
|
}
|
||||||
|
set fullfile [SplitReply [exe fullpath $tablefile]]
|
||||||
|
set in [open $fullfile r]
|
||||||
|
gets $in header
|
||||||
|
set __tableheader [csv2list $header]
|
||||||
|
while {[gets $in line] > 0} {
|
||||||
|
set status [catch {processtablerow $line} msg]
|
||||||
|
if {$status != 0} {
|
||||||
|
set int [getint]
|
||||||
|
if {[string first continue $int] < 0} {
|
||||||
|
break
|
||||||
|
} else {
|
||||||
|
clientput "ERROR: $msg while processing row"
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
close $in
|
||||||
|
set __tableheader NULL
|
||||||
|
return "Done processing table"
|
||||||
|
}
|
||||||
|
#---------------------------------------------------------------------------
|
||||||
|
proc loop args {
|
||||||
|
clientput $args
|
||||||
|
if {[llength $args] < 2} {
|
||||||
|
error \
|
||||||
|
"Usage: loop <no> <sicscommand>\n\t<no> number of repetions\n\t<sicscommand> any SICS command"
|
||||||
|
}
|
||||||
|
set len [lindex $args 0]
|
||||||
|
set command [lrange $args 1 end]
|
||||||
|
for {set i 1} {$i <= $len} {incr i} {
|
||||||
|
clientput "Repetition $i of $len"
|
||||||
|
set status [catch {eval [join $command]} msg]
|
||||||
|
if {$status != 0} {
|
||||||
|
clientput "ERROR: $msg while processing loop command"
|
||||||
|
}
|
||||||
|
testinterrupt
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#==============================================================================
|
||||||
|
# This is an old attempt
|
||||||
|
#=============================================================================
|
||||||
|
proc __tablescan__ args {
|
||||||
|
global __tableheader
|
||||||
|
|
||||||
|
set idx [lsearch $__tableheader monitor]
|
||||||
|
if {$idx >= 0} {
|
||||||
|
set preset [lindex $args $idx]
|
||||||
|
set mode monitor
|
||||||
|
}
|
||||||
|
set idx [lsearch $__tableheader timer]
|
||||||
|
if {$idx >= 0} {
|
||||||
|
set preset [lindex $args $idx]
|
||||||
|
set mode timer
|
||||||
|
}
|
||||||
|
|
||||||
|
set idx [lsearch $__tableheader scanvar]
|
||||||
|
if {$idx >= 0} {
|
||||||
|
set var [lindex $args $idx]
|
||||||
|
} else {
|
||||||
|
error "ERROR: No scan variable in table"
|
||||||
|
}
|
||||||
|
|
||||||
|
set idx [lsearch $__tableheader scanstart]
|
||||||
|
if {$idx >= 0} {
|
||||||
|
set start [lindex $args $idx]
|
||||||
|
} else {
|
||||||
|
error "ERROR: No scan start in table"
|
||||||
|
}
|
||||||
|
|
||||||
|
set idx [lsearch $__tableheader scanend]
|
||||||
|
if {$idx >= 0} {
|
||||||
|
set end [lindex $args $idx]
|
||||||
|
} else {
|
||||||
|
error "ERROR: No scan end in table"
|
||||||
|
}
|
||||||
|
|
||||||
|
set idx [lsearch $__tableheader scanstep]
|
||||||
|
if {$idx >= 0} {
|
||||||
|
set step [lindex $args $idx]
|
||||||
|
} else {
|
||||||
|
error "ERROR: No scan step in table"
|
||||||
|
}
|
||||||
|
|
||||||
|
set np [expr abs($end - $start)/$step]
|
||||||
|
xxxscan var $var $start $step
|
||||||
|
xxxscan run $np $mode $preset
|
||||||
|
}
|
Reference in New Issue
Block a user