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

@@ -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);

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 hobj_long_name [normalgetatt $node_name long_name]
-          set node_path $basePath/$arg_array(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 hcom_long_name [normalgetatt $command long_name]
-  set cmd_path $basePath/$cmd_atts(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}

site_ansto/instrument/config/hmm/hmm_configuration_common_1.tcl

@@ -1,5 +1,5 @@
-# $Revision: 1.31 $
+# $Revision: 1.32 $
-# $Date: 2008-06-10 04:40:30 $
+# $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

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
+  set bank 1
-  $hm init
   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 {

site_ansto/instrument/hipd/wombat_configuration.tcl

@@ -1,5 +1,5 @@
-# $Revision: 1.20 $
+# $Revision: 1.21 $
-# $Date: 2008-05-30 00:26:55 $
+# $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

site_ansto/instrument/hrpd/echidna_configuration.tcl

@@ -1,5 +1,5 @@
-# $Revision: 1.27 $
+# $Revision: 1.28 $
-# $Date: 2008-05-30 00:26:55 $
+# $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

site_ansto/instrument/reflectometer/platypus_configuration.tcl

@@ -1,5 +1,5 @@
-# $Revision: 1.16 $
+# $Revision: 1.17 $
-# $Date: 2008-06-11 23:05:36 $
+# $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

site_ansto/instrument/rsd/kowari_configuration.tcl

@@ -1,5 +1,5 @@
-# $Revision: 1.10 $
+# $Revision: 1.11 $
-# $Date: 2008-05-30 00:26:56 $
+# $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

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"
+  }
+}

site_ansto/instrument/sans/config/optics/optics.tcl

@@ -1 +1,2 @@
 fileeval $cfPath(optics)/guide_configuration.tcl
+fileeval $cfPath(optics)/aperture_configuration.tcl

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} {
+foreach {var lname nxname} {
-    VelSelCoordScheme     coordinate_scheme
+    VelSelCoordScheme    VelSelCoordScheme   coordinate_scheme
-    SApCoordScheme        coordinate_scheme
+    SApCoordScheme       SApCoordScheme      coordinate_scheme
-    EApCoordScheme        coordinate_scheme
+    EApCoordScheme       EApCoordScheme      coordinate_scheme
-    SampleCoordScheme     coordinate_scheme
+    SampleCoordScheme    SampleCoordScheme   coordinate_scheme
-    DetCoordScheme        coordinate_scheme
+    DetCoordScheme       DetCoordScheme      coordinate_scheme
-    BeamstopCoordScheme   coordinate_scheme
+    BeamstopCoordScheme  BeamstopCoordScheme coordinate_scheme
-    CollCoordScheme       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} {
+foreach {var lname nxname priv klass} {
-    EApShape     shape  user
+    SApShape     SApShape     shape   user       parameter
-    RotApshape   shape  readonly
+    BSShape      BSShape      shape   user       parameter
-    SApShape     shape  readonly
-    BSShape      shape  user
 } {
-  ::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} {
+foreach {var lname nxname units klass} {
-    VelSelPosXmm    x   mm
+    VelSelPosXmm   VelSelPosXmm   x   mm @none
-    VelSelPosYmm    y   mm
+    VelSelPosYmm   VelSelPosYmm   y   mm @none
-    VelSelPosZmm    z   mm
+    VelSelPosZmm   VelSelPosZmm   z   mm @none
-    EndFacePosYmm   y   mm
+    EndFacePosYmm  EndFacePosYmm  y   mm parameter
-    RotApPosYmm     y   mm
+    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} {
+# Parameter SicsVariables
-    LambdaA           wavelength          nm      	  	 user
+foreach {var lname nxname units priv } {
-    LambdaResFWHM%    wavelength_spread   1       	  	 user
+    LambdaA           LambdaA           wavelength          nm        user    
-    VSdeg             twist               degrees 	  	 user
+    LambdaResFWHM%    LambdaResFWHM%    wavelength_spread   1         user    
-    VSrpm             rotation_speed      rpm     	  	 user
+    VSdeg             VSdeg             twist               degrees   user    
-    AttFactor         attenuation_factor  1              user
+    VSrpm             VSrpm             rotation_speed      rpm       user    
-    AttRotDeg         AttRotDeg           degrees 	  	 readonly
+    EApYmm            EApYmm            y                   mm        user    
-    PleXmm            x                   mm      	  	 user
+    EApPosYmm         EApPosYmm         y                   mm        user    
-    RotApXmm          x                   mm      	  	 user
+    SApXmm            SApXmm            x                   mm        user
-    RotApZmm          z                   mm      	  	 user
+    SApZmm            SApZmm            z                   mm        user
-    RotApDeg          RotApDeg            degrees 	  	 readonly
+    SApPosXmm         SApPosXmm         x                   mm        user    
-    EApXmm            x                   mm      	  	 user
+    SApPosYmm         SApPosYmm         y                   mm        user    
-    EApYmm            y                   mm      	  	 user
+    SApPosZmm         SApPosZmm         z                   mm        user    
-    EApZmm            z                   mm      	  	 user
+    SamplePosXmm      SamplePosXmm      x                   mm        user    
-    EApPosYmm         y                   mm      	  	 user
+    SamplePosYmm      SamplePosYmm      y                   mm        user    
-    SApXmm            x                   mm      	  	 readonly
+    SamplePosZmm      SamplePosZmm      z                   mm        user    
-    SApZmm            z                   mm      	  	 readonly
+    DetPosYOffsetmm   DetPosYOffsetmm   detposyoffset       mm        user    
-    SApPosXmm         x                   mm      	  	 user
+    BSXmm             BSXmm             x                   mm        user    
-    SApPosYmm         y                   mm      	  	 user
+    BSZmm             BSZmm             z                   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
 } {
-  ::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 L1mm
-sicslist setatt L1mm long_name eap_sap_dist
+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 L2mm
-sicslist setatt L2mm long_name sample_det_dist
+sicslist setatt L2mm klass derived_parameter
 sicslist setatt L2mm units mm
+sicslist setatt L2mm depends DetPosYmm,DetPosYOffsetmm,SamplePosYmm
 
-foreach {pname motor hdbname units} {
+# Derive motor parameters
-    DetPosXmm        detoff    x                mm
+foreach {pname motor units} {
-    DetPosYmm        det       y                mm
+    DetPosXmm        detoff   mm     
-    BSPosXmm         bsx       x                mm
+    DetPosYmm        det      mm     
-    BSPosZmm         bsz       z                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 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 {
+#::hdb::MakeGeometry sample_geometry sample {
-    coordinate_scheme   SampleCoordScheme
+#    coordinate_scheme   SampleCoordScheme
-    position            {SamplePosXmm       SamplePosYmm     SamplePosZmm}
+#    position            {SamplePosXmm       SamplePosYmm     SamplePosZmm}
-    orientation         {SampleTiltXdeg     SampleTiltYdeg   SampleRotDeg}
+#    orientation         {SampleTiltXDeg     SampleTiltYDeg   SampleRotDeg}
-    refpos              {VelSelPosXmm       EndFacePosYmm    VelSelPosZmm}
+#    refpos              {VelSelPosXmm       EndFacePosYmm    VelSelPosZmm}
-}
+#}
 
 ::hdb::MakeGeometry detector_geometry detector {
     coordinate_scheme   DetCoordScheme
@@ -205,6 +280,7 @@ RotApPosYmm     675
 # Check Config
 namespace eval parameters {
 	set paramlist {
+		AttFactor
 		AttRotDeg
 		BS1
 		BS2
@@ -227,14 +303,16 @@ namespace eval parameters {
 		C9
 		DetPosXmm
 		DetPosYmm
-      DetPosYmm
 		DetPosYOffsetmm
 		EApPosYmm
 		EApShape
+		EApShape
 		EApXmm
 		EApYmm
 		EApZmm
 		EndFacePosYmm
+		L1mm
+		L2mm
 		LambdaA
 		LambdaResFWHM%
 		Pent
@@ -265,21 +343,6 @@ namespace eval parameters {
 		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
-    }
-  }
 }
 ##
 # @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
     }
   }
 }

site_ansto/instrument/sans/quokka_configuration.tcl

@@ -1,5 +1,5 @@
-# $Revision: 1.8 $
+# $Revision: 1.9 $
-# $Date: 2008-06-11 23:05:36 $
+# $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

site_ansto/instrument/server_config.tcl

@@ -1,7 +1,7 @@
 # SICS common configuration
 
-# $Revision: 1.34 $
+# $Revision: 1.35 $
-# $Date: 2008-06-11 23:05:36 $
+# $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} {
+  proc opal {status} {
-    return "CALIBRATED.CALIBRATED REACTOR POWER 0290_04:ARPCS_CNTRL.RO0005 = 20 (08-06-04 11:42:39)"
+		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"

site_ansto/instrument/util/utility.tcl

@@ -1,7 +1,7 @@
 # Some useful functions for SICS configuration.
 
-# $Revision: 1.12 $
+# $Revision: 1.13 $
-# $Date: 2008-06-11 23:05:36 $
+# $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

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,11 +102,28 @@ 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;
+	} 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);
@@ -110,6 +131,7 @@ static int StateInterest(int iEvent, void *pEvent, void *pUser,
     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
 	 */