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 program produces a ``class histogram'' of the live objects, one
michael@0: # line per class, with the total number of objects allocated, and
michael@0: # total number of bytes attributed to those objects.
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_types = "${FindBin::Bin}/types.dat";
michael@0: 
michael@0: GetOptions("help", "types=s");
michael@0: 
michael@0: if ($::opt_help) {
michael@0:     die "usage: histogram.pl [options] <dumpfile>
michael@0:   --help          Display this message
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: if ($::opt_types) {
michael@0:     TraceMalloc::init_type_inference($::opt_types);
michael@0: }
michael@0: 
michael@0: # Read the dump file, collecting count and size information for each
michael@0: # object that's detected.
michael@0: 
michael@0: # This'll hold a record for each class that we detect
michael@0: $::Classes = { };
michael@0: 
michael@0: sub collect_objects($) {
michael@0:     my ($object) = @_;
michael@0:     my $type = $object->{'type'};
michael@0: 
michael@0:     my $entry = $::Classes{$type};
michael@0:     if (! $entry) {
michael@0:         $entry = $::Classes{$type} = { '#count#' => 0, '#bytes#' => 0 };
michael@0:     }
michael@0: 
michael@0:     $entry->{'#count#'} += 1;
michael@0:     $entry->{'#bytes#'} += $object->{'size'};
michael@0: }
michael@0: 
michael@0: TraceMalloc::read(\&collect_objects);
michael@0: 
michael@0: # Print one line per class, sorted with the classes that accumulated
michael@0: # the most bytes first.
michael@0: foreach my $class (sort { $::Classes{$b}->{'#bytes#'} <=> $::Classes{$a}->{'#bytes#'} } keys %::Classes) {
michael@0:     print "$class $::Classes{$class}->{'#count#'} $::Classes{$class}->{'#bytes#'}\n";
michael@0: }