proc var_mem_usage var { if {[llength $var]==1} { if [catch {incr var}] { return [expr ([ string length "$var" ]+16)& -4] } else { return 16 } } set size 0 foreach v $var { # some strings make this abort, so catch and put in a dummy if [catch {incr size [var_mem_usage $v] } ] { incr size 20 } } return $size } proc debug_pvars {pvar_up pvars chan} { set memory_usage 0 puts $chan "
"
set non_array {}
set non_maxl 0
set pvars [lsort $pvars]
foreach pvar_var $pvars {
upvar $pvar_up $pvar_var lvar
if ![array exists lvar] {
lappend non_array $pvar_var
set len [string len $pvar_var]
if {$len > $non_maxl} { set non_maxl $len }
continue
}
set var_mem [var_mem_usage [array get lvar]]
incr memory_usage $var_mem
puts $chan "-----------------------------------"
puts $chan [format "ARRAY $pvar_var (size=%d)" $var_mem]
set arr_maxl 0
set arrnames [lsort [array names lvar]]
foreach name $arrnames {
set len [string len $name]
if {$len > $arr_maxl} { set arr_maxl $len }
}
incr arr_maxl [string length $pvar_var]
incr arr_maxl 2
foreach name $arrnames {
if {![regexp {SerialNumber} $name]} {
puts $chan [format " %-*s (%4d)= %s" $arr_maxl [format %s(%s) $pvar_var $name] [var_mem_usage $lvar($name)] $lvar($name)]
}
}
}
puts $chan "-----------------------------------"
foreach pvar_var $non_array {
if {![regexp {userpass|procbody} $pvar_var]} {
upvar $pvar_up $pvar_var lvar
set var_mem [var_mem_usage $lvar]
incr memory_usage $var_mem
puts $chan [format "%-*s (%4d)= %s" $non_maxl $pvar_var $var_mem $lvar]
}
}
puts $chan "-----------------------------------"
puts $chan "Total Memory Usage: $memory_usage"
puts $chan "-----------------------------------"
puts $chan ""
}