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