1158 lines
34 KiB
Tcl
1158 lines
34 KiB
Tcl
#-----------------------------------------------------------------------------
|
|
# This is the library file for the Tcl syntax checker for SICS commands.
|
|
# The basic idea is this:
|
|
# - SICS commands are replaced by Tcl procedures with the same name which
|
|
# implement the actual syntax check for this command.
|
|
# - As many SICS commands are object commands a facility is needed to map
|
|
# syntax checking procedures to names.
|
|
#
|
|
# copyright: see file COPYRIGHT
|
|
#
|
|
# Mark Koennecke, March 2003
|
|
#---------------------------------------------------------------------------
|
|
# sicsSyntaxMap maps the procedure syntaxProc to the name name. The name
|
|
# is prepended to the argument list in order to make the name available
|
|
# in the syntax checking procedure as the first argument
|
|
# This means syntax check procedures have two arguments:
|
|
# - the name
|
|
# - the list of remaining parameters as a string. Use syntaxListify
|
|
# to convert the list to a proper list for further processing
|
|
#---------------------------------------------------------------------------
|
|
proc sicsSyntaxMap {name syntaxProc} {
|
|
append newProc "proc " $name " args " \{ $syntaxProc " "
|
|
append newProc $name " " "\$args" \}
|
|
eval $newProc
|
|
}
|
|
#--------------------------------------------------------------------------
|
|
# a helper procedure which tests a value if it is numeric
|
|
#--------------------------------------------------------------------------
|
|
proc syntaxNumeric {val} {
|
|
set ret [catch {expr $val *1.} msg]
|
|
if { $ret == 0} {
|
|
return 1
|
|
} else {
|
|
return 0
|
|
}
|
|
}
|
|
#--------------------------------------------------------------------------
|
|
# a helper procedure which converts a stringified list back into a proper
|
|
# list
|
|
#--------------------------------------------------------------------------
|
|
proc syntaxListify {uff} {
|
|
set l [string trim $uff "{}"]
|
|
return [split $l]
|
|
}
|
|
#--------------------------------------------------------------------------
|
|
# a helper procedure which gets a parameter from the global parameter
|
|
# array or replaces it by the default 77 if it does not exist
|
|
#-------------------------------------------------------------------------
|
|
proc syntaxGet {name} {
|
|
global sicsPar
|
|
if { [info exists sicsPar($name)] == 1} {
|
|
return [format "%s = %s" $name \
|
|
$sicsPar($name)]
|
|
} else {
|
|
return [format " %s = 77" $name]
|
|
}
|
|
}
|
|
#------------------------------------------------------------------------
|
|
# syntaxCounterMode tests if par is a valid counter mode
|
|
#-----------------------------------------------------------------------
|
|
proc syntaxCounterMode {par} {
|
|
set p [string trim [string tolower $par]]
|
|
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} {
|
|
}
|
|
#---------------------------------------------------------------------------
|
|
# 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 warns about it.
|
|
#-------------------------------------------------------------------------
|
|
proc syntaxWarn {name args} {
|
|
puts stdout "INFO: Syntax for $name not checked"
|
|
return
|
|
}
|
|
#-----------------------------------------------------------------------
|
|
# syntaxTextPar is a syntax handling procedure for simple text variables
|
|
#----------------------------------------------------------------------
|
|
proc syntaxTextPar {name args} {
|
|
global sicsPar
|
|
|
|
set args [syntaxListify $args]
|
|
if { [llength $args] > 0} {
|
|
if { [string first setaccess [string tolower [lindex $args 0]]] < 0} {
|
|
set sicsPar($name) [join $args]
|
|
}
|
|
} else {
|
|
if { [info exists sicsPar($name)] == 1} {
|
|
return [format "%s = %s" $name \
|
|
$sicsPar($name)]
|
|
} else {
|
|
return [format " %s = UNKNOWN" $name]
|
|
}
|
|
}
|
|
}
|
|
#------------------------------------------------------------------------
|
|
# syntaxNumPar is a syntax handling procedure for a numeric variable
|
|
#-----------------------------------------------------------------------
|
|
proc syntaxNumPar {name args} {
|
|
global sicsPar
|
|
|
|
set args [syntaxListify $args]
|
|
if { [llength $args] > 0} {
|
|
if { [syntaxNumeric [lindex $args 0]] == 1} {
|
|
if { [string first setaccess \
|
|
[string tolower [lindex $args 0]]] < 0} {
|
|
set sicsPar($name) [lindex $args 0]
|
|
}
|
|
} else {
|
|
error [format \
|
|
"ERROR: expected numeric argument for %s, received: %s" \
|
|
$name [lindex $args 0]]
|
|
}
|
|
} else {
|
|
return [syntaxGet $name]
|
|
}
|
|
}
|
|
#--------------------------------------------------------------------------
|
|
# 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 accesscode
|
|
|
|
proc syntaxMotor {name args} {
|
|
global sicsPar motSub motSubKey
|
|
|
|
set args [syntaxListify $args]
|
|
#----- value request
|
|
if { [llength $args] == 0} {
|
|
return [syntaxGet $name]
|
|
}
|
|
#---------- keywords
|
|
set subcommand [string tolower [lindex $args 0]]
|
|
if { [lsearch $motSubKey $subcommand] >= 0} {
|
|
return
|
|
}
|
|
#---------- parameters
|
|
if { [lsearch $motSub $subcommand] < 0} {
|
|
error [format "ERROR: motor %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]
|
|
}
|
|
}
|
|
}
|
|
#---------------------------------------------------------------------------
|
|
# syntaxCounter deals with the syntax for a single counter
|
|
#---------------------------------------------------------------------------
|
|
lappend cterKey interest uninterest stop send
|
|
|
|
proc syntaxCounter {name args} {
|
|
global cterKey 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 $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
|
|
#--------------------------------------------------------------------------
|
|
set countSum 0
|
|
set countSavedPreset 1
|
|
#------------------------------------------------------------------------
|
|
proc count { {mode NULL } { preset NULL } } {
|
|
global countSum countSavedPreset
|
|
set m [string trim [string tolower $mode]]
|
|
if { [string compare $m null] == 0} {
|
|
return
|
|
} else {
|
|
set c [string index $mode 0]
|
|
if { [regexp \[mt\] $c] != 1 } {
|
|
error "ERROR: invalid counter mode $m specified for count"
|
|
}
|
|
}
|
|
set p [string trim [string tolower $preset]]
|
|
if { [string compare $p null] == 0} {
|
|
set countSum [expr $countSum + $countSavedPreset]
|
|
return
|
|
} else {
|
|
if {[syntaxNumeric $p] != 1 } {
|
|
error "ERROR: count expected numeric preset, got $p"
|
|
}
|
|
set countSum [expr $countSum + $p]
|
|
set countSavedPreset $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} } {
|
|
global countSum countSavedPreset
|
|
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 {
|
|
set c [string index $mode 0]
|
|
if { [regexp \[mc\] $c] != 1 } {
|
|
error "ERROR: invalid counter mode $m specified for count"
|
|
}
|
|
}
|
|
set p [string trim [string tolower $preset]]
|
|
if { [string compare $p null] == 0} {
|
|
set countSum [expr $countSum + $num*$countSavedPreset]
|
|
return
|
|
} else {
|
|
if {[syntaxNumeric $p] != 1 } {
|
|
error "ERROR: count expected numeric preset, got $p"
|
|
|
|
}
|
|
set countSum [expr $countSum + $num*$p]
|
|
set countSavedPreset $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"
|
|
}
|
|
}
|
|
}
|
|
#---------------------------------------------------------------------------
|
|
# syntax for xytables as used at SANS
|
|
#---------------------------------------------------------------------------
|
|
proc syntaxXY {name args} {
|
|
set args [syntaxListify $args]
|
|
if { [llength $args] < 1} {
|
|
error "ERROR: expected argument to $name"
|
|
}
|
|
set subcommand [string tolower [string trim [lindex $args 0]]]
|
|
switch $subcommand {
|
|
clear -
|
|
list -
|
|
uuget {return}
|
|
write {
|
|
if { [llength $args] < 2} {
|
|
error "ERROR: missing file name for $name write"
|
|
}
|
|
return
|
|
}
|
|
add {
|
|
if { [llength $args] < 3} {
|
|
error "ERROR: missing values for $name add"
|
|
}
|
|
for { set i 1} { $i < 3} {incr i} {
|
|
set val [string trim [lindex $args $i]]
|
|
if { [syntaxNumeric $val] != 1} {
|
|
error "ERROR: expected numeric arg to $name add, got $val"
|
|
}
|
|
}
|
|
}
|
|
default {
|
|
error "ERROR: subcommand $subcommand to $name not recognized"
|
|
}
|
|
}
|
|
}
|
|
#--------------------------------------------------------------------------
|
|
# Syntax check for the exe batch manager
|
|
#--------------------------------------------------------------------------
|
|
lappend exeFileList grrrrrrrmmmppppppppfffffff
|
|
|
|
proc checkExeBuffer {buffer} {
|
|
global exeFileList
|
|
if { [string compare [string index $buffer 0] "/"] == 0 } {
|
|
set name [file tail $buffer]
|
|
} else {
|
|
set name buffer
|
|
}
|
|
if { [lsearch $exeFileList $buffer] >= 0} {
|
|
puts stdout "INFO: Command file loop detected!"
|
|
return
|
|
}
|
|
}
|
|
#-------------------------------------------------------------------------
|
|
proc exe args {
|
|
global sicsPar
|
|
if { [llength $args] < 1} {
|
|
error "ERROR: exe needs at least one argument"
|
|
}
|
|
set key [lindex $args 0]
|
|
set key [string tolower $key]
|
|
switch $key {
|
|
syspath {
|
|
if { [llength $args] > 1} {
|
|
set sicsPar(exe.syspath) [lindex $args 1]
|
|
} else {
|
|
return [syntaxGet exe.syspath]
|
|
}
|
|
}
|
|
batchpath {
|
|
if { [llength $args] > 1} {
|
|
set sicsPar(exe.batchpath) [lindex $args 1]
|
|
} else {
|
|
return [syntaxGet exe.batchpath]
|
|
}
|
|
}
|
|
print -
|
|
info -
|
|
enqueue -
|
|
clear -
|
|
run -
|
|
interest -
|
|
queue {}
|
|
default {
|
|
checkExeBuffer $key
|
|
}
|
|
}
|
|
}
|
|
#---------------------------------------------------------------------------
|
|
# 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
|
|
|
|
|