tools/trace-malloc/blame.pl

Thu, 22 Jan 2015 13:21:57 +0100

author
Michael Schloh von Bennewitz <michael@schloh.com>
date
Thu, 22 Jan 2015 13:21:57 +0100
branch
TOR_BUG_9701
changeset 15
b8a032363ba2
permissions
-rwxr-xr-x

Incorporate requested changes from Mozilla in review:
https://bugzilla.mozilla.org/show_bug.cgi?id=1123480#c6

     1 #!/usr/bin/perl -w
     2 #
     3 # This Source Code Form is subject to the terms of the Mozilla Public
     4 # License, v. 2.0. If a copy of the MPL was not distributed with this
     5 # file, You can obtain one at http://mozilla.org/MPL/2.0/.
     7 #
     8 # Process output of TraceMallocDumpAllocations() to produce a table
     9 # that attributes memory to the allocators using call stack.
    10 #
    12 use 5.004;
    13 use strict;
    15 # A table of all ancestors. Key is function name, value is an
    16 # array of ancestors, each attributed with a number of calls and
    17 # the amount of memory allocated.
    18 my %Ancestors;
    20 # Ibid, for descendants.
    21 my %Descendants;
    23 # A table that keeps the total amount of memory allocated by each
    24 # function
    25 my %Totals;
    26 $Totals{".root"} = { "#memory#" => 0, "#calls#" => 0 };
    28 # A table that maps the long ugly function name to a unique number so
    29 # that the HTML we generate isn't too fat
    30 my %Ids;
    31 my $NextId = 0;
    33 $Ids{".root"} = ++$NextId;
    36 LINE: while (<>) {
    37     # The line'll look like:
    38     #
    39     #  0x4000a008     16  PR_Malloc+16; nsMemoryImpl::Alloc(unsigned int)+12; ...
    41     # Ignore any lines that don't start with an address
    42     next LINE unless /^0x/;
    44     # Parse it
    45     my ($address, $size, $rest) = /^(0x\S*)\s*(\d+)\s*(.*)$/;
    46     my @stack = reverse(split /; /, $rest);
    48     # Accumulate at the root
    49     $Totals{".root"}->{"#memory#"} += $size;
    50     ++$Totals{".root"}->{"#calls#"};
    52     my $caller = ".root";
    53     foreach my $callee (@stack) {
    54         # Strip the offset from the callsite information. I don't
    55         # think we care.
    56         $callee =~ s/\+\d+$//g;
    58         # Accumulate the total for the callee
    59         if (! $Totals{$callee}) {
    60             $Totals{$callee} = { "#memory#" => 0, "#calls#" => 0 };
    61         }
    63         $Totals{$callee}->{"#memory#"} += $size;
    64         ++$Totals{$callee}->{"#calls#"};
    66         # Descendants
    67         my $descendants = $Descendants{$caller};
    68         if (! $descendants) {
    69             $descendants = $Descendants{$caller} = [ ];
    70         }
    72         # Manage the list of descendants
    73         {
    74             my $wasInserted = 0;
    75           DESCENDANT: foreach my $item (@$descendants) {
    76                 if ($item->{"#name#"} eq $callee) {
    77                     $item->{"#memory#"} += $size;
    78                     ++$item->{"#calls#"};
    79                     $wasInserted = 1;
    80                     last DESCENDANT;
    81                 }
    82             }
    84             if (! $wasInserted) {
    85                 $descendants->[@$descendants] = {
    86                     "#name#"   => $callee,
    87                     "#memory#" => $size,
    88                     "#calls#"  => 1
    89                 };
    90             }
    91         }
    93         # Ancestors
    94         my $ancestors = $Ancestors{$callee};
    95         if (! $ancestors) {
    96             $ancestors = $Ancestors{$callee} = [ ];
    97         }
    99         # Manage the list of ancestors
   100         {
   101             my $wasInserted = 0;
   102           ANCESTOR: foreach my $item (@$ancestors) {
   103                 if ($item->{"#name#"} eq $caller) {
   104                     $item->{"#memory#"} += $size;
   105                     ++$item->{"#calls#"};
   106                     $wasInserted = 1;
   107                     last ANCESTOR;
   108                 }
   109             }
   111             if (! $wasInserted) {
   112                 $ancestors->[@$ancestors] = {
   113                     "#name#"   => $caller,
   114                     "#memory#" => $size,
   115                     "#calls#"  => 1
   116                 };
   117             }
   118         }
   120         # Make a new "id", if necessary
   121         if (! $Ids{$callee}) {
   122             $Ids{$callee} = ++$NextId;
   123         }
   125         # On to the next one...
   126         $caller = $callee;
   127     }
   128 }
   131 # Change the manky looking callsite into a pretty function; strip argument
   132 # types and offset information.
   133 sub pretty($) {
   134     $_ = $_[0];
   135     s/&/&amp;/g;
   136     s/</&lt;/g;
   137     s/>/&gt;/g;
   139     if (/([^\(]*)(\(.*\))/) {
   140         return $1 . "()";
   141     }
   142     else {
   143         return $_[0];
   144     }
   145 }
   147 # Dump a web page!
   148 print "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0//EN\">\n";
   149 print "<html><head>\n";
   150 print "<title>Live Bloat Blame</title>\n";
   151 print "<link rel=\"stylesheet\" type=\"text/css\" href=\"blame.css\">\n";
   152 print "</head>\n";
   153 print "<body>\n";
   155 # At most 100 rows per table so as not to kill the browser.
   156 my $maxrows = 100;
   158 print "<table>\n";
   159 print "<thead><tr><td>Function</td><td>Ancestors</td><td>Descendants</td></tr></thead>\n";
   161 foreach my $node (sort(keys(%Ids))) {
   162     print "<tr>\n";
   164     # Print the current node
   165     {
   166         my ($memory, $calls) =
   167             ($Totals{$node}->{"#memory#"},
   168              $Totals{$node}->{"#calls#"});
   170         my $pretty = pretty($node);
   171         print "  <td><a name=\"$Ids{$node}\">$pretty&nbsp;$memory&nbsp;($calls)</a></td>\n";
   172     }
   174     # Ancestors, sorted descending by amount of memory allocated
   175     print "  <td>\n";
   176     my $ancestors = $Ancestors{$node};
   177     if ($ancestors) {
   178         foreach my $ancestor (sort { $b->{"#memory#"} <=> $a->{"#memory#"} } @$ancestors) {
   179             my ($name, $memory, $calls) =
   180                 ($ancestor->{"#name#"},
   181                  $ancestor->{"#memory#"},
   182                  $ancestor->{"#calls#"});
   184             my $pretty = pretty($name);
   186             print "    <a href=\"#$Ids{$name}\">$pretty</a>&nbsp;$memory&nbsp;($calls)<br>\n";
   187         }
   188     }
   190     print "  </td>\n";
   192     # Descendants, sorted descending by amount of memory allocated
   193     print "  <td>\n";
   194     my $descendants = $Descendants{$node};
   195     if ($descendants) {
   196         foreach my $descendant (sort { $b->{"#memory#"} <=> $a->{"#memory#"} } @$descendants) {
   197             my ($name, $memory, $calls) =
   198                 ($descendant->{"#name#"},
   199                  $descendant->{"#memory#"},
   200                  $descendant->{"#calls#"});
   202             my $pretty = pretty($name);
   204             print "    <a href=\"#$Ids{$name}\">$pretty</a>&nbsp;$memory&nbsp;($calls)<br>\n";
   205         }
   206     }
   207     print "  </td></tr>\n";
   209     if (--$maxrows == 0) {
   210         print "</table>\n";
   211         print "<table>\n";
   212         print "<thead><tr><td>Function</td><td>Ancestors</td><td>Descendants</td></tr></thead>\n";
   213         $maxrows = 100;
   214     }
   215 }
   217 # Footer
   218 print "</table>\n";
   219 print "</body></html>\n";

mercurial