tools/trace-malloc/histogram.pl

Thu, 22 Jan 2015 13:21:57 +0100

author
Michael Schloh von Bennewitz <michael@schloh.com>
date
Thu, 22 Jan 2015 13:21:57 +0100
branch
TOR_BUG_9701
changeset 15
b8a032363ba2
permissions
-rwxr-xr-x

Incorporate requested changes from Mozilla in review:
https://bugzilla.mozilla.org/show_bug.cgi?id=1123480#c6

michael@0 1 #!/usr/bin/perl -w
michael@0 2 #
michael@0 3 # This Source Code Form is subject to the terms of the Mozilla Public
michael@0 4 # License, v. 2.0. If a copy of the MPL was not distributed with this
michael@0 5 # file, You can obtain one at http://mozilla.org/MPL/2.0/.
michael@0 6
michael@0 7 # This program produces a ``class histogram'' of the live objects, one
michael@0 8 # line per class, with the total number of objects allocated, and
michael@0 9 # total number of bytes attributed to those objects.
michael@0 10
michael@0 11 use 5.004;
michael@0 12 use strict;
michael@0 13 use Getopt::Long;
michael@0 14
michael@0 15 # So we can find TraceMalloc.pm
michael@0 16 use FindBin;
michael@0 17 use lib "$FindBin::Bin";
michael@0 18
michael@0 19 use TraceMalloc;
michael@0 20
michael@0 21 # Collect program options
michael@0 22 $::opt_help = 0;
michael@0 23 $::opt_types = "${FindBin::Bin}/types.dat";
michael@0 24
michael@0 25 GetOptions("help", "types=s");
michael@0 26
michael@0 27 if ($::opt_help) {
michael@0 28 die "usage: histogram.pl [options] <dumpfile>
michael@0 29 --help Display this message
michael@0 30 --types=<file> Read type heuristics from <file>";
michael@0 31 }
michael@0 32
michael@0 33 # Initialize type inference juju from the type file specified by
michael@0 34 # ``--types''.
michael@0 35 if ($::opt_types) {
michael@0 36 TraceMalloc::init_type_inference($::opt_types);
michael@0 37 }
michael@0 38
michael@0 39 # Read the dump file, collecting count and size information for each
michael@0 40 # object that's detected.
michael@0 41
michael@0 42 # This'll hold a record for each class that we detect
michael@0 43 $::Classes = { };
michael@0 44
michael@0 45 sub collect_objects($) {
michael@0 46 my ($object) = @_;
michael@0 47 my $type = $object->{'type'};
michael@0 48
michael@0 49 my $entry = $::Classes{$type};
michael@0 50 if (! $entry) {
michael@0 51 $entry = $::Classes{$type} = { '#count#' => 0, '#bytes#' => 0 };
michael@0 52 }
michael@0 53
michael@0 54 $entry->{'#count#'} += 1;
michael@0 55 $entry->{'#bytes#'} += $object->{'size'};
michael@0 56 }
michael@0 57
michael@0 58 TraceMalloc::read(\&collect_objects);
michael@0 59
michael@0 60 # Print one line per class, sorted with the classes that accumulated
michael@0 61 # the most bytes first.
michael@0 62 foreach my $class (sort { $::Classes{$b}->{'#bytes#'} <=> $::Classes{$a}->{'#bytes#'} } keys %::Classes) {
michael@0 63 print "$class $::Classes{$class}->{'#count#'} $::Classes{$class}->{'#bytes#'}\n";
michael@0 64 }

mercurial