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 33use Getopt::Long; 34use File::Basename; 35 36use strict; 37use warnings; 38 39sub commify($); 40 41sub 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 166exit(main()); 167 168# Copied from perldoc -- please excuse the style 169sub commify($) 170{ 171 local $_ = shift; 172 1 while s/^([-+]?\d+)(\d{3})/$1,$2/; 173 return $_; 174} 175