mirror of
https://github.com/mozilla/gecko-dev.git
synced 2024-10-09 03:15:11 +00:00
First checked in.
This commit is contained in:
parent
f8b94139ff
commit
f5c45800dc
160
tools/trace-malloc/TraceMalloc.pm
Normal file
160
tools/trace-malloc/TraceMalloc.pm
Normal file
@ -0,0 +1,160 @@
|
||||
# The contents of this file are subject to the Mozilla Public
|
||||
# License Version 1.1 (the "License"); you may not use this file
|
||||
# except in compliance with the License. You may obtain a copy of
|
||||
# the License at http://www.mozilla.org/MPL/
|
||||
#
|
||||
# Software distributed under the License is distributed on an "AS
|
||||
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
|
||||
# implied. See the License for the specific language governing
|
||||
# rights and limitations under the License.
|
||||
#
|
||||
# The Original Code is TraceMalloc.pm, released Nov 27, 2000.
|
||||
#
|
||||
# The Initial Developer of the Original Code is Netscape
|
||||
# Communications Corporation. Portions created by Netscape are
|
||||
# Copyright (C) 2000 Netscape Communications Corporation. All
|
||||
# Rights Reserved.
|
||||
#
|
||||
# Contributor(s):
|
||||
# Chris Waterson <waterson@netscape.com>
|
||||
#
|
||||
package TraceMalloc;
|
||||
|
||||
use strict;
|
||||
|
||||
# Read in the type inference file and construct a network that we can
|
||||
# use to match stack prefixes to types.
|
||||
sub init_type_inference($) {
|
||||
my ($file) = @_;
|
||||
|
||||
$::Fingerprints = { };
|
||||
|
||||
open(TYPES, "<$file") || die "unable to open $::opt_types, $!";
|
||||
|
||||
TYPE: while (<TYPES>) {
|
||||
next TYPE unless /<(.*)>/;
|
||||
my $type = $1;
|
||||
|
||||
my $link = \%::Fingerprints;
|
||||
|
||||
FRAME: while (<TYPES>) {
|
||||
chomp;
|
||||
last FRAME if /^$/;
|
||||
|
||||
my $next = $link->{$_};
|
||||
if (! $next) {
|
||||
$next = $link->{$_} = {};
|
||||
}
|
||||
$link = $next;
|
||||
}
|
||||
|
||||
$link->{'#type#'} = $type;
|
||||
|
||||
last TYPE if eof;
|
||||
}
|
||||
}
|
||||
|
||||
# Infer the type, trying to find the most specific type possible.
|
||||
sub infer_type($) {
|
||||
my ($stack) = @_;
|
||||
|
||||
my $link = \%::Fingerprints;
|
||||
my $last;
|
||||
FRAME: foreach my $frame (@$stack) {
|
||||
last FRAME unless $link;
|
||||
|
||||
$frame =~ s/\[.*\]$//; # ignore exact addresses, as they'll drift
|
||||
$last = $link;
|
||||
$link = $link->{$frame};
|
||||
}
|
||||
|
||||
if ($last && $last->{'#type#'}) {
|
||||
return $last->{'#type#'};
|
||||
}
|
||||
else {
|
||||
return 'void*';
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
#----------------------------------------------------------------------
|
||||
#
|
||||
# Read in the output a trace malloc's dump.
|
||||
#
|
||||
sub read {
|
||||
my ($callback, $noslop) = @_;
|
||||
|
||||
OBJECT: while (<>) {
|
||||
# e.g., 0x0832FBD0 <void*> (80)
|
||||
next OBJECT unless /^0x(\S+) <(.*)> \((\d+)\)/;
|
||||
my ($addr, $type, $size) = (hex $1, $2, $3);
|
||||
|
||||
my $object = $::Objects{$addr};
|
||||
if (! $object) {
|
||||
# Found a new object entry. Record its type and size
|
||||
$::Objects{$addr} =
|
||||
$object =
|
||||
{ 'type' => $type, 'size' => $size };
|
||||
}
|
||||
|
||||
# Record the object's slots
|
||||
my @slots;
|
||||
|
||||
SLOT: while (<>) {
|
||||
# e.g., 0x00000000
|
||||
last SLOT unless /^\t0x(\S+)/;
|
||||
my $value = hex $1;
|
||||
|
||||
# Ignore low bits, unless they've specified --noslop
|
||||
$value &= ~0x7 unless $noslop;
|
||||
|
||||
$slots[$#slots + 1] = $value;
|
||||
}
|
||||
|
||||
$object->{'slots'} = \@slots;
|
||||
|
||||
# Record the stack by which the object was allocated
|
||||
my @stack;
|
||||
|
||||
while (/^(.*)\[(.*) \+0x(\S+)\]$/) {
|
||||
# e.g., _dl_debug_message[/lib/ld-linux.so.2 +0x0000B858]
|
||||
my ($func, $lib, $off) = ($1, $2, hex $3);
|
||||
|
||||
chomp;
|
||||
$stack[$#stack + 1] = $_;
|
||||
|
||||
$_ = <>;
|
||||
}
|
||||
|
||||
$object->{'stack'} = \@stack;
|
||||
|
||||
$object->{'type'} = infer_type(\@stack)
|
||||
if $object->{'type'} eq 'void*';
|
||||
|
||||
&$callback($object) if $callback;
|
||||
|
||||
# Gotta check EOF explicitly...
|
||||
last OBJECT if eof;
|
||||
}
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
TraceMalloc - Perl routines to deal with output from ``trace malloc''
|
||||
and the Boehm GC
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use TraceMalloc;
|
||||
|
||||
TraceMalloc::init_type_inference("types.dat");
|
||||
TraceMalloc::read(0);
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
=head1 EXAMPLES
|
||||
|
||||
=cut
|
81
tools/trace-malloc/histogram.pl
Executable file
81
tools/trace-malloc/histogram.pl
Executable file
@ -0,0 +1,81 @@
|
||||
#!/usr/bin/perl -w
|
||||
#
|
||||
# The contents of this file are subject to the Mozilla Public
|
||||
# License Version 1.1 (the "License"); you may not use this file
|
||||
# except in compliance with the License. You may obtain a copy of
|
||||
# the License at http://www.mozilla.org/MPL/
|
||||
#
|
||||
# Software distributed under the License is distributed on an "AS
|
||||
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
|
||||
# implied. See the License for the specific language governing
|
||||
# rights and limitations under the License.
|
||||
#
|
||||
# The Original Code is histogram.pl, released Nov 27, 2000.
|
||||
#
|
||||
# The Initial Developer of the Original Code is Netscape
|
||||
# Communications Corporation. Portions created by Netscape are
|
||||
# Copyright (C) 2000 Netscape Communications Corporation. All
|
||||
# Rights Reserved.
|
||||
#
|
||||
# Contributor(s):
|
||||
# Chris Waterson <waterson@netscape.com>
|
||||
#
|
||||
# This program produces a ``class histogram'' of the live objects, one
|
||||
# line per class, with the total number of objects allocated, and
|
||||
# total number of bytes attributed to those objects.
|
||||
#
|
||||
|
||||
use 5.004;
|
||||
use strict;
|
||||
use Getopt::Long;
|
||||
|
||||
# So we can find TraceMalloc.pm
|
||||
use FindBin;
|
||||
use lib "$FindBin::Bin";
|
||||
|
||||
use TraceMalloc;
|
||||
|
||||
# Collect program options
|
||||
$::opt_help = 0;
|
||||
$::opt_types = "${FindBin::Bin}/types.dat";
|
||||
|
||||
GetOptions("help", "types=s");
|
||||
|
||||
if ($::opt_help) {
|
||||
die "usage: histogram.pl [options] <dumpfile>
|
||||
--help Display this message
|
||||
--types=<file> Read type heuristics from <file>";
|
||||
}
|
||||
|
||||
# Initialize type inference juju from the type file specified by
|
||||
# ``--types''.
|
||||
if ($::opt_types) {
|
||||
TraceMalloc::init_type_inference($::opt_types);
|
||||
}
|
||||
|
||||
# Read the dump file, collecting count and size information for each
|
||||
# object that's detected.
|
||||
|
||||
# This'll hold a record for each class that we detect
|
||||
$::Classes = { };
|
||||
|
||||
sub collect_objects($) {
|
||||
my ($object) = @_;
|
||||
my $type = $object->{'type'};
|
||||
|
||||
my $entry = $::Classes{$type};
|
||||
if (! $entry) {
|
||||
$entry = $::Classes{$type} = { '#count#' => 0, '#bytes#' => 0 };
|
||||
}
|
||||
|
||||
$entry->{'#count#'} += 1;
|
||||
$entry->{'#bytes#'} += $object->{'size'};
|
||||
}
|
||||
|
||||
TraceMalloc::read(\&collect_objects);
|
||||
|
||||
# Print one line per class, sorted with the classes that accumulated
|
||||
# the most bytes first.
|
||||
foreach my $class (sort { $::Classes{$b}->{'#bytes#'} <=> $::Classes{$a}->{'#bytes#'} } keys %::Classes) {
|
||||
print "$class $::Classes{$class}->{'#count#'} $::Classes{$class}->{'#bytes#'}\n";
|
||||
}
|
1228
tools/trace-malloc/types.dat
Normal file
1228
tools/trace-malloc/types.dat
Normal file
File diff suppressed because it is too large
Load Diff
134
tools/trace-malloc/uncategorized.pl
Executable file
134
tools/trace-malloc/uncategorized.pl
Executable file
@ -0,0 +1,134 @@
|
||||
#!/usr/bin/perl -w
|
||||
#
|
||||
# The contents of this file are subject to the Mozilla Public
|
||||
# License Version 1.1 (the "License"); you may not use this file
|
||||
# except in compliance with the License. You may obtain a copy of
|
||||
# the License at http://www.mozilla.org/MPL/
|
||||
#
|
||||
# Software distributed under the License is distributed on an "AS
|
||||
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
|
||||
# implied. See the License for the specific language governing
|
||||
# rights and limitations under the License.
|
||||
#
|
||||
# The Original Code is uncategorized.pl, released Nov 27, 2000.
|
||||
#
|
||||
# The Initial Developer of the Original Code is Netscape
|
||||
# Communications Corporation. Portions created by Netscape are
|
||||
# Copyright (C) 2000 Netscape Communications Corporation. All
|
||||
# Rights Reserved.
|
||||
#
|
||||
# Contributor(s):
|
||||
# Chris Waterson <waterson@netscape.com>
|
||||
#
|
||||
# This tool is used to construct the ``type inference'' file. It
|
||||
# prints the total number of bytes that are attributed to a type that
|
||||
# cannot be inferred, grouped by stack trace; e.g.,
|
||||
#
|
||||
# (100) PR_Malloc
|
||||
# (50) foo
|
||||
# (50) foo2::foo2
|
||||
# (25) bar
|
||||
# (25) baz
|
||||
# (50) __builtin_new
|
||||
# (50) foo2::foo2
|
||||
#
|
||||
#
|
||||
# Which indicates that 100 bytes were allocated by uninferrable
|
||||
# classes via PR_Malloc(). Of that 100 bytes, 50 were allocated from
|
||||
# calls by foo(), 25 from calls by bar(), and 25 from calls by baz().
|
||||
# 50 bytes were allocated by __builtin_new from foo2's ctor.
|
||||
#
|
||||
#
|
||||
# From this, we might be able to infer the type of the object that was
|
||||
# created by examining the PR_Malloc() usage in foo() and the
|
||||
# ::operator new() usage in foo2(), and could add new type inference
|
||||
# rules; e.g.,
|
||||
#
|
||||
# <unclassified-string>
|
||||
# foo
|
||||
# foo2
|
||||
#
|
||||
# # Attribute ::operator new() usage in foo2's ctor to foo2
|
||||
# <foo2>
|
||||
# __builtin_new
|
||||
# foo2::foo2
|
||||
#
|
||||
|
||||
use 5.004;
|
||||
use strict;
|
||||
use Getopt::Long;
|
||||
|
||||
# So we can find TraceMalloc.pm
|
||||
use FindBin;
|
||||
use lib "$FindBin::Bin";
|
||||
|
||||
use TraceMalloc;
|
||||
|
||||
# Collect program options
|
||||
$::opt_help = 0;
|
||||
$::opt_depth = 10;
|
||||
$::opt_types = "${FindBin::Bin}/types.dat";
|
||||
GetOptions("help", "depth=n", "types=s");
|
||||
|
||||
if ($::opt_help) {
|
||||
die "usage: uncategorized.pl [options] <dumpfile>
|
||||
--help Display this message
|
||||
--depth=<n> Display at most <n> stack frames
|
||||
--types=<file> Read type heuristics from <file>";
|
||||
}
|
||||
|
||||
# Initialize type inference juju from the type file specified by
|
||||
# ``--types''.
|
||||
TraceMalloc::init_type_inference($::opt_types);
|
||||
|
||||
# Read the objects from the dump file. For each object, remember up to
|
||||
# ``--depth'' stack frames (from the top). Thread together common
|
||||
# stack prefixes, accumulating the number of bytes attributed to the
|
||||
# prefix.
|
||||
|
||||
# This'll hold the inverted stacks
|
||||
$::Stacks = { '#bytes#' => 0 };
|
||||
|
||||
sub collect_stacks($) {
|
||||
my ($object) = @_;
|
||||
my $stack = $object->{'stack'};
|
||||
|
||||
return unless ($object->{'type'} eq 'void*') && (TraceMalloc::infer_type($stack) eq 'void*');
|
||||
|
||||
my $count = 0;
|
||||
my $link = \%::Stacks;
|
||||
FRAME: foreach my $frame (@$stack) {
|
||||
last FRAME unless $count++ < $::opt_depth;
|
||||
|
||||
$link->{'#bytes#'} += $object->{'size'};
|
||||
$link->{$frame} = { '#bytes#' => 0 } unless $link->{$frame};
|
||||
$link = $link->{$frame};
|
||||
}
|
||||
}
|
||||
|
||||
TraceMalloc::read(\&collect_stacks);
|
||||
|
||||
# Do a depth-first walk of the inverted stack tree.
|
||||
|
||||
sub walk($$) {
|
||||
my ($links, $indent) = @_;
|
||||
|
||||
my @keys;
|
||||
KEY: foreach my $key (keys %$links) {
|
||||
next KEY if $key eq '#bytes#';
|
||||
$keys[$#keys + 1] = $key;
|
||||
}
|
||||
|
||||
foreach my $key (sort { $links->{$b}->{'#bytes#'} <=> $links->{$a}->{'#bytes#'} } @keys) {
|
||||
for (my $i = 0; $i < $indent; ++$i) {
|
||||
print " ";
|
||||
}
|
||||
|
||||
print "($links->{$key}->{'#bytes#'}) $key\n";
|
||||
|
||||
walk($links->{$key}, $indent + 1);
|
||||
}
|
||||
}
|
||||
|
||||
walk(\%::Stacks, 0);
|
||||
|
Loading…
Reference in New Issue
Block a user