linse/sics
0
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

pelican

Browse Source 
Create pas/config/source/source.tcl
config/source/source_common.tcl
pelican_configuration.tcl

deploySICS.sh
Don't deploy script validator configs, they are obsolete

server_config.tcl
Source config has been moved to  config/source and is specialised for each instrument by calling the instrument specific initialiser ::source:isc_initalize

commands_common_1.tcl
The monitor mode and preset are recorded when running the count command

counter_common_1.tcl
Report and record the counts and time for the multicounter and each monitor.  Also record the mode and preset for the multicounter.

hmm_configuration_common_1.tcl
Cleanup, remove obsolete code.
Report and record the hmm total counts and time.
Allow monitor controlled acquisition from the histogram server

nxscripts_common_1.tcl
Add DataType to NXdata section, preserve case in text attributes.

scan_common_1.tcl
Provide sensible feedback for our bmonscan and hmscan objects.
Set run_mode when doing a scan.  Allow users to select the datatype for histmem scans and to force a scan

wombat_configuration.tcl
echidna_configuration.tcl
platypus_configuration.tcl
kowari_configuration.tcl
quokka_configuration.tcl
Load source config.

quokka_configuration.tcl
SICS-198 HACK, Add AttrotDeg and RotApDeg status feedback.

sans/commands/commands.tcl
Add status feedback for quokka "guide" command.

sans/parameters/parameters.tcl
Make sure data can be saved as xml (replace % with _percent)
SICS-198 HACK, add AttRotDeg and RotApDeg status feedback.

utility.tcl
Fix nasty "params array generator" bug.  SICS commands execute at runlevel 0 which means that the params anonymous array must be made at this level.
Provide the normalattlist command to enable creating attribute lists with the case preserved.

Added the runsics, runtestsics and sicsclient scripts to CVS.
Added source configurations for echidna, wombat, kowari, quokka, platypus, and pelican to CVS

r2644 | ffr | 2008-07-11 11:09:57 +1000 (Fri, 11 Jul 2008) | 53 lines
This commit is contained in:
Ferdi Franceschini
2008-07-11 11:09:57 +10:00
committed by Douglas Clowes
parent b4fb916018
commit 01be487c52
33 changed files with 779 additions and 393 deletions
Download Patch File Download Diff File Expand all files Collapse all files

12
site_ansto/instrument/config/README.TXT
View File

@@ -1,2 +1,14 @@
This directory contains common configuration files shared by the instrument specific configurations.
How to add a new configuration section
mkdir config/newcomp
Create the common config file, eg
config/newcomp/newcomp_common.tcl
Create the instrument specific config file which sources the common config
hrpd/config/newcomp/newcomp.tcl
Add the path for the common config file to the common config list
hrpd/config/INSTCFCOMMON.TXT
DON'T FORGET TO ADD THE NEW FILES AND DIRECTORIES TO CVS

2
site_ansto/instrument/config/commands/commands_common.tcl
View File

@@ -72,7 +72,9 @@ namespace eval monitor {
} {
::monitor::count -set feedback status BUSY
bm setmode $mode
bm_mode $mode
bm count $preset
bm_preset $preset
::monitor::count -set feedback counts [SplitReply [bm getcounts]];
::monitor::count -set feedback status IDLE
}

53
site_ansto/instrument/config/counter/counter_common_1.tcl
View File

@@ -7,7 +7,6 @@ namespace eval counter {
proc ::counter::transferscript {} {
variable isc_numchannels
# set val "123.4 10 20 30 40 50 60 70 80"
set val [SplitReply [bm1 gettime]]
for {set i 1} {$i <= $isc_numchannels} {incr i} {
append val " [SplitReply [bm$i getcounts] ]"
@@ -29,30 +28,60 @@ proc ::counter::ic_initialize {} {
# MakeCounter bm SIM 0.0;
for {set n 1} {$n <= $isc_numchannels} {incr n} {
MakeCounter bm$n SIM 0.0
append bm_list "bm$n "
append bm_list "bm$n "
}
eval "MakeMultiCounter bm $bm_list"
} else {
# Make and configure an ANSTO beam monitor counter.
# This must be sourced before the hmm_configuration.tcl until we separate the scan setup from the hmm setup
for {set i 0; set n 1} {$i < $isc_numchannels} {incr i; incr n} {
MakeCounter bm$n anstomonitor [ params host $isc_monitor_address port [lindex $isc_portlist $i] ]
append bm_list "bm$n "
}
}
eval "MakeMultiCounter bm $bm_list"
bm transferscript ::counter::transferscript
bm SetExponent 0
sicslist setatt bm privilege internal
::utility::mkVar bm_mode Text user mode true monitor true true
::utility::mkVar bm_preset Float user preset true monitor true true
::utility::macro::getset float monitor_counts {} {
return "monitor_counts = [SplitReply [bm getcounts]]"
}
sicslist setatt monitor_counts klass monitor
sicslist setatt monitor_counts long_name data
sicslist setatt monitor_counts mutable true
::utility::macro::getset float monitor_time {} {
return "monitor_time = [SplitReply [bm gettime]]"
}
sicslist setatt monitor_time klass monitor
sicslist setatt monitor_time long_name time
sicslist setatt monitor_time mutable true
for {set bm_num 1} {$bm_num <= $isc_numchannels} {incr bm_num} {
set bm_counts bm${bm_num}_counts
set bmon bm${bm_num}
::utility::macro::getset int $bm_counts {} [subst -nocommands {
return "[$bmon getcounts]"
}]
sicslist setatt $bm_counts klass monitor
sicslist setatt $bm_counts long_name $bm_counts
sicslist setatt $bm_counts mutable true
set bm_time bm${bm_num}_time
set bmon bm${bm_num}
::utility::macro::getset float $bm_time {} [subst -nocommands {
return "[$bmon gettime]"
}]
sicslist setatt $bm_time klass monitor
sicslist setatt $bm_time long_name $bm_time
sicslist setatt $bm_time mutable true
}
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
::utility::macro::getset float monitor_counts {} {
return "monitor_counts = [SplitReply [bm getcounts]]"
}
sicslist setatt monitor_counts klass monitor
sicslist setatt monitor_counts long_name data
sicslist setatt monitor_counts mutable true

95
site_ansto/instrument/config/hmm/hmm_configuration_common_1.tcl
View File

@@ -1,5 +1,5 @@
# $Revision: 1.33 $
# $Date: 2008-07-01 07:02:26 $
# $Revision: 1.34 $
# $Date: 2008-07-11 01:09:56 $
# Author: Ferdi Franceschini
# Based on the examples in the hs_test.tcl sample configuration by Mark Lesha.
# http://gumtree.ansto.gov.au:9080/nbicms/bragg-systems/histogram-server/hs_test.tcl/view
@@ -18,6 +18,8 @@ namespace eval histogram_memory {
# Common config variables
variable histmem_simulation
variable ic_count_methods
variable preset_mult
variable monitor_controlled
# Instrument Specific Config variables
@@ -95,13 +97,13 @@ namespace eval histogram_memory {
array set default_frame_source_always_internal {
echidna "true"
koala "false"
kowari "false"
pelican "false"
platypus "false"
quokka "false"
taipan "false"
wombat "false"
koala "false"
kowari "false"
pelican "false"
platypus "false"
quokka "false"
taipan "false"
wombat "false"
}
::utility::mkVar detector_active_height_mm Float user active_height true detector true true
@@ -112,16 +114,7 @@ namespace eval histogram_memory {
::utility::mkVar hmm_user_configpath Text manager user_configpath false detector false false
hmm_user_configpath ../user_config/hmm
::utility::mkVar hmm_mode Text user mode true detector true true
::utility::mkVar _hmm_vert_axis Text user vert_axis true detector false true
::utility::mkVar _hmm_hor_axis Text user hor_axis true detector false true
::utility::mkVar _hmm_hor_axis_alias Text user hor_axis_alias true detector false true
::utility::mkVar _hmm_vert_axis_alias Text user vert_axis_alias true detector false true
::utility::mkVar _hmm_hor_channel_name Text user hor_channel_name true detector false true
_hmm_vert_axis y_pixel_offset
_hmm_vert_axis_alias dvaxis
_hmm_hor_axis polar_angle
_hmm_hor_axis_alias dtheta
_hmm_hor_channel_name horizontal_channel_number
::utility::mkVar hmm_preset Float user preset true detector true true
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
@@ -1549,6 +1542,33 @@ proc ::histogram_memory::t_max {} {
return -code error $message
}
}
##
# @brief Total counts in histogram defined by the OAT table.
::utility::macro::getset int ::histogram_memory::total_counts {} {
return "total_counts = [SplitReply [hmm configure num_events_filled_to_histo]]"
}
sicslist setatt ::histogram_memory::total_counts klass detector
sicslist setatt ::histogram_memory::total_counts long_name total_counts
sicslist setatt ::histogram_memory::total_counts mutable true
##
# @brief Histogram memory acquisition time
::utility::macro::getset float ::histogram_memory::time {} {
return "time = [SplitReply [hmm configure acq_dataset_active_sec]]"
}
sicslist setatt ::histogram_memory::time klass detector
sicslist setatt ::histogram_memory::time long_name time
sicslist setatt ::histogram_memory::time mutable true
sicslist setatt ::histogram_memory::time units seconds
##
# @brief Update the beam monitors when the histmem has finished counting.
proc ::histogram_memory::update_bm {} {
bm status
}
publish ::histogram_memory::update_bm user
##
# @brief Sets histogram server to default configuration, initialises SICS histogram memory
# dictionary values and clears SICS OAT BAT CAT FAT ... tables
@@ -1570,14 +1590,6 @@ proc ::histogram_memory::ic_initialize {} {
sicslist setatt $bm_status long_name $bm_status
sicslist setatt $bm_status mutable false
set bm_counts bm${bm_num}_counts
::utility::macro::getset int $bm_counts {} [subst -nocommands {
return "$bm_counts = [lindex [hmm configure $bm_counts] 2]"
}]
sicslist setatt $bm_counts klass monitor
sicslist setatt $bm_counts long_name $bm_counts
sicslist setatt $bm_counts mutable true
set bm_event_rate bm${bm_num}_event_rate
::utility::macro::getset float $bm_event_rate {} [subst -nocommands {
return "$bm_event_rate = [lindex [hmm configure $bm_event_rate] 2]"
@@ -1618,6 +1630,7 @@ proc ::histogram_memory::ic_initialize {} {
hmm configure hmDataPath ../HMData
hmm configure hmconfigscript $configuration
::histogram_memory::configure_dims
scriptcallback connect hmm COUNTEND ::histogram_memory::update_bm
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
@@ -1644,6 +1657,8 @@ proc ::histogram_memory::post_count {} {}
# @param block (optional) default="noblock"
proc ::histogram_memory::start {{blocking "noblock"}} {
variable histmem_simulation
variable monitor_controlled
if [ catch {
set options [list block noblock]
if {[lsearch $options $blocking] == -1} {
@@ -1651,7 +1666,11 @@ proc ::histogram_memory::post_count {} {}
}
::histogram_memory::pre_count
hmm init
hmc start 1000000000 timer pause 1
if {$monitor_controlled == "true"} {
hmm count
} else {
hmc start 1000000000 timer pause 1
}
set reply [SplitReply [hmm configure daq]]
if {$histmem_simulation==false && $reply != "Started"} {
error "ERROR: Histogram server failed to start"
@@ -1659,7 +1678,7 @@ proc ::histogram_memory::post_count {} {}
clientput "histmem started" value
if {$blocking == "block"} {
blockctr count 0
::histogram_memory::pause
::histogram_memory::pause
}
} message ] {
if {$::errorCode=="NONE"} {return $message}
@@ -1717,6 +1736,8 @@ proc ::histogram_memory::post_count {} {}
# @param method Set histmem mode or return current mode if blank
proc ::histogram_memory::count_method {{method ""}} {
variable ic_count_methods
variable preset_mult
variable monitor_controlled
if [ catch {
set modes $ic_count_methods
@@ -1726,10 +1747,21 @@ proc ::histogram_memory::post_count {} {}
if {[lsearch $modes $method] == -1} {
error "ERROR: Count mode, $method, must be one of $modes"
}
if {$method == "time"} {
set preset_mult 100
} else {
set preset_mult 1
}
hmm configure FAT_COUNT_METHOD $method
if {[string range $method 0 [string first "R_" $method]] == "MONITOR"} {
hmm configure FAT_${method}_CONTROL ENABLE
set bmchan [expr [string index $method end] - 1]
bm setchannel $bmchan
set monitor_controlled "true"
} else {
set monitor_controlled "false"
}
hmm stop
hmm init
hmm_mode $method
}
@@ -1746,6 +1778,8 @@ proc ::histogram_memory::post_count {} {}
# @see count_method
proc ::histogram_memory::count_size {{preset ""}} {
variable state
variable preset_mult
if [ catch {
if {$preset == ""} {
return $state(preset)
@@ -1753,9 +1787,10 @@ proc ::histogram_memory::post_count {} {}
if {[string is double $preset] == 0 || $preset < 0} {
error "ERROR: The preset must be a non-negative floating point number"
}
hmm configure FAT_COUNT_SIZE [expr {100.0 * $preset}]
hmm configure FAT_COUNT_SIZE [expr {$preset_mult * $preset}]
hmm init
set state(preset) $preset
hmm_preset $preset
}
} message ] {
if {$::errorCode=="NONE"} {return $message}

25
site_ansto/instrument/config/nexus/nxscripts_common_1.tcl
View File

@@ -11,12 +11,15 @@ sicsdatafactory new nxscript_data
::utility::mkVar eend Text user end_time true entry false true
::utility::mkVar timestamp int user time_stamp true entry false true
::utility::mkVar data_run_number int user run_number true instrument false true
::utility::mkVar nexus_datatype text user DataType true data false true
sicslist setatt data_run_number mutable true
sicslist setatt timestamp mutable true
sicslist setatt timestamp units seconds
sicslist setatt nexus_datatype mutable false
namespace eval nexus {
variable data_gp_path "/data"
nexus_datatype "UNKNOWN"
set exports [list newfile closefile save data]
eval namespace export $exports
if 0 {datafilename}
@@ -129,6 +132,7 @@ proc newFileName {postfix} {
}
proc ::nexus::process_filetype_policy {filetype filetype_spec} {
upvar $filetype_spec ft_spec
array set ft_spec_arr $ft_spec
if {[info exists ft_spec_arr($filetype)] == 0} {
@@ -265,8 +269,10 @@ proc ::nexus::newfile {type {namestyle data}} {
::hdb::set_save / false
hsetprop $data_gp_path currentfiletype UNKNOWN
hsetprop $data_gp_path datatype UNKNOWN
nexus_datatype "UNKNOWN"
} else {
::nexus::process_filetype_policy $type filetype_spec
nexus_datatype $type
}
} message ] {
if {$::errorCode=="NONE"} {return $message}
@@ -484,10 +490,10 @@ proc ::nexus::newfile {type {namestyle data}} {
}
"clear" {
debug_msg "'clear' case of switch"
foreach child [hlist $dpath] {
hsetprop $dpath/$child link @none
hsetprop $dpath/$child long_name @none
}
foreach child [hlist $dpath] {
hsetprop $dpath/$child link @none
hsetprop $dpath/$child long_name @none
}
}
"alias" {
debug_msg "'alias' case of switch"
@@ -808,7 +814,6 @@ proc ::nexus::histmem::save {hm nxalias data_type args} {
# TODO Get rank from /data
proc ::nexus::histmem::sdsinfo {hm data_type args} {
array set param $args
array set hm_prop [attlist $hm]
set rank [SplitReply [$hm configure rank]]
for {set i 0} {$i < $rank} {incr i} {lappend dimstr "\$(padim$i)"}
@@ -839,7 +844,7 @@ proc ::nexus::motor::save {motor nxalias data_type args} {
}
proc ::nexus::motor::sdsinfo {motor data_type args} {
array set param $args
array set attribute [attlist $motor]
array set attribute [::utility::normalattlist $motor]
set dtype [::nexus::hdb2nx_type $data_type]
if {[info exists attribute(units)]} {
set units_att " -attr {units,$attribute(units)} "
@@ -889,7 +894,7 @@ proc ::nexus::macro::getset_save {sobj nxalias data_type args} {
# @brief Define the scientific data set path for the nexus dictionary.
proc ::nexus::macro::getset_sdsinfo {sobj data_type args} {
array set param $args
array set attribute [attlist $sobj]
array set attribute [::utility::normalattlist $sobj]
set dtype [::nexus::hdb2nx_type $data_type]
if {[info exists attribute(units)]} {
set units_att " -attr {units,$attribute(units)} "
@@ -916,7 +921,7 @@ proc ::nexus::environment_controller::save {evc nxalias data_type args} {
}
proc ::nexus::environment_controller::sdsinfo {evc data_type args} {
array set param $args
array set attribute [attlist $evc]
array set attribute [::utility::normalattlist $evc]
set dtype [::nexus::hdb2nx_type $data_type]
if {[info exists attribute(units)]} {
set units_att " -attr {units,$attribute(units)} "
@@ -958,6 +963,8 @@ proc ::nexus::sicsvariable::save {svar nxalias data_type args} {
nxscript putattribute $nxalias units $attribute(units)
}
}
# TODO Add optional units to sicsvariables
proc ::nexus::sicsvariable::sdsinfo {svar data_type args} {
array set param $args
set dtype [::nexus::hdb2nx_type $data_type]
@@ -1053,7 +1060,7 @@ foreach expt $::nexus::exports {
set tmpstr [string map {"$" ""} {$Name: not supported by cvs2svn $}]
set nx_content_release_tag [lindex $tmpstr [expr [llength $tmpstr] - 1]]
set tmpstr [string map {"$" ""} {$Revision: 1.39 $}]
set tmpstr [string map {"$" ""} {$Revision: 1.40 $}]
set nx_content_revision_num [lindex $tmpstr [expr [llength $tmpstr] - 1]]
#namespace eval data {

176
site_ansto/instrument/config/scan/scan_common_1.tcl
View File

@@ -15,7 +15,7 @@
namespace eval scan {
variable ic_runscanpar
variable hmm_filetype
variable ic_hmm_datatype
variable save_filetype
variable reset_position
variable check_thread0
@@ -32,16 +32,47 @@ set reset_position "false"
set check_thread0 false
}
proc scan_collect {sobj uobj point} {
}
}
proc ::scan::bm_scan_collect {sobj uobj point} {
set vlist [split [$sobj getvarpar 0] = ];
set w(NP) $point
set sv [string trim [lindex [split [lindex $vlist 0] . ] 1]]
set header [format "%-4.4s %-9.9s %-14s %-11s %-11s %-11s %-7.7s" NP $sv Counts Channel0 Channel1 Channel2 Time]
set varval [SplitReply [$sv]]
set counts [SplitReply [bm getcounts]]
set mon1 [SplitReply [bm getmonitor 0]]
set mon2 [SplitReply [bm getmonitor 1]]
set mon3 [SplitReply [bm getmonitor 2]]
set time [SplitReply [bm gettime]]
set data [format "%-4d %-9.3f %-14d %-11d %-11d %-11d %-7.2f" $point $varval $counts $mon1 $mon2 $mon3 $time]
clientput $header
clientput $data
}
proc ::scan::hmm_scan_collect {sobj uobj point} {
set vlist [split [$sobj getvarpar 0] = ];
set w(NP) $point
set sv [string trim [lindex [split [lindex $vlist 0] . ] 1]]
set header [format "%-4.4s %-9.9s %-14s %-11s %-11s %-11s %-7.7s" NP $sv Counts Monitor1 Monitor2 Monitor3 Time]
set varval [SplitReply [$sv]]
set counts [SplitReply [::histogram_memory::total_counts]]
set mon1 [SplitReply [bm1 getcounts]]
set mon2 [SplitReply [bm2 getcounts]]
set mon3 [SplitReply [bm3 getcounts]]
set time [SplitReply [::histogram_memory::time]]
set data [format "%-4d %-9.3f %-14d %-11d %-11d %-11d %-7.2f" $point $varval $counts $mon1 $mon2 $mon3 $time]
clientput $header
clientput $data
}
proc ::scan::ic_initialize {} {
if [ catch {
variable ic_runscanpar
variable hmm_filetype
variable ic_hmm_datatype
set hmm_filetype HISTOGRAM_XYT
set ic_hmm_datatype HISTOGRAM_XYT
MakeScanCommand hmscan bm $::cfPath(scan)/scan_common_1.hdd recover.bin
MakeScanCommand bmonscan bm $::cfPath(scan)/scan_common_1.hdd recover.bin
@@ -50,18 +81,16 @@ proc ::scan::ic_initialize {} {
bmonscan function writeheader ::scan::donothing
bmonscan function writepoint ::scan::bm_writepoint
bmonscan function count ::scan::bm_count
#bmonscan function collect ::scan::scan_collect
bmonscan function collect ::scan::bm_scan_collect
bmonscan function prepare ::scan::bm_scan_prepare
bmonscan function finish ::scan::bm_scan_finish
hmscan configure script
#hmscan function prepare hdbprepare
#hmscan function collect hdbcollect
hmscan function writeheader ::scan::donothing
hmscan function writepoint ::scan::hmm_writepoint
hmscan function count ::scan::hmm_count
#hmscan function collect ::scan::scan_collect
hmscan function collect ::scan::hmm_scan_collect
hmscan function prepare ::scan::hmm_scan_prepare
hmscan function finish ::scan::hmm_scan_finish
@@ -151,7 +180,7 @@ proc ::scan::pre_hmm_scan_prepare {} {}
proc ::scan::hmm_scan_prepare {sobj uobj} {
variable scan_pt_start_time
variable save_filetype
variable hmm_filetype
variable ic_hmm_datatype
variable check_instrument_ready
variable force_scan
@@ -161,32 +190,33 @@ proc ::scan::hmm_scan_prepare {sobj uobj} {
::scan::check_scanvar $sobj $uobj
::scan::pre_hmm_scan_prepare
}] {
abortbatch
return -code error "HMSCAN ABORTED: $::errorInfo"
}
if [catch {
set numpoints [SplitReply [$sobj np]]
set vlist [split [$sobj getvarpar 0] = ]
set scanstart [lindex $vlist 1]
set scanstep [lindex $vlist 2]
::scan::hdb_hmscan -set NP $numpoints
::scan::hdb_hmscan -set scan_variable [string trim [lindex [split [lindex $vlist 0] . ] 1]]
::scan::hdb_hmscan -set scan_start $scanstart
::scan::hdb_hmscan -set scan_increment $scanstep
set numpoints [SplitReply [$sobj np]]
set vlist [split [$sobj getvarpar 0] = ]
set scanstart [lindex $vlist 1]
set scanstep [lindex $vlist 2]
::scan::hdb_hmscan -set NP $numpoints
::scan::hdb_hmscan -set scan_variable [string trim [lindex [split [lindex $vlist 0] . ] 1]]
::scan::hdb_hmscan -set scan_start $scanstart
::scan::hdb_hmscan -set scan_increment $scanstep
set scan_pt_start_time [sicstime]
set scan_pt_start_time [sicstime]
::scan::hdb_hmscan -set feedback status BUSY
::scan::hdb_hmscan -set feedback status BUSY
run_mode "hmscan"
::nexus::newfile $hmm_filetype $save_filetype
data axis 1 [::scan::hdb_hmscan -set scan_variable]
::nexus::newfile $ic_hmm_datatype $save_filetype
data axis 1 [::scan::hdb_hmscan -set scan_variable]
clientput "Scan start: $scanstart, Scan step: $scanstep, Number of points: $numpoints"
clientput "Filetype: $hmm_filetype"
# Prime DAE
hmm pause
clientput "Scan start: $scanstart, Scan step: $scanstep, Number of points: $numpoints"
clientput "Datatype: $ic_hmm_datatype"
# Prime DAE
hmm pause
}] {
run_mode "normal"
return -code error $::errorInfo
}
} else {
@@ -212,6 +242,7 @@ proc ::scan::hmm_scan_finish {sobj uobj} {
set $save_filetype "data"
::histogram_memory::stop
::scan::hdb_hmscan -set feedback status IDLE
run_mode "normal"
# Make sure that the next save command doesn't overwrite our scan data.
# and clear any data links
::nexus::newfile clear data
@@ -229,6 +260,7 @@ proc ::scan::hmm_scan_finish {sobj uobj} {
proc ::scan::bm_scan_finish {sobj uobj} {
variable reset_position
::scan::hdb_bmonscan -set feedback status IDLE
run_mode "normal"
# Make sure that the next save command doesn't overwrite our scan data.
# and clear any data links
::nexus::newfile clear data
@@ -278,55 +310,65 @@ proc ::scan::bm_count {sobj uobj point mode preset} {
proc ::scan::bm_scan_prepare {sobj uobj} {
variable scan_pt_start_time
variable check_instrument_ready
variable force_scan
if {[::plc::inst_ready] != 1} {
return -code error "HMSCAN ABORTED: Instrument not ready"
if {$force_scan || $check_instrument_ready && [::plc::inst_ready]} {
set force_scan false
if [catch {
::scan::check_scanvar $sobj $uobj
::scan::pre_hmm_scan_prepare
}] {
return -code error "BMONSCAN ABORTED: $::errorInfo"
}
if [catch {
#TODO Parameterise varindex in some way
set varindex 0;
set numpoints [SplitReply [$sobj np]]
set vlist [split [$sobj getvarpar $varindex] = ]
set scanstart [lindex $vlist 1]
set scanstep [lindex $vlist 2]
::scan::hdb_bmonscan -set feedback filename [SplitReply [dataFileName]]
::scan::hdb_bmonscan -set NP $numpoints
::scan::hdb_bmonscan -set scan_variable [string trim [lindex [split [lindex $vlist 0] . ] 1]];
::scan::hdb_bmonscan -set scan_start $scanstart
::scan::hdb_bmonscan -set scan_increment $scanstep
set scanvar_pts [SplitReply [$sobj getvardata $varindex]]
todo_msg "SET START TIME [sicstime]"
::scan::hdb_bmonscan -set feedback status BUSY
run_mode "bmonscan"
array set bm_fb [::scan::hdb_bmonscan -list feedback]
::nexus::newfile BEAM_MONITOR data
::nexus::data axis 1 [::scan::hdb_bmonscan -set scan_variable]
#stdscan prepare $sobj $uobj;
clientput "Scan start: $scanstart, Scan step: $scanstep, Number of points: $numpoints"
clientput "Datatype: BEAM_MONITOR"
}] {
run_mode "normal"
return -code error $::errorInfo
}
} else {
return -code error "BMONSCAN ABORTED: Instrument not ready"
}
if [catch {
::scan::check_scanvar $sobj $uobj
::scan::pre_hmm_scan_prepare
}] {
abortbatch
return -code error "BMONSCAN ABORTED: $::errorInfo"
}
#TODO Parameterise varindex in some way
set varindex 0;
set numpoints [SplitReply [$sobj np]]
set vlist [split [$sobj getvarpar $varindex] = ]
set scanstart [lindex $vlist 1]
set scanstep [lindex $vlist 2]
::scan::hdb_bmonscan -set feedback filename [SplitReply [dataFileName]]
::scan::hdb_bmonscan -set NP $numpoints
::scan::hdb_bmonscan -set scan_variable [string trim [lindex [split [lindex $vlist 0] . ] 1]];
::scan::hdb_bmonscan -set scan_start $scanstart
::scan::hdb_bmonscan -set scan_increment $scanstep
set scanvar_pts [SplitReply [$sobj getvardata $varindex]]
todo_msg "SET START TIME [sicstime]"
::scan::hdb_bmonscan -set feedback status BUSY
array set bm_fb [::scan::hdb_bmonscan -list feedback]
::nexus::newfile BEAM_MONITOR data
::nexus::data axis 1 [::scan::hdb_bmonscan -set scan_variable]
#stdscan prepare $sobj $uobj;
clientput "Scan start: $scanstart, Scan step: $scanstep, Number of points: $numpoints"
clientput "Filetype: BEAM_MONITOR"
}
Publish ::scan::scan_collect user
Publish ::scan::write_nxentry user
Publish ::scan::hmm_count user
Publish ::scan::hmm_scan_prepare user
Publish ::scan::hmm_scan_finish user
Publish ::scan::hmm_scan_collect user
Publish ::scan::hmm_writepoint user
Publish ::scan::donothing user
Publish ::scan::bm_scan_prepare user
Publish ::scan::bm_scan_finish user
Publish ::scan::bm_scan_collect user
Publish ::scan::bm_writepoint user
Publish ::scan::bm_count user
@@ -342,7 +384,7 @@ namespace eval scan {
# @param force true/false (default=false)
proc runscan {scanvar start stop numpoints mode preset args} {
variable hmm_filetype
variable ic_hmm_datatype
variable save_filetype
variable reset_position
variable force_scan
@@ -352,7 +394,7 @@ namespace eval scan {
set hm_ft_names [array names ::nexus::histmem_filetype_spec]
# Default filetype for histogram memory scans
set hmm_filetype "HISTOGRAM_XYT"
set ic_hmm_datatype "HISTOGRAM_XYT"
# Default save uniquely numbered files
set savetype "save"
set reset_position [SplitReply [::scan::runscan_reset_position]]
@@ -387,11 +429,11 @@ namespace eval scan {
error "ERROR: force must be true or false"
}
}
"filetype" {
"datatype" {
if {[lsearch $hm_ft_names $val] == -1} {
error "ERROR: filetype should be one of $hm_ft_names"
error "ERROR: datatype should be one of $hm_ft_names"
} else {
set hmm_filetype $val
set ic_hmm_datatype $val
}
}
"savetype" {
@@ -408,7 +450,7 @@ namespace eval scan {
}
}
default {
error "ERROR: $arg should be 'filetype' 'savetype' or 'force'"
error "ERROR: $arg should be 'datatype' 'savetype' or 'force'"
}
}
}

12
site_ansto/instrument/deploySICS.sh
View File

@@ -1,6 +1,6 @@
#!/bin/sh
# $Revision: 1.27 $
# $Date: 2008-05-30 00:26:54 $
# $Revision: 1.28 $
# $Date: 2008-07-11 01:09:56 $
# Author: Ferdi Franceschini (ffr@ansto.gov.au)
# Last revision by $Author: ffr $
@@ -184,18 +184,14 @@ fi
# Get list of files to copy and prepend directory name
COMMON=$(for f in $(cat $SRCDIR/MANIFEST.TXT); do echo -n "$SRCDIR/$f "; done)
INSTSPEC=$(for f in $(cat $INSTSRC/MANIFEST.TXT); do echo -n "$INSTSRC/$f "; done)
SCRIPT_VALIDATOR=$(for f in $(cat $INSTSRC/script_validator/MANIFEST.TXT); do echo -n "$INSTSRC/script_validator/$f "; done)
# Create Instrument Control Server directories and copy SICS configs to the 'server' directory
mkdir -p $TEMPDIR/$DESTDIR/{batch,server,log,tmp}
copy_server_config server
cp -a --preserve=timestamps ../SICServer $TEMPDIR/$DESTDIR/server
# Create Script Validator directories and copy SICS configs to the 'script_validator/server' directory
mkdir -p $TEMPDIR/$DESTDIR/script_validator/{batch,server,data,log,tmp}
copy_server_config script_validator/server
# Copy any script_validator configs
cp -a --preserve=timestamps $SCRIPT_VALIDATOR $TEMPDIR/$DESTDIR/script_validator/server
# Create Script Validator directories
mkdir -p $TEMPDIR/$DESTDIR/script_validator/{data,log,tmp}
# Create a manifest of the files installed on the IC host
echo "Date: $(date -Iminutes)" > $TEMPDIR/$DESTDIR/server/MANIFEST.TXT

1
site_ansto/instrument/hipd/config/INSTCFCOMMON.TXT
View File

@@ -1,3 +1,4 @@
config/source/source_common.tcl
config/anticollider/anticollider_common.tcl
config/plc/plc_common_1.tcl
config/counter/counter_common_1.tcl

5
site_ansto/instrument/hipd/config/source/source.tcl Normal file
View File

@@ -0,0 +1,5 @@
source $cfPath(source)/source_common.tcl
proc ::source::isc_initialize {} {
::source::ic_initialize "thermal"
}

7
site_ansto/instrument/hipd/wombat_configuration.tcl
View File

@@ -1,5 +1,5 @@
# $Revision: 1.22 $
# $Date: 2008-07-01 07:02:26 $
# $Revision: 1.23 $
# $Date: 2008-07-11 01:09:56 $
# Author: Ferdi Franceschini (ffr@ansto.gov.au)
# Last revision by: $Author: ffr $
@@ -21,6 +21,7 @@ fileeval $cfPath(motors)/motor_configuration.tcl
source instrument_vars.tcl
fileeval $cfPath(source)/source.tcl
source $cfPath(hipadaba)/hipadaba_configuration.tcl
fileeval $cfPath(plc)/plc.tcl
fileeval $cfPath(counter)/counter.tcl
@@ -48,8 +49,6 @@ catch {
if [file exists extraconfig.tcl] {
fileeval extraconfig.tcl
} else {
clientput "extraconfig.tcl not found. continueing"
}
buildHDB instrument_dictionary

1
site_ansto/instrument/hrpd/config/INSTCFCOMMON.TXT
View File

@@ -1,3 +1,4 @@
config/source/source_common.tcl
config/anticollider/anticollider_common.tcl
config/plc/plc_common_1.tcl
config/counter/counter_common_1.tcl

5
site_ansto/instrument/hrpd/config/source/source.tcl Normal file
View File

@@ -0,0 +1,5 @@
source $cfPath(source)/source_common.tcl
proc ::source::isc_initialize {} {
::source::ic_initialize "thermal"
}

7
site_ansto/instrument/hrpd/echidna_configuration.tcl
View File

@@ -1,5 +1,5 @@
# $Revision: 1.29 $
# $Date: 2008-07-01 07:02:26 $
# $Revision: 1.30 $
# $Date: 2008-07-11 01:09:57 $
# Author: Ferdi Franceschini (ffr@ansto.gov.au)
# Last revision by: $Author: ffr $
@@ -21,6 +21,7 @@ fileeval $cfPath(motors)/motor_configuration.tcl
source instrument_vars.tcl
fileeval $cfPath(source)/source.tcl
source $cfPath(hipadaba)/hipadaba_configuration.tcl
fileeval $cfPath(plc)/plc.tcl
fileeval $cfPath(counter)/counter.tcl
@@ -44,8 +45,6 @@ catch {
if [file exists extraconfig.tcl] {
fileeval extraconfig.tcl
} else {
clientput "extraconfig.tcl not found. continueing"
}
buildHDB instrument_dictionary

2
site_ansto/instrument/hrpd/script_validator/MANIFEST.TXT
View File

@@ -1,2 +0,0 @@
sics_ports.tcl
config

13
site_ansto/instrument/pas/config/INSTCFCOMMON.TXT Normal file
View File

@@ -0,0 +1,13 @@
config/source/source_common.tcl
config/anticollider/anticollider_common.tcl
config/plc/plc_common_1.tcl
config/counter/counter_common_1.tcl
config/hipadaba/hipadaba_configuration_common.tcl
config/hipadaba/common_instrument_dictionary.tcl
config/hipadaba/instdict_specification.tcl
config/hmm/hmm_configuration_common_1.tcl
config/hmm/anstohm_linked.xml
config/scan/scan_common_1.hdd
config/scan/scan_common_1.tcl
config/nexus/nxscripts_common_1.tcl
config/commands/commands_common.tcl

7
site_ansto/instrument/pas/config/source/source.tcl Normal file
View File

@@ -0,0 +1,7 @@
source $cfPath(source)/source_common.tcl
proc ::source::isc_initialize {} {
::source::ic_initialize "cold"
}

53
site_ansto/instrument/pas/pelican_configuration.tcl Normal file
View File

@@ -0,0 +1,53 @@
# $Revision: 1.1 $
# $Date: 2008-07-11 01:09:57 $
# Author: Ferdi Franceschini (ffr@ansto.gov.au)
# Last revision by: $Author: ffr $
# Required by server_config.tcl
VarMake Instrument Text Internal
Instrument pelican
Instrument lock
#START SERVER CONFIGURATION SECTION
source util/dmc2280/dmc2280_util.tcl
source sics_ports.tcl
source server_config.tcl
#END SERVER CONFIGURATION SECTION
########################################
# INSTRUMENT SPECIFIC CONFIGURATION
fileeval $cfPath(source)/source.tcl
source $cfPath(hipadaba)/hipadaba_configuration.tcl
fileeval $cfPath(parameters)/parameters.tcl
fileeval $cfPath(motors)/motor_configuration.tcl
fileeval $cfPath(plc)/plc.tcl
fileeval $cfPath(counter)/counter.tcl
fileeval $cfPath(hmm)/hmm_configuration.tcl
fileeval $cfPath(hmm)/detector.tcl
fileeval $cfPath(nexus)/nxscripts.tcl
fileeval $cfPath(scan)/scan.tcl
fileeval $cfPath(commands)/commands.tcl
fileeval $cfPath(anticollider)/anticollider.tcl
source gumxml.tcl
########
# Parameters set above the restore command will be clobbered by
# the values in the status.tcl file
# BIG WARNING: DON'T PUT 'restore' IN A CATCH BLOCK BECAUSE IT RETURNS
# AN ERROR IF THERE IS NO ../log/status.tcl FILE.
restore
catch {
server_init
if [file exists extraconfig.tcl] {
fileeval extraconfig.tcl
}
buildHDB instrument_dictionary
}
clientput $errorContext
clientput $callStack

1
site_ansto/instrument/reflectometer/config/INSTCFCOMMON.TXT
View File

@@ -1,3 +1,4 @@
config/source/source_common.tcl
config/anticollider/anticollider_common.tcl
config/plc/plc_common_1.tcl
config/counter/counter_common_1.tcl

7
site_ansto/instrument/reflectometer/config/source/source.tcl Normal file
View File

@@ -0,0 +1,7 @@
source $cfPath(source)/source_common.tcl
proc ::source::isc_initialize {} {
::source::ic_initialize "cold"
}

7
site_ansto/instrument/reflectometer/platypus_configuration.tcl
View File

@@ -1,5 +1,5 @@
# $Revision: 1.18 $
# $Date: 2008-07-01 07:02:26 $
# $Revision: 1.19 $
# $Date: 2008-07-11 01:09:57 $
# Author: Ferdi Franceschini (ffr@ansto.gov.au)
# Last revision by: $Author: ffr $
@@ -17,6 +17,7 @@ source server_config.tcl
########################################
# INSTRUMENT SPECIFIC CONFIGURATION
fileeval $cfPath(source)/source.tcl
source $cfPath(hipadaba)/hipadaba_configuration.tcl
fileeval $cfPath(parameters)/parameters.tcl
fileeval $cfPath(motors)/motor_configuration.tcl
@@ -48,8 +49,6 @@ catch {
if [file exists extraconfig.tcl] {
fileeval extraconfig.tcl
} else {
clientput "extraconfig.tcl not found. continueing"
}
buildHDB instrument_dictionary

1
site_ansto/instrument/rsd/config/INSTCFCOMMON.TXT
View File

@@ -1,3 +1,4 @@
config/source/source_common.tcl
config/anticollider/anticollider_common.tcl
config/plc/plc_common_1.tcl
config/counter/counter_common_1.tcl

6
site_ansto/instrument/rsd/config/source/source.tcl Normal file
View File

@@ -0,0 +1,6 @@
source $cfPath(source)/source_common.tcl
proc ::source::isc_initialize {} {
::source::ic_initialize "thermal"
}

7
site_ansto/instrument/rsd/kowari_configuration.tcl
View File

@@ -1,5 +1,5 @@
# $Revision: 1.12 $
# $Date: 2008-07-01 07:02:26 $
# $Revision: 1.13 $
# $Date: 2008-07-11 01:09:57 $
# Author: Ferdi Franceschini (ffr@ansto.gov.au)
# Last revision by: $Author: ffr $
@@ -20,6 +20,7 @@ source server_config.tcl
fileeval $cfPath(motors)/motor_configuration.tcl
fileeval $cfPath(source)/source.tcl
source $cfPath(hipadaba)/hipadaba_configuration.tcl
fileeval $cfPath(plc)/plc.tcl
fileeval $cfPath(counter)/counter.tcl
@@ -43,8 +44,6 @@ catch {
if [file exists extraconfig.tcl] {
fileeval extraconfig.tcl
} else {
clientput "extraconfig.tcl not found. continueing"
}
buildHDB instrument_dictionary

1
site_ansto/instrument/sans/config/INSTCFCOMMON.TXT
View File

@@ -1,3 +1,4 @@
config/source/source_common.tcl
config/anticollider/anticollider_common.tcl
config/plc/plc_common_1.tcl
config/counter/counter_common_1.tcl

37
site_ansto/instrument/sans/config/commands/commands.tcl
View File

@@ -45,21 +45,30 @@ namespace eval optics {
variable guide_configuration
variable guide_configuration_columns
if [ catch {
array set c1_map {G 1 MT 2 P 3}
array set c2_map {MT 1 G 2 A 3}
array set c3_map {MT 1 G 2 A 3}
array set c4_map {MT 1 G 2 A 3}
array set c5_map {MT 1 G 2 A 3}
array set c6_map {MT 1 G 2 A 3}
array set c7_map {MT 1 G 2 A 3}
array set c8_map {MT 1 G 2 A 3}
array set c9_map {LP 1 MT 2 G 3 A 4 L 5}
array set c1_map {G 1 MT 2 P 3}
array set c2_map {MT 1 G 2 A 3}
array set c3_map {MT 1 G 2 A 3}
array set c4_map {MT 1 G 2 A 3}
array set c5_map {MT 1 G 2 A 3}
array set c6_map {MT 1 G 2 A 3}
array set c7_map {MT 1 G 2 A 3}
array set c8_map {MT 1 G 2 A 3}
array set c9_map {LP 1 MT 2 G 3 A 4 L 5}
foreach el $guide_configuration($configuration) guide $guide_configuration_columns {
lappend to_config $guide
lappend to_config [set ${guide}_map($el)]
foreach el $guide_configuration($configuration) guide $guide_configuration_columns {
lappend to_config $guide
lappend to_config [set ${guide}_map($el)]
}
::optics::guide -set feedback status BUSY
eval "drive $to_config"
} message ] {
::optics::guide -set feedback status IDLE
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
eval "drive $to_config"
::optics::guide -set feedback status IDLE
}
::optics::guide -addfb text status
::optics::guide -set feedback status IDLE
}

108
site_ansto/instrument/sans/config/parameters/parameters.tcl
View File

@@ -48,23 +48,23 @@ foreach {var lname nxname units klass} {
# Parameter SicsVariables
foreach {var lname nxname units priv } {
LambdaA LambdaA wavelength nm user
LambdaResFWHM% LambdaResFWHM% wavelength_spread 1 user
VSdeg VSdeg twist degrees user
VSrpm VSrpm rotation_speed rpm user
EApYmm EApYmm y mm user
EApPosYmm EApPosYmm y mm user
SApXmm SApXmm x mm user
SApZmm SApZmm z mm user
SApPosXmm SApPosXmm x mm user
SApPosYmm SApPosYmm y mm user
SApPosZmm SApPosZmm z mm user
SamplePosXmm SamplePosXmm x mm user
SamplePosYmm SamplePosYmm y mm user
SamplePosZmm SamplePosZmm z mm user
DetPosYOffsetmm DetPosYOffsetmm detposyoffset mm user
BSXmm BSXmm x mm user
BSZmm BSZmm z mm user
LambdaA LambdaA wavelength nm user
LambdaResFWHM_percent LambdaResFWHM_percent wavelength_spread 1 user
VSdeg VSdeg twist degrees user
VSrpm VSrpm rotation_speed rpm user
EApYmm EApYmm y mm user
EApPosYmm EApPosYmm y mm user
SApXmm SApXmm x mm user
SApZmm SApZmm z mm user
SApPosXmm SApPosXmm x mm user
SApPosYmm SApPosYmm y mm user
SApPosZmm SApPosZmm z mm user
SamplePosXmm SamplePosXmm x mm user
SamplePosYmm SamplePosYmm y mm user
SamplePosZmm SamplePosZmm z mm user
DetPosYOffsetmm DetPosYOffsetmm detposyoffset mm user
BSXmm BSXmm x mm user
BSZmm BSZmm z mm user
} {
::utility::mkVar $var float $priv $lname true parameter true true
if {$units != 1} {
@@ -74,7 +74,7 @@ foreach {var lname nxname units priv } {
# Derived Parameter SicsVariables
foreach {var type lname units depends} {
AttFactor float AttFactor 1 AttRotDeg,LambdaA,LambdaResFWHM%
AttFactor float AttFactor 1 AttRotDeg,LambdaA,LambdaResFWHM_percent
PleXmm float PleXmm mm AttRotDeg
EApXmm float EApXmm mm RotApDeg
EApZmm float EApZmm mm RotApDeg
@@ -139,22 +139,28 @@ foreach {pname motor units} {
if {[set args] == ""} {
return [sicsmsgfmt [SplitReply [$motor]]]
} else {
set target [lindex [set args] 0]
Plexmm -1
set target [lindex [set args] 0]
Plexmm -1
${pname}_status "BUSY"
drive $motor \$target
set motpos [SplitReply [$motor]]
set motpos [SplitReply [$motor]]
set tolerance [SplitReply [$motor precision] ]
if {[expr abs(\$motpos - \$target)] > \$tolerance} {
error "ERROR: failed to set $pname target \$target"
} else {
Plexmm [::optics::AttRotLookup \$target]
}
if {[expr abs(\$motpos - \$target)] > \$tolerance} {
${pname}_status "IDLE"
error "ERROR: failed to set $pname target \$target"
} else {
Plexmm [::optics::AttRotLookup \$target]
}
${pname}_status "IDLE"
}
}]
sicslist setatt $pname units $units
sicslist setatt $pname long_name $pname
sicslist setatt $pname klass derived_parameter
# sicslist setatt $pname depends $motor
# TODO SICS-198 add feedback support to getset macro generator
VarMake ${pname}_status text mugger
${pname}_status "IDLE"
}
foreach {pname motor units} {
@@ -164,34 +170,40 @@ foreach {pname motor units} {
if {[set args] == ""} {
return [sicsmsgfmt [SplitReply [$motor]]]
} else {
set target [lindex [set args] 0]
RotApXmm 0
RotApZmm 0
RotApShape "UNKNOWN"
EApXmm 0
EApZmm 0
EApShape "UNKNOWN"
set target [lindex [set args] 0]
RotApXmm 0
RotApZmm 0
RotApShape "UNKNOWN"
EApXmm 0
EApZmm 0
EApShape "UNKNOWN"
${pname}_status "BUSY"
drive $motor \$target
set motpos [SplitReply [$motor]]
set motpos [SplitReply [$motor]]
set tolerance [SplitReply [$motor precision] ]
if {[expr abs(\$motpos - \$target)] > \$tolerance} {
error "ERROR: failed to set $pname target \$target"
} else {
set size [::optics::EApLookUp \$target "size"]
set shape [::optics::EApLookUp \$target "shape"]
RotApXmm \$size
RotApZmm \$size
RotApShape \$shape
EApXmm \$size
EApZmm \$size
EApShape \$shape
}
if {[expr abs(\$motpos - \$target)] > \$tolerance} {
${pname}_status "IDLE"
error "ERROR: failed to set $pname target \$target"
} else {
set size [::optics::EApLookUp \$target "size"]
set shape [::optics::EApLookUp \$target "shape"]
RotApXmm \$size
RotApZmm \$size
RotApShape \$shape
EApXmm \$size
EApZmm \$size
EApShape \$shape
}
${pname}_status "IDLE"
}
}]
sicslist setatt $pname units $units
sicslist setatt $pname long_name $pname
sicslist setatt $pname klass derived_parameter
# sicslist setatt $pname depends $motor
# TODO SICS-198 add feedback support to getset macro generator
VarMake ${pname}_status text mugger
${pname}_status "IDLE"
}
################################################################################
##
@@ -199,7 +211,7 @@ foreach {pname motor units} {
# as the reference for other positions. x=y=z=0.
::hdb::MakeVelocity_Selector velocity_selector {
wavelength LambdaA
wavelength_spread LambdaResFWHM%
wavelength_spread LambdaResFWHM_percent
coordinate_scheme VelSelCoordScheme
position {VelSelPosXmm VelSelPosYmm VelSelPosZmm}
}
@@ -314,7 +326,7 @@ namespace eval parameters {
L1mm
L2mm
LambdaA
LambdaResFWHM%
LambdaResFWHM_percent
Pent
Plexmm
RotApDeg

6
site_ansto/instrument/sans/config/source/source.tcl Normal file
View File

@@ -0,0 +1,6 @@
source $cfPath(source)/source_common.tcl
proc ::source::isc_initialize {} {
::source::ic_initialize "cold"
}

12
site_ansto/instrument/sans/quokka_configuration.tcl
View File

@@ -1,5 +1,5 @@
# $Revision: 1.10 $
# $Date: 2008-07-01 07:02:26 $
# $Revision: 1.11 $
# $Date: 2008-07-11 01:09:57 $
# Author: Ferdi Franceschini (ffr@ansto.gov.au)
# Last revision by: $Author: ffr $
@@ -17,6 +17,7 @@ source server_config.tcl
########################################
# INSTRUMENT SPECIFIC CONFIGURATION
fileeval $cfPath(source)/source.tcl
source $cfPath(hipadaba)/hipadaba_configuration.tcl
fileeval $cfPath(nexus)/nxscripts.tcl
fileeval $cfPath(parameters)/parameters.tcl
@@ -57,11 +58,14 @@ catch {
if [file exists extraconfig.tcl] {
fileeval extraconfig.tcl
} else {
clientput "extraconfig.tcl not found. continueing"
}
buildHDB instrument_dictionary
# TODO SICS-198 add feedback support to getset macro generator
foreach pname {AttRotDeg RotApDeg} {
hmake /instrument/parameters/derived_parameters/$pname/feedback spy none
hattach /instrument/parameters/derived_parameters/$pname/feedback ${pname}_status status
}
}
clientput $errorContext

89
site_ansto/instrument/server_config.tcl
View File

@@ -1,7 +1,7 @@
# SICS common configuration
# $Revision: 1.36 $
# $Date: 2008-07-01 07:02:25 $
# $Revision: 1.37 $
# $Date: 2008-07-11 01:09:56 $
# Author: Ferdi Franceschini (ffr@ansto.gov.au)
# Last revision by $Author: ffr $
@@ -80,6 +80,7 @@ set cfParent config
#WARNING Make sure there are no spaces after the back-slashes
array set cfPath [list\
parameters $cfParent/parameters\
source $cfParent/source\
anticollider $cfParent/anticollider\
motors $cfParent/motors\
optics $cfParent/optics\
@@ -124,14 +125,20 @@ SicsDataPrefix [SplitReply [Instrument]]
::utility::mkVar SicsDataPostFix Text manager
SicsDataPostFix nx.hdf
foreach {var val klass} {
program_name "SICS" entry
run_mode "normal" entry
} {
::utility::mkVar $var Text manager $var true $klass true true
$var $val
}
::utility::mkVar sics_release Text manager sics_release true entry true true
set tmpstr [string map {"$" ""} {$Name: not supported by cvs2svn $}]
sics_release [lindex $tmpstr [expr [llength $tmpstr] - 1]]
sics_release lock
::utility::mkVar sics_revision_num Text internal
set tmpstr [string map {"$" ""} {$Revision: 1.36 $}]
set tmpstr [string map {"$" ""} {$Revision: 1.37 $}]
sics_revision_num [lindex $tmpstr [expr [llength $tmpstr] - 1]]
sics_revision_num lock
@@ -176,6 +183,7 @@ proc server_set_sobj_attributes {} {
proc server_init {} {
if [ catch {
::source::isc_initialize
::counter::isc_initialize
::histogram_memory::isc_initialize
::scan::isc_initialize
@@ -195,76 +203,3 @@ proc server_init {} {
return -code error $message
}
}
# Make the opal status info object
set sim_mode [SplitReply [opal_simulation]]
if {$sim_mode == "true"} {
proc opal {status} {
set opal_status {
"CALIBRATED.CALIBRATED REACTOR POWER 0290_04:ARPCS_CNTRL.RO0005 = 20 (08-06-04 11:42:39)"
"CNS HELIUM INLET TEMPERATURE 6290_09:TI_100.PNT = 19.6426 (08-06-20 12:17:36)"
"CNS H/E HELIUM OUTLET TEMPERATUR 6290_MB08:TI_712DCI.MEAS = 25.68 (08-06-20 12:17:36)"
"CNS HELIUM FLOW 6290_09:FI1_106.PNT = 64.2064 (08-06-20 12:17:36)"
}
switch $status {
"CALIBRATED REACTOR POWER" {
return [lindex $opal_status 0]
}
"CNS HELIUM INLET TEMPERATURE" {
return [lindex $opal_status 1]
}
"HELIUM OUTLET TEMPERATUR" {
return [lindex $opal_status 2]
}
"CNS HELIUM FLOW" {
return [lindex $opal_status 3]
}
"list" {
return $opal_status
}
}
}
publish opal user
} else {
MakeAsyncQueue lss_chan LSS 137.157.204.67 31250
MakeLSSMonitor opal lss_chan 0
}
::utility::macro::getset float reactor_power {} {
set str [opal "CALIBRATED REACTOR POWER"]
set value [lindex [lindex [split $str =] 1] 0]
return "reactor_power = $value"
}
sicslist setatt reactor_power klass source
sicslist setatt reactor_power long_name power
sicslist setatt reactor_power mutable true
sicslist setatt reactor_power units "MW"
::utility::macro::getset float cns_inlet_temp {} {
set str [opal "CNS HELIUM INLET TEMPERATURE"]
set value [lindex [lindex [split $str =] 1] 0]
return "cns_inlet_temp = $value"
}
sicslist setatt cns_inlet_temp klass source
sicslist setatt cns_inlet_temp long_name cns_inlet_temp
sicslist setatt cns_inlet_temp mutable true
sicslist setatt cns_inlet_temp units "K"
::utility::macro::getset float cns_outlet_temp {} {
set str [opal "HELIUM OUTLET TEMPERATUR"]
set value [lindex [lindex [split $str =] 1] 0]
return "cns_outlet_temp = $value"
}
sicslist setatt cns_outlet_temp klass source
sicslist setatt cns_outlet_temp long_name cns_outlet_temp
sicslist setatt cns_outlet_temp mutable true
sicslist setatt cns_outlet_temp units "K"
::utility::macro::getset float cns_flow {} {
set str [opal "CNS HELIUM FLOW"]
set value [lindex [lindex [split $str =] 1] 0]
return "cns_flow = $value"
}
sicslist setatt cns_flow klass source
sicslist setatt cns_flow long_name cns_flow_temp
sicslist setatt cns_flow mutable true
sicslist setatt cns_flow units "ls-1"

93
site_ansto/instrument/util/runsics Executable file
View File

@@ -0,0 +1,93 @@
#!/bin/sh
# We should really have an init script calling this or something like it.
INSTRUMENT=${HOSTNAME#ics1-}
# Start SICS
startsics() {
if netstat -ltp 2> /dev/null|grep -q "server-${INSTRUMENT}.*SICServer"; then
echo SICS is already running
return 1
fi
echo Starting SICS
cd /usr/local/sics/server
nohup $PWD/SICServer ${INSTRUMENT}_configuration.tcl
if netstat -ltp 2> /dev/null|grep -q "server-${INSTRUMENT}.*SICServer"; then
echo SUCCESS
return 1
else
echo SICS failed to start
return 0
fi
}
# Start script validator
startscriptvalidator() {
if netstat -ltp 2> /dev/null|grep -q "server-val-${INSTRUMENT}.*SICServer"; then
echo SICS script validator is already running
return 1
fi
echo Starting SICS Script Validator
cd /usr/local/sics/server/
SICS_SIMULATION=script_validator nohup $PWD/SICServer ${INSTRUMENT}_configuration.tcl
if netstat -ltp 2> /dev/null|grep -q "server-val-${INSTRUMENT}.*SICServer"; then
echo SUCCESS
return 1
else
echo SICS script validator failed to start
return 0
fi
}
usage() {
progname=`basename $0`
echo Usage: $progname start
echo "To start SICS and the Script validator"
echo
echo You can get status or stop SICS as follows,
echo $progname status
echo $progname stop
}
if [ $# -eq 0 ]
then
usage
exit
fi
if [ $1 = "start" ]
then
startsics
echo
startscriptvalidator
echo
elif [ $1 = "stop" ]
then
if killall SICServer; then
echo Terminating all SICS servers
else
echo No SICS servers are running
fi
if netstat -ltp 2> /dev/null|grep -q "server-${INSTRUMENT}.*SICServer"; then
echo FAILED to stop SICServer
else
echo SICServer stopped
fi
if netstat -ltp 2> /dev/null|grep -q "server-val-${INSTRUMENT}.*SICServer"; then
echo FAILED to stop SICS script validator
else
echo SICS script validator stopped
fi
elif [ $1 = "status" ]
then
if netstat -ltp 2> /dev/null|grep -q "server-${INSTRUMENT}.*SICServer"; then
echo SICServer running
else
echo SICServer NOT running
fi
if netstat -ltp 2> /dev/null|grep -q "server-val-${INSTRUMENT}.*SICServer"; then
echo SICS script validator running
else
echo SICS script validator NOT running
fi
fi

93
site_ansto/instrument/util/runtestsics Executable file
View File

@@ -0,0 +1,93 @@
#!/bin/sh
# We should really have an init script calling this or something like it.
INSTRUMENT=${HOSTNAME#ics1-}
# Start SICS
startsics() {
if netstat -ltp 2> /dev/null|grep -q "server-${INSTRUMENT}.*SICServer"; then
echo SICS is already running
return 1
fi
echo Starting SICS
cd /usr/local/TEST_SICS/${INSTRUMENT}/sics/server
SICS_SIMULATION=full nohup $PWD/SICServer ${INSTRUMENT}_configuration.tcl
if netstat -ltp 2> /dev/null|grep -q "server-${INSTRUMENT}.*SICServer"; then
echo SUCCESS
return 1
else
echo SICS failed to start
return 0
fi
}
# Start script validator
startscriptvalidator() {
if netstat -ltp 2> /dev/null|grep -q "server-val-${INSTRUMENT}.*SICServer"; then
echo SICS script validator is already running
return 1
fi
echo Starting SICS Script Validator
cd /usr/local/TEST_SICS/${INSTRUMENT}/sics/server
SICS_SIMULATION=script_validator nohup $PWD/SICServer ${INSTRUMENT}_configuration.tcl
if netstat -ltp 2> /dev/null|grep -q "server-val-${INSTRUMENT}.*SICServer"; then
echo SUCCESS
return 1
else
echo SICS script validator failed to start
return 0
fi
}
usage() {
progname=`basename $0`
echo Usage: $progname start
echo "To start SICS and the Script validator"
echo
echo You can get status or stop SICS as follows,
echo $progname status
echo $progname stop
}
if [ $# -eq 0 ]
then
usage
exit
fi
if [ $1 = "start" ]
then
startsics
echo
startscriptvalidator
echo
elif [ $1 = "stop" ]
then
if killall SICServer; then
echo Terminating all SICS servers
else
echo No SICS servers are running
fi
if netstat -ltp 2> /dev/null|grep -q "server-${INSTRUMENT}.*SICServer"; then
echo FAILED to stop SICServer
else
echo SICServer stopped
fi
if netstat -ltp 2> /dev/null|grep -q "server-val-${INSTRUMENT}.*SICServer"; then
echo FAILED to stop SICS script validator
else
echo SICS script validator stopped
fi
elif [ $1 = "status" ]
then
if netstat -ltp 2> /dev/null|grep -q "server-${INSTRUMENT}.*SICServer"; then
echo SICServer running
else
echo SICServer NOT running
fi
if netstat -ltp 2> /dev/null|grep -q "server-val-${INSTRUMENT}.*SICServer"; then
echo SICS script validator running
else
echo SICS script validator NOT running
fi
fi

5
site_ansto/instrument/util/sicsclient Executable file
View File

@@ -0,0 +1,5 @@
#!/bin/sh
INSTRUMENT=${HOSTNAME#ics1-}
socat READLINE,history=history tcp4:127.0.0.1:server-${INSTRUMENT},crlf

223
site_ansto/instrument/util/utility.tcl
View File

@@ -1,7 +1,7 @@
# Some useful functions for SICS configuration.
# $Revision: 1.13 $
# $Date: 2008-06-23 02:41:12 $
# $Revision: 1.14 $
# $Date: 2008-07-11 01:09:57 $
# Author: Ferdi Franceschini (ffr@ansto.gov.au)
# Last revision by $Author: ffr $
@@ -215,110 +215,6 @@ proc ::environment::mkenvinfo {sobj paramlist} {
}
}
# Returns attribute name and value
proc getatt {sicsobj att} {
if [catch {
lindex [split [tolower_sicslist $sicsobj $att] =] 1
} reply ] {
return -code error $reply
} else {
return $reply
}
}
proc normalgetatt {sicsobj att} {
if [catch {
lindex [split [sicslist $sicsobj $att] =] 1
} reply ] {
return -code error $reply
} else {
return $reply
}
}
# @brief Determine if a SICS object implements the drivable interface.
#
# @param sicsobj, Name of a SICS object
# @return 1 if drivable, otherwise 0
proc is_drivable {sicsobj} {
if [catch {
getatt $sicsobj drivable
} reply] {
return -code error $reply
}
if {$reply == "true"} {
return 1
} else {
return 0
}
}
# Utility fucntion for setting the home and upper and lower
# limits for a motor
proc setHomeandRange {args} {
set usage "
Usage: setHomeandRange -motor motName -home homeVal -lowrange low -uprange high
eg
setHomeandRange -motor mchi -home 90 -lowrange 5 -uprange 7
this sets the home position to 90 degreess for motor mchi
with the lower limit at 85 and the upper limit at 97
"
if {$args == ""} {clientput $usage; return}
array set params $args
set motor $params(-motor)
set home $params(-home)
set lowlim [expr $home - $params(-lowrange)]
set uplim [expr $home + $params(-uprange)]
uplevel 1 "$motor softlowerlim $lowlim"
uplevel 1 "$motor softupperlim $uplim"
uplevel 1 "$motor home $home"
}
# Use this to create an array of named parameters to initialise motors.
proc params {args} {
upvar 1 "" x;
if [info exists x] {unset x}
foreach {k v} $args {set x([string tolower $k]) $v}
}
# Parse motor readings for virtual motor scripts.
proc SplitReply { text } {
set l [split $text =]
return [string trim [lindex $l 1]]
}
# Sets motor position reading to pos by adjusting the softzero
proc setpos {motor pos} {
set currPos [SplitReply [$motor]]
set oldZero [SplitReply [$motor softzero]]
set newZero [expr $currPos - $pos + $oldZero]
uplevel #0 "$motor softzero $newZero"
}
proc getinfo {object} {
set wc [format "%s_*" $object];
set objlist [sicslist match $wc];
foreach v $objlist {
if { [SplitReply [sicslist $v type]]== "SicsVariable"} {
clientput [$v];
}
}
}
# Convenience function for setting klass group and name attributes
# on sics object metadata
proc set_sicsobj_atts {sobj aklass agroup aname acontrol adata} {
sicslist setatt $sobj klass $aklass;
if {$agroup != "@none"} {
sicslist setatt $sobj group $agroup;
}
sicslist setatt $sobj long_name $aname;
sicslist setatt $sobj control $acontrol;
sicslist setatt $sobj data $adata;
}
## TODO put all the utility macros in the utility namespace
namespace eval utility {
variable instrument_names [list echidna wombat kowari quokka platypus pelican taipan]
@@ -404,6 +300,121 @@ proc mkData {sobj name aklass args} {
return [info $option $args];
}
}
# Returns attribute name and value
proc getatt {sicsobj att} {
if [catch {
lindex [split [tolower_sicslist $sicsobj $att] =] 1
} reply ] {
return -code error $reply
} else {
return $reply
}
}
proc normalgetatt {sicsobj att} {
if [catch {
lindex [split [sicslist $sicsobj $att] =] 1
} reply ] {
return -code error $reply
} else {
return $reply
}
}
proc ::utility::normalattlist {sicsobj} {
if [ catch {
foreach att [sicslist $sicsobj] {
lappend atts [split [string range $att 0 end-1] =]
}
return [join $atts]
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
# @brief Determine if a SICS object implements the drivable interface.
#
# @param sicsobj, Name of a SICS object
# @return 1 if drivable, otherwise 0
proc is_drivable {sicsobj} {
if [catch {
getatt $sicsobj drivable
} reply] {
return -code error $reply
}
if {$reply == "true"} {
return 1
} else {
return 0
}
}
# Utility fucntion for setting the home and upper and lower
# limits for a motor
proc setHomeandRange {args} {
set usage "
Usage: setHomeandRange -motor motName -home homeVal -lowrange low -uprange high
eg
setHomeandRange -motor mchi -home 90 -lowrange 5 -uprange 7
this sets the home position to 90 degreess for motor mchi
with the lower limit at 85 and the upper limit at 97
"
if {$args == ""} {clientput $usage; return}
array set params $args
set motor $params(-motor)
set home $params(-home)
set lowlim [expr $home - $params(-lowrange)]
set uplim [expr $home + $params(-uprange)]
uplevel 1 "$motor softlowerlim $lowlim"
uplevel 1 "$motor softupperlim $uplim"
uplevel 1 "$motor home $home"
}
# Use this to create an array of named parameters to initialise motors.
proc params {args} {
upvar #0 "" x;
if [info exists x] {unset x}
foreach {k v} $args {set x([string tolower $k]) $v}
}
# Parse motor readings for virtual motor scripts.
proc SplitReply { text } {
set l [split $text =]
return [string trim [lindex $l 1]]
}
# Sets motor position reading to pos by adjusting the softzero
proc setpos {motor pos} {
set currPos [SplitReply [$motor]]
set oldZero [SplitReply [$motor softzero]]
set newZero [expr $currPos - $pos + $oldZero]
uplevel #0 "$motor softzero $newZero"
}
proc getinfo {object} {
set wc [format "%s_*" $object];
set objlist [sicslist match $wc];
foreach v $objlist {
if { [SplitReply [sicslist $v type]]== "SicsVariable"} {
clientput [$v];
}
}
}
# Convenience function for setting klass group and name attributes
# on sics object metadata
proc set_sicsobj_atts {sobj aklass agroup aname acontrol adata} {
sicslist setatt $sobj klass $aklass;
if {$agroup != "@none"} {
sicslist setatt $sobj group $agroup;
}
sicslist setatt $sobj long_name $aname;
sicslist setatt $sobj control $acontrol;
sicslist setatt $sobj data $adata;
}
proc debug {args} {
clientput $args