* Scripts/parse-malloc-history: Added copyright info.
[WebKit-https.git] / WebKitTools / Scripts / parse-malloc-history
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         "  --callstack-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-depth        Merge all call stacks that match at this stack depth and above.\n";
48
49     my $mergeDepth = -1;
50     my $callstackRegexp = "";
51     my $byteMinimum = 0;
52     my $getOptionsResult = GetOptions(
53         "callstack-regexp:s" => \$callstackRegexp,
54         "byte-minimum:i" => \$byteMinimum,
55         "merge-depth:i" => \$mergeDepth
56     );
57     my $fileName = $ARGV[0];
58     die $usage if (!$getOptionsResult || !$fileName);
59
60     open FILE, "<$fileName" or die "bad file: $fileName";
61     my @file = <FILE>;
62     close FILE;
63
64     my %callstacks = ();
65     my $byteCountTotal = 0;
66
67     for my $line (@file) {
68         my ($callCount, $byteCount) = ($line =~ /(\d+) calls for (\d+) bytes/);
69         if ($callCount && $byteCount) {
70             $byteCountTotal += $byteCount;
71
72             next if !($line =~ $callstackRegexp);
73
74             my $callstackBegin;
75             if ($mergeDepth == -1) { # start at beginning of callstack
76                 $callstackBegin = index($line, "|");
77             } else { # count stack frames backwards from end of callstack
78                 $callstackBegin = length($line);
79                 for (my $pipeCount = 0; $pipeCount < $mergeDepth; $pipeCount++) {
80                     my $rindexResult = rindex($line, "|", $callstackBegin - 1);
81                     last if $rindexResult == -1;
82                     $callstackBegin = $rindexResult;
83                 }
84             }
85
86             my $callstack = substr($line, $callstackBegin + 2); # + 2 skips "| "
87             if (!$callstacks{$callstack}) {
88                 $callstacks{$callstack} = {"callCount" => 0, "byteCount" => 0};
89             }
90
91             $callstacks{$callstack}{"callCount"} += $callCount;
92             $callstacks{$callstack}{"byteCount"} += $byteCount;
93         }
94     }
95
96     my $byteCountTotalReported = 0;
97     for my $callstack (sort { $callstacks{$b}{"byteCount"} <=> $callstacks{$a}{"byteCount"} } keys %callstacks) {
98         my $callCount = $callstacks{$callstack}{"callCount"};
99         my $byteCount = $callstacks{$callstack}{"byteCount"};
100         last if $byteCount < $byteMinimum;
101
102         $byteCountTotalReported += $byteCount;
103         print commify($callCount) . " calls for " . commify($byteCount) . " bytes: $callstack\n";
104     }
105
106     print "total: " . commify($byteCountTotalReported) . " bytes (" . commify($byteCountTotal - $byteCountTotalReported) . " bytes excluded).\n";
107 }
108
109 exit(main());
110
111 # Copied from perldoc -- please excuse the style
112 sub commify($)
113 {
114     local $_  = shift;
115     1 while s/^([-+]?\d+)(\d{3})/$1,$2/;
116     return $_;
117 }