|
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 |
|
33 use Getopt::Long; |
|
34 use File::Basename; |
|
35 |
|
36 use strict; |
|
37 use warnings; |
|
38 |
|
39 sub commify($); |
|
40 |
|
41 sub 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 my $fileName = $ARGV[0]; |
|
61 die $usage if (!$getOptionsResult || !$fileName); |
|
62 |
|
63 open FILE, "<$fileName" or die "bad file: $fileName"; |
|
64 my @file = <FILE>; |
|
65 close FILE; |
|
66 |
|
67 my %callstacks = (); |
|
68 my $byteCountTotal = 0; |
|
69 |
|
70 for (my $i = 0; $i < @file; $i++) { |
|
71 my $line = $file[$i]; |
|
72 my ($callCount, $byteCount); |
|
73 |
|
74 # First try malloc_history format |
|
75 # 6 calls for 664 bytes thread_ffffffff |0x0 | start |
|
76 ($callCount, $byteCount) = ($line =~ /(\d+) calls for (\d+) bytes/); |
|
77 |
|
78 # Then try leaks format |
|
79 # Leak: 0x0ac3ca40 size=48 |
|
80 # 0x00020001 0x00000001 0x00000000 0x00000000 ................ |
|
81 # Call stack: [thread ffffffff]: | 0x0 | start |
|
82 if (!$callCount || !$byteCount) { |
|
83 $callCount = 1; |
|
84 ($byteCount) = ($line =~ /Leak: [x[:xdigit:]]* size=(\d+)/); |
|
85 |
|
86 if ($byteCount) { |
|
87 while (!($line =~ "Call stack: ")) { |
|
88 $i++; |
|
89 $line = $file[$i]; |
|
90 } |
|
91 } |
|
92 } |
|
93 |
|
94 # Then try LeakFinder format |
|
95 # --------------- Key: 213813, 84 bytes --------- |
|
96 # c:\cygwin\home\buildbot\webkit\opensource\webcore\rendering\renderarena.cpp(78): WebCore::RenderArena::allocate |
|
97 # c:\cygwin\home\buildbot\webkit\opensource\webcore\rendering\renderobject.cpp(82): WebCore::RenderObject::operator new |
|
98 if (!$callCount || !$byteCount) { |
|
99 $callCount = 1; |
|
100 ($byteCount) = ($line =~ /Key: (?:\d+), (\d+) bytes/); |
|
101 if ($byteCount) { |
|
102 $line = $file[++$i]; |
|
103 my @tempStack; |
|
104 while ($file[$i+1] !~ /^(?:-|\d)/) { |
|
105 if ($line =~ /\): (.*)$/) { |
|
106 my $call = $1; |
|
107 $call =~ s/\r$//; |
|
108 unshift(@tempStack, $call); |
|
109 } |
|
110 $line = $file[++$i]; |
|
111 } |
|
112 $line = join(" | ", @tempStack); |
|
113 } |
|
114 } |
|
115 |
|
116 # Then give up |
|
117 next if (!$callCount || !$byteCount); |
|
118 |
|
119 $byteCountTotal += $byteCount; |
|
120 |
|
121 next if ($grepRegexp && !($line =~ $grepRegexp)); |
|
122 |
|
123 my $callstackBegin = 0; |
|
124 if ($mergeDepth) { |
|
125 # count stack frames backwards from end of callstack |
|
126 $callstackBegin = length($line); |
|
127 for (my $pipeCount = 0; $pipeCount < $mergeDepth; $pipeCount++) { |
|
128 my $rindexResult = rindex($line, "|", $callstackBegin - 1); |
|
129 last if $rindexResult == -1; |
|
130 $callstackBegin = $rindexResult; |
|
131 } |
|
132 } else { |
|
133 # start at beginning of callstack |
|
134 $callstackBegin = index($line, "|"); |
|
135 } |
|
136 |
|
137 my $callstack = substr($line, $callstackBegin + 2); # + 2 skips "| " |
|
138 for my $regexp (@mergeRegexps) { |
|
139 if ($callstack =~ $regexp) { |
|
140 $callstack = $regexp . "\n"; |
|
141 last; |
|
142 } |
|
143 } |
|
144 |
|
145 if (!$callstacks{$callstack}) { |
|
146 $callstacks{$callstack} = {"callCount" => 0, "byteCount" => 0}; |
|
147 } |
|
148 |
|
149 $callstacks{$callstack}{"callCount"} += $callCount; |
|
150 $callstacks{$callstack}{"byteCount"} += $byteCount; |
|
151 } |
|
152 |
|
153 my $byteCountTotalReported = 0; |
|
154 for my $callstack (sort { $callstacks{$b}{"byteCount"} <=> $callstacks{$a}{"byteCount"} } keys %callstacks) { |
|
155 my $callCount = $callstacks{$callstack}{"callCount"}; |
|
156 my $byteCount = $callstacks{$callstack}{"byteCount"}; |
|
157 last if ($byteMinimum && $byteCount < $byteMinimum); |
|
158 |
|
159 $byteCountTotalReported += $byteCount; |
|
160 print commify($callCount) . " calls for " . commify($byteCount) . " bytes: $callstack\n"; |
|
161 } |
|
162 |
|
163 print "total: " . commify($byteCountTotalReported) . " bytes (" . commify($byteCountTotal - $byteCountTotalReported) . " bytes excluded).\n"; |
|
164 } |
|
165 |
|
166 exit(main()); |
|
167 |
|
168 # Copied from perldoc -- please excuse the style |
|
169 sub commify($) |
|
170 { |
|
171 local $_ = shift; |
|
172 1 while s/^([-+]?\d+)(\d{3})/$1,$2/; |
|
173 return $_; |
|
174 } |