- A syntax checker for SICS was implemented
This commit is contained in:
cvs
@@ -60,19 +60,81 @@ proc syntaxGet {name} {
|
||||
#-----------------------------------------------------------------------
|
||||
proc syntaxCounterMode {par} {
|
||||
set p [string trim [string tolower $par]]
|
||||
switch $p{
|
||||
switch $p {
|
||||
monitor { return 1}
|
||||
timer {return 1}
|
||||
default { return 0}
|
||||
}
|
||||
}
|
||||
#-------------------------------------------------------------------------
|
||||
# syntaxLoadSICS loads a SICS status file. The trick is to ignore all
|
||||
# errors because the syntax checker may not have all commands implemented
|
||||
#-------------------------------------------------------------------------
|
||||
proc syntaxLoadSICS {fname} {
|
||||
set f [open $fname r]
|
||||
while { [gets $f line] > 0} {
|
||||
set ret [catch {eval $line} msg]
|
||||
# if { $ret != 0} {
|
||||
# puts stdout "ERROR in: $line"
|
||||
# }
|
||||
}
|
||||
close $f
|
||||
}
|
||||
#-------------------------------------------------------------------------
|
||||
# syntaxLimit checks if a parameter violates a limit
|
||||
#------------------------------------------------------------------------
|
||||
proc syntaxLimit {var val} {
|
||||
global sicsPar
|
||||
|
||||
#-------- fixed?
|
||||
if { [info exists sicsPar($var.fixed)] } {
|
||||
set lim $sicsPar($var.fixed)
|
||||
if { $lim > 0 } {
|
||||
error "ERROR: $var is fixed"
|
||||
}
|
||||
}
|
||||
|
||||
#--------- lower limit?
|
||||
set lim shit
|
||||
if { [info exists sicsPar($var.softlowerlim)] } {
|
||||
set lim $sicsPar($var.softlowerlim)
|
||||
}
|
||||
if { [info exists sicsPar($var.lowerlimit)] } {
|
||||
set lim $sicsPar($var.lowerlimit)
|
||||
}
|
||||
if { [syntaxNumeric $lim] == 1} {
|
||||
if { $val < $lim} {
|
||||
error "ERROR: lower limit $lim violated by $val for $var"
|
||||
}
|
||||
}
|
||||
#------------ upper limit?
|
||||
set lim shit
|
||||
if { [info exists sicsPar($var.softupperlim)] } {
|
||||
set lim $sicsPar($var.softupperlim)
|
||||
}
|
||||
if { [info exists sicsPar($var.upperlimit)] } {
|
||||
set lim $sicsPar($var.upperlimit)
|
||||
}
|
||||
if { [syntaxNumeric $lim] == 1} {
|
||||
if { $val > $lim} {
|
||||
error "ERROR: upper limit $lim violated by $val for $var"
|
||||
}
|
||||
}
|
||||
}
|
||||
#---------------------------------------------------------------------------
|
||||
# syntaxDummy is a syntax checking procedure which does nothing. This is a
|
||||
# quick fix for SICS commands for which no syntax checking procedure has yet
|
||||
# been defined.
|
||||
#-------------------------------------------------------------------------
|
||||
proc syntaxDummy {name args} {
|
||||
set args [syntaxListify $args]
|
||||
}
|
||||
#---------------------------------------------------------------------------
|
||||
# syntaxWarn is a syntax checking procedure which does nothing. This is a
|
||||
# quick fix for SICS commands for which no syntax checking procedure has not
|
||||
# yet been defined or makes no sense. This version wanrs about it.
|
||||
#-------------------------------------------------------------------------
|
||||
proc syntaxWarn {name args} {
|
||||
puts stdout "INFO: Syntax for $name not checked"
|
||||
return
|
||||
}
|
||||
#-----------------------------------------------------------------------
|
||||
@@ -113,12 +175,12 @@ proc syntaxNumPar {name args} {
|
||||
}
|
||||
}
|
||||
#--------------------------------------------------------------------------
|
||||
# syntaxMotor handles the syntax for a SICS motor
|
||||
# syntaxMtor handles the syntax for a SICS motor
|
||||
#-------------------------------------------------------------------------
|
||||
lappend motSubKey list reset interest uninterest position hardposition
|
||||
lappend motSub hardlowerlim hardupperlim softlowerlim
|
||||
lappend motSub softupperlim softzero fixed interruptmode precision
|
||||
lappend motSub accessmode sign failafter
|
||||
lappend motSub accessmode sign failafter accesscode
|
||||
|
||||
proc syntaxMotor {name args} {
|
||||
global sicsPar motSub motSubKey
|
||||
@@ -154,15 +216,836 @@ proc syntaxMotor {name args} {
|
||||
#---------------------------------------------------------------------------
|
||||
# syntaxCounter deals with the syntax for a single counter
|
||||
#---------------------------------------------------------------------------
|
||||
lappend cterKey interest uninterest stop send
|
||||
|
||||
proc syntaxCounter {name args} {
|
||||
global sicsPar motSub motSubKey
|
||||
global cterKey sicsPar
|
||||
|
||||
set args [syntaxListify $args]
|
||||
if { [llength $args == 0} {
|
||||
if { [llength $args] == 0} {
|
||||
error [format "ERROR: subcommand expected to %s" $name]
|
||||
}
|
||||
#--------- get command
|
||||
set subcommand [string trim [string tolower [lindex $args 0]]]
|
||||
switch $subcommand {
|
||||
#------ test keyWords
|
||||
if { [lsearch $cterKey $subcommand] >= 0} {
|
||||
return
|
||||
}
|
||||
}
|
||||
#------- the rest
|
||||
switch $subcommand {
|
||||
count -
|
||||
countnb {
|
||||
if { [llength $args] < 2} {
|
||||
error "ERROR: missing argument to count/coutnb"
|
||||
}
|
||||
if {[syntaxNumeric [lindex $args 1]] == 0 } {
|
||||
error "ERROR: expected numeric argument to count/countb"
|
||||
}
|
||||
return
|
||||
}
|
||||
getpreset {
|
||||
return [syntaxGet $name.preset]
|
||||
}
|
||||
getexponent {
|
||||
return [syntaxGet $name.exponent]
|
||||
}
|
||||
gettime {
|
||||
return [format "%s.time = 77" $name]
|
||||
}
|
||||
getcounts {
|
||||
return [format "%s.counts = {77 77 77 77 77}" $name]
|
||||
}
|
||||
getthreshold {
|
||||
if { [llength $args] < 2} {
|
||||
error "ERROR: missing argument to getthreshold"
|
||||
}
|
||||
if {[syntaxNumeric [lindex $args 1]] == 0 } {
|
||||
error "ERROR: expected numeric argument to getthreshold"
|
||||
}
|
||||
return [syntaxGet $name.threshold]
|
||||
}
|
||||
getmonitor {
|
||||
if { [llength $args] < 2} {
|
||||
error "ERROR: missing argument to getmonitor"
|
||||
}
|
||||
if {[syntaxNumeric [lindex $args 1]] == 0 } {
|
||||
error "ERROR: expected numeric argument to getmonitor"
|
||||
}
|
||||
return "$name.monitor 1 = 77"
|
||||
}
|
||||
status {
|
||||
return "counter.status = 77 77 77"
|
||||
}
|
||||
setmode {
|
||||
if { [llength $args] < 2} {
|
||||
error "ERROR: missing argument to getthreshold"
|
||||
}
|
||||
if { [syntaxCounterMode [lindex $args 1]] == 0} {
|
||||
error [format "ERROR: invalid counter mode: %s" \
|
||||
[lindex $args 1]]
|
||||
}
|
||||
return
|
||||
}
|
||||
setpreset {
|
||||
if { [llength $args] < 2} {
|
||||
error "ERROR: missing argument to setpreset"
|
||||
}
|
||||
if {[syntaxNumeric [lindex $args 1]] == 0 } {
|
||||
error "ERROR: expected numeric argument to setpreset"
|
||||
}
|
||||
return
|
||||
}
|
||||
setexponent {
|
||||
if { [llength $args] < 2} {
|
||||
error "ERROR: missing argument to setexponent"
|
||||
}
|
||||
if {[syntaxNumeric [lindex $args 1]] == 0 } {
|
||||
error "ERROR: expected numeric argument to setexponent"
|
||||
}
|
||||
return
|
||||
}
|
||||
mode {
|
||||
if { [llength $args] <2} {
|
||||
return [syntaxGet $name.mode]
|
||||
} else {
|
||||
if { [syntaxCounterMode [lindex $args 1]] == 0} {
|
||||
error [format "ERROR: invalid counter mode: %s" \
|
||||
[lindex $args 1]]
|
||||
}
|
||||
set sicsPar($name.mode) [lindex $args 1]
|
||||
return
|
||||
}
|
||||
}
|
||||
preset {
|
||||
if { [llength $args] <2} {
|
||||
return [syntaxGet $name.preset]
|
||||
} else {
|
||||
if { [syntaxNumeric [lindex $args 1]] == 0} {
|
||||
error [format "ERROR: iexpected numeric preset, got : %s" \
|
||||
[lindex $args 1]]
|
||||
}
|
||||
set sicsPar($name.preset) [lindex $args 1]
|
||||
return
|
||||
}
|
||||
}
|
||||
getthreshold {
|
||||
if { [llength $args] < 2} {
|
||||
error "ERROR: missing argument to getthreshold"
|
||||
}
|
||||
if {[syntaxNumeric [lindex $args 1]] == 0 } {
|
||||
error "ERROR: expected numeric argument to getthreshold"
|
||||
}
|
||||
return "$name.threshold = 77"
|
||||
}
|
||||
setthreshold {
|
||||
if { [llength $args] < 3} {
|
||||
error "ERROR: missing argument to setthreshold"
|
||||
}
|
||||
if {[syntaxNumeric [lindex $args 1]] == 0 } {
|
||||
error "ERROR: expected numeric argument to setthreshold"
|
||||
}
|
||||
if {[syntaxNumeric [lindex $args 2]] == 0 } {
|
||||
error "ERROR: expected numeric argument to setthreshold"
|
||||
}
|
||||
return
|
||||
}
|
||||
default {
|
||||
error "ERROR: subcommand $subcommand to counter not known"
|
||||
}
|
||||
}
|
||||
}
|
||||
#---------------------------------------------------------------------------
|
||||
# The syntax handler for SICS histogram memories
|
||||
#--------------------------------------------------------------------------
|
||||
lappend hmKey count countf interest uninterest init countblock clearbin
|
||||
lappend hmConf dim0 dim1 binwidth rank overflowmode histmode xfac yfac
|
||||
lappend hmConf xfrac yfrac hmcomputer hmport counter init
|
||||
|
||||
proc syntaxHM {name args} {
|
||||
global hmKey hmConf sicsPar
|
||||
|
||||
set args [syntaxListify $args]
|
||||
if { [llength $args] == 0} {
|
||||
error [format "ERROR: subcommand expected to %s" $name]
|
||||
}
|
||||
#--------- get command
|
||||
set subcommand [string trim [string tolower [lindex $args 0]]]
|
||||
#------ test keyWords
|
||||
if { [lsearch $hmKey $subcommand] >= 0} {
|
||||
return
|
||||
}
|
||||
switch $subcommand {
|
||||
preset {
|
||||
if { [llength $args] <2} {
|
||||
return [syntaxGet $name.preset]
|
||||
} else {
|
||||
if { [syntaxNumeric [lindex $args 1]] == 0} {
|
||||
error [format "ERROR: iexpected numeric preset, got : %s" \
|
||||
[lindex $args 1]]
|
||||
}
|
||||
set sicsPar($name.preset) [lindex $args 1]
|
||||
return
|
||||
}
|
||||
}
|
||||
exponent {
|
||||
if { [llength $args] <2} {
|
||||
return [syntaxGet $name.exponent]
|
||||
} else {
|
||||
if { [syntaxNumeric [lindex $args 1]] == 0} {
|
||||
error [format "ERROR: expected numeric exponent, got : %s"\
|
||||
[lindex $args 1]]
|
||||
}
|
||||
set sicsPar($name.exponent) [lindex $args 1]
|
||||
return
|
||||
}
|
||||
}
|
||||
countmode -
|
||||
mode {
|
||||
if { [llength $args] <2} {
|
||||
return [syntaxGet $name.mode]
|
||||
} else {
|
||||
if { [syntaxCounterMode [lindex $args 1]] == 0} {
|
||||
error [format "ERROR: invalid counter mode: %s" \
|
||||
[lindex $args 1]]
|
||||
}
|
||||
set sicsPar($name.mode) [lindex $args 1]
|
||||
return
|
||||
}
|
||||
}
|
||||
get -
|
||||
uuget -
|
||||
zipget {
|
||||
for { set i 1} { $i < [llength $args]} {incr i} {
|
||||
if { [syntaxNumeric [lindex $args $i]] == 0} {
|
||||
error \
|
||||
[format "ERROR: expected numeric hm argument, got %s"\
|
||||
[lindex $args $i]]
|
||||
|
||||
}
|
||||
}
|
||||
return
|
||||
}
|
||||
genbin {
|
||||
if { [llength $args] < 4 } {
|
||||
error "ERROR: insufficient number of argument to hm genbin"
|
||||
}
|
||||
for { set i 1} { $i < 4} { incr i} {
|
||||
if { [syntaxNumeric [lindex $args $i]] == 0} {
|
||||
error \
|
||||
[format "ERROR: expected numeric hm argument, got %s"\
|
||||
[lindex $args $i]]
|
||||
|
||||
}
|
||||
}
|
||||
}
|
||||
notimebin {
|
||||
return "$name.notimebin = 77"
|
||||
}
|
||||
timebin {
|
||||
return "histogram.timebins = 77 77 77 77 77 77"
|
||||
}
|
||||
setbin {
|
||||
if { [llength $args] < 3 } {
|
||||
error "ERROR: insufficient number of argument to hm setbin"
|
||||
}
|
||||
for { set i 1} { $i < 3} { incr i} {
|
||||
if { [syntaxNumeric [lindex $args $i]] == 0} {
|
||||
error \
|
||||
[format "ERROR: expected numeric hm argument, got %s"\
|
||||
[lindex $args $i]]
|
||||
|
||||
}
|
||||
}
|
||||
}
|
||||
sum {
|
||||
return
|
||||
}
|
||||
configure {
|
||||
if { [llength $args] < 2} {
|
||||
error "ERROR: insufficient number of arguments to hm configure"
|
||||
}
|
||||
set opt [string trim [string tolower [lindex $args 1]]]
|
||||
if { [lsearch $hmConf $opt] < 0} {
|
||||
error "ERROR: configuration option $opt not known"
|
||||
}
|
||||
return
|
||||
}
|
||||
default {
|
||||
error "ERROR: subcommand $subcommand to hm not known"
|
||||
}
|
||||
}
|
||||
}
|
||||
#-----------------------------------------------------------------------------
|
||||
# a syntax handler for environment controllers
|
||||
#-----------------------------------------------------------------------------
|
||||
lappend evKey send interest uninterest list
|
||||
lappend evPar tolerance access errorHandler interrupt upperlimit lowerlimit
|
||||
lappend evPar safevalue maxwait settle ramp
|
||||
|
||||
proc evSyntax {name args} {
|
||||
global sicsPar evKey evPar
|
||||
|
||||
set args [syntaxListify $args]
|
||||
#------ no subcommand: get value
|
||||
if { [llength $args] == 0} {
|
||||
return [syntaxGet $name]
|
||||
}
|
||||
set subcommand [string trim [string tolower [lindex $args 0]]]
|
||||
#-------- numeric subcommand: drive!
|
||||
if { [syntaxNumeric $subcommand] == 1} {
|
||||
set sicsPar($name) $subcommand
|
||||
return
|
||||
}
|
||||
#--------- keywords
|
||||
if { [lsearch $evKey $subcommand] >= 0} {
|
||||
return
|
||||
}
|
||||
#---------- parameters
|
||||
if { [lsearch $evPar $subcommand] < 0} {
|
||||
error [format "ERROR: evcontroller %s does not know subcommand %s" \
|
||||
$name $subcommand]
|
||||
} else {
|
||||
if { [llength $args] > 1 } {
|
||||
set val [lindex $args 1]
|
||||
if { [syntaxNumeric $val] == 0 } {
|
||||
error [format "ERROR: %s.%s expected number, received %s" \
|
||||
$name $subcommand $val]
|
||||
} else {
|
||||
set sicsPar($name.$subcommand) $val
|
||||
}
|
||||
} else {
|
||||
return [syntaxGet $name.$subcommand]
|
||||
}
|
||||
}
|
||||
}
|
||||
#----------------------------------------------------------------------------
|
||||
# the syntax drive command
|
||||
#---------------------------------------------------------------------------
|
||||
proc syntaxDrive {name args} {
|
||||
global sicsPar
|
||||
|
||||
set args [syntaxListify $args]
|
||||
if { [llength $args] < 2 } {
|
||||
error "insufficient number or arguments for $name"
|
||||
}
|
||||
for {set i 0} {$i < [llength $args]} {set i [expr $i + 2]} {
|
||||
set ret [catch {info body [lindex $args $i]} msg]
|
||||
if { $ret != 0 } {
|
||||
error [format "ERROR: no %s to %s found" $name [lindex $args $i]]
|
||||
}
|
||||
if { [syntaxNumeric [lindex $args [expr $i + 1]]] != 1 } {
|
||||
error [format "ERROR: expected numeric %s target, got %s" \
|
||||
$name [lindex $args [expr $i +1]]]
|
||||
}
|
||||
syntaxLimit [lindex $args $i] [lindex $args [expr $i + 1]]
|
||||
set sicsPar([lindex $args $i]) [lindex $args [expr $i + 1]]
|
||||
}
|
||||
}
|
||||
#--------------------------------------------------------------------------
|
||||
# The syntax count command
|
||||
#--------------------------------------------------------------------------
|
||||
proc count { {mode NULL } { preset NULL } } {
|
||||
set m [string trim [string tolower $mode]]
|
||||
if { [string compare $m null] == 0} {
|
||||
return
|
||||
} else {
|
||||
if { [syntaxCounterMode $m] != 1 } {
|
||||
error "ERROR: invalid counter mode $m specified for count"
|
||||
}
|
||||
}
|
||||
set p [string trim [string tolower $preset]]
|
||||
if { [string compare $p null] == 0} {
|
||||
return
|
||||
} else {
|
||||
if {[syntaxNumeric $p] != 1 } {
|
||||
error "ERROR: count expected numeric preset, got $p"
|
||||
}
|
||||
}
|
||||
}
|
||||
#---------------------------------------------------------------------------
|
||||
# The co command, same syntax as count though functionally different
|
||||
#---------------------------------------------------------------------------
|
||||
proc co { {mode NULL} {prest NULL} } {
|
||||
count $mode $prest
|
||||
}
|
||||
#---------------------------------------------------------------------------
|
||||
# the syntax repeat command
|
||||
#---------------------------------------------------------------------------
|
||||
proc repeat { num {mode NULL} {preset NULL} } {
|
||||
if { [syntaxNumeric $num] != 1 } {
|
||||
error "ERROR: expected numeric repeat count, got $num"
|
||||
}
|
||||
set m [string trim [string tolower $mode]]
|
||||
if { [string compare $m null] == 0} {
|
||||
return
|
||||
} else {
|
||||
if { [syntaxCounterMode $m] != 1 } {
|
||||
error "ERROR: invalid counter mode $m specified for count"
|
||||
}
|
||||
}
|
||||
set p [string trim [string tolower $preset]]
|
||||
if { [string compare $p null] == 0} {
|
||||
return
|
||||
} else {
|
||||
if {[syntaxNumeric $p] != 1 } {
|
||||
error "ERROR: count expected numeric preset, got $p"
|
||||
}
|
||||
}
|
||||
}
|
||||
#----------------------------------------------------------------------------
|
||||
# The scan commands for the syntax checker
|
||||
#----------------------------------------------------------------------------
|
||||
proc cscan { var center delta np preset } {
|
||||
|
||||
set ret [catch {info body $var} msg]
|
||||
if { $ret != 0 } {
|
||||
error [format "ERROR: no %s to scan found" $var]
|
||||
}
|
||||
if { [syntaxNumeric $center] != 1} {
|
||||
error "ERROR: $center is no number, expected scan center"
|
||||
}
|
||||
if { [syntaxNumeric $delta] != 1} {
|
||||
error "ERROR: $delta is no number, expected scan step"
|
||||
}
|
||||
if { [syntaxNumeric $np] != 1} {
|
||||
error "ERROR: $np is no number, expected scan noPoints"
|
||||
}
|
||||
if { [syntaxNumeric $preset] != 1} {
|
||||
error "ERROR: $preset is no number, expected scan preset"
|
||||
}
|
||||
set val [expr $center - ($np/2) *$delta]
|
||||
syntaxLimit $var $val
|
||||
set val [expr $center + ($np/2)*$delta]
|
||||
syntaxLimit $var $val
|
||||
}
|
||||
#---------------------------------------------------------------------------
|
||||
proc sscan args {
|
||||
set lang [llength $args]
|
||||
if { $lang < 5} {
|
||||
error "ERROR: not enough arguments to sscan"
|
||||
}
|
||||
#-------- last two: np, preset
|
||||
set val [lindex $args [expr $lang - 1]]
|
||||
if { [syntaxNumeric $val] != 1} {
|
||||
error "ERROR: expected numeric preset, got $val"
|
||||
}
|
||||
set val [lindex $args [expr $lang - 2]]
|
||||
if { [syntaxNumeric $val] != 1} {
|
||||
error "ERROR: expected numeric NP, got $val"
|
||||
}
|
||||
set np $val
|
||||
#-------- from start: var start step sequences
|
||||
for {set i 0} { $i < [expr $lang - 2]} { set i [expr $i + 3]} {
|
||||
set var [string trim [string tolower [lindex $args $i]]]
|
||||
set ret [catch {info body $var} msg]
|
||||
if { $ret != 0 } {
|
||||
error [format "ERROR: no %s to scan found" $var]
|
||||
}
|
||||
set start [lindex $args [expr $i + 1]]
|
||||
if { [syntaxNumeric $start] != 1} {
|
||||
error "ERROR: $start is no number, expected scan start"
|
||||
}
|
||||
set step [lindex $args [expr $i + 2]]
|
||||
if { [syntaxNumeric $step] != 1} {
|
||||
error "ERROR: $step is no number, expected scan step"
|
||||
}
|
||||
syntaxLimit $var $start
|
||||
set val [expr $start + $np * $step]
|
||||
syntaxLimit $var $val
|
||||
}
|
||||
}
|
||||
#------------------------------------------------------------------------
|
||||
# The main scan object
|
||||
#------------------------------------------------------------------------
|
||||
proc scan args {
|
||||
global sicsPar
|
||||
|
||||
if { [llength $args] < 1} {
|
||||
error "ERROR: need subcommand for scan"
|
||||
}
|
||||
set subcommand [string trim [string tolower [lindex $args 0]]]
|
||||
switch $subcommand {
|
||||
info -
|
||||
getvars -
|
||||
xaxis -
|
||||
cinterest -
|
||||
uuinterest -
|
||||
pinterest -
|
||||
file -
|
||||
list -
|
||||
clear -
|
||||
getcounts -
|
||||
run -
|
||||
recover -
|
||||
forceclear {
|
||||
return
|
||||
}
|
||||
np -
|
||||
preset -
|
||||
setchannel {
|
||||
if { [llength $args] > 1} {
|
||||
set val [lindex $args 1]
|
||||
if { [syntaxNumeric $val] != 1} {
|
||||
error ERROR: expected numeric arg to $subcommand, got $val
|
||||
}
|
||||
set sicsPar(scan.$subcommand) $val
|
||||
} else {
|
||||
return [syntaxGet scan.$subcommand]
|
||||
}
|
||||
}
|
||||
var {
|
||||
if { [llength $args] < 4} {
|
||||
error "ERROR: not enough arguments for scan var"
|
||||
}
|
||||
set var [lindex $args 1]
|
||||
set ret [catch {info body $var} msg]
|
||||
if { $ret != 0 } {
|
||||
error [format "ERROR: no %s to scan found" $var]
|
||||
}
|
||||
set val [lindex $args 2]
|
||||
if { [syntaxNumeric $val] != 1} {
|
||||
error "ERROR: expected number for start, got $val"
|
||||
}
|
||||
set val [lindex $args 3]
|
||||
if { [syntaxNumeric $val] != 1} {
|
||||
error "ERROR: expected number for step, got $val"
|
||||
}
|
||||
}
|
||||
mode {
|
||||
if { [llength $args] > 1} {
|
||||
set val [lindex $args 1]
|
||||
if { [syntaxCounterMode $val] != 1} {
|
||||
error ERROR: expected counter mode, got $val
|
||||
}
|
||||
set sicsPar(scan.mode) $val
|
||||
} else {
|
||||
return [syntaxGet scan.mode]
|
||||
}
|
||||
}
|
||||
default {
|
||||
error "ERROR: subcommand $subcommand to scan not known"
|
||||
}
|
||||
}
|
||||
}
|
||||
#------------------------------------------------------------------------
|
||||
# optimiseSyntax: The syntax for the optimize command
|
||||
#-----------------------------------------------------------------------
|
||||
lappend optiPar maxcycles threshold channel preset
|
||||
|
||||
proc optiSyntax {name args} {
|
||||
global optiPar
|
||||
|
||||
set args [syntaxListify $args]
|
||||
if { [llength $args] < 1} {
|
||||
error "ERROR: need subcommand for optimise"
|
||||
}
|
||||
set subcommand [string trim [string tolower [lindex $args 0]]]
|
||||
if { [lsearch $optiPar $subcommand] >= 0} {
|
||||
if { [llength $args] > 1 } {
|
||||
set val [lindex $args 1]
|
||||
if { [syntaxNumeric $val] == 0 } {
|
||||
error [format "ERROR: %s.%s expected number, received %s" \
|
||||
$name $subcommand $val]
|
||||
} else {
|
||||
set sicsPar($name.$subcommand) $val
|
||||
return
|
||||
}
|
||||
} else {
|
||||
return [syntaxGet $name.$subcommand]
|
||||
}
|
||||
}
|
||||
switch $subcommand {
|
||||
addvar {
|
||||
if { [llength $args] < 5} {
|
||||
error "ERROR: not enough arguments to addvar"
|
||||
}
|
||||
set var [string trim [string tolower [lindex $args 1]]]
|
||||
set ret [catch {info body $var} msg]
|
||||
if { $ret != 0 } {
|
||||
error [format "ERROR: no %s to optimise found" $var]
|
||||
}
|
||||
for { set i 2} {$i < [llength $args]} {incr i} {
|
||||
set val [lindex $args $i]
|
||||
if { [syntaxNumeric $val] != 1} {
|
||||
error "ERROR: expected numeric par to opti, got $val"
|
||||
}
|
||||
}
|
||||
}
|
||||
clear -
|
||||
run { return}
|
||||
countmode {
|
||||
if { [llength $args] > 1} {
|
||||
set val [lindex $args 1]
|
||||
if { [syntaxCounterMode $val] != 1} {
|
||||
error ERROR: expected counter mode, got $val
|
||||
}
|
||||
set sicsPar(opti.mode) $val
|
||||
} else {
|
||||
return [syntaxGet opti.mode]
|
||||
}
|
||||
}
|
||||
default {
|
||||
error "ERROR: optimiser does not know about subcommand $subcommand"
|
||||
}
|
||||
}
|
||||
}
|
||||
#-------------------------------------------------------------------------
|
||||
# mumoSyntax: the syntax for SANS style multi motors
|
||||
# The aliases must be set in sicsPar(multimotorname.alias) during setup
|
||||
# in order for this to find them
|
||||
# Also sicsPar(multimotorname.nampos) has to be initialised to [list back]
|
||||
#------------------------------------------------------------------------
|
||||
proc mumoSyntax {name args} {
|
||||
global sicsPar
|
||||
|
||||
set args [syntaxListify $args]
|
||||
if { [llength $args] == 0} {
|
||||
return
|
||||
}
|
||||
set subcommand [string trim [string tolower [lindex $args 0]]]
|
||||
#---------check named position
|
||||
if {[lsearch $sicsPar($name.nampos) $subcommand] >= 0} {
|
||||
return
|
||||
}
|
||||
switch $subcommand {
|
||||
list {
|
||||
return
|
||||
}
|
||||
pos -
|
||||
recovernampos {
|
||||
if { [llength $args] < 2} {
|
||||
error "ERROR: not enough args to $subcommand"
|
||||
}
|
||||
set nam [string trim [string tolower [lindex $args 1]]]
|
||||
if { [lsearch $sicsPar($name.nampos) $nam] < 0} {
|
||||
lappend sicsPar($name.nampos) $nam
|
||||
}
|
||||
return
|
||||
}
|
||||
drop {
|
||||
if { [llength $args] < 2} {
|
||||
error "ERROR: not enough args to $subcommand"
|
||||
}
|
||||
set nam [string trim [string tolower [lindex $args 1]]]
|
||||
if { [string compare $name all] == 0} {
|
||||
set sicsPar($name.nampos) [list back]
|
||||
} else {
|
||||
set ind [lsearch $sicsPar($name.nampos) $nam]
|
||||
if { $ind >= 0} {
|
||||
set sicsPar($name.nampos) \
|
||||
[lreplace $sicsPar($name.nampos) $ind $ind]
|
||||
} else {
|
||||
puts stdout "INFO: failed to drop $nam"
|
||||
}
|
||||
}
|
||||
return
|
||||
}
|
||||
}
|
||||
#------------------ now it can only be the alias syntax
|
||||
# but we have to wash away all =,+,- first before we can analyze it
|
||||
set aliastxt [string trim [string tolower [join $args]]]
|
||||
set word 1
|
||||
set length [string length $aliastxt]
|
||||
for {set i 0} { $i < $length} {incr i} {
|
||||
set c [string index $aliastxt $i]
|
||||
if { [regexp \[=+-\] $c] == 1} {
|
||||
# puts stdout "Discovered +=- $c"
|
||||
if { $word == 1} {
|
||||
append washedTxt " "
|
||||
set word 0
|
||||
}
|
||||
continue
|
||||
}
|
||||
if { [string match {\ } $c] == 1} {
|
||||
# puts stdout "Discovered white space $c"
|
||||
if { $word == 1} {
|
||||
append washedTxt $c
|
||||
set word 0
|
||||
}
|
||||
continue
|
||||
}
|
||||
# puts stdout "Discovered $c"
|
||||
append washedTxt $c
|
||||
set word 1
|
||||
}
|
||||
# puts stdout $washedTxt
|
||||
#------- now we should have aliases followed by numbers only
|
||||
set args [split $washedTxt]
|
||||
for { set i 0} { $i < [llength $args]} { set i [expr $i +2]} {
|
||||
set var [lindex $args $i]
|
||||
if { [lsearch $sicsPar($name.alias) $var] < 0} {
|
||||
error "ERROR: alias $var does not exist in $name"
|
||||
}
|
||||
set val [lindex $args [expr $i + 1]]
|
||||
if { [syntaxNumeric $val] != 1 } {
|
||||
error "ERROR expected numeric target, got $val"
|
||||
}
|
||||
}
|
||||
}
|
||||
#--------------------------------------------------------------------------
|
||||
# The wait operation
|
||||
#--------------------------------------------------------------------------
|
||||
proc wait {time} {
|
||||
if { [syntaxNumeric $time] != 1} {
|
||||
error "ERROR: expected numeric wait time, got $time"
|
||||
}
|
||||
}
|
||||
#--------------------------------------------------------------------------
|
||||
# fileeval. Fileeval checks for loops in command
|
||||
# files. This is no error but a usage feature
|
||||
#--------------------------------------------------------------------------
|
||||
lappend fileList grrrmmmpffff
|
||||
|
||||
proc fileeval {name} {
|
||||
global fileList
|
||||
set f [file tail $name]
|
||||
if { [lsearch $fileList $f] >= 0} {
|
||||
puts stdout "INFO: Command file loop detected!"
|
||||
return
|
||||
} else {
|
||||
lappend fileList $f
|
||||
source $name
|
||||
}
|
||||
}
|
||||
#--------------------------------------------------------------------------
|
||||
# batchrun
|
||||
#--------------------------------------------------------------------------
|
||||
proc batchrun {name} {
|
||||
global sicsPar
|
||||
fileeval $sicspar(batchroot)/$name
|
||||
}
|
||||
#---------------------------------------------------------------------------
|
||||
# The sp command for setting zero points
|
||||
#--------------------------------------------------------------------------
|
||||
proc sp {axis value} {
|
||||
set axis [string tolower [string trim $axis]]
|
||||
set ret [catch {info body $axis]} msg]
|
||||
if { $ret != 0 } {
|
||||
error [format "ERROR: no %s to zero found" $axis]
|
||||
}
|
||||
if { [syntaxNumeric $value] != 1 } {
|
||||
error [format "ERROR: expected numeric zero target, got %s" \
|
||||
$name $value]
|
||||
}
|
||||
}
|
||||
#--------------------------------------------------------------------------
|
||||
# The psdconfigure command 4 TRICS and AMOR
|
||||
#--------------------------------------------------------------------------
|
||||
proc psdconfigure {hm xSize ySize} {
|
||||
set ret [catch {info body $hm} msg]
|
||||
if { $ret != 0 } {
|
||||
error [format "ERROR: $hm to configure not found!" $hm]
|
||||
}
|
||||
if { [syntaxNumeric $xSize] != 1 } {
|
||||
error "ERROR: expected numeric xSize, got $xSize"
|
||||
}
|
||||
if { [syntaxNumeric $ySize] != 1 } {
|
||||
error "ERROR: expected numeric ySize, got $ySize"
|
||||
}
|
||||
}
|
||||
#------------------------------------------------------------------------
|
||||
# The histogram memory control syntax
|
||||
#-----------------------------------------------------------------------
|
||||
proc hmcSyntax {name args} {
|
||||
set args [syntaxListify $args]
|
||||
if { [llength $args] < 2} {
|
||||
error "ERROR: missing argumnets to $name"
|
||||
}
|
||||
set p [lindex $args 0]
|
||||
if { [syntaxNumeric $p] != 1} {
|
||||
error "ERROR: expected numeric preset for $name, got $p"
|
||||
}
|
||||
set p [string trim [string tolower [lindex $args 1]]]
|
||||
if { [syntaxCountMode $p] != 1} {
|
||||
error "ERROR: invalid count mode $p for $name"
|
||||
}
|
||||
}
|
||||
#-------------------------------------------------------------------------
|
||||
# The syntax for the fourcircle calculation module
|
||||
#--------------------------------------------------------------------------
|
||||
lappend hklKey list current
|
||||
lappend hklPar lambda hm
|
||||
|
||||
proc syntaxHKL {name args} {
|
||||
global hklKey hklPar
|
||||
|
||||
set args [syntaxListify $args]
|
||||
|
||||
if { [llength $args] < 1} {
|
||||
error "ERROR: no subcommand to $name"
|
||||
}
|
||||
set subcommand [string trim [string tolower [lindex $args 0]]]
|
||||
#-------- check keyword commands
|
||||
if { [lsearch $hklKey $subcommand] >= 0} {
|
||||
return
|
||||
}
|
||||
#-------- check parameter commands
|
||||
if { [lsearch $hklPar $subcommand] >= 0} {
|
||||
if { [llength $args] > 1 } {
|
||||
set val [lindex $args 1]
|
||||
if { [syntaxNumeric $val] == 0 } {
|
||||
error [format "ERROR: %s.%s expected number, received %s" \
|
||||
$name $subcommand $val]
|
||||
} else {
|
||||
set sicsPar($name.$subcommand) $val
|
||||
}
|
||||
} else {
|
||||
return [syntaxGet $name.$subcommand]
|
||||
}
|
||||
}
|
||||
#------------ check the rest
|
||||
switch $subcommand {
|
||||
calc -
|
||||
drive -
|
||||
run {
|
||||
if { [llength $args] < 4} {
|
||||
error "ERROR: insufficient no args to $name calc,drive,run"
|
||||
}
|
||||
for { set i 1} { $i < [llength $args]} { incr i} {
|
||||
set val [lindex $args $i]
|
||||
if { [syntaxNumeric $val] != 1} {
|
||||
error "ERROR: expected numeric argument, got $val"
|
||||
}
|
||||
}
|
||||
}
|
||||
nb -
|
||||
quadrant {
|
||||
if { [llength $args] < 2} {
|
||||
error "ERROR: insufficient no args to $name nb, quadrant"
|
||||
}
|
||||
set val [lindex $args 1]
|
||||
if { [syntaxNumeric $val] != 1} {
|
||||
error \
|
||||
"ERROR: expected numeric argument ot nb, quadrant, got $val"
|
||||
}
|
||||
}
|
||||
setub {
|
||||
if { [llength $args] < 10 } {
|
||||
error "ERROR: insufficient no args to $name setub"
|
||||
}
|
||||
for { set i 1} { $i < [llength $args]} { incr i} {
|
||||
set val [lindex $args $i]
|
||||
if { [syntaxNumeric $val] != 1} {
|
||||
error "ERROR: expected numeric argument, got $val"
|
||||
}
|
||||
}
|
||||
}
|
||||
default {
|
||||
error "ERROR: $name does not know subcomand $subcommand"
|
||||
}
|
||||
}
|
||||
}
|
||||
#---------------------------------------------------------------------------
|
||||
# Mappings for some common SICS commands and variables
|
||||
#---------------------------------------------------------------------------
|
||||
sicsSyntaxMap clientput syntaxDummy
|
||||
sicsSyntaxMap ClientPut syntaxDummy
|
||||
sicsSyntaxMap success syntaxDummy
|
||||
sicsSyntaxMap drive syntaxDrive
|
||||
sicsSyntaxMap run syntaxDrive
|
||||
sicsSyntaxMap peak syntaxDummy
|
||||
sicsSyntaxMap center syntaxDummy
|
||||
sicsSyntaxMap batchroot syntaxTextPar
|
||||
sicsSyntaxMap sicstime syntaxDummy
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user