tools/trace-malloc/uncategorized.pl

   1 #!/usr/bin/perl -w
   2 #
   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 uncategorized.pl, released
  17 # Nov 27, 2000.
  18 #
  19 # The Initial Developer of the Original Code is
  20 # Netscape Communications Corporation.
  21 # Portions created by the Initial Developer are Copyright (C) 2000
  22 # the Initial Developer. All Rights Reserved.
  23 #
  24 # Contributor(s):
  25 #   Chris Waterson <waterson@netscape.com>
  26 #
  27 # Alternatively, the contents of this file may be used under the terms of
  28 # either the GNU General Public License Version 2 or later (the "GPL"), or
  29 # the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
  30 # in which case the provisions of the GPL or the LGPL are applicable instead
  31 # of those above. If you wish to allow use of your version of this file only
  32 # under the terms of either the GPL or the LGPL, and not to allow others to
  33 # use your version of this file under the terms of the MPL, indicate your
  34 # decision by deleting the provisions above and replace them with the notice
  35 # and other provisions required by the GPL or the LGPL. If you do not delete
  36 # the provisions above, a recipient may use your version of this file under
  37 # the terms of any one of the MPL, the GPL or the LGPL.
  38 #
  39 # ***** END LICENSE BLOCK *****
  40
  41 # This tool is used to construct the ``type inference'' file. It
  42 # prints the total number of bytes that are attributed to a type that
  43 # cannot be inferred, grouped by stack trace; e.g.,
  44 #
  45 # (100) PR_Malloc
  46 #   (50) foo
  47 #     (50) foo2::foo2
  48 #   (25) bar
  49 #   (25) baz
  50 # (50) __builtin_new
  51 #   (50) foo2::foo2
  52 #
  53 #
  54 # Which indicates that 100 bytes were allocated by uninferrable
  55 # classes via PR_Malloc(). Of that 100 bytes, 50 were allocated from
  56 # calls by foo(), 25 from calls by bar(), and 25 from calls by baz().
  57 # 50 bytes were allocated by __builtin_new from foo2's ctor.
  58 #
  59 #
  60 # From this, we might be able to infer the type of the object that was
  61 # created by examining the PR_Malloc() usage in foo() and the
  62 # ::operator new() usage in foo2(), and could add new type inference
  63 # rules; e.g.,
  64 #
  65 #   <unclassified-string>
  66 #   foo
  67 #   foo2
  68 #
  69 #   # Attribute ::operator new() usage in foo2's ctor to foo2
  70 #   <foo2>
  71 #   __builtin_new
  72 #   foo2::foo2
  73
  74 use 5.004;
  75 use strict;
  76 use Getopt::Long;
  77
  78 # So we can find TraceMalloc.pm
  79 use FindBin;
  80 use lib "$FindBin::Bin";
  81
  82 use TraceMalloc;
  83
  84 # Collect program options
  85 $::opt_help = 0;
  86 $::opt_depth = 10;
  87 $::opt_types = "${FindBin::Bin}/types.dat";
  88 GetOptions("help", "depth=n", "types=s");
  89
  90 if ($::opt_help) {
  91     die "usage: uncategorized.pl [options] <dumpfile>
  92   --help          Display this message
  93   --depth=<n>     Display at most <n> stack frames
  94   --types=<file>  Read type heuristics from <file>";
  95 }
  96
  97 # Initialize type inference juju from the type file specified by
  98 # ``--types''.
  99 TraceMalloc::init_type_inference($::opt_types);
 100
 101 # Read the objects from the dump file. For each object, remember up to
 102 # ``--depth'' stack frames (from the top). Thread together common
 103 # stack prefixes, accumulating the number of bytes attributed to the
 104 # prefix.
 105
 106 # This'll hold the inverted stacks
 107 $::Stacks = { '#bytes#' => 0 };
 108
 109 sub collect_stacks($) {
 110     my ($object) = @_;
 111     my $stack = $object->{'stack'};
 112
 113     return unless ($object->{'type'} eq 'void*') && (TraceMalloc::infer_type($stack) eq 'void*');
 114
 115     my $count = 0;
 116     my $link = \%::Stacks;
 117   FRAME: foreach my $frame (@$stack) {
 118       last FRAME unless $count++ < $::opt_depth;
 119
 120       $link->{'#bytes#'} += $object->{'size'};
 121       $link->{$frame} = { '#bytes#' => 0 } unless $link->{$frame};
 122       $link = $link->{$frame};
 123   }
 124 }
 125
 126 TraceMalloc::read(\&collect_stacks);
 127
 128 # Do a depth-first walk of the inverted stack tree.
 129
 130 sub walk($$) {
 131     my ($links, $indent) = @_;
 132
 133     my @keys;
 134   KEY: foreach my $key (keys %$links) {
 135       next KEY if $key eq '#bytes#';
 136       $keys[$#keys + 1] = $key;
 137   }
 138
 139     foreach my $key (sort { $links->{$b}->{'#bytes#'} <=> $links->{$a}->{'#bytes#'} } @keys) {
 140         for (my $i = 0; $i < $indent; ++$i) {
 141             print "  ";
 142         }
 143
 144         print "($links->{$key}->{'#bytes#'}) $key\n";
 145
 146         walk($links->{$key}, $indent + 1);
 147     }
 148 }
 149
 150 walk(\%::Stacks, 0);
 151