tools/trace-malloc/histogram.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 histogram.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 program produces a ``class histogram'' of the live objects, one
  42 # line per class, with the total number of objects allocated, and
  43 # total number of bytes attributed to those objects.
  44
  45 use 5.004;
  46 use strict;
  47 use Getopt::Long;
  48
  49 # So we can find TraceMalloc.pm
  50 use FindBin;
  51 use lib "$FindBin::Bin";
  52
  53 use TraceMalloc;
  54
  55 # Collect program options
  56 $::opt_help = 0;
  57 $::opt_types = "${FindBin::Bin}/types.dat";
  58
  59 GetOptions("help", "types=s");
  60
  61 if ($::opt_help) {
  62     die "usage: histogram.pl [options] <dumpfile>
  63   --help          Display this message
  64   --types=<file>  Read type heuristics from <file>";
  65 }
  66
  67 # Initialize type inference juju from the type file specified by
  68 # ``--types''.
  69 if ($::opt_types) {
  70     TraceMalloc::init_type_inference($::opt_types);
  71 }
  72
  73 # Read the dump file, collecting count and size information for each
  74 # object that's detected.
  75
  76 # This'll hold a record for each class that we detect
  77 $::Classes = { };
  78
  79 sub collect_objects($) {
  80     my ($object) = @_;
  81     my $type = $object->{'type'};
  82
  83     my $entry = $::Classes{$type};
  84     if (! $entry) {
  85         $entry = $::Classes{$type} = { '#count#' => 0, '#bytes#' => 0 };
  86     }
  87
  88     $entry->{'#count#'} += 1;
  89     $entry->{'#bytes#'} += $object->{'size'};
  90 }
  91
  92 TraceMalloc::read(\&collect_objects);
  93
  94 # Print one line per class, sorted with the classes that accumulated
  95 # the most bytes first.
  96 foreach my $class (sort { $::Classes{$b}->{'#bytes#'} <=> $::Classes{$a}->{'#bytes#'} } keys %::Classes) {
  97     print "$class $::Classes{$class}->{'#count#'} $::Classes{$class}->{'#bytes#'}\n";
  98 }