• Home
  • Line#
  • Scopes#
  • Navigate#
  • Raw
  • Download
1#!/usr/bin/perl
2
3# Copyright (C) 2007 Apple Inc. All rights reserved.
4#
5# Redistribution and use in source and binary forms, with or without
6# modification, are permitted provided that the following conditions
7# are met:
8#
9# 1.  Redistributions of source code must retain the above copyright
10#     notice, this list of conditions and the following disclaimer.
11# 2.  Redistributions in binary form must reproduce the above copyright
12#     notice, this list of conditions and the following disclaimer in the
13#     documentation and/or other materials provided with the distribution.
14# 3.  Neither the name of Apple Computer, Inc. ("Apple") nor the names of
15#     its contributors may be used to endorse or promote products derived
16#     from this software without specific prior written permission.
17#
18# THIS SOFTWARE IS PROVIDED BY APPLE AND ITS CONTRIBUTORS "AS IS" AND ANY
19# EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
20# WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
21# DISCLAIMED. IN NO EVENT SHALL APPLE OR ITS CONTRIBUTORS BE LIABLE FOR ANY
22# DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
23# (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
24# LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
25# ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
26# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
27# THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
28
29# Parses the callstacks in a file with malloc_history formatted content, sorting
30# based on total number of bytes allocated, and filtering based on command-line
31# parameters.
32
33use Getopt::Long;
34use File::Basename;
35
36use strict;
37use warnings;
38
39sub commify($);
40
41sub main()
42{
43    my $usage =
44        "Usage: " . basename($0) . " [options] malloc_history.txt\n" .
45        "  --grep-regexp        Include only call stacks that match this regular expression.\n" .
46        "  --byte-minimum       Include only call stacks with allocation sizes >= this value.\n" .
47        "  --merge-regexp       Merge all call stacks that match this regular expression.\n" .
48        "  --merge-depth        Merge all call stacks that match at this stack depth and above.\n";
49
50    my $grepRegexp = "";
51    my $byteMinimum = "";
52    my @mergeRegexps = ();
53    my $mergeDepth = "";
54    my $getOptionsResult = GetOptions(
55        "grep-regexp:s" => \$grepRegexp,
56        "byte-minimum:i" => \$byteMinimum,
57        "merge-regexp:s" => \@mergeRegexps,
58        "merge-depth:i" => \$mergeDepth
59    );
60    die $usage if (!$getOptionsResult || !scalar(@ARGV));
61
62    my @lines = ();
63    foreach my $fileName (@ARGV) {
64        open FILE, "<$fileName" or die "bad file: $fileName";
65        push(@lines, <FILE>);
66        close FILE;
67    }
68
69    my %callstacks = ();
70    my $byteCountTotal = 0;
71
72    for (my $i = 0; $i < @lines; $i++) {
73        my $line = $lines[$i];
74        my ($callCount, $byteCount);
75
76        # First try malloc_history format
77        #   6 calls for 664 bytes thread_ffffffff |0x0 | start
78        ($callCount, $byteCount) = ($line =~ /(\d+) calls for (\d+) bytes/);
79
80        # Then try leaks format
81        #   Leak: 0x0ac3ca40  size=48
82        #   0x00020001 0x00000001 0x00000000 0x00000000     ................
83        #   Call stack: [thread ffffffff]: | 0x0 | start
84        if (!$callCount || !$byteCount) {
85            $callCount = 1;
86            ($byteCount) = ($line =~ /Leak: [x[:xdigit:]]*  size=(\d+)/);
87
88            if ($byteCount) {
89                while (!($line =~ "Call stack: ")) {
90                    $i++;
91                    $line = $lines[$i];
92                }
93            }
94        }
95
96        # Then try LeakFinder format
97        # --------------- Key: 213813, 84 bytes ---------
98        # c:\cygwin\home\buildbot\webkit\opensource\webcore\rendering\renderarena.cpp(78): WebCore::RenderArena::allocate
99        # c:\cygwin\home\buildbot\webkit\opensource\webcore\rendering\renderobject.cpp(82): WebCore::RenderObject::operator new
100        if (!$callCount || !$byteCount) {
101            $callCount = 1;
102            ($byteCount) = ($line =~ /Key: (?:\d+), (\d+) bytes/);
103            if ($byteCount) {
104                $line = $lines[++$i];
105                my @tempStack;
106                while ($lines[$i+1] !~ /^(?:-|\d)/) {
107                    if ($line =~ /\): (.*)$/) {
108                        my $call = $1;
109                        $call =~ s/\r$//;
110                        unshift(@tempStack, $call);
111                    }
112                    $line = $lines[++$i];
113                }
114                $line = join(" | ", @tempStack);
115            }
116        }
117
118        # Then give up
119        next if (!$callCount || !$byteCount);
120
121        $byteCountTotal += $byteCount;
122
123        next if ($grepRegexp && !($line =~ $grepRegexp));
124
125        my $callstackBegin = 0;
126        if ($mergeDepth) {
127            # count stack frames backwards from end of callstack
128            $callstackBegin = length($line);
129            for (my $pipeCount = 0; $pipeCount < $mergeDepth; $pipeCount++) {
130                my $rindexResult = rindex($line, "|", $callstackBegin - 1);
131                last if $rindexResult == -1;
132                $callstackBegin = $rindexResult;
133            }
134        } else {
135            # start at beginning of callstack
136            $callstackBegin = index($line, "|");
137        }
138
139        my $callstack = substr($line, $callstackBegin + 2); # + 2 skips "| "
140        for my $regexp (@mergeRegexps) {
141            if ($callstack =~ $regexp) {
142                $callstack = $regexp . "\n";
143                last;
144            }
145        }
146
147        if (!$callstacks{$callstack}) {
148            $callstacks{$callstack} = {"callCount" => 0, "byteCount" => 0};
149        }
150
151        $callstacks{$callstack}{"callCount"} += $callCount;
152        $callstacks{$callstack}{"byteCount"} += $byteCount;
153    }
154
155    my $byteCountTotalReported = 0;
156    for my $callstack (sort { $callstacks{$b}{"byteCount"} <=> $callstacks{$a}{"byteCount"} } keys %callstacks) {
157        my $callCount = $callstacks{$callstack}{"callCount"};
158        my $byteCount = $callstacks{$callstack}{"byteCount"};
159        last if ($byteMinimum && $byteCount < $byteMinimum);
160
161        $byteCountTotalReported += $byteCount;
162        print commify($callCount) . " calls for " . commify($byteCount) . " bytes: $callstack\n";
163    }
164
165    print "total: " . commify($byteCountTotalReported) . " bytes (" . commify($byteCountTotal - $byteCountTotalReported) . " bytes excluded).\n";
166    return 0;
167}
168
169exit(main());
170
171# Copied from perldoc -- please excuse the style
172sub commify($)
173{
174    local $_  = shift;
175    1 while s/^([-+]?\d+)(\d{3})/$1,$2/;
176    return $_;
177}
178