Home | History | Annotate | Download | only in Scripts 
      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 }
    178