diff --git a/tcl/deltatau.tcl b/tcl/deltatau.tcl new file mode 100644 index 00000000..872d4c7c --- /dev/null +++ b/tcl/deltatau.tcl @@ -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 +#=============================================================================== diff --git a/tcl/hdbutil.tcl b/tcl/hdbutil.tcl index dde7e9fb..483c7574 100644 --- a/tcl/hdbutil.tcl +++ b/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 +} \ No newline at end of file diff --git a/tcl/secsim.tcl b/tcl/secsim.tcl new file mode 100644 index 00000000..498ddb92 --- /dev/null +++ b/tcl/secsim.tcl @@ -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 +} diff --git a/tcl/table.tcl b/tcl/table.tcl new file mode 100644 index 00000000..dba5878a --- /dev/null +++ b/tcl/table.tcl @@ -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 +# 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 \n\t number of repetions\n\t 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 +}