michael@0: #!/usr/bin/perl -w
michael@0: #
michael@0: # This Source Code Form is subject to the terms of the Mozilla Public
michael@0: # License, v. 2.0. If a copy of the MPL was not distributed with this
michael@0: # file, You can obtain one at http://mozilla.org/MPL/2.0/.
michael@0: 
michael@0: # This tool is used to construct the ``type inference'' file. It
michael@0: # prints the total number of bytes that are attributed to a type that
michael@0: # cannot be inferred, grouped by stack trace; e.g.,
michael@0: #
michael@0: # (100) PR_Malloc
michael@0: #   (50) foo
michael@0: #     (50) foo2::foo2
michael@0: #   (25) bar
michael@0: #   (25) baz
michael@0: # (50) __builtin_new
michael@0: #   (50) foo2::foo2
michael@0: #
michael@0: #
michael@0: # Which indicates that 100 bytes were allocated by uninferrable
michael@0: # classes via PR_Malloc(). Of that 100 bytes, 50 were allocated from
michael@0: # calls by foo(), 25 from calls by bar(), and 25 from calls by baz().
michael@0: # 50 bytes were allocated by __builtin_new from foo2's ctor.
michael@0: #
michael@0: #
michael@0: # From this, we might be able to infer the type of the object that was
michael@0: # created by examining the PR_Malloc() usage in foo() and the
michael@0: # ::operator new() usage in foo2(), and could add new type inference
michael@0: # rules; e.g.,
michael@0: #
michael@0: #   <unclassified-string>
michael@0: #   foo
michael@0: #   foo2
michael@0: #
michael@0: #   # Attribute ::operator new() usage in foo2's ctor to foo2
michael@0: #   <foo2>
michael@0: #   __builtin_new
michael@0: #   foo2::foo2
michael@0: 
michael@0: use 5.004;
michael@0: use strict;
michael@0: use Getopt::Long;
michael@0: 
michael@0: # So we can find TraceMalloc.pm
michael@0: use FindBin;
michael@0: use lib "$FindBin::Bin";
michael@0: 
michael@0: use TraceMalloc;
michael@0: 
michael@0: # Collect program options
michael@0: $::opt_help = 0;
michael@0: $::opt_depth = 10;
michael@0: $::opt_types = "${FindBin::Bin}/types.dat";
michael@0: GetOptions("help", "depth=n", "types=s");
michael@0: 
michael@0: if ($::opt_help) {
michael@0:     die "usage: uncategorized.pl [options] <dumpfile>
michael@0:   --help          Display this message
michael@0:   --depth=<n>     Display at most <n> stack frames
michael@0:   --types=<file>  Read type heuristics from <file>";
michael@0: }
michael@0: 
michael@0: # Initialize type inference juju from the type file specified by
michael@0: # ``--types''.
michael@0: TraceMalloc::init_type_inference($::opt_types);
michael@0: 
michael@0: # Read the objects from the dump file. For each object, remember up to
michael@0: # ``--depth'' stack frames (from the top). Thread together common
michael@0: # stack prefixes, accumulating the number of bytes attributed to the
michael@0: # prefix.
michael@0: 
michael@0: # This'll hold the inverted stacks
michael@0: $::Stacks = { '#bytes#' => 0 };
michael@0: 
michael@0: sub collect_stacks($) {
michael@0:     my ($object) = @_;
michael@0:     my $stack = $object->{'stack'};
michael@0: 
michael@0:     return unless ($object->{'type'} eq 'void*') && (TraceMalloc::infer_type($stack) eq 'void*');
michael@0: 
michael@0:     my $count = 0;
michael@0:     my $link = \%::Stacks;
michael@0:   FRAME: foreach my $frame (@$stack) {
michael@0:       last FRAME unless $count++ < $::opt_depth;
michael@0: 
michael@0:       $link->{'#bytes#'} += $object->{'size'};
michael@0:       $link->{$frame} = { '#bytes#' => 0 } unless $link->{$frame};
michael@0:       $link = $link->{$frame};
michael@0:   }
michael@0: }
michael@0: 
michael@0: TraceMalloc::read(\&collect_stacks);
michael@0: 
michael@0: # Do a depth-first walk of the inverted stack tree.
michael@0: 
michael@0: sub walk($$) {
michael@0:     my ($links, $indent) = @_;
michael@0: 
michael@0:     my @keys;
michael@0:   KEY: foreach my $key (keys %$links) {
michael@0:       next KEY if $key eq '#bytes#';
michael@0:       $keys[$#keys + 1] = $key;
michael@0:   }
michael@0: 
michael@0:     foreach my $key (sort { $links->{$b}->{'#bytes#'} <=> $links->{$a}->{'#bytes#'} } @keys) {
michael@0:         for (my $i = 0; $i < $indent; ++$i) {
michael@0:             print "  ";
michael@0:         }
michael@0: 
michael@0:         print "($links->{$key}->{'#bytes#'}) $key\n";
michael@0: 
michael@0:         walk($links->{$key}, $indent + 1);
michael@0:     }
michael@0: }
michael@0: 
michael@0: walk(\%::Stacks, 0);
michael@0: