From ef7c2a6f87b216068750ae74f3f50cd9a3b59cb3 Mon Sep 17 00:00:00 2001 From: Ferdi Franceschini Date: Mon, 23 Jun 2008 12:41:12 +1000 Subject: [PATCH] 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 --- sicvar.c | 2 +- .../hipadaba_configuration_common.tcl | 27 +- .../config/hmm/hmm_configuration_common_1.tcl | 34 +- .../config/nexus/nxscripts_common_1.tcl | 7 +- .../instrument/hipd/wombat_configuration.tcl | 7 +- .../instrument/hrpd/echidna_configuration.tcl | 7 +- .../reflectometer/platypus_configuration.tcl | 7 +- .../instrument/rsd/kowari_configuration.tcl | 7 +- .../config/optics/aperture_configuration.tcl | 78 ++++ .../instrument/sans/config/optics/optics.tcl | 1 + .../sans/config/parameters/parameters.tcl | 357 +++++++++++------- .../instrument/sans/quokka_configuration.tcl | 7 +- site_ansto/instrument/server_config.tcl | 79 +++- site_ansto/instrument/util/utility.tcl | 18 +- statemon.c | 55 ++- 15 files changed, 476 insertions(+), 217 deletions(-) create mode 100644 site_ansto/instrument/sans/config/optics/aperture_configuration.tcl diff --git a/sicvar.c b/sicvar.c index ddf27bdb..a62d3b15 100644 --- a/sicvar.c +++ b/sicvar.c @@ -588,7 +588,7 @@ static int VarSetFromText(pSicsVariable self, SConnection *pCon, char *text) { /* now, only a new value is still possible */ eStat = GetStatus(); - if( (eStat != eEager) && (eStat != eBatch) ) + if( (eStat != eEager) && (eStat != eBatch) && (eStat != eCounting) ) { SCWrite(pCon, "You cannot set variables while a scan is running",eError); diff --git a/site_ansto/instrument/config/hipadaba/hipadaba_configuration_common.tcl b/site_ansto/instrument/config/hipadaba/hipadaba_configuration_common.tcl index d62c4947..07e5ec52 100644 --- a/site_ansto/instrument/config/hipadaba/hipadaba_configuration_common.tcl +++ b/site_ansto/instrument/config/hipadaba/hipadaba_configuration_common.tcl @@ -372,7 +372,7 @@ proc ::hdb::add_subtree {hpath subtree {object @none} {type @none} {makenode @no set target [::utility::tabget subtree target] set nxalias [::utility::tabget subtree nxalias] foreach l $nxalias t $target { - set refname [getatt $t long_name] + set refname [normalgetatt $t long_name] ::hdb::add_hpath $hpath $refname hsetprop $hpath/$refname data "true" hsetprop $hpath/$refname nxsave "false" @@ -517,8 +517,9 @@ proc ::hdb::add_node {basePath args} { } } hobj { - hattach $basePath $node_name $arg_array(long_name) - set node_path $basePath/$arg_array(long_name) + set hobj_long_name [normalgetatt $node_name long_name] + hattach $basePath $node_name $hobj_long_name + set node_path $basePath/$hobj_long_name hsetprop $node_path data [getatt $node_name data] hsetprop $node_path control [getatt $node_name control] hsetprop $node_path nxsave [getatt $node_name nxsave] @@ -538,7 +539,7 @@ proc ::hdb::add_node {basePath args} { } script - getset { # A r/w pair of scripts, node = a node path - set node_path $basePath/[getatt $node_name long_name] + set node_path $basePath/[normalgetatt $node_name long_name] set data_type [getatt $node_name dtype] set data_length [getatt $node_name dlen] if {[getatt $node_name access] == "read_only"} { @@ -557,13 +558,18 @@ proc ::hdb::add_node {basePath args} { } } if {[info exists attribute(units)]} { - hsetprop $node_path units $attribute(units) + hsetprop $node_path units [normalgetatt $node_name units] } if {[info exists arg_array(prop_list)]} { foreach {prop pval} $arg_array(prop_list) { hsetprop $node_path $prop $pval } } + if {[info exists attribute(depends)]} { + foreach dep [split [normalgetatt $node_name depends] , ] { + ::hdb::sobjadd $node_path $dep + } + } sicslist setatt $node_name hdb_path $node_path return $node_path } @@ -587,8 +593,9 @@ proc ::hdb::add_command {basePath command} { hsetprop $basePath type part } } - hcommand $basePath/$cmd_atts(long_name) $command - set cmd_path $basePath/$cmd_atts(long_name) + set hcom_long_name [normalgetatt $command long_name] + hcommand $basePath/$hcom_long_name $command + set cmd_path $basePath/$hcom_long_name hsetprop $cmd_path privilege $cmd_atts(privilege) hsetprop $cmd_path type $cmd_atts(kind) hsetprop $cmd_path data $cmd_atts(data) @@ -674,7 +681,7 @@ proc ::hdb::sobjadd {hpath sobj args} { if {[catch {hsetprop $hpath type part} err]} {clientput $err error} } if {[lsearch [hlist $hpath] $sobjatt(long_name)] == -1} { - set node_path [add_node $hpath node $sobj long_name $sobjatt(long_name) kind $sobjatt(kind)] + set node_path [add_node $hpath node $sobj long_name [normalgetatt $sobj long_name] kind $sobjatt(kind)] if {[catch {hsetprop $node_path savecmd $sobjatt(savecmd)} err]} {clientput $err error} if {[catch {hsetprop $node_path sdsinfo $sobjatt(sdsinfo)} err]} {clientput $err error} if {[catch {hsetprop $node_path nxalias $sobjatt(nxalias)} err]} {clientput $err error} @@ -706,7 +713,7 @@ proc ::hdb::sobjadd {hpath sobj args} { if {[catch {hsetprop $hpath type part} err]} {clientput $err error} } if {[lsearch [hlist $hpath] $sobjatt(long_name)] == -1} { - set node_path [add_node $hpath node $sobj long_name $sobjatt(long_name) kind $sobjatt(kind)] + set node_path [add_node $hpath node $sobj long_name [normalgetatt $sobj long_name] kind $sobjatt(kind)] if {[catch {hsetprop $node_path sicsdev $sobj} err]} {clientput $err error} if {[catch {hsetprop $node_path nxalias $sobj} err]} {clientput $err error} if {[catch {hsetprop $node_path savecmd $sobjatt(savecmd)} err]} {clientput $err error} @@ -729,7 +736,7 @@ proc ::hdb::sobjadd {hpath sobj args} { if {[catch {hsetprop $hpath type part} err]} {clientput $err error} } if {[lsearch [hlist $hpath] $sobjatt(long_name)] == -1} { - set node_path [add_node $hpath node $sobj long_name $sobjatt(long_name) kind $sobjatt(kind)] + set node_path [add_node $hpath node $sobj long_name [normalgetatt $sobj long_name] kind $sobjatt(kind)] if {[catch {hsetprop $node_path savecmd $sobjatt(savecmd)} err]} {clientput $err error} if {[catch {hsetprop $node_path sdsinfo $sobjatt(sdsinfo)} err]} {clientput $err error} if {[catch {hsetprop $node_path nxalias $sobjatt(nxalias)} err]} {clientput $err error} diff --git a/site_ansto/instrument/config/hmm/hmm_configuration_common_1.tcl b/site_ansto/instrument/config/hmm/hmm_configuration_common_1.tcl index 9c765086..c0638167 100644 --- a/site_ansto/instrument/config/hmm/hmm_configuration_common_1.tcl +++ b/site_ansto/instrument/config/hmm/hmm_configuration_common_1.tcl @@ -1,5 +1,5 @@ -# $Revision: 1.31 $ -# $Date: 2008-06-10 04:40:30 $ +# $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 @@ -1347,36 +1347,36 @@ proc ::histogram_memory::configure_dims {} { if {[instname] == "wombat"} { array set dim_map { hmm {{hmm_dim0 oat_ntc_eff} {hmm_dim1 stitch_nyc} {hmm_dim2 stitch_nxc}} - hmm,fat_read_data_type HISTOPERIOD_XYT + hmm,read_data_type HISTOPERIOD_XYT hmm_xy {{hmm_dim0 stitch_nyc} {hmm_dim1 stitch_nxc}} - hmm_xy,fat_read_data_type TOTAL_HISTOGRAM_XY + hmm_xy,read_data_type TOTAL_HISTOGRAM_XY hmm_xt {{hmm_dim0 oat_ntc_eff} {hmm_dim1 stitch_nxc}} - hmm_xt,fat_read_data_type TOTAL_HISTOGRAM_XT + hmm_xt,read_data_type TOTAL_HISTOGRAM_XT hmm_yt {{hmm_dim0 oat_ntc_eff} {hmm_dim1 stitch_nyc}} - hmm_yt,fat_read_data_type TOTAL_HISTOGRAM_YT + hmm_yt,read_data_type TOTAL_HISTOGRAM_YT hmm_x {{hmm_dim0 stitch_nxc}} - hmm_x,fat_read_data_type TOTAL_HISTOGRAM_X + hmm_x,read_data_type TOTAL_HISTOGRAM_X hmm_y {{hmm_dim0 stitch_nyc}} - hmm_y,fat_read_data_type TOTAL_HISTOGRAM_Y + hmm_y,read_data_type TOTAL_HISTOGRAM_Y hmm_t {{hmm_dim0 oat_ntc_eff}} - hmm_t,fat_read_data_type TOTAL_HISTOGRAM_T + 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,fat_read_data_type HISTOPERIOD_XYT + hmm,read_data_type HISTOPERIOD_XYT hmm_xy {{hmm_dim0 oat_nyc_eff} {hmm_dim1 oat_nxc_eff}} - hmm_xy,fat_read_data_type TOTAL_HISTOGRAM_XY + hmm_xy,read_data_type TOTAL_HISTOGRAM_XY hmm_xt {{hmm_dim0 oat_ntc_eff} {hmm_dim1 oat_nxc_eff}} - hmm_xt,fat_read_data_type TOTAL_HISTOGRAM_XT + hmm_xt,read_data_type TOTAL_HISTOGRAM_XT hmm_yt {{hmm_dim0 oat_ntc_eff} {hmm_dim1 oat_nyc_eff}} - hmm_yt,fat_read_data_type TOTAL_HISTOGRAM_YT + hmm_yt,read_data_type TOTAL_HISTOGRAM_YT hmm_x {{hmm_dim0 oat_nxc_eff}} - hmm_x,fat_read_data_type TOTAL_HISTOGRAM_X + hmm_x,read_data_type TOTAL_HISTOGRAM_X hmm_y {{hmm_dim0 oat_nyc_eff}} - hmm_y,fat_read_data_type TOTAL_HISTOGRAM_Y + hmm_y,read_data_type TOTAL_HISTOGRAM_Y hmm_t {{hmm_dim0 oat_ntc_eff}} - hmm_t,fat_read_data_type TOTAL_HISTOGRAM_T + hmm_t,read_data_type TOTAL_HISTOGRAM_T } } @@ -1386,7 +1386,7 @@ proc ::histogram_memory::configure_dims {} { foreach elmt $dim_map($hm_obj) { set [lindex $elmt 0] [hmmdictitemval hmm [lindex $elmt 1]] } - $hm_obj configure FAT_READ_DATA_TYPE $dim_map($hm_obj,fat_read_data_type) + $hm_obj configure READ_DATA_TYPE $dim_map($hm_obj,read_data_type) $hm_obj stop $hm_obj configure init 0 $hm_obj init diff --git a/site_ansto/instrument/config/nexus/nxscripts_common_1.tcl b/site_ansto/instrument/config/nexus/nxscripts_common_1.tcl index db25b583..fb22c997 100644 --- a/site_ansto/instrument/config/nexus/nxscripts_common_1.tcl +++ b/site_ansto/instrument/config/nexus/nxscripts_common_1.tcl @@ -588,7 +588,7 @@ proc ::nexus::newfile {type {namestyle data}} { array unset p_arr array set p_arr [::utility::hlistplainprop /$hpath/$child] if {[info exists p_arr(type)] && $p_arr(type) == "nxvgroup"} { - return + continue } set data_type [lindex [split [hinfo /$hpath/$child] , ] 0] if {$p_arr(data) == true && $p_arr(nxsave) == true } { @@ -790,8 +790,7 @@ proc ::nexus::histmem::save {hm nxalias data_type args} { nxscript updatedictvar padim$i [set dim$i] } set data_start 0 - set bank 0 - $hm init + set bank 1 nxscript putslab $nxalias $indStartList $indLenList $hm $data_start $datalen $bank }] { return -code error $::errorInfo @@ -1035,7 +1034,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.37 $}] +set tmpstr [string map {"$" ""} {$Revision: 1.38 $}] set nx_content_revision_num [lindex $tmpstr [expr [llength $tmpstr] - 1]] #namespace eval data { diff --git a/site_ansto/instrument/hipd/wombat_configuration.tcl b/site_ansto/instrument/hipd/wombat_configuration.tcl index 6bde5f7c..14ccb98e 100644 --- a/site_ansto/instrument/hipd/wombat_configuration.tcl +++ b/site_ansto/instrument/hipd/wombat_configuration.tcl @@ -1,5 +1,5 @@ -# $Revision: 1.20 $ -# $Date: 2008-05-30 00:26:55 $ +# $Revision: 1.21 $ +# $Date: 2008-06-23 02:41:12 $ # Author: Ferdi Franceschini (ffr@ansto.gov.au) # Last revision by: $Author: ffr $ @@ -43,12 +43,11 @@ restore #::environment::temperature::add_ls340 -MakeStateMon hmscan if [file exists extraconfig.tcl] { fileeval extraconfig.tcl } else { clientput "extraconfig.tcl not found. continueing" } -server_set_sobj_attributes +server_init buildHDB instrument_dictionary diff --git a/site_ansto/instrument/hrpd/echidna_configuration.tcl b/site_ansto/instrument/hrpd/echidna_configuration.tcl index b1706534..caefe597 100644 --- a/site_ansto/instrument/hrpd/echidna_configuration.tcl +++ b/site_ansto/instrument/hrpd/echidna_configuration.tcl @@ -1,5 +1,5 @@ -# $Revision: 1.27 $ -# $Date: 2008-05-30 00:26:55 $ +# $Revision: 1.28 $ +# $Date: 2008-06-23 02:41:12 $ # Author: Ferdi Franceschini (ffr@ansto.gov.au) # Last revision by: $Author: ffr $ @@ -43,12 +43,11 @@ restore #::environment::temperature::add_ls340 -MakeStateMon hmscan if [file exists extraconfig.tcl] { fileeval extraconfig.tcl } else { clientput "extraconfig.tcl not found. continueing" } -server_set_sobj_attributes +server_init buildHDB instrument_dictionary diff --git a/site_ansto/instrument/reflectometer/platypus_configuration.tcl b/site_ansto/instrument/reflectometer/platypus_configuration.tcl index 10878399..e4ed8431 100644 --- a/site_ansto/instrument/reflectometer/platypus_configuration.tcl +++ b/site_ansto/instrument/reflectometer/platypus_configuration.tcl @@ -1,5 +1,5 @@ -# $Revision: 1.16 $ -# $Date: 2008-06-11 23:05:36 $ +# $Revision: 1.17 $ +# $Date: 2008-06-23 02:41:12 $ # Author: Ferdi Franceschini (ffr@ansto.gov.au) # Last revision by: $Author: ffr $ @@ -44,7 +44,6 @@ restore ::histogram_memory::initialize -MakeStateMon hmscan if [file exists extraconfig.tcl] { fileeval extraconfig.tcl } else { @@ -52,5 +51,5 @@ if [file exists extraconfig.tcl] { } ::anticollider::init -server_set_sobj_attributes +server_init buildHDB instrument_dictionary diff --git a/site_ansto/instrument/rsd/kowari_configuration.tcl b/site_ansto/instrument/rsd/kowari_configuration.tcl index 850dec4f..4944f78e 100644 --- a/site_ansto/instrument/rsd/kowari_configuration.tcl +++ b/site_ansto/instrument/rsd/kowari_configuration.tcl @@ -1,5 +1,5 @@ -# $Revision: 1.10 $ -# $Date: 2008-05-30 00:26:56 $ +# $Revision: 1.11 $ +# $Date: 2008-06-23 02:41:12 $ # Author: Ferdi Franceschini (ffr@ansto.gov.au) # Last revision by: $Author: ffr $ @@ -39,7 +39,6 @@ restore ::histogram_memory::initialize -MakeStateMon hmscan if [file exists extraconfig.tcl] { fileeval extraconfig.tcl } else { @@ -47,5 +46,5 @@ if [file exists extraconfig.tcl] { } ::anticollider::init -server_set_sobj_attributes +server_init buildHDB instrument_dictionary diff --git a/site_ansto/instrument/sans/config/optics/aperture_configuration.tcl b/site_ansto/instrument/sans/config/optics/aperture_configuration.tcl new file mode 100644 index 00000000..a53d6ba7 --- /dev/null +++ b/site_ansto/instrument/sans/config/optics/aperture_configuration.tcl @@ -0,0 +1,78 @@ +namespace eval optics { + array set AttRotLookupTable { + 0 0.0 + 30 1.5 + 60 3.4 + 90 4.9 + 120 6.4 + 150 8.3 + 180 9.8 + 210 11.2 + 240 13.2 + 270 18.1 + 300 23.0 + 330 25.0 + } + + array set EApLookupTable { + 0 { 5 circ} + 30 {10 circ} + 60 {20 circ} + 90 {30 circ} + 120 {40 circ} + 150 {50 circ} + 180 {50 squ } + 210 {open open} + 240 {open open} + 270 {open open} + 300 {open open} + 330 {open open} + } +} + +proc ::optics::AttRotLookup {angle} { + variable AttRotLookupTable + set foundit false + foreach vangle [array names AttRotLookupTable] { + if {$vangle == [expr int($angle)]} { + set foundit true + break + } + } + if {$foundit == true} { + return [lindex $AttRotLookupTable($vangle) 0] + } else { + return -1 + } +} + +proc ::optics::EApLookUp {angle param} { + variable EApLookupTable + set foundit false + if [ catch { + switch $param { + "size" {set index 0} + "shape" {set index 1} + default { + error "ERROR: Invalid lookup parameter $param" + } + } + foreach vangle [array names EApLookupTable] { + if {$vangle == [expr int($angle)]} { + set foundit true + break + } + } + if {$foundit == true} { + return [lindex $EApLookupTable($vangle) $index] + } else { + switch $param { + "size" {return 0} + "shape" {return "UNKNOWN"} + } + } + } message ] { + if {$::errorCode == "NONE"} {return $message} + return -code error "$message" + } +} diff --git a/site_ansto/instrument/sans/config/optics/optics.tcl b/site_ansto/instrument/sans/config/optics/optics.tcl index c5b59654..766cd383 100644 --- a/site_ansto/instrument/sans/config/optics/optics.tcl +++ b/site_ansto/instrument/sans/config/optics/optics.tcl @@ -1 +1,2 @@ fileeval $cfPath(optics)/guide_configuration.tcl +fileeval $cfPath(optics)/aperture_configuration.tcl diff --git a/site_ansto/instrument/sans/config/parameters/parameters.tcl b/site_ansto/instrument/sans/config/parameters/parameters.tcl index d4292090..bdbf85d2 100644 --- a/site_ansto/instrument/sans/config/parameters/parameters.tcl +++ b/site_ansto/instrument/sans/config/parameters/parameters.tcl @@ -1,16 +1,16 @@ ## # @brief We can't change the coordinate scheme at runtime because this would require # restructuring the hdb tree, but we should save it. -foreach {var nxname} { - VelSelCoordScheme coordinate_scheme - SApCoordScheme coordinate_scheme - EApCoordScheme coordinate_scheme - SampleCoordScheme coordinate_scheme - DetCoordScheme coordinate_scheme - BeamstopCoordScheme coordinate_scheme - CollCoordScheme coordinate_scheme +foreach {var lname nxname} { + VelSelCoordScheme VelSelCoordScheme coordinate_scheme + SApCoordScheme SApCoordScheme coordinate_scheme + EApCoordScheme EApCoordScheme coordinate_scheme + SampleCoordScheme SampleCoordScheme coordinate_scheme + DetCoordScheme DetCoordScheme coordinate_scheme + BeamstopCoordScheme BeamstopCoordScheme coordinate_scheme + CollCoordScheme CollCoordScheme coordinate_scheme } { - ::utility::mkVar $var text readonly $var true @none false true + ::utility::mkVar $var text readonly $lname true @none false true $var Cartesian $var lock } @@ -22,68 +22,73 @@ foreach {var nxname} { # The set parameter will have a domain. If the param is readonly then the hdb privilege is readonly # Pros, GumTree will know the data type of the parameter (text params will have a list of valid values). # Cons, There is no "instant" feedback, macros are polled on the hdb tree. -foreach {var nxname priv} { - EApShape shape user - RotApshape shape readonly - SApShape shape readonly - BSShape shape user +foreach {var lname nxname priv klass} { + SApShape SApShape shape user parameter + BSShape BSShape shape user parameter } { - ::utility::mkVar $var text $priv $var true @none true true + ::utility::mkVar $var text $priv $lname true $klass true true } # The velocity selector position is used as the reference for other instrument # component positions. For simplicity we set it as the origin x=y=z=0. -foreach {var nxname units} { - VelSelPosXmm x mm - VelSelPosYmm y mm - VelSelPosZmm z mm - EndFacePosYmm y mm - RotApPosYmm y mm +foreach {var lname nxname units klass} { + VelSelPosXmm VelSelPosXmm x mm @none + VelSelPosYmm VelSelPosYmm y mm @none + VelSelPosZmm VelSelPosZmm z mm @none + EndFacePosYmm EndFacePosYmm y mm parameter + RotApPosYmm RotApPosYmm y mm @none } { - ::utility::mkVar $var float readonly $var true @none true true + ::utility::mkVar $var float readonly $lname true $klass true true if {$units != 1} { sicslist setatt $var units $units } } -::utility::mkVar SampleNum int readonly changer_position true sample true true +::utility::mkVar SampleNum int readonly changer_position true parameter true true -foreach {var nxname units priv} { - LambdaA wavelength nm user - LambdaResFWHM% wavelength_spread 1 user - VSdeg twist degrees user - VSrpm rotation_speed rpm user - AttFactor attenuation_factor 1 user - AttRotDeg AttRotDeg degrees readonly - PleXmm x mm user - RotApXmm x mm user - RotApZmm z mm user - RotApDeg RotApDeg degrees readonly - EApXmm x mm user - EApYmm y mm user - EApZmm z mm user - EApPosYmm y mm user - SApXmm x mm readonly - SApZmm z mm readonly - SApPosXmm x mm user - SApPosYmm y mm user - SApPosZmm z mm user - SamplePosXmm x mm user - SamplePosYmm y mm user - SamplePosZmm z mm user - SampleRotDeg SampleRotDeg degrees user - SampleTiltXdeg SampleTiltXdeg degrees user - SampleTiltYdeg SampleTiltYdeg degrees user - DetPosYOffsetmm detposyoffset mm user - BSXmm x mm user - BSZmm z mm user +# 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 } { - ::utility::mkVar $var float $priv $var true @none true true + ::utility::mkVar $var float $priv $lname true parameter true true if {$units != 1} { sicslist setatt $var units $units } } +# Derived Parameter SicsVariables +foreach {var type lname units depends} { + AttFactor float AttFactor 1 AttRotDeg,LambdaA,LambdaResFWHM% + PleXmm float PleXmm mm AttRotDeg + EApXmm float EApXmm mm RotApDeg + EApZmm float EApZmm mm RotApDeg + RotApXmm float RotApXmm mm RotApDeg + RotApZmm float RotApZmm mm RotApDeg + EApShape text EApShape 1 RotApDeg + RotApShape text RotApShape 1 RotApDeg +} { + ::utility::mkVar $var $type user $lname true derived_parameter true true + sicslist setatt $var depends $depends + if {$units != 1} { + sicslist setatt $var units $units + } +} proc sicsmsgfmt {args} {return "[info level -1] = $args"} ::utility::macro::getset float L1mm {} { set efpy [SplitReply [EndFacePosYmm]] @@ -91,9 +96,10 @@ proc sicsmsgfmt {args} {return "[info level -1] = $args"} set eapy [SplitReply [EApPosYmm]] return [sicsmsgfmt [expr {$efpy + $sapy - $eapy}]] } -sicslist setatt L1mm klass sample -sicslist setatt L1mm long_name eap_sap_dist +sicslist setatt L1mm long_name L1mm +sicslist setatt L1mm klass derived_parameter sicslist setatt L1mm units mm +sicslist setatt L1mm depends EndFacePosYmm,SApPosYmm,EApPosYmm ::utility::macro::getset float L2mm {} { set detpy [SplitReply [DetPosYmm]] @@ -101,23 +107,92 @@ sicslist setatt L1mm units mm set sapy [SplitReply [SamplePosYmm]] return [sicsmsgfmt [expr {$detpyos + $detpyos - $sapy}]] } -sicslist setatt L2mm klass detector -sicslist setatt L2mm long_name sample_det_dist +sicslist setatt L2mm long_name L2mm +sicslist setatt L2mm klass derived_parameter sicslist setatt L2mm units mm +sicslist setatt L2mm depends DetPosYmm,DetPosYOffsetmm,SamplePosYmm -foreach {pname motor hdbname units} { - DetPosXmm detoff x mm - DetPosYmm det y mm - BSPosXmm bsx x mm - BSPosZmm bsz z mm +# Derive motor parameters +foreach {pname motor units} { + DetPosXmm detoff mm + DetPosYmm det mm + BSPosXmm bsx mm + BSPosZmm bsz mm + SampleTiltXDeg samphi degrees + SampleTiltYDeg samchi degrees + SampleRotDeg samthet degrees } { ::utility::macro::getset float $pname {} [subst -nocommands { return [sicsmsgfmt [SplitReply [$motor]]] }] sicslist setatt $pname units $units - sicslist setatt $pname long_name $pname + sicslist setatt $pname long_name $pname + sicslist setatt $pname klass derived_parameter + sicslist setatt $pname depends $motor } +foreach {pname motor units} { + AttRotDeg att degrees +} { + ::utility::macro::getset float $pname {args} [subst -nocommands { +# TODO AttFactor + if {[set args] == ""} { + return [sicsmsgfmt [SplitReply [$motor]]] + } else { + set target [lindex [set args] 0] + Plexmm -1 + drive $motor \$target + 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] + } + } + }] + sicslist setatt $pname units $units + sicslist setatt $pname long_name $pname + sicslist setatt $pname klass derived_parameter + sicslist setatt $pname depends $motor +} + +foreach {pname motor units} { + RotApDeg srce degrees +} { + ::utility::macro::getset float $pname {args} [subst -nocommands { + 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" + drive $motor \$target + 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 + } + } + }] + sicslist setatt $pname units $units + sicslist setatt $pname long_name $pname + sicslist setatt $pname klass derived_parameter + sicslist setatt $pname depends $motor +} ################################################################################ ## # @brief This is the position of the velocity selector bunker face. It is used @@ -153,12 +228,12 @@ foreach {pname motor hdbname units} { refpos VelSelPosYmm } -::hdb::MakeGeometry sample_geometry sample { - coordinate_scheme SampleCoordScheme - position {SamplePosXmm SamplePosYmm SamplePosZmm} - orientation {SampleTiltXdeg SampleTiltYdeg SampleRotDeg} - refpos {VelSelPosXmm EndFacePosYmm VelSelPosZmm} -} +#::hdb::MakeGeometry sample_geometry sample { +# coordinate_scheme SampleCoordScheme +# position {SamplePosXmm SamplePosYmm SamplePosZmm} +# orientation {SampleTiltXDeg SampleTiltYDeg SampleRotDeg} +# refpos {VelSelPosXmm EndFacePosYmm VelSelPosZmm} +#} ::hdb::MakeGeometry detector_geometry detector { coordinate_scheme DetCoordScheme @@ -204,82 +279,70 @@ RotApPosYmm 675 ################################################################################ # Check Config namespace eval parameters { - set paramlist { - AttRotDeg - BS1 - BS2 - BS3 - BS4 - BS5 - BSPosXmm - BSPosZmm - BSShape - BSXmm - BSZmm - C1 - C2 - C3 - C4 - C5 - C6 - C7 - C8 - C9 - DetPosXmm - DetPosYmm - DetPosYmm - DetPosYOffsetmm - EApPosYmm - EApShape - EApXmm - EApYmm - EApZmm - EndFacePosYmm - LambdaA - LambdaResFWHM% - Pent - Plexmm - RotApDeg - RotApShape - RotApXmm - RotApZmm - SampleAttributes - SampleComments - SampleName - SampleNum - SamplePosXmm - SamplePosYmm - SamplePosYmm - SamplePosZmm - SampleRotDeg - SampleTiltXDeg - SampleTiltYDeg - SampleTitle - SApPosXmm - SApPosYmm - SApPosYmm - SApPosZmm - SApShape - SApXmm - SApZmm - VSdeg - VSrpm - } - foreach p $paramlist { - if [::utility::obj_exists $p] { - sicslist setatt $p klass parameter - } - } - set derived_paramlist { - AttFactor - L1mm - L2mm - } - foreach p $derived_paramlist { - if [::utility::obj_exists $p] { - sicslist setatt $p klass derived_parameter - } - } + set paramlist { + AttFactor + AttRotDeg + BS1 + BS2 + BS3 + BS4 + BS5 + BSPosXmm + BSPosZmm + BSShape + BSXmm + BSZmm + C1 + C2 + C3 + C4 + C5 + C6 + C7 + C8 + C9 + DetPosXmm + DetPosYmm + DetPosYOffsetmm + EApPosYmm + EApShape + EApShape + EApXmm + EApYmm + EApZmm + EndFacePosYmm + L1mm + L2mm + LambdaA + LambdaResFWHM% + Pent + Plexmm + RotApDeg + RotApShape + RotApXmm + RotApZmm + SampleAttributes + SampleComments + SampleName + SampleNum + SamplePosXmm + SamplePosYmm + SamplePosYmm + SamplePosZmm + SampleRotDeg + SampleTiltXDeg + SampleTiltYDeg + SampleTitle + SApPosXmm + SApPosYmm + SApPosYmm + SApPosZmm + SApShape + SApXmm + SApZmm + VSdeg + VSrpm + } } ## # @brief List undefined parameters @@ -294,6 +357,8 @@ proc ::parameters::missingparams {} { } if {$num > 0} { clientput "There are $num missing parameters" + } else { + clientput "OK" } } @@ -302,7 +367,7 @@ proc ::parameters::missingparams {} { proc check {args} { switch $args { "missing" { - missingparams + ::parameters::missingparams } } } diff --git a/site_ansto/instrument/sans/quokka_configuration.tcl b/site_ansto/instrument/sans/quokka_configuration.tcl index 25ee59dc..1cec92bf 100644 --- a/site_ansto/instrument/sans/quokka_configuration.tcl +++ b/site_ansto/instrument/sans/quokka_configuration.tcl @@ -1,5 +1,5 @@ -# $Revision: 1.8 $ -# $Date: 2008-06-11 23:05:36 $ +# $Revision: 1.9 $ +# $Date: 2008-06-23 02:41:12 $ # Author: Ferdi Franceschini (ffr@ansto.gov.au) # Last revision by: $Author: ffr $ @@ -53,7 +53,6 @@ restore ::histogram_memory::initialize -MakeStateMon hmscan if [file exists extraconfig.tcl] { fileeval extraconfig.tcl } else { @@ -61,5 +60,5 @@ if [file exists extraconfig.tcl] { } ::anticollider::init -server_set_sobj_attributes +server_init buildHDB instrument_dictionary diff --git a/site_ansto/instrument/server_config.tcl b/site_ansto/instrument/server_config.tcl index 44e21a4a..2deaa699 100644 --- a/site_ansto/instrument/server_config.tcl +++ b/site_ansto/instrument/server_config.tcl @@ -1,7 +1,7 @@ # SICS common configuration -# $Revision: 1.34 $ -# $Date: 2008-06-11 23:05:36 $ +# $Revision: 1.35 $ +# $Date: 2008-06-23 02:41:12 $ # Author: Ferdi Franceschini (ffr@ansto.gov.au) # Last revision by $Author: ffr $ @@ -131,7 +131,7 @@ sics_release [lindex $tmpstr [expr [llength $tmpstr] - 1]] sics_release lock ::utility::mkVar sics_revision_num Text internal -set tmpstr [string map {"$" ""} {$Revision: 1.34 $}] +set tmpstr [string map {"$" ""} {$Revision: 1.35 $}] sics_revision_num [lindex $tmpstr [expr [llength $tmpstr] - 1]] sics_revision_num lock @@ -174,11 +174,47 @@ proc server_set_sobj_attributes {} { } } +proc server_init {} { + MakeStateMon hmscan + sicslist setatt sics_suid privilege readonly + sicslist setatt sics_suid klass data + sicslist setatt sics_suid kind hobj + sicslist setatt sics_suid mutable true + sicslist setatt sics_suid data true + sicslist setatt sics_suid control true + sicslist setatt sics_suid nxsave true + sicslist setatt sics_suid long_name sics_suid + + server_set_sobj_attributes +} + # Make the opal status info object set sim_mode [SplitReply [opal_simulation]] if {$sim_mode == "true"} { - proc opal {args} { - return "CALIBRATED.CALIBRATED REACTOR POWER 0290_04:ARPCS_CNTRL.RO0005 = 20 (08-06-04 11:42:39)" + 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 { @@ -186,10 +222,41 @@ if {$sim_mode == "true"} { MakeLSSMonitor opal lss_chan 0 } ::utility::macro::getset float reactor_power {} { - return "reactor_power = [lindex [opal calibrated] 5]" + 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" diff --git a/site_ansto/instrument/util/utility.tcl b/site_ansto/instrument/util/utility.tcl index 55ae9532..4c0f4e4e 100644 --- a/site_ansto/instrument/util/utility.tcl +++ b/site_ansto/instrument/util/utility.tcl @@ -1,7 +1,7 @@ # Some useful functions for SICS configuration. -# $Revision: 1.12 $ -# $Date: 2008-06-11 23:05:36 $ +# $Revision: 1.13 $ +# $Date: 2008-06-23 02:41:12 $ # Author: Ferdi Franceschini (ffr@ansto.gov.au) # Last revision by $Author: ffr $ @@ -226,6 +226,16 @@ proc getatt {sicsobj att} { } } +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 @@ -750,8 +760,10 @@ proc ::utility::macro::getset {type name arglist body} { publish $name user if {$arglist == ""} { sicslist setatt $name access read_only + } else { + sicslist setatt $name access user } - sicslist setatt $name privilege manager + sicslist setatt $name privilege user sicslist setatt $name dtype $type sicslist setatt $name dlen 1 sicslist setatt $name data true diff --git a/statemon.c b/statemon.c index f7b735ef..cb56f00d 100644 --- a/statemon.c +++ b/statemon.c @@ -16,11 +16,15 @@ #include "stptok.h" #include "statemon.h" #include "sicshipadaba.h" +#include "sicsvar.h" + +#define SICS_SUID "sics_suid" /*==========================================================================*/ typedef struct __STATEMON { pObjectDescriptor pDes; pICallBack pCall; }StateMon; +SConnection *pStateMonDummyCon = NULL; /*============================ Callbacks =================================*/ static int DevexecCallback(int iEvent, void *text, void *pData, commandContext cc){ @@ -98,19 +102,37 @@ static int StateInterest(int iEvent, void *pEvent, void *pUser, SConnection *pCon = (SConnection *)pUser; char *device = (char *)pEvent; char buffer[256]; + pSicsVariable pVar = NULL; - if(pCon == NULL || device == NULL){ + if( pCon == NULL || device == NULL) { printf("Bad StateInterest in statemon\n"); return 0; - } - if(iEvent == STSTART){ - snprintf(buffer,255,"STARTED = %s", device); - SCWriteInContext(pCon,buffer,eWarning,cc); - } - if(iEvent == STEND){ - snprintf(buffer,255,"FINISH = %s", device); - SCWriteInContext(pCon,buffer,eWarning,cc); - } + } else if (pCon == pStateMonDummyCon) { + if(iEvent == STSTART){ + snprintf(buffer,255,"SUID MSG STARTED = %s", device); + SCWrite(pStateMonDummyCon,buffer,eError); + } + if(iEvent == STEND){ + snprintf(buffer,255,"SUID MSG FINISH = %s", device); + SCWrite(pStateMonDummyCon,buffer,eError); + } + pVar = (pSicsVariable)FindCommandData(pServ->pSics,SICS_SUID,"SicsVariable"); + if (pVar == NULL) { + SCWrite(pStateMonDummyCon,"ERROR: StateMon.c: Could not find SUID SicsVariable",eError); + return 0; + } + (pVar->iVal)++; + InvokeCallBack(pVar->pCall, VALUECHANGE, pVar); + } else { + if(iEvent == STSTART){ + snprintf(buffer,255,"STARTED = %s", device); + SCWriteInContext(pCon,buffer,eWarning,cc); + } + if(iEvent == STEND){ + snprintf(buffer,255,"FINISH = %s", device); + SCWriteInContext(pCon,buffer,eWarning,cc); + } + } return 1; } /*--------------------------------------------------------------------------*/ @@ -207,16 +229,21 @@ static void killStateMon(void *pData){ if(self->pCall != NULL){ DeleteCallBackInterface(self->pCall); } + if(pStateMonDummyCon != NULL) { + SCDeleteConnection(pStateMonDummyCon); + } free(self); } } /*---------------------------------------------------------------------------*/ int StateMonFactory(SConnection *pCon, SicsInterp *pSics, void *pData, int argc, char *argv[]){ + long lID; pStateMon pNew = NULL; commandContext cc; pICallBack target = NULL; void *pPtr = NULL, *exe = NULL, *pDevexec = NULL; + pSicsVariable pRes = NULL; exe = FindCommandData(pSics,"exe", "ExeManager"); pDevexec = FindCommandData(pSics,"stopexe","DeviceExecutor"); @@ -266,6 +293,14 @@ int StateMonFactory(SConnection *pCon, SicsInterp *pSics, void *pData, RegisterCallback(target,cc,SCANEND,StateMonScanInterest,pNew,NULL); } } + /* Make dummy connection for SUID (instrument state id) */ + pStateMonDummyCon = SCCreateDummyConnection(pSics); + lID = RegisterCallback(pNew->pCall, SCGetContext(pStateMonDummyCon),STSTART, StateInterest, pStateMonDummyCon, NULL); + SCRegister(pStateMonDummyCon,pSics, pNew->pCall,lID); + lID = RegisterCallback(pNew->pCall, SCGetContext(pStateMonDummyCon),STEND, StateInterest, pStateMonDummyCon, NULL); + SCRegister(pStateMonDummyCon,pSics, pNew->pCall,lID); + pRes = VarCreate(usInternal,veInt,SICS_SUID); + AddCommand(pSics,SICS_SUID,VarWrapper,(KillFunc)VarKill,pRes); /* * TODO: add kill functions */