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