tool/stack_usage.tcl

   1 #!/usr/bin/tclsh
   2 #
   3 # Parse the output of
   4 #
   5 #         objdump -d sqlite3.o
   6 #
   7 # for x64 and generate a report showing:
   8 #
   9 #    (1)  Stack used by each function
  10 #    (2)  Recursion paths and their aggregate stack depth
  11 #
  12 set getStack 0
  13 while {![eof stdin]} {
  14   set line [gets stdin]
  15   if {[regexp {^[0-9a-f]+ <([^>]+)>:\s*$} $line all procname]} {
  16     set curfunc $procname
  17     set root($curfunc) 1
  18     set calls($curfunc) {}
  19     set calledby($curfunc) {}
  20     set recursive($curfunc) {}
  21     set stkdepth($curfunc) 0
  22     set getStack 1
  23     continue
  24   }
  25   if {[regexp {callq? +[0-9a-z]+ <([^>]+)>} $line all other]} {
  26     set key [list $curfunc $other]
  27     set callpair($key) 1
  28     unset -nocomplain root($curfunc)
  29     continue
  30   }
  31   if {[regexp {sub +\$(0x[0-9a-z]+),%[er]sp} $line all xdepth]} {
  32     if {$getStack} {
  33       scan $xdepth %x depth
  34       set stkdepth($curfunc) $depth
  35       set getStack 0
  36     }
  37     continue
  38   }
  39 }
  40
  41 puts "****************** Stack Usage By Function ********************"
  42 set sdlist {}
  43 foreach f [array names stkdepth] {
  44   lappend sdlist [list $stkdepth($f) $f]
  45 }
  46 foreach sd [lsort -integer -decr -index 0 $sdlist] {
  47   foreach {depth fname} $sd break
  48   puts [format {%6d %s} $depth $fname]
  49 }
  50
  51 puts "****************** Stack Usage By Recursion *******************"
  52 foreach key [array names callpair] {
  53   foreach {from to} $key break
  54   lappend calls($from) $to
  55   # lappend calledby($to) $from
  56 }
  57 proc all_descendents {root} {
  58   global calls recursive
  59   set todo($root) $root
  60   set go 1
  61   while {$go} {
  62     set go 0
  63     foreach f [array names todo] {
  64       set path $todo($f)
  65       unset todo($f)
  66       if {![info exists calls($f)]} continue
  67       foreach x $calls($f) {
  68         if {$x==$root} {
  69           lappend recursive($root) [concat $path $root]
  70         } elseif {![info exists d($x)]} {
  71           set go 1
  72           set todo($x) [concat $path $x]
  73           set d($x) 1
  74         }
  75       }
  76     }
  77   }
  78   return [array names d]
  79 }
  80 set pathlist {}
  81 foreach f [array names recursive] {
  82   all_descendents $f
  83   foreach m $recursive($f) {
  84     set depth 0
  85     foreach b [lrange $m 0 end-1] {
  86       set depth [expr {$depth+$stkdepth($b)}]
  87     }
  88     lappend pathlist [list $depth $m]
  89   }
  90 }
  91 foreach path [lsort -integer -decr -index 0 $pathlist] {
  92   foreach {depth m} $path break
  93   set first [lindex $m 0]
  94   puts [format {%6d %s %d} $depth $first $stkdepth($first)]
  95   foreach b [lrange $m 1 end] {
  96     puts "          $b $stkdepth($b)"
  97   }
  98 }