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