1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/tools/trace-malloc/blame.pl Wed Dec 31 06:09:35 2014 +0100
1.3 @@ -0,0 +1,219 @@
1.4 +#!/usr/bin/perl -w
1.5 +#
1.6 +# This Source Code Form is subject to the terms of the Mozilla Public
1.7 +# License, v. 2.0. If a copy of the MPL was not distributed with this
1.8 +# file, You can obtain one at http://mozilla.org/MPL/2.0/.
1.9 +
1.10 +#
1.11 +# Process output of TraceMallocDumpAllocations() to produce a table
1.12 +# that attributes memory to the allocators using call stack.
1.13 +#
1.14 +
1.15 +use 5.004;
1.16 +use strict;
1.17 +
1.18 +# A table of all ancestors. Key is function name, value is an
1.19 +# array of ancestors, each attributed with a number of calls and
1.20 +# the amount of memory allocated.
1.21 +my %Ancestors;
1.22 +
1.23 +# Ibid, for descendants.
1.24 +my %Descendants;
1.25 +
1.26 +# A table that keeps the total amount of memory allocated by each
1.27 +# function
1.28 +my %Totals;
1.29 +$Totals{".root"} = { "#memory#" => 0, "#calls#" => 0 };
1.30 +
1.31 +# A table that maps the long ugly function name to a unique number so
1.32 +# that the HTML we generate isn't too fat
1.33 +my %Ids;
1.34 +my $NextId = 0;
1.35 +
1.36 +$Ids{".root"} = ++$NextId;
1.37 +
1.38 +
1.39 +LINE: while (<>) {
1.40 + # The line'll look like:
1.41 + #
1.42 + # 0x4000a008 16 PR_Malloc+16; nsMemoryImpl::Alloc(unsigned int)+12; ...
1.43 +
1.44 + # Ignore any lines that don't start with an address
1.45 + next LINE unless /^0x/;
1.46 +
1.47 + # Parse it
1.48 + my ($address, $size, $rest) = /^(0x\S*)\s*(\d+)\s*(.*)$/;
1.49 + my @stack = reverse(split /; /, $rest);
1.50 +
1.51 + # Accumulate at the root
1.52 + $Totals{".root"}->{"#memory#"} += $size;
1.53 + ++$Totals{".root"}->{"#calls#"};
1.54 +
1.55 + my $caller = ".root";
1.56 + foreach my $callee (@stack) {
1.57 + # Strip the offset from the callsite information. I don't
1.58 + # think we care.
1.59 + $callee =~ s/\+\d+$//g;
1.60 +
1.61 + # Accumulate the total for the callee
1.62 + if (! $Totals{$callee}) {
1.63 + $Totals{$callee} = { "#memory#" => 0, "#calls#" => 0 };
1.64 + }
1.65 +
1.66 + $Totals{$callee}->{"#memory#"} += $size;
1.67 + ++$Totals{$callee}->{"#calls#"};
1.68 +
1.69 + # Descendants
1.70 + my $descendants = $Descendants{$caller};
1.71 + if (! $descendants) {
1.72 + $descendants = $Descendants{$caller} = [ ];
1.73 + }
1.74 +
1.75 + # Manage the list of descendants
1.76 + {
1.77 + my $wasInserted = 0;
1.78 + DESCENDANT: foreach my $item (@$descendants) {
1.79 + if ($item->{"#name#"} eq $callee) {
1.80 + $item->{"#memory#"} += $size;
1.81 + ++$item->{"#calls#"};
1.82 + $wasInserted = 1;
1.83 + last DESCENDANT;
1.84 + }
1.85 + }
1.86 +
1.87 + if (! $wasInserted) {
1.88 + $descendants->[@$descendants] = {
1.89 + "#name#" => $callee,
1.90 + "#memory#" => $size,
1.91 + "#calls#" => 1
1.92 + };
1.93 + }
1.94 + }
1.95 +
1.96 + # Ancestors
1.97 + my $ancestors = $Ancestors{$callee};
1.98 + if (! $ancestors) {
1.99 + $ancestors = $Ancestors{$callee} = [ ];
1.100 + }
1.101 +
1.102 + # Manage the list of ancestors
1.103 + {
1.104 + my $wasInserted = 0;
1.105 + ANCESTOR: foreach my $item (@$ancestors) {
1.106 + if ($item->{"#name#"} eq $caller) {
1.107 + $item->{"#memory#"} += $size;
1.108 + ++$item->{"#calls#"};
1.109 + $wasInserted = 1;
1.110 + last ANCESTOR;
1.111 + }
1.112 + }
1.113 +
1.114 + if (! $wasInserted) {
1.115 + $ancestors->[@$ancestors] = {
1.116 + "#name#" => $caller,
1.117 + "#memory#" => $size,
1.118 + "#calls#" => 1
1.119 + };
1.120 + }
1.121 + }
1.122 +
1.123 + # Make a new "id", if necessary
1.124 + if (! $Ids{$callee}) {
1.125 + $Ids{$callee} = ++$NextId;
1.126 + }
1.127 +
1.128 + # On to the next one...
1.129 + $caller = $callee;
1.130 + }
1.131 +}
1.132 +
1.133 +
1.134 +# Change the manky looking callsite into a pretty function; strip argument
1.135 +# types and offset information.
1.136 +sub pretty($) {
1.137 + $_ = $_[0];
1.138 + s/&/&/g;
1.139 + s/</</g;
1.140 + s/>/>/g;
1.141 +
1.142 + if (/([^\(]*)(\(.*\))/) {
1.143 + return $1 . "()";
1.144 + }
1.145 + else {
1.146 + return $_[0];
1.147 + }
1.148 +}
1.149 +
1.150 +# Dump a web page!
1.151 +print "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0//EN\">\n";
1.152 +print "<html><head>\n";
1.153 +print "<title>Live Bloat Blame</title>\n";
1.154 +print "<link rel=\"stylesheet\" type=\"text/css\" href=\"blame.css\">\n";
1.155 +print "</head>\n";
1.156 +print "<body>\n";
1.157 +
1.158 +# At most 100 rows per table so as not to kill the browser.
1.159 +my $maxrows = 100;
1.160 +
1.161 +print "<table>\n";
1.162 +print "<thead><tr><td>Function</td><td>Ancestors</td><td>Descendants</td></tr></thead>\n";
1.163 +
1.164 +foreach my $node (sort(keys(%Ids))) {
1.165 + print "<tr>\n";
1.166 +
1.167 + # Print the current node
1.168 + {
1.169 + my ($memory, $calls) =
1.170 + ($Totals{$node}->{"#memory#"},
1.171 + $Totals{$node}->{"#calls#"});
1.172 +
1.173 + my $pretty = pretty($node);
1.174 + print " <td><a name=\"$Ids{$node}\">$pretty $memory ($calls)</a></td>\n";
1.175 + }
1.176 +
1.177 + # Ancestors, sorted descending by amount of memory allocated
1.178 + print " <td>\n";
1.179 + my $ancestors = $Ancestors{$node};
1.180 + if ($ancestors) {
1.181 + foreach my $ancestor (sort { $b->{"#memory#"} <=> $a->{"#memory#"} } @$ancestors) {
1.182 + my ($name, $memory, $calls) =
1.183 + ($ancestor->{"#name#"},
1.184 + $ancestor->{"#memory#"},
1.185 + $ancestor->{"#calls#"});
1.186 +
1.187 + my $pretty = pretty($name);
1.188 +
1.189 + print " <a href=\"#$Ids{$name}\">$pretty</a> $memory ($calls)<br>\n";
1.190 + }
1.191 + }
1.192 +
1.193 + print " </td>\n";
1.194 +
1.195 + # Descendants, sorted descending by amount of memory allocated
1.196 + print " <td>\n";
1.197 + my $descendants = $Descendants{$node};
1.198 + if ($descendants) {
1.199 + foreach my $descendant (sort { $b->{"#memory#"} <=> $a->{"#memory#"} } @$descendants) {
1.200 + my ($name, $memory, $calls) =
1.201 + ($descendant->{"#name#"},
1.202 + $descendant->{"#memory#"},
1.203 + $descendant->{"#calls#"});
1.204 +
1.205 + my $pretty = pretty($name);
1.206 +
1.207 + print " <a href=\"#$Ids{$name}\">$pretty</a> $memory ($calls)<br>\n";
1.208 + }
1.209 + }
1.210 + print " </td></tr>\n";
1.211 +
1.212 + if (--$maxrows == 0) {
1.213 + print "</table>\n";
1.214 + print "<table>\n";
1.215 + print "<thead><tr><td>Function</td><td>Ancestors</td><td>Descendants</td></tr></thead>\n";
1.216 + $maxrows = 100;
1.217 + }
1.218 +}
1.219 +
1.220 +# Footer
1.221 +print "</table>\n";
1.222 +print "</body></html>\n";
