PSI sics-cvs-psi-2006
This commit is contained in:
Douglas Clowes
219
sycamore.tcl
Normal file
219
sycamore.tcl
Normal file
@@ -0,0 +1,219 @@
|
||||
#source $sychome/stooop/mkpkgidx.tcl
|
||||
#source stooop.tcl
|
||||
#set tcl_pkgPath $sychome
|
||||
# ClientPut $tcl_pkgPath "value"
|
||||
# package require stooop 4 ;# load stooop package
|
||||
# namespace forget stooop::* ;# remove if previously loaded
|
||||
# namespace import stooop::*
|
||||
|
||||
# -----------------------------------------------------------------------------
|
||||
# source $sychome/ns_site.tcl
|
||||
# source $sychome/ns_sequencer.tcl
|
||||
# source $sychome/ns_server.tcl
|
||||
|
||||
set STACKTRACE 0
|
||||
proc stackTrace args {
|
||||
set level [ info level ]
|
||||
ClientPut "====================" "value"
|
||||
for {set i 1} {$i < $level} {incr i} {
|
||||
ClientPut [info level $i] "value"
|
||||
ClientPut " " "value"
|
||||
}
|
||||
ClientPut "====================" "value"
|
||||
}
|
||||
|
||||
# -----------------------------------------------------------------------------
|
||||
# testing stubs when SICS modules not available
|
||||
# proc sinfox args
|
||||
# proc ClientPut {msg oCode}
|
||||
# proc SICSType {objName}
|
||||
# source stubs.tcl
|
||||
|
||||
# -----------------------------------------------------------------------------
|
||||
# Sycamore Utilities: tcl procedures required by sycamore implementation
|
||||
|
||||
proc sinWrite {msg oCode} {
|
||||
# simplest processing of format for now
|
||||
global STACKTRACE
|
||||
if {$STACKTRACE} {
|
||||
stackTrace
|
||||
}
|
||||
ClientPut $msg $oCode
|
||||
}
|
||||
|
||||
proc varexist {nsp var} {
|
||||
return [expr [string compare $nsp$var [namespace which -variable $nsp$var]]==0]
|
||||
}
|
||||
|
||||
#proc sycFormat {connID transID devID msgFlag args} {
|
||||
# return "\[$connID:$transID:$devID:$msgFlag\] $args"
|
||||
#}
|
||||
#source $sychome/sycFormat.tcl
|
||||
#publish sycFormat spy
|
||||
|
||||
proc arga argStr {
|
||||
set args [ split $argStr ]
|
||||
set argc [llength $args]
|
||||
# syc::debug "arga.argc = %s" $argc
|
||||
set objName ""
|
||||
set key ""
|
||||
set name ""
|
||||
set val ""
|
||||
set bObj [expr $argc > 0]
|
||||
set bKey [expr $argc > 1]
|
||||
set bName [expr $argc > 2]
|
||||
set bVal [expr $argc > 3]
|
||||
if $bObj {
|
||||
set objName [string tolower [lindex $args 0]]
|
||||
#syc::debug "arga.objName = %s" $objName
|
||||
}
|
||||
if $bKey {
|
||||
set key [string tolower [lindex $args 1]]
|
||||
#syc::debug "arga.key = %s" $key
|
||||
}
|
||||
if $bName {
|
||||
set name [string tolower [lindex $args 2]]
|
||||
}
|
||||
if $bVal {
|
||||
set val [string tolower [lindex $args 3]]
|
||||
}
|
||||
# ? cannot get 'array set' to work in the form:
|
||||
# array set argv {
|
||||
# argc $argc
|
||||
# objName $objName
|
||||
# ... etcetera
|
||||
# }
|
||||
set argv(argc) $argc
|
||||
set argv(bObj) $bObj
|
||||
set argv(bKey) $bKey
|
||||
set argv(bName) $bName
|
||||
set argv(bVal) $bVal
|
||||
set argv(objName) $objName
|
||||
set argv(key) $key
|
||||
set argv(name) $name
|
||||
set argv(val) $val
|
||||
# would like to return associative array
|
||||
# for now, settle for list
|
||||
# syc::debug "arga.argv = { %s }" [array get argv]
|
||||
return [array get argv]
|
||||
}
|
||||
|
||||
# alternative solution for passing arguments around
|
||||
#class argv {
|
||||
# proc argv {this args} {
|
||||
# set ($this,argc) [llength $args]
|
||||
# set ($this,objName) ""
|
||||
# set ($this,key) ""
|
||||
# set ($this,name) ""
|
||||
# set ($this,val) ""
|
||||
# set ($this,bObj) [expr $l > 0]
|
||||
# set ($this,bKey) [expr $l > 0]
|
||||
# set ($this,bName) [expr $l > 1]
|
||||
# set ($this,bVal) [expr $l > 2]
|
||||
# if $($this,bObj) {
|
||||
# set ($this,objName) [lindex $args 0]
|
||||
# }
|
||||
# if $($this,bKey) {
|
||||
# set ($this,key) [lindex $args 0]
|
||||
# }
|
||||
# if $($this,bName) {
|
||||
# set ($this,name) [lindex $args 1]
|
||||
# }
|
||||
# if $($this,bVal) {
|
||||
# set ($this,val) [lindex $args 2]
|
||||
# }
|
||||
# }
|
||||
# proc ~argv {this} {}
|
||||
#}
|
||||
#
|
||||
## -----------------------------------------------------------------------------
|
||||
# working idea for making diagnostic class global
|
||||
class diagnostic {
|
||||
proc diagnostic {this} {
|
||||
set ($this,id) $this
|
||||
set ($this,debug) 0
|
||||
}
|
||||
proc ~diagnostic {this} {}
|
||||
|
||||
proc diag {this flag} {
|
||||
set msg [format "diag=%s" $flag]
|
||||
switch $flag {
|
||||
"on" {
|
||||
set ($this,debug) 1
|
||||
}
|
||||
"off" {
|
||||
set ($this,debug) 0
|
||||
}
|
||||
default {}
|
||||
}
|
||||
if {1 == ($this,debug)} {
|
||||
set msg "diag=on"
|
||||
} else {
|
||||
set msg "diag=off"
|
||||
}
|
||||
return [format "%s.diag = \{ %s \}" $this $msg]
|
||||
}
|
||||
|
||||
proc debug {this dMsg dVal} {
|
||||
if {1 > ($this,debug)} {
|
||||
return
|
||||
}
|
||||
sinWrite [format "%s::debug: %s" $this [format $dMsg $dVal]] "value"
|
||||
}
|
||||
}
|
||||
|
||||
## -----------------------------------------------------------------------------
|
||||
# Class for module static variables and methods
|
||||
class syc {
|
||||
# class lifecycle methods
|
||||
proc syc {this} {}
|
||||
proc ~syc {this} {}
|
||||
|
||||
# static data members
|
||||
set debug 0
|
||||
|
||||
# static methods
|
||||
proc debug args {
|
||||
if {$syc::debug < 1} {
|
||||
return
|
||||
}
|
||||
set l [llength $args]
|
||||
set dMsg "Script code event"
|
||||
set dVal " "
|
||||
if {$l > 0} {
|
||||
set dMsg [lindex $args 0]
|
||||
if {$l > 1} {
|
||||
set dVal [lindex $args 1]
|
||||
}
|
||||
}
|
||||
sinWrite [format "syc::debug: %s" [format $dMsg $dVal]] "value"
|
||||
}
|
||||
|
||||
proc diag args {
|
||||
set flag [lindex $args 0]
|
||||
set msg [format "diag=%s" $flag]
|
||||
switch $flag {
|
||||
"on" {
|
||||
set syc::debug 1
|
||||
}
|
||||
"off" {
|
||||
set syc::debug 0
|
||||
}
|
||||
default {
|
||||
if {1 == $syc::debug} {
|
||||
set msg "diag=on"
|
||||
} else {
|
||||
set msg "diag=off"
|
||||
}
|
||||
}
|
||||
}
|
||||
return [format "syc.diag = \{ %s \}" $msg]
|
||||
}
|
||||
}
|
||||
|
||||
## -----------------------------------------------------------------------------
|
||||
sinWrite "Loading sinfo" "value"
|
||||
#source $sychome/sinfo.tcl
|
||||
#publish sinfo spy
|
||||
# source $sychome/sequencer.tcl
|
||||
|
||||
Reference in New Issue
Block a user