#******************************************************************************* # Region - is an object class for mapped memory regions. When a region # object is created, the named memory region is mapped into the task's # address space. An internal database of field addresses and types is # created using the "Define" method. The values in individual fields # can be stored and retrieved using the "Set" and "Get" methods, # respectively. #******************************************************************************* itcl_class Region { public mapFunction {mapRAM} protected regionAddress protected addressOf ; # Arrays of information indexed by field names. protected typeOf protected info ; # Array of general information indexed by key. constructor {name config} { set regionAddress [eval $mapFunction $name] set info(baseAddress) $regionAddress set info(nextOffset) 0 } method Fill {{type byte} {numElements 1}} { incr info(nextOffset) [expr [SizeOf $type] * $numElements] } method Define {variable {type {long -unsigned}} {size 0}} { set addressOf($variable) [address $regionAddress -offset $info(nextOffset)] incr info(nextOffset) [SizeOf $type $size] set typeOf($variable) $type } method Get {variable {index 0} {stride 0}} { return [eval peek [IndexedAddress $variable $index $stride] -type $typeOf($variable)] } method GetInfo {key} { return $info($key) } method IndexedAddress {variable index stride} { if {$index > 0} then { if {$stride == 0} then { set stride [SizeOf $typeOf($variable)] } return [address $addressOf($variable) -offset [expr $index * $stride]] } else { return $addressOf($variable) } } method Set {variable value {index 0} {stride 0}} { catch {set value [expr $value]} return [eval poke [IndexedAddress $variable $index $stride] -type $typeOf($variable) \"$value\"] } method SetInfo {key value} { catch {set value [expr $value]} set info($key) $value } proc SizeOf {type {size 0}} { if {$size > 0} {return $size} switch [lindex $type 0] \ byte {return 1} \ char {return 1} \ string {return 1} \ short {return 2} \ int {return 4} \ long {return 4} \ float {return 4} \ double {return 8} \ pointer {return 4} \ default {return 4} } } #******************************************************************************* # DefineStatusHeader - defines the standard MEDS header fields for a # status region. This procedure should be called before defining # any additional fields in the status region. #******************************************************************************* proc DefineStatusHeader {region} { $region Define gsSize {short -unsigned} $region Define gsTag short $region Define gsMnemonic string 4 $region Define gsIdentifier $region Fill byte $region Define gsPattern {byte -unsigned} $region Define gsMinor byte $region Define gsCopy byte $region Fill short $region Define gsHealth short $region Define gsHealthMsg string 80 } #******************************************************************************* # DataSampler - is an object class for a data sampler. Multiple data # samplers can be created with different sampling rates. Each # data sampler keeps a list of sample requests; every N seconds, # the sampler evaluates each request (e.g., it gets the value of # the variable being sampled and writes it to the client). #******************************************************************************* itcl_class DataSampler { public updateInterval 5.0 protected requests ; # Indexed by tag. protected updateTimer constructor {config} { set updateTimer [Timer #auto $updateInterval "$this Sample"] } destructor { $updateTimer delete unset requests } method Start {tag request} { set requests($tag) $request } method Stop {tag} { unset requests($tag) } method Sample {} { foreach tag [array names requests] { set value [eval $requests($tag)] client Write [concat "\[DS\]" [list $tag $value]] } } } #******************************************************************************* # Timer. #******************************************************************************* itcl_class Timer { public periodic true protected timerID constructor {seconds command config} { if {$periodic} then { set timerID [timer $seconds -expire $command -periodic] } else { set timerID [timer $seconds -expire $command] } } destructor { $timerID Cancel } }