Tools/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         "  --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 }