Files
sics/site_ansto/instrument/config/hmm/hmm_configuration_common_1.tcl
Ferdi Franceschini ef7c2a6f87 histmem.c
sicvar.c
SICS-93 Save histogram data and instrument state during an acquisition

hipadaba_configuration_common.tcl
SICS-185 Preserve case on hdb node names

hmm_configuration_common_1.tcl
nxscripts_common_1.tcl
sicvar.c
SICS-174 Allow saving of histmem data and instrument status during a count operation.

wombat_configuration.tcl
echidna_configuration.tcl
platypus_configuration.tcl
kowari_configuration.tcl
quokka_configuration.tcl
SICS-153 Move setup of statemon to new server_init function for the new sics_uid state variable

server_config.tcl
SICS-153 set attributes on the sics_suid var which is now created by MakeStateMon
SICS-187 Add cold source info (TODO move to platypus,quokka and pelican configs)

utility.tcl
SICS-185 Added normalgetatt to preserve case on hdb node names etc.

sans/config/optics/aperture_configuration.tcl
New file, Provides lookup tables for attenuation and entrance apertures. (SICS-157)

sans/config/optics/optics.tcl
Load the new aperture_configuration.tcl

sans/config/parameters/parameters.tcl
SICS-157 Add instrument parameters section with derived parameters and their dependencies

statemon.c
SICS-153 Create sics_suid sicsvariable when loading statemon and increment it on each status change.

r2635 | ffr | 2008-06-23 12:41:12 +1000 (Mon, 23 Jun 2008) | 38 lines
2012-11-15 13:39:42 +11:00

1819 lines
59 KiB
Tcl

# $Revision: 1.32 $
# $Date: 2008-06-23 02:41:12 $
# 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
# Last revision by: $Author: ffr $
##
# @file Provides generic code and parameters for configuring the ANSTO histogram memory server
# The instrument specific histogram memory configuration files must define an initialisation
# function with the following signature
# @code proc ::histogram_memory::initialize {}
# this function should call the generic initalisation function,
# ::histogram_memory::_initialize
#
#@see ::histogram_memory::_initialize
set sim_mode [SplitReply [hmm_simulation]]
if {$sim_mode == "true"} {
MakeHM hmm SIM
MakeHM hmm_xy SIM
MakeHM hmm_xt SIM
MakeHM hmm_yt SIM
MakeHM hmm_x SIM
MakeHM hmm_y SIM
MakeHM hmm_t SIM
hmm configure daq Stopped
hmm configure statuscheck false
namespace eval histogram_memory {
proc hmc {_start _preset _mode _pause pauseval} {
if [ catch {
bm mode $_mode;
bm preset $_preset;
hmm countblock;
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
}
} else {
MakeHM hmm anstohttp;
MakeHM hmm_xy anstohttp;
MakeHM hmm_xt anstohttp;
MakeHM hmm_yt anstohttp;
MakeHM hmm_x anstohttp;
MakeHM hmm_y anstohttp;
MakeHM hmm_t anstohttp;
MakeHMControl_ANSTO hmc bm hmm;
}
hmm configure rank 3
hmm_xy configure rank 2
hmm_xt configure rank 2
hmm_yt configure rank 2
hmm_x configure rank 1
hmm_y configure rank 1
hmm_t configure rank 1
namespace eval histogram_memory {
# Frame source for each instrument if freq = 0, this can happen when automatically
# setting frequencies from choppers.
array set default_frame_source_when_there_is_no_frame_signal {
echidna INTERNAL
koala INTERNAL
kowari EXTERNAL
pelican INTERNAL
platypus EXTERNAL
quokka INTERNAL
taipan INTERNAL
wombat INTERNAL
}
array set default_frame_source_always_internal {
echidna "true"
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
sicslist setatt detector_active_height_mm units mm
::utility::mkVar detector_active_width_mm Float user active_width true detector true true
sicslist setatt detector_active_width_mm units mm
::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
##############################################
# Creating the histogram memories in SICS
##############################################
# Make a histogram memory object hmm, allows control of the
# remote histogram server via http, and acquisition
# of histogram period data.
##############################################
# Configuring the histogram server
##############################################
# Procedure to read a single config (or any) file, return content as a string.
proc returnconfigfile {filename} {
if [ catch {
set fh [open $filename]
set xml [read $fh]
close $fh
return [subst $xml]
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
# Here, define a function to let us read back the value of dictionary items from the hmm
# such as OAT dimensions.
proc hmmdictitemval {histomem dictitem} {
if [ catch {
set resp [$histomem configure $dictitem]
set retn [lindex [split $resp " "] 2]
return $retn
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
##
# @brief Use histogram server to control acquisitions
proc set_termination_conditions {count_method count_size count_stop} {
if [ catch {
hmm configure FAT_COUNT_METHOD $count_method
hmm configure FAT_COUNT_SIZE $count_size
hmm configure FAT_COUNT_STOP $count_stop
hmm init
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
# Simulated counter. No error rate. Required for technical reasons...
# The simulated counter is used only to block execution till the bm count is actually reached,
# for the scan example using hmc and bm objects to control the acquisition duration from SICS.
MakeCounter blockctr SIM -1.0
blockctr SetExponent 0
blockctr SetMode timer
blockctr SetPreset 0
##############################################
# Support for using expanded histogram period
# to create interlaced/overlapped histograms
##############################################
# Define an OAT offset variable to use with both scans:
# It is possible to effectively offset the histogram filler's
# OAT table by an arbitrary amount. For overlapped data acquisitions, we can
# configure an oversized histogram period using the EXPAND_OAT parameters
# in the FAT. Then at each scan stop, before acqisition commences the offset
# can be adjusted using the OFFSET_OAT paramters of the FAT. By progressively
# stepping the OFFSET_OAT, an overlapped image can be built up.
# The global variable oatoffset is defined for this purpose.
# During the scan, this variable is incremented and can be passed
# in to an argument of set_oat_offset to provide progressively
# increasing offset, producing an overlapped histogram.
#
global oatoffset
#
#Function to apply OAT offsets to the histogram server.
proc set_oat_offset {oatoff_x oatoff_y oatoff_t} {
if [ catch {
hmm configure FAT_OFFSET_OAT_X $oatoff_x
hmm configure FAT_OFFSET_OAT_Y $oatoff_y
hmm configure FAT_OFFSET_OAT_T $oatoff_t
hmm init
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
##############################################
# Support for data acquisition
##############################################
# A simple procedure to read the histogram data through SICS
# and dump the data to a numbered file.
proc savehistodata {histomem filename} {
set ::errorInfo ""
set fh [open $filename "w"]
# To get the whole memory, we don't need to specify the start or end arguments.
# But we need to specify the bank number, this sets the type of data to be read.
#
set histodata [$histomem get [hmmdictitemval $histomem bank]]
# clientput $histodata value
puts -nonewline $fh $histodata
close $fh
return
}
##############################################
##############################################
## Scan Callback Procedures ##
##############################################
##############################################
proc init {} {
}
proc graphics_hpath_setup {parent} {
}
proc commands_hpath_setup {parent} {
}
proc instrument_hpath_setup {parent} {
}
proc experiment_hpath_setup {parent} {
}
proc set_sobj_attributes {} {
if [ catch {
# SICS commands
sicslist setatt blockctr privilege internal;
# histogram memory macros
sicslist setatt ::histogram_memory::set_oat_offset privilege internal;
sicslist setatt ::histogram_memory::scan2_runb privilege internal;
sicslist setatt ::histogram_memory::scan2_runa privilege internal;
sicslist setatt ::histogram_memory::returnconfigfile privilege internal;
sicslist setatt ::histogram_memory::save privilege internal;
foreach hm_obj [sicslist type histmem] {
set_sicsobj_atts $hm_obj detector @none $hm_obj false true;
sicslist setatt $hm_obj privilege user
sicslist setatt $hm_obj kind hobj
sicslist setatt $hm_obj nxsave false
}
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
##
# @brief Returns the histogram memory server clock scale.
#
# NOTE: The histmem server doesn't provide the clock scale to SICS\n
# so we just hardwire 1000 nanoseconds which is the current (10/01/08)\n
# value on all the servers.
proc clock_scale {args} {
switch $args {
"" { return 1 }
"units" { return "microseconds"}
default {
todo_msg "Set clock_scale as an integer number of nanoseconds"
}
}
}
## @brief Calculate axis array from a given list of bin boundaries
#
# @param proc_name Fully qualified name of the calling procedure
# @param scale_factor axis scale factor or @none
# @param offset axis offset or @none
# @param boundaries list of bin boundaries or @none
proc calc_axis {proc_name scale_factor offset boundaries args} {
variable state
if [ catch {
set parlist [join $args]
set opt [lindex $parlist 0]
set arglist [lrange $parlist 1 end]
if {$scale_factor == "@none" || $boundaries == "@none"} {
# Don't calculate axis values, we're just setting or getting the graph_type
} else {
set i 0
${proc_name}_array clear
if {$state($proc_name,graph_type) == "boundaries"} {
foreach bb $boundaries {
set val [expr {$scale_factor*$bb + $offset}]
lappend values $val
${proc_name}_array putfloat $i $val
incr i
}
} else {
foreach b0 [lrange $boundaries 0 end-1] b1 [lrange $boundaries 1 end] {
set val [expr {$scale_factor*($b1 + $b0)/2.0 + $offset}]
lappend values $val
${proc_name}_array putfloat $i $val
incr i
}
}
}
switch -- $opt {
"-arrayname" {
return "${proc_name}_array"
}
"-centres" {
set state($proc_name,graph_type) "centres"
}
"-boundaries" {
set state($proc_name,graph_type) "boundaries"
}
"-graph_type" {
return $state($proc_name,graph_type)
}
default {
return $values
}
}
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
sicsdatafactory new ::histogram_memory::y_bin_array
##
# @brief Provides y_bin boundary array for data axes
proc y_bin {args} {
if [ catch {
set opt [lindex $args 0]
set arglist [lrange $args 1 end]
set proc_name [namespace origin [lindex [info level 0] 0]]
switch -- $opt {
"-centres" - "-boundaries" - "-graph_type" {
return [::histogram_memory::calc_axis $proc_name @none @none @none $opt $arglist]
}
"-arrayname" {
return [::histogram_memory::calc_axis $proc_name 1.0 0.0 [OAT_TABLE Y -getdata BOUNDARIES] $opt $arglist]
}
default {
return [::histogram_memory::calc_axis $proc_name 1.0 0.0 [OAT_TABLE Y -getdata BOUNDARIES] $args]
}
}
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
set script_name ::histogram_memory::y_bin
publish $script_name user
sicslist setatt $script_name privilege user
sicslist setatt $script_name kind script
sicslist setatt $script_name access read_only
sicslist setatt $script_name dtype floatvarar
sicslist setatt $script_name dlen 100
sicslist setatt $script_name klass detector
sicslist setatt $script_name control false
sicslist setatt $script_name data true
sicslist setatt $script_name nxsave true
sicslist setatt $script_name mutable false
sicslist setatt $script_name long_name y_bin
unset script_name
sicsdatafactory new ::histogram_memory::x_bin_array
##
# @brief Provides x_bin boundary array for data axes
proc x_bin {args} {
if [ catch {
set opt [lindex $args 0]
set arglist [lrange $args 1 end]
set proc_name [namespace origin [lindex [info level 0] 0]]
switch -- $opt {
"-centres" - "-boundaries" - "-graph_type" {
return [::histogram_memory::calc_axis $proc_name @none @none @none $opt $arglist]
}
"-arrayname" {
return [::histogram_memory::calc_axis $proc_name 1.0 0.0 [OAT_TABLE X -getdata BOUNDARIES] $opt $arglist]
}
default {
return [::histogram_memory::calc_axis $proc_name 1.0 0.0 [OAT_TABLE X -getdata BOUNDARIES] $args]
}
}
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
set script_name ::histogram_memory::x_bin
publish $script_name user
sicslist setatt $script_name privilege user
sicslist setatt $script_name kind script
sicslist setatt $script_name access read_only
sicslist setatt $script_name dtype floatvarar
sicslist setatt $script_name dlen 100
sicslist setatt $script_name klass detector
sicslist setatt $script_name control false
sicslist setatt $script_name data true
sicslist setatt $script_name nxsave true
sicslist setatt $script_name mutable false
sicslist setatt $script_name long_name x_bin
unset script_name
# requires detector_active_width_mm det_radius_mm
sicsdatafactory new ::histogram_memory::y_pixel_offset_array
proc y_pixel_offset {args} {
variable state
if [ catch {
set opt [lindex $args 0]
set arglist [lrange $args 1 end]
set proc_name [namespace origin [lindex [info level 0] 0]]
switch -- $opt {
"-centres" - "-boundaries" - "-graph_type" {
return [::histogram_memory::calc_axis $proc_name @none @none @none $opt $arglist]
}
"-arrayname" {
set det_height_mm [SplitReply [detector_active_height_mm]]
set max_chan [OAT_TABLE Y -getdata MAX_CHAN]
set scale_factor [expr {$det_height_mm / $max_chan}]
set offset 0.0
return [::histogram_memory::calc_axis $proc_name $scale_factor $offset [OAT_TABLE Y -getdata BOUNDARIES] $opt $arglist]
}
"-units" {
return "mm"
}
default {
set det_height_mm [SplitReply [detector_active_height_mm]]
set max_chan [OAT_TABLE Y -getdata MAX_CHAN]
set scale_factor [expr {$det_height_mm / $max_chan}]
set offset 0.0
return [::histogram_memory::calc_axis $proc_name $scale_factor $offset [OAT_TABLE Y -getdata BOUNDARIES] $args]
}
}
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
set script_name ::histogram_memory::y_pixel_offset
publish $script_name user
sicslist setatt $script_name privilege user
sicslist setatt $script_name kind script
sicslist setatt $script_name access read_only
sicslist setatt $script_name dtype floatvarar
sicslist setatt $script_name dlen 100
sicslist setatt $script_name klass detector
sicslist setatt $script_name control false
sicslist setatt $script_name data true
sicslist setatt $script_name nxsave true
sicslist setatt $script_name mutable false
sicslist setatt $script_name long_name y_pixel_offset
sicslist setatt $script_name units [::histogram_memory::y_pixel_offset -units]
unset script_name
# requires detector_active_width_mm det_radius_mm
sicsdatafactory new ::histogram_memory::x_pixel_offset_array
proc x_pixel_offset {args} {
variable state
if [ catch {
set opt [lindex $args 0]
set arglist [lrange $args 1 end]
set proc_name [namespace origin [lindex [info level 0] 0]]
switch -- $opt {
"-centres" - "-boundaries" - "-graph_type" {
return [::histogram_memory::calc_axis $proc_name @none @none @none $opt $args]
}
"-arrayname" {
set det_width_mm [SplitReply [detector_active_width_mm]]
set max_chan [OAT_TABLE X -getdata MAX_CHAN]
set scale_factor [expr {$det_width_mm / $max_chan}]
set offset 0.0
return [::histogram_memory::calc_axis $proc_name $scale_factor $offset [OAT_TABLE X -getdata BOUNDARIES] $opt $arglist]
}
"-units" {
return "mm"
}
default {
set det_width_mm [SplitReply [detector_active_width_mm]]
set max_chan [OAT_TABLE X -getdata MAX_CHAN]
set scale_factor [expr {$det_width_mm / $max_chan}]
set offset 0.0
return [::histogram_memory::calc_axis $proc_name $scale_factor $offset [OAT_TABLE X -getdata BOUNDARIES] $args]
}
}
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
set script_name ::histogram_memory::x_pixel_offset
publish $script_name user
sicslist setatt $script_name privilege user
sicslist setatt $script_name kind script
sicslist setatt $script_name access read_only
sicslist setatt $script_name dtype floatvarar
sicslist setatt $script_name dlen 100
sicslist setatt $script_name klass detector
sicslist setatt $script_name control false
sicslist setatt $script_name data true
sicslist setatt $script_name nxsave true
sicslist setatt $script_name mutable false
sicslist setatt $script_name long_name x_pixel_offset
sicslist setatt $script_name units [::histogram_memory::x_pixel_offset -units]
unset script_name
sicsdatafactory new ::histogram_memory::time_channel_array
proc time_channel {args} {
variable state
if [ catch {
set opt [lindex $args 0]
set arglist [lrange $args 1 end]
set proc_name [namespace origin [lindex [info level 0] 0]]
switch -- $opt {
"-centres" - "-boundaries" - "-graph_type" {
return [::histogram_memory::calc_axis $proc_name @none @none @none $opt $args]
}
"-arrayname" {
return [::histogram_memory::calc_axis $proc_name [::histogram_memory::clock_scale] 0.0 [OAT_TABLE T -getdata BOUNDARIES] $opt $arglist]
}
default {
return [::histogram_memory::calc_axis $proc_name [::histogram_memory::clock_scale] 0.0 [OAT_TABLE T -getdata BOUNDARIES] $args]
}
}
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
set script_name ::histogram_memory::time_channel
publish $script_name user
sicslist setatt $script_name privilege user
sicslist setatt $script_name kind script
sicslist setatt $script_name access read_only
sicslist setatt $script_name dtype floatvarar
sicslist setatt $script_name dlen 100
sicslist setatt $script_name klass detector
sicslist setatt $script_name control false
sicslist setatt $script_name data true
sicslist setatt $script_name nxsave true
sicslist setatt $script_name mutable false
sicslist setatt $script_name long_name time_of_flight
sicslist setatt $script_name units [::histogram_memory::clock_scale units]
unset script_name
}
#################################
# Must always specify number of channels
# bb list len <= channels+1
# Calculate the boundaries after successfully uploading a configuration.
# set values [OAT_TABLE -get X]
# set channels [OAT_TABLE -get NXC]
# OAT_TABLE X -setdata BOUNDARIES [calc_boundaries $values $channels]
proc ::histogram_memory::calc_boundaries {values channels} {
if [ catch {
set bbnum [llength $values]
set maxbblen [expr $channels+1]
set maxchan [expr $channels - 1]
if {$bbnum > $maxbblen} {
error "ERROR: The number of bin boundaries must be less than or equal to $maxbblen"
}
set BOUNDARIES ""
if {$bbnum > 2} {
set BOUNDARIES $values
} elseif {$bbnum == 2} {
foreach {leftbb rightbb} $values {}
set bstep [expr {$rightbb-$leftbb}]
if {$bstep == 0} {
error "ERROR: The generating bin boundaries are equal"
}
set startbin [expr ($leftbb+$rightbb)/2.0]
# FIXME This check doesn't work for time, T
# if {$startbin < 0.0 || $startbin > $maxchan} {
# error "ERROR: $leftbb and $rightbb must bound a channel >= 0 or <= $maxchan"
# }
for {set bb $leftbb; set i 0} {$i < $maxbblen} {incr i; set bb [expr {$bb + $bstep}]} {
lappend BOUNDARIES $bb
}
} else {
error "ERROR: You must specify at least two bin boundaries"
}
return $BOUNDARIES
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
set hmm_xml ""
##
# @brief Provides a standard set of subcommands for the histogram server table
# configuration commands.
#
# @param tag Table identifier, one of BAT CAT FAT NAT OAT SAT SRV
# @param attributes Defines the list of attributes which you will be allowed to set.
# @param element_list Defines the list of elements which you will be allowed to set.
# Use "" if your table doesn't contain any elements.
# @param args This can be empty, or a list of name value pairs for the attributes
# and elements which you want to set or one of the subcommands listed below.
# If args is empty this function will simply return an xml fragment for the named table,
#
# Subcommands\n
# -clear clears the table\n
# -init A list of name value pairs. If you use attribute or element names then
# the corresponding table entries will be initilised to the given values, any
# attributes or elements which aren't specified will be cleared. You can also
# specify extra parameters to store in the table which might be required to
# specify limits or constants which may be necessary for deriving configuration
# parameters.\n
# -get return the value for the named attribute or element\n
# -attlist list all of the attributes with their values.\n
# TODO Maintain "proposed" and "current" tables. Provide a setcurrent command which can
# only be called by the upload_config command to set the proposed tables as current
# TODO Allow for top level content in tables and attributes in sub-elements
proc HISTMEM_TABLE {tpath args} {
global hmm_xml
if [ catch {
set tpath [string toupper $tpath]
foreach {opt arglist} [::utility::get_opt_arglist $args] {}
switch -- $opt {
"-dump" {
foreach {k v} $hmm_xml {clientput $k; foreach {name val} $v {clientput "$name: $val"}}
}
"-allowed_attributes" {
if {[llength $arglist] == 0} {
return [::utility::tabget hmm_xml $tpath/_ALLOWED_ATTRIBUTES_]
} else {
::utility::tabset hmm_xml $tpath/_ALLOWED_ATTRIBUTES_ [lindex $arglist 0]
}
}
"-allowed_elements" {
if {[llength $arglist] == 0} {
return [::utility::tabget hmm_xml $tpath/_ALLOWED_ELEMENTS_]
} else {
::utility::tabset hmm_xml $tpath/_ALLOWED_ELEMENTS_ [lindex $arglist 0]
::utility::tabset hmm_xml $tpath/_ELEMENTS_ [lindex $arglist 0]
}
}
"-setel" {
set element [lindex $arglist 0]
set value [lindex $arglist 1]
if {[lsearch [::utility::tabget hmm_xml $tpath/_ALLOWED_ELEMENTS_] $element] != -1} {
::utility::tabset hmm_xml $tpath/$element/_CONTENT_ $value
} else {
error "ERROR: $element is not an allowed element in $tpath"
}
}
"-setatt" {
set attname [lindex $arglist 0]
set value [lindex $arglist 1]
if {[lsearch [::utility::tabget hmm_xml $tpath/_ALLOWED_ATTRIBUTES_] $attname] != -1} {
::utility::tabset hmm_xml $tpath/_ATTLIST_/$attname $value
} else {
error "ERROR: $attname is not an allowed attribute in $tpath"
}
}
"-getel" {
set element [lindex $arglist 0]
return [::utility::tabget hmm_xml $tpath/$element/_CONTENT_]
}
"-getatt" {
set attribute [lindex $arglist 0]
return [::utility::tabget hmm_xml $tpath/_ATTLIST_/$attribute]
}
"-delel" {
set element [lindex $arglist 0]
::utility::tabdel hmm_xml $tpath/$element
}
"-delatt" {
set attribute [lindex $arglist 0]
::utility::tabdel hmm_xml $tpath/_ATTLIST_/$attribute
}
"-clear" {
::utility::tabdel hmm_xml $tpath/_ATTLIST_
::utility::tabdel hmm_xml $tpath/_CONTENT_
foreach element [::utility::tabget hmm_xml $tpath/_ELEMENTS_] {
::utility::tabdel hmm_xml $tpath/$element
}
}
"-setdata" {
if {[llength $arglist] == 1} {
set arglist [lindex $arglist 0]
}
foreach {name value} $arglist {
if {$value == ""} {
error "ERROR: No value supplied when setting $name at $tpath in the histogram memory table"
}
::utility::tabset hmm_xml $tpath/_DATA_/$name $value
}
}
"-getdata" {
if {[llength $arglist] == 1} {
set arglist [lindex $arglist 0]
}
if {[llength $arglist] <= 1} {
return [::utility::tabget hmm_xml $tpath/_DATA_/$arglist]
} else {
foreach name $arglist {
lappend values [::utility::tabget hmm_xml $tpath/_DATA_/$name]
}
return $values
}
}
"-getxml" {
return [::utility::tabxml hmm_xml $tpath]
}
}
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
##
# @brief Base Address Table configuration parameters as maintained by SICS
#
proc BAT_TABLE {args} {
if [ catch {
set attributes { FRAME_FREQUENCY SIZE_PERIOD COUNT_METHOD COUNT_SIZE READ_DATA_TYPE }
set elements {{ }}
set tag BAT
foreach {opt arglist} [::utility::get_opt_arglist $args] {}
switch -- $opt {
"" {
return [HISTMEM_TABLE $tag -getxml]
}
"-init" {
HISTMEM_TABLE $tag -allowed_elements $elements
HISTMEM_TABLE $tag -allowed_attributes [concat $attributes $arglist]
}
"-set" {
set allowed_atts [HISTMEM_TABLE $tag -allowed_attributes]
set allowed_els [HISTMEM_TABLE $tag -allowed_elements]
foreach {arg val} $arglist {
set index [lsearch -exact $allowed_els $arg]
if {$index >= 0} {
incr index
HISTMEM_TABLE $tag -setel $arg $val
} else {
set attname $arg
set index [lsearch -exact $allowed_atts $attname]
if {$index >= 0} {
incr index
HISTMEM_TABLE $tag -setatt $attname $val
}
}
}
}
"-get" {
set allowed_atts [HISTMEM_TABLE $tag -allowed_attributes]
set allowed_els [HISTMEM_TABLE $tag -allowed_elements]
foreach arg $arglist {
set index [lsearch -exact $allowed_els $arg]
if {$index >= 0} {
lappend values [HISTMEM_TABLE $tag -getel $arg]
} else {
set attname $arg
set index [lsearch -exact $allowed_atts $attname]
if {$index >= 0} {
lappend values [HISTMEM_TABLE $tag -getatt $attname]
}
}
}
if {[llength $values] == 1} {
return [lindex $values 0]
} else {
return $values
}
}
"-del" {
foreach att [lindex $attributes 0] el [lindex $elements 0] {
set index [lsearch -exact $arglist $el]
if {$index != -1} {
HISTMEM_TABLE $tag -delel $el
}
set index [lsearch -exact $arglist $att]
if {$index != -1} {
HISTMEM_TABLE $tag -delatt $att
}
}
}
"-setdata" {
HISTMEM_TABLE $tag -setdata $arglist
}
"-getdata" {
return [HISTMEM_TABLE $tag -getdata $arglist]
}
"-clear" {
HISTMEM_TABLE $tag -clear
}
default {
error "ERROR: Unknown subcommand $opt"
}
}
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
##
# @brief CAlibration Table configuration parameters as maintained by SICS
#
proc CAT_TABLE {args} {
if [ catch {
set attributes { FRAME_FREQUENCY SIZE_PERIOD COUNT_METHOD COUNT_SIZE READ_DATA_TYPE }
set elements {{ }}
set tag CAT
foreach {opt arglist} [::utility::get_opt_arglist $args] {}
switch -- $opt {
"" {
return [HISTMEM_TABLE $tag -getxml]
}
"-init" {
HISTMEM_TABLE $tag -allowed_elements $elements
HISTMEM_TABLE $tag -allowed_attributes [concat $attributes $arglist]
}
"-set" {
set allowed_atts [HISTMEM_TABLE $tag -allowed_attributes]
set allowed_els [HISTMEM_TABLE $tag -allowed_elements]
foreach {arg val} $arglist {
set index [lsearch -exact $allowed_els $arg]
if {$index >= 0} {
incr index
HISTMEM_TABLE $tag -setel $arg $val
} else {
set attname $arg
set index [lsearch -exact $allowed_atts $attname]
if {$index >= 0} {
incr index
HISTMEM_TABLE $tag -setatt $attname $val
}
}
}
}
"-get" {
set allowed_atts [HISTMEM_TABLE $tag -allowed_attributes]
set allowed_els [HISTMEM_TABLE $tag -allowed_elements]
foreach arg $arglist {
set index [lsearch -exact $allowed_els $arg]
if {$index >= 0} {
lappend values [HISTMEM_TABLE $tag -getel $arg]
} else {
set attname $arg
set index [lsearch -exact $allowed_atts $attname]
if {$index >= 0} {
lappend values [HISTMEM_TABLE $tag -getatt $attname]
}
}
}
if {[llength $values] == 1} {
return [lindex $values 0]
} else {
return $values
}
}
"-del" {
foreach att [lindex $attributes 0] el [lindex $elements 0] {
set index [lsearch -exact $arglist $el]
if {$index != -1} {
HISTMEM_TABLE $tag -delel $el
}
set index [lsearch -exact $arglist $att]
if {$index != -1} {
HISTMEM_TABLE $tag -delatt $att
}
}
}
"-setdata" {
HISTMEM_TABLE $tag -setdata $arglist
}
"-getdata" {
return [HISTMEM_TABLE $tag -getdata $arglist]
}
"-clear" {
HISTMEM_TABLE $tag -clear
}
default {
error "ERROR: Unknown subcommand $opt"
}
}
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
##
# @brief Frequency Address Table configuration parameters as maintained by SICS
#
proc FAT_TABLE {args} {
if [ catch {
set attributes { FRAME_FREQUENCY SIZE_PERIOD COUNT_METHOD COUNT_SIZE READ_DATA_TYPE }
set elements {{ }}
set tag FAT
foreach {opt arglist} [::utility::get_opt_arglist $args] {}
switch -- $opt {
"" {
return [HISTMEM_TABLE $tag -getxml]
}
"-init" {
HISTMEM_TABLE $tag -allowed_elements $elements
HISTMEM_TABLE $tag -allowed_attributes [concat $attributes $arglist]
}
"-set" {
set allowed_atts [HISTMEM_TABLE $tag -allowed_attributes]
set allowed_els [HISTMEM_TABLE $tag -allowed_elements]
foreach {arg val} $arglist {
set index [lsearch -exact $allowed_els $arg]
if {$index >= 0} {
incr index
HISTMEM_TABLE $tag -setel $arg $val
} else {
set attname $arg
set index [lsearch -exact $allowed_atts $attname]
if {$index >= 0} {
incr index
HISTMEM_TABLE $tag -setatt $attname $val
}
}
}
}
"-get" {
set allowed_atts [HISTMEM_TABLE $tag -allowed_attributes]
set allowed_els [HISTMEM_TABLE $tag -allowed_elements]
foreach arg $arglist {
set index [lsearch -exact $allowed_els $arg]
if {$index >= 0} {
lappend values [HISTMEM_TABLE $tag -getel $arg]
} else {
set attname $arg
set index [lsearch -exact $allowed_atts $attname]
if {$index >= 0} {
lappend values [HISTMEM_TABLE $tag -getatt $attname]
}
}
}
if {[llength $values] == 1} {
return [lindex $values 0]
} else {
return $values
}
}
"-del" {
foreach att [lindex $attributes 0] el [lindex $elements 0] {
set index [lsearch -exact $arglist $el]
if {$index != -1} {
HISTMEM_TABLE $tag -delel $el
}
set index [lsearch -exact $arglist $att]
if {$index != -1} {
HISTMEM_TABLE $tag -delatt $att
}
}
}
"-setdata" {
HISTMEM_TABLE $tag -setdata $arglist
}
"-getdata" {
return [HISTMEM_TABLE $tag -getdata $arglist]
}
"-clear" {
HISTMEM_TABLE $tag -clear
}
default {
error "ERROR: Unknown subcommand $opt"
}
}
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
##
# @brief Offset Address Table configuration parameters as maintained by SICS
#
# @param -clear clears OAT_TABLE XML fragment
# @param -init X_MIN <x0> X_MAX <x1> Y_MIN <y0> Y_MAX <y1>
# Initialise minimum and maximum bin boundaries.
# @param -get
# @param -attlist
# @param -clear clears the oat table and the fat table SIZE_PERIOD
#
# Sets X_BOUNDARIES, Y_BOUNDARIES and T_BOUNDARIES
proc OAT_TABLE {args} {
if [ catch {
array set attlookup {NXC NO_OAT_X_CHANNELS NYC NO_OAT_Y_CHANNELS NTC NO_OAT_T_CHANNELS}
set elements {{ X Y T }}
set tag OAT
set element [lindex $args 0]
if {[ lsearch [lindex $elements 0] $element] == -1} {
unset element
} else {
set tag $tag/$element
set args [lrange $args 1 end]
}
foreach {opt arglist} [::utility::get_opt_arglist $args] {}
switch -- $opt {
"" {
return [HISTMEM_TABLE $tag -getxml]
}
"-init" {
HISTMEM_TABLE $tag -allowed_elements $elements
foreach {n v} [array get attlookup] {
lappend attributes $v
}
HISTMEM_TABLE $tag -allowed_attributes [concat $attributes $arglist]
}
"-set" {
set allowed_atts [HISTMEM_TABLE $tag -allowed_attributes]
set allowed_els [HISTMEM_TABLE $tag -allowed_elements]
foreach {arg val} $arglist {
set index [lsearch -exact $allowed_els $arg]
if {$index >= 0} {
incr index
HISTMEM_TABLE $tag -setel $arg $val
} else {
if [info exists attlookup($arg)] {
set attname $attlookup($arg)
} else {
set attname $arg
}
set index [lsearch -exact $allowed_atts $attname]
if {$index >= 0} {
incr index
HISTMEM_TABLE $tag -setatt $attname $val
}
}
}
foreach {nxc nyc} [OAT_TABLE -get NXC NYC] {}
set max_nxc [::histogram_memory::max_chan_num X]
set max_nyc [::histogram_memory::max_chan_num Y]
if {$nxc > $max_nxc} {
gumput "WARNING: Reducing NO_OAT_X_CHANNELS from $nxc to maximum $max_nxc" warning
OAT_TABLE -set NXC $max_nxc
}
if {$nyc > $max_nyc} {
gumput "WARNING: Reducing NO_OAT_Y_CHANNELS from $nyc to maximum $max_nyc" warning
OAT_TABLE -set NYC $max_nyc
}
foreach axis {X Y T} {
set bins [::histogram_memory::oat_bins $axis]
set nch [::histogram_memory::number_of_channels $axis]
OAT_TABLE $axis -setdata BOUNDARIES [::histogram_memory::calc_boundaries $bins $nch]
}
}
"-get" {
set allowed_atts [HISTMEM_TABLE $tag -allowed_attributes]
set allowed_els [HISTMEM_TABLE $tag -allowed_elements]
foreach arg $arglist {
set index [lsearch -exact $allowed_els $arg]
if {$index >= 0} {
lappend values [HISTMEM_TABLE $tag -getel $arg]
} else {
if [info exists attlookup($arg)] {
set attname $attlookup($arg)
} else {
set attname $arg
}
set index [lsearch -exact $allowed_atts $attname]
if {$index >= 0} {
lappend values [HISTMEM_TABLE $tag -getatt $attname]
}
}
}
if {[llength $values] == 1} {
return [lindex $values 0]
} else {
return $values
}
}
"-del" {
foreach att [array names attlookup] el [lindex $elements 0] {
set index [lsearch -exact $arglist $el]
if {$index != -1} {
HISTMEM_TABLE $tag -delel $el
}
set index [lsearch -exact $arglist $att]
if {$index != -1} {
HISTMEM_TABLE $tag -delatt $attlookup($att)
}
}
}
"-setdata" {
HISTMEM_TABLE $tag -setdata $arglist
}
"-getdata" {
return [HISTMEM_TABLE $tag -getdata $arglist]
}
"-clear" {
HISTMEM_TABLE $tag -clear
}
default {
error "ERROR: Unknown subcommand $opt"
}
}
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
# @brief Spatial Allocation Table configuration parameters as maintained by SICS
#
# Only one element, ie SPLIT with no content just attributes.
proc SAT_TABLE {args} {
if [ catch {
set attributes { APPLY MIDPOINT DIRECTION WRAP SWAP}
set elements {{ SPLIT }}
set tag SAT
set attpath SAT/SPLIT
foreach {opt arglist} [::utility::get_opt_arglist $args] {}
switch -- $opt {
"" {
return [HISTMEM_TABLE $tag -getxml]
}
"-init" {
HISTMEM_TABLE $tag -allowed_elements $elements
HISTMEM_TABLE $attpath -allowed_attributes [concat $attributes $arglist]
}
"-set" {
set allowed_atts [HISTMEM_TABLE $attpath -allowed_attributes]
set allowed_els [HISTMEM_TABLE $tag -allowed_elements]
foreach {arg val} $arglist {
set index [lsearch -exact $allowed_els $arg]
if {$index >= 0} {
incr index
HISTMEM_TABLE $tag -setel $arg $val
} else {
set attname $arg
set index [lsearch -exact $allowed_atts $attname]
if {$index >= 0} {
incr index
HISTMEM_TABLE $attpath -setatt $attname $val
}
}
}
}
"-get" {
set allowed_atts [HISTMEM_TABLE $attpath -allowed_attributes]
set allowed_els [HISTMEM_TABLE $tag -allowed_elements]
foreach arg $arglist {
set index [lsearch -exact $allowed_els $arg]
if {$index >= 0} {
lappend values [HISTMEM_TABLE $tag -getel $arg]
} else {
set attname $arg
set index [lsearch -exact $allowed_atts $attname]
if {$index >= 0} {
lappend values [HISTMEM_TABLE $tag -getatt $attname]
}
}
}
if {[llength $values] == 1} {
return [lindex $values 0]
} else {
return $values
}
}
"-del" {
foreach att $attributes {
set index [lsearch -exact $arglist $att]
if {$index != -1} {
HISTMEM_TABLE $attpath -delatt $att
}
}
}
"-setdata" {
HISTMEM_TABLE $tag -setdata $arglist
}
"-getdata" {
return [HISTMEM_TABLE $tag -getdata $arglist]
}
"-clear" {
HISTMEM_TABLE $tag -clear
HISTMEM_TABLE $attpath -allowed_attributes $attributes
}
default {
error "ERROR: Unknown subcommand $opt"
}
}
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
##
# @brief Resolve dependencies between the histogram memory tables
proc ::histogram_memory::synch_tables {} {
if [ catch {
set noxch [OAT_TABLE -get NXC]
set noych [OAT_TABLE -get NYC]
set notch [OAT_TABLE -get NTC]
FAT_TABLE -set SIZE_PERIOD [expr $noxch*$noych*$notch]
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
proc ::histogram_memory::clear_tables {} {
if [ catch {
set ::errorInfo ""
BAT_TABLE -clear
CAT_TABLE -clear
FAT_TABLE -clear
OAT_TABLE -clear
SAT_TABLE -clear
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
##
# @brief Calculate the maximum number of oat channels from the generating bin
# boundaries of the given axis
proc ::histogram_memory::max_chan_num {axis} {
if [ catch {
set bins [OAT_TABLE -get $axis]
set numb_bins [llength $bins]
if {$numb_bins < 2} {
error "ERROR: $axis must have at least two bin boundaries"
} elseif {$numb_bins > 2} {
return $numb_bins
} else {
foreach {leftbb rightbb} $bins {}
set bstep [expr $rightbb - $leftbb]
if {$bstep == 0} {
error "ERROR: Bin boundaries for $axis must not be equal"
} elseif {$bstep < 0} {
set binlim [OAT_TABLE $axis -getdata BMIN]
} else {
set binlim [OAT_TABLE $axis -getdata BMAX]
}
}
set numb_bins [expr {int(floor(($binlim - $leftbb)/$bstep))}]
return $numb_bins
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
##
# @brief When called without arguments this returns the name of the filler defaults file
# for the histogram server. When called with an argument it sets the current name of the
# filler defaults file.
#
# When anstohm_linked.xml is uploaded to the histogram server it calls this via
# command substitution to set the name of the filler defaults file.
proc ::histogram_memory::filler_defaults {args} {
variable hmm_def_filename
if [ catch {
if {[llength $args] == 0} {
return $hmm_def_filename
} else {
set hmm_def_filename $args
}
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
##
# @brief Returns the oat table bin boundaries.
# This function can be replaced with an instrument specific definition
# in the instrumenent specific configuration file.
proc ::histogram_memory::oat_bins {axis} {
if [ catch {
set bins [OAT_TABLE -get $axis]
return $bins
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
##
# @brief Returns the current number of channels for a given axis.
# This function can be replaced with an instrument specific definition
# in the instrumenent specific configuration file.
proc ::histogram_memory::number_of_channels {axis} {
array set channID {X NXC Y NYC T NTC}
if [ catch {
return [OAT_TABLE -get $channID($axis)]
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
# TODO Set current oat table after uploading proposed oat_table
proc ::histogram_memory::upload_config {filler_defaults} {
if [ catch {
::histogram_memory::synch_tables
::histogram_memory::filler_defaults $filler_defaults
hmm stop
hmm configure init 1
hmm init
# Restore the init level to 0
# subesquent inits will only upload specified FAT settings to histogram server.
hmm configure init 0
# Now issue stop to the server.
# This not only makes sure it's stopped, but lets us see certain configuration variables
# which get placed in the dictionary as part of the status checking done during the stop.
hmm configure statuscheck true
hmm stop
hmm configure statuscheck false
::histogram_memory::configure_dims
# foreach axis {X Y T} {
# set bins [oat_bins $axis]
# set nch [number_of_channels $axis]
# OAT_TABLE $axis -setdata BOUNDARIES [calc_boundaries $bins $nch]
# }
} message ] {
if {$::errorCode=="NONE"} {
clientput "histmem configuration uploaded"
return $message
} else {
return -code error $message
}
}
}
##
# @brief Configure the dimensions for the controlling histogram object, and for
# each auxiliary histogram object.
proc ::histogram_memory::configure_dims {} {
if [ catch {
if {[instname] == "wombat"} {
array set dim_map {
hmm {{hmm_dim0 oat_ntc_eff} {hmm_dim1 stitch_nyc} {hmm_dim2 stitch_nxc}}
hmm,read_data_type HISTOPERIOD_XYT
hmm_xy {{hmm_dim0 stitch_nyc} {hmm_dim1 stitch_nxc}}
hmm_xy,read_data_type TOTAL_HISTOGRAM_XY
hmm_xt {{hmm_dim0 oat_ntc_eff} {hmm_dim1 stitch_nxc}}
hmm_xt,read_data_type TOTAL_HISTOGRAM_XT
hmm_yt {{hmm_dim0 oat_ntc_eff} {hmm_dim1 stitch_nyc}}
hmm_yt,read_data_type TOTAL_HISTOGRAM_YT
hmm_x {{hmm_dim0 stitch_nxc}}
hmm_x,read_data_type TOTAL_HISTOGRAM_X
hmm_y {{hmm_dim0 stitch_nyc}}
hmm_y,read_data_type TOTAL_HISTOGRAM_Y
hmm_t {{hmm_dim0 oat_ntc_eff}}
hmm_t,read_data_type TOTAL_HISTOGRAM_T
}
} else {
array set dim_map {
hmm {{hmm_dim0 oat_ntc_eff} {hmm_dim1 oat_nyc_eff} {hmm_dim2 oat_nxc_eff}}
hmm,read_data_type HISTOPERIOD_XYT
hmm_xy {{hmm_dim0 oat_nyc_eff} {hmm_dim1 oat_nxc_eff}}
hmm_xy,read_data_type TOTAL_HISTOGRAM_XY
hmm_xt {{hmm_dim0 oat_ntc_eff} {hmm_dim1 oat_nxc_eff}}
hmm_xt,read_data_type TOTAL_HISTOGRAM_XT
hmm_yt {{hmm_dim0 oat_ntc_eff} {hmm_dim1 oat_nyc_eff}}
hmm_yt,read_data_type TOTAL_HISTOGRAM_YT
hmm_x {{hmm_dim0 oat_nxc_eff}}
hmm_x,read_data_type TOTAL_HISTOGRAM_X
hmm_y {{hmm_dim0 oat_nyc_eff}}
hmm_y,read_data_type TOTAL_HISTOGRAM_Y
hmm_t {{hmm_dim0 oat_ntc_eff}}
hmm_t,read_data_type TOTAL_HISTOGRAM_T
}
}
foreach hm_obj [sicslist type histmem] {
set rank [SplitReply [$hm_obj configure rank]]
set hmm_length 1
foreach elmt $dim_map($hm_obj) {
set [lindex $elmt 0] [hmmdictitemval hmm [lindex $elmt 1]]
}
$hm_obj configure READ_DATA_TYPE $dim_map($hm_obj,read_data_type)
$hm_obj stop
$hm_obj configure init 0
$hm_obj init
for {set i 0} {$i < $rank} {incr i} {
set hmm_length [expr {$hmm_length * [set hmm_dim$i]} ]
$hm_obj configure dim$i [set hmm_dim$i]
}
}
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
##
# @brief If set to true then the frame_source will always be set to INTERNAL.
#
# @see ::histogram_memory::set_frame_source
proc ::histogram_memory::frame_source_always_internal {args} {
variable fs_always_internal
if [ catch {
if {$args == ""} {
return $fs_always_internal
}
set flag [lindex $args 0]
if {[string is boolean $flag] == 0} {
error "ERROR: $args must be a boolean"
} else {
set fs_always_internal $flag
}
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
publish ::histogram_memory::frame_source_always_internal mugger
##
# @brief Return the last frame source which SICS attempted to set
proc ::histogram_memory::get_frame_source {} {
if [ catch {
if [::histogram_memory::frame_source_always_internal] {
clientput "WARNING: The frame source is set to always_internal" value
clientput "Use ::histogram_memory::frame_source_always_internal <true/false> to change this." value
return INTERNAL
} else {
return [SplitReply [hmm configure fat_frame_source]]
}
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
##
# @brief Sets the histogram memory frame source to the given value.
#
# @param srce EXTERNAL or INTERNAL
# @param always_internal true or false (optional) (default false)
proc ::histogram_memory::set_frame_source {srce} {
if [ catch {
if [::histogram_memory::frame_source_always_internal] {
clientput "WARNING: The frame source is set to always_internal" value
clientput "Use ::histogram_memory::frame_source_always_internal <true/false> to change this." value
hmm configure fat_frame_source INTERNAL
} else {
hmm configure fat_frame_source $srce
}
::histogram_memory::stop
hmm init
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
##
# @brief Return the last frame frequency which SICS attempted to set
proc ::histogram_memory::get_frame_freq {} {
if [ catch {
return [SplitReply [hmm configure fat_frame_frequency]]
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
##
# @brief Sets the histogram memory frame frequency to the given value.
#
# @param freq Frequency in Hz.\n
# @param frame_source INTERNAL or EXTERNAL(default)
#
# If freq=0 then it sets the frequency to 50Hz with an internal frame source. This is useful
# if you are setting the frequency from a chopper which is stopped.
proc ::histogram_memory::set_frame_freq {freq {frame_source EXTERNAL}} {
variable state
variable default_frame_source_when_there_is_no_frame_signal
if [ catch {
if {[string is double $freq] == 0 || $freq < 0} {
error "ERROR: Frequency must be a non-negative floating point number"
}
#TODO Add tolerance parameters to choppercontroller
if {abs($freq - 0) <= [expr {2.0/60.0}]} {
set zf_frame_source $default_frame_source_when_there_is_no_frame_signal([instname])
if {$zf_frame_source == "INTERNAL"} {
clientput "WARNING: A histmem frame frequency of zero was requested, setting frequency to 50Hz instead" value
} else {
clientput "WARNING: A histmem frame frequency of zero was requested, setting frequency to 50Hz instead" value
clientput "WARNING: You must provide an external oscillator" value
}
::histogram_memory::set_frame_source $zf_frame_source
set newfreq 50
} else {
::histogram_memory::set_frame_source [string toupper $frame_source]
::set newfreq $freq
}
::histogram_memory::stop
set clock_scale_ns 1000.0
hmm configure fat_frame_frequency $newfreq
hmm init
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
publish ::histogram_memory::set_frame_freq user
proc ::histogram_memory::t_max {} {
if [ catch {
set frame_freq [SplitReply [hmm configure fat_frame_frequency]]
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
##
# @brief Sets histogram server to default configuration, initialises SICS histogram memory
# dictionary values and clears SICS OAT BAT CAT FAT ... tables
proc ::histogram_memory::_initialize {} {
variable default_frame_source_when_there_is_no_frame_signal
variable default_frame_source_always_internal
set ::errorInfo ""
if [ catch {
set configuration "::histogram_memory::returnconfigfile config/hmm/anstohm_linked.xml"
::histogram_memory::y_bin -boundaries
::histogram_memory::x_bin -boundaries
::histogram_memory::y_pixel_offset -boundaries
::histogram_memory::x_pixel_offset -boundaries
::histogram_memory::time_channel -boundaries
::histogram_memory::clear_tables
#XXX ::histogram_memory::upload_config Filler_defaults
foreach hm_obj [sicslist type histmem] {
$hm_obj configure hmaddress http://das1-[instname].nbi.ansto.gov.au:8080
$hm_obj configure username SICS
$hm_obj configure password SICS
$hm_obj configure histmode transparent
}
hmm configure init 0
hmm init
hmm configure statuscheck true
hmm stop
hmm configure statuscheck false
::histogram_memory::frame_source_always_internal $default_frame_source_always_internal([instname])
::histogram_memory::set_frame_freq 50
::histogram_memory::set_frame_source $default_frame_source_when_there_is_no_frame_signal([instname])
::histogram_memory::count_method unlimited
::histogram_memory::count_size 0
hmm configure hmDataPath ../HMData
hmm configure hmconfigscript $configuration
::histogram_memory::configure_dims
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
Publish ::histogram_memory::set_oat_offset user
Publish ::histogram_memory::scan2_runb user
Publish ::histogram_memory::scan2_runa user
Publish ::histogram_memory::returnconfigfile user
Publish ::histogram_memory::save user
Publish BAT_TABLE user
Publish CAT_TABLE user
Publish FAT_TABLE user
Publish OAT_TABLE user
Publish SAT_TABLE user
proc ::histogram_memory::pre_count {} {}
proc ::histogram_memory::post_count {} {}
##
# @brief Start an acquisition, non-blocking by default
#
# @param block (optional) default="noblock"
proc ::histogram_memory::start {{blocking "noblock"}} {
if [ catch {
set options [list block noblock]
if {[lsearch $options $blocking] == -1} {
error "ERROR: Valid options are $options"
}
::histogram_memory::pre_count
hmm init
hmc start 1000000000 timer pause 1
set reply [SplitReply [hmm configure daq]]
if {$reply != "Started"} {
error "ERROR: Histogram server failed to start"
}
clientput "histmem started" value
if {$blocking == "block"} {
blockctr count 0
::histogram_memory::pause
}
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
##
# @brief This sends the magic incantation which stops the histogram server.
proc ::histogram_memory::stop {} {
if [ catch {
hmm pause
hmm configure statuscheck true
hmm stop
hmm configure statuscheck false
set reply [SplitReply [hmm configure daq]]
if {$reply != "Stopped"} {
error "ERROR: Histogram server failed to stop"
}
} message ] {
if {$::errorCode=="NONE"} {
clientput "histmem stopped" value
return $message
} else {
return -code error $message
}
}
}
##
# @brief Allows resume if MULTIPLE_DATASETS=DISABLE, otherwise if MULTIPLE_DATASETS=ENABLE
# (the default) this acts like a stop but allows a fast restart.
proc ::histogram_memory::pause {} {
if [ catch {
hmm pause
::histogram_memory::post_count
set reply [SplitReply [hmm configure daq]]
if {$reply != "Paused"} {
error "ERROR: Histogram server failed to pause"
}
} message ] {
if {$::errorCode=="NONE"} {
clientput "histmem paused" value
return $message
} else {
return -code error $message
}
}
}
##
# @brief Choose method for controlling acquisition duration.
#
# @param method Set histmem mode or return current mode if blank
proc ::histogram_memory::count_method {{method ""}} {
if [ catch {
set modes [list time monitor unlimited period count frame]
if {$method==""} {
return [SplitReply [hmm_mode]]
} else {
if {[lsearch $modes $method] == -1} {
error "ERROR: Count mode, $method, must be one of $modes"
}
hmm configure FAT_COUNT_METHOD $method
hmm init
hmm_mode $method
}
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
##
# @brief Count until the preset count size has been reached.
#
# @param preset: The interpretation of the preset depends on the count method.
# @see count_method
proc ::histogram_memory::count_size {{preset ""}} {
variable state
if [ catch {
if {$preset == ""} {
return $state(preset)
} else {
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 init
set state(preset) $preset
}
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
##
# @brief Check histogram memory status
#
# @return Stopped, Paused, Started, or raises a Tcl error
proc ::histogram_memory::status {} {
if [ catch {
set reply [SplitReply [hmm configure daq]]
} message ] {
if {$::errorCode=="NONE"} {return $reply}
return -code error $message
}
}
##
# @brief Set stop condition for histogram memory
#
# @param condition
proc ::histogram_memory::stop_condition {condition} {
variable state
if [ catch {
array set count_stop {immediate IMMEDIATE period AT_END_OF_PERIOD}
if {$condition == ""} {
return $state(stop_cond)
} else {
hmm configure FAT_COUNT_STOP $count_stop($condition)
hmm init
set state(stop_cond) $condition
}
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
namespace eval ::histogram_memory {
#TODO Create GumTree commands to setup, start and stop the histmem
##
# @brief Choose method for controlling acquisition duration.
#command mode {text:time,monitor,unlimited,period,count,frame method} {}
##
# @brief Count until the preset count size has been reached.
#
# @param preset: The interpretation of the preset depends on the count method.
# @see count_method
#command preset {float: pre} {}
##
# @brief Set stop condition for histogram memory
#
# @param condition
#command stop_condition {text:immediate,period condition}
}
##
# @brief Convenience command providing user interface to histogram control
#
# @param cmd is one of start, stop, pause, mode, preset, fsrce, status, loadconf
# @param args is an optional list of arguments for the given command
proc _histmem {cmd args} {
#TODO Add "continue"
set reply ""
if [ catch {
switch $cmd {
"start" {
eval "::histogram_memory::start $args"
}
"stop" {
::histogram_memory::stop
}
"pause" {
::histogram_memory::pause
}
"mode" {
if {$args == ""} {
set reply [::histogram_memory::count_method ]
} else {
eval "::histogram_memory::count_method $args"
}
}
"preset" {
if {$args == ""} {
set reply [::histogram_memory::count_size ]
} else {
eval "::histogram_memory::count_size $args"
}
}
"freq" {
if {$args == ""} {
set reply [::histogram_memory::get_frame_freq ]
} else {
eval "::histogram_memory::set_frame_freq $args"
}
}
"fsrce" {
if {$args == ""} {
set reply [::histogram_memory::get_frame_source ]
} else {
eval "::histogram_memory::set_frame_source $args"
}
}
"status" {
set reply [::histogram_memory::status]
}
"loadconf" {
# Loads configuration tables (OAT, FAT, ...) to histogram server
if {$args == ""} {
::histogram_memory::upload_config Filler_defaults
} else {
eval "::histogram_memory::upload_config $args"
}
}
default {
error "ERROR: Available commands are, start stop pause mode preset freq fsrce status loadconf"
}
}
return $reply
} message ] {
if {$::errorCode=="NONE"} { return $reply }
return -code error $message
}
}