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     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 }
    175