Ensure old tab state is cleared between iterations of run-benchmark
[WebKit-https.git] / Tools / Scripts / parse-malloc-history
1 #!/usr/bin/env 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 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     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
169 exit(main());
170
171 # Copied from perldoc -- please excuse the style
172 sub commify($)
173 {
174     local $_  = shift;
175     1 while s/^([-+]?\d+)(\d{3})/$1,$2/;
176     return $_;
177 }