- Added table execution
- Driver for Delta Tau Motor controller
This commit is contained in:
koennecke
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:
|
||||
# * the internal scan command xxxscan
|
||||
# * scan data to live /graphics/scan_data
|
||||
#
|
||||
# Many updates, till November 2008, Mark Koennecke
|
||||
#----------------------------------------------------------------------
|
||||
if { [info exists hdbinit] == 0 } {
|
||||
set hdbinit 1
|
||||
@ -31,10 +33,14 @@ if { [info exists hdbinit] == 0 } {
|
||||
Publish makemumopos User
|
||||
Publish dropmumo User
|
||||
Publish hdbbatchpath User
|
||||
Publish cscan User
|
||||
Publish sscan User
|
||||
# Publish hmake Mugger
|
||||
# Publish hmakescript Mugger
|
||||
# Publish hlink Mugger
|
||||
# Publish hcommand Mugger
|
||||
Publish hdbstorenexus User
|
||||
Publish scaninfo Spy
|
||||
}
|
||||
#===================================================================
|
||||
# Configuration commands provided:
|
||||
@ -56,6 +62,7 @@ if { [info exists hdbinit] == 0 } {
|
||||
# makeevproxy rootpath hdbname devicename
|
||||
# makemumo rootpath mumoname
|
||||
# makeexe
|
||||
# confnxhdb path alias pass
|
||||
#===================== hfactory adapters ==========================
|
||||
proc hmake {path priv type {len 1}} {
|
||||
hfactory $path plain $priv $type $len
|
||||
@ -321,7 +328,7 @@ proc hdbscan {scanvars scanstart scanincr np mode preset} {
|
||||
set varlist [split $scanvars ,]
|
||||
set startlist [split $scanstart ,]
|
||||
set incrlist [split $scanincr ,]
|
||||
hset $stdscangraph/scan_variable/name [lindex $varlist 0]
|
||||
catch {hset $stdscangraph/scan_variable/name [lindex $varlist 0]}
|
||||
set count 0
|
||||
foreach var $varlist {
|
||||
if {[string first / $var] >= 0} {
|
||||
@ -343,14 +350,14 @@ proc hdbscan {scanvars scanstart scanincr np mode preset} {
|
||||
proc hdbprepare {obj userdata } {
|
||||
global stdscangraph
|
||||
stdscan prepare $obj userdata
|
||||
hupdate $stdscangraph/dim
|
||||
catch {hupdate $stdscangraph/dim}
|
||||
}
|
||||
#------------------------------------------------------------------------------
|
||||
proc hdbcollect {obj userobj np} {
|
||||
global stdscangraph
|
||||
stdscan collect $obj $userobj $np
|
||||
hupdate $stdscangraph/scan_variable
|
||||
hupdate $stdscangraph/counts
|
||||
catch {hupdate $stdscangraph/scan_variable}
|
||||
catch {hupdate $stdscangraph/counts}
|
||||
}
|
||||
#-----------------------------------------------------------------------------
|
||||
proc gethdbscanvardata {no} {
|
||||
@ -542,6 +549,7 @@ proc makestdadmin {} {
|
||||
hfactory /instrument/experiment/batchpath script "exe batchpath" \
|
||||
"exe batchpath" text
|
||||
hsetprop /instrument/experiment/batchpath priv user
|
||||
sicspoll add /instrument/experiment/batchpath hdb 60
|
||||
}
|
||||
#----------------------------------------------------------
|
||||
proc makecount {path} {
|
||||
@ -688,3 +696,189 @@ proc makeexe {} {
|
||||
hfactory $path/execute/file/values script listbatchfiles hdbReadOnly text
|
||||
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