tools/trace-malloc/diffbloatdump.pl

   1 #!/usr/bin/perl -w
   2 # vim:cindent:ts=8:et:sw=4:
   3 # ***** BEGIN LICENSE BLOCK *****
   4 # Version: MPL 1.1/GPL 2.0/LGPL 2.1
   5 #
   6 # The contents of this file are subject to the Mozilla Public License Version
   7 # 1.1 (the "License"); you may not use this file except in compliance with
   8 # the License. You may obtain a copy of the License at
   9 # http://www.mozilla.org/MPL/
  10 #
  11 # Software distributed under the License is distributed on an "AS IS" basis,
  12 # WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
  13 # for the specific language governing rights and limitations under the
  14 # License.
  15 #
  16 # The Original Code is mozilla.org code.
  17 #
  18 # The Initial Developer of the Original Code is
  19 # Netscape Communications Corporation.
  20 # Portions created by the Initial Developer are Copyright (C) 2001
  21 # the Initial Developer. All Rights Reserved.
  22 #
  23 # Contributor(s):
  24 #   L. David Baron <dbaron@dbaron.org> (original author)
  25 #
  26 # Alternatively, the contents of this file may be used under the terms of
  27 # either the GNU General Public License Version 2 or later (the "GPL"), or
  28 # the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
  29 # in which case the provisions of the GPL or the LGPL are applicable instead
  30 # of those above. If you wish to allow use of your version of this file only
  31 # under the terms of either the GPL or the LGPL, and not to allow others to
  32 # use your version of this file under the terms of the MPL, indicate your
  33 # decision by deleting the provisions above and replace them with the notice
  34 # and other provisions required by the GPL or the LGPL. If you do not delete
  35 # the provisions above, a recipient may use your version of this file under
  36 # the terms of any one of the MPL, the GPL or the LGPL.
  37 #
  38 # ***** END LICENSE BLOCK ***** */
  39
  40 # This script produces a diff between two files that are the result of
  41 # calling NS_TraceMallocDumpAllocations.  Such files can be created
  42 # through the command-line option --shutdown-leaks=<filename> or through
  43 # the DOM function window.TraceMallocDumpAllocations(<filename>).  Both
  44 # methods will work only if --trace-malloc=<malloc-log> is also given on
  45 # the command line.
  46
  47 use 5.004;
  48 use strict;
  49 use Getopt::Long;
  50
  51 $::opt_help = 0;
  52 $::opt_depth = 6;
  53 $::opt_include_zero = 0;
  54 $::opt_allocation_count = 0;
  55 $::opt_use_address = 0;
  56
  57 # XXX Change --use-address to be the default and remove the option
  58 # once tinderbox is no longer using it without --use-address.
  59
  60 Getopt::Long::Configure("pass_through");
  61 Getopt::Long::GetOptions("help", "allocation-count", "depth=i",
  62                          "include-zero", "use-address");
  63
  64 if ($::opt_help) {
  65     die "usage: diffbloatdump.pl [options] <dump1> <dump2>
  66   --help                 Display this message
  67
  68   --allocation-count     Use allocation count rather than size (i.e., treat
  69                            all sizes as 1).
  70   --depth=<num>          Only display <num> frames at top of allocation stack.
  71   --include-zero         Display subtrees totalling zero.
  72   --use-address          Don't ignore the address part of the stack trace
  73                            (can make comparison more accurate when comparing
  74                            results from the same build)
  75
  76   The input files (<dump1> and <dump2> above) are either trace-malloc
  77   memory dumps OR this script's output.  (If this script's output,
  78   --allocation-count and --use-address are ignored.)  If the input files
  79   have .gz or .bz2 extension, they are uncompressed.
  80 ";
  81 }
  82
  83 my $calltree = { count => 0 }; # leave children undefined
  84
  85 sub get_child($$) {
  86     my ($node, $frame) = @_;
  87     if (!defined($node->{children})) {
  88         $node->{children} = {};
  89     }
  90     if (!defined($node->{children}->{$frame})) {
  91         $node->{children}->{$frame} = { count => 0 };
  92     }
  93     return $node->{children}->{$frame};
  94 }
  95
  96 sub add_tree_file($$$) {
  97     my ($infile, $firstline, $factor) = @_;
  98
  99     my @nodestack;
 100     $nodestack[1] = $calltree;
 101     $firstline =~ /^(-?\d+) malloc$/;
 102     $calltree->{count} += $1 * $factor;
 103
 104     my $lineno = 1;
 105     while (!eof($infile)) {
 106         my $line = <$infile>;
 107         ++$lineno;
 108         $line =~ /^( *)(-?\d+) (.*)$/ || die "malformed input, line $lineno";
 109         my $depth = length($1);
 110         my $count = $2;
 111         my $frame = $3;
 112         die "malformed input, line $lineno" if ($depth % 2 != 0);
 113         $depth /= 2;
 114         die "malformed input, line $lineno" if ($depth > $#nodestack);
 115         $#nodestack = $depth;
 116         my $node = get_child($nodestack[$depth], $frame);
 117         push @nodestack, $node;
 118         $node->{count} += $count * $factor;
 119     }
 120 }
 121
 122 sub add_file($$) {
 123     # Takes (1) a reference to a file descriptor for input and (2) the
 124     # factor to multiply the stacks by (generally +1 or -1).
 125     # Returns a reference to an array representing the stack, allocation
 126     # site in array[0].
 127     sub read_stack($) {
 128         my ($infile) = @_;
 129         my $line;
 130         my @stack;
 131
 132         # read the data at the memory location
 133         while ( defined($infile) && ($line = <$infile>) && substr($line,0,1) eq "\t" ) {
 134             # do nothing
 135         }
 136
 137         # read the stack
 138         do {
 139             chomp($line);
 140             if ( ! $::opt_use_address &&
 141                  $line =~ /(.*)\[(.*)\]/) {
 142                 $line = $1;
 143             }
 144             $stack[$#stack+1] = $line;
 145         } while ( defined($infile) && ($line = <$infile>) && $line ne "\n" && $line ne "\r\n" );
 146
 147         return \@stack;
 148     }
 149
 150     # adds the stack given as a parameter (reference to array, $stack[0] is
 151     # allocator) to $calltree, with the call count multiplied by $factor
 152     # (typically +1 or -1).
 153     sub add_stack($$) {
 154         my @stack = @{$_[0]};
 155         my $factor = $_[1];
 156
 157         my $i = 0;
 158         my $node = $calltree;
 159         while ($i < $#stack && $i < $::opt_depth) {
 160             $node->{count} += $factor;
 161             $node = get_child($node, $stack[$i]);
 162             ++$i;
 163         }
 164         $node->{count} += $factor;
 165     }
 166
 167     my ($infile, $factor) = @_;
 168
 169     if ($infile =~ /\.bz2$/) {
 170         # XXX This doesn't propagate errors from bzip2.
 171         open (INFILE, "bzip2 -cd '$infile' |") || die "Can't open input \"$infile\"";
 172     } elsif ($infile =~ /\.gz$/) {
 173         # XXX This doesn't propagate errors from gzip.
 174         open (INFILE, "gzip -cd '$infile' |") || die "Can't open input \"$infile\"";
 175     } else {
 176         open (INFILE, "<$infile") || die "Can't open input \"$infile\"";
 177     }
 178     my $first = 1;
 179     while ( ! eof(INFILE) ) {
 180         # read the type and address
 181         my $line = <INFILE>;
 182         if ($first) {
 183             $first = 0;
 184             if ($line =~ /^-?\d+ malloc$/) {
 185                 # We're capable of reading in our own output as well.
 186                 add_tree_file(\*INFILE, $line, $factor);
 187                 close INFILE;
 188                 return;
 189             }
 190         }
 191         unless ($line =~ /.*\((\d*)\)[\r|\n]/) {
 192             die "badly formed allocation header in $infile";
 193         }
 194         my $size;
 195         if ($::opt_allocation_count) {
 196             $size = 1;
 197         } else {
 198             $size = $1;
 199         }
 200
 201         add_stack(read_stack(\*INFILE), $size * $factor);
 202     }
 203     close INFILE;
 204 }
 205
 206 sub print_node_indent($$$);
 207
 208 sub print_calltree() {
 209     sub print_indent($) {
 210         my ($i) = @_;
 211         while (--$i >= 0) {
 212             print "  ";
 213         }
 214     }
 215
 216     sub print_node_indent($$$) {
 217         my ($nodename, $node, $indent) = @_;
 218
 219         if (!$::opt_include_zero && $node->{count} == 0) {
 220             return;
 221         }
 222
 223         print_indent($indent);
 224         print "$node->{count} $nodename\n";
 225         if (defined($node->{children})) {
 226             my %kids = %{$node->{children}};
 227             ++$indent;
 228             foreach my $kid (sort { $kids{$b}->{count} <=> $kids{$a}->{count} }
 229                                   keys (%kids)) {
 230                 print_node_indent($kid, $kids{$kid}, $indent);
 231             }
 232         }
 233     }
 234
 235     print_node_indent("malloc", $calltree, 0);
 236 }
 237
 238 add_file($ARGV[0], -1);
 239 add_file($ARGV[1],  1);
 240 print_calltree();