| OLD | NEW |
|---|
| (Empty) |
| 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 ex
pression.\n" . | |
| 48 " --merge-depth Merge all call stacks that match at this stack d
epth 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\renderaren
a.cpp(78): WebCore::RenderArena::allocate | |
| 99 # c:\cygwin\home\buildbot\webkit\opensource\webcore\rendering\layoutobje
ct.cpp(82): WebCore::LayoutObject::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) . " byte
s: $callstack\n"; | |
| 163 } | |
| 164 | |
| 165 print "total: " . commify($byteCountTotalReported) . " bytes (" . commify($b
yteCountTotal - $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 } | |
| OLD | NEW |
|---|
Chromium Code Reviews
Issue 1253013003:
Remove all perl scripts from Tools/Scripts (Closed)
Base URL: svn://svn.chromium.org/blink/trunk