• Home
  • Line#
  • Scopes#
  • Navigate#
  • Raw
  • Download
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        next if $line =~ /^\-/;
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 = $file[$i];
92                }
93            }
94        }
95
96        # Then give up
97        next if (!$callCount || !$byteCount);
98
99        $byteCountTotal += $byteCount;
100
101        next if ($grepRegexp && !($line =~ $grepRegexp));
102
103        my $callstackBegin = 0;
104        if ($mergeDepth) {
105            # count stack frames backwards from end of callstack
106            $callstackBegin = length($line);
107            for (my $pipeCount = 0; $pipeCount < $mergeDepth; $pipeCount++) {
108                my $rindexResult = rindex($line, "|", $callstackBegin - 1);
109                last if $rindexResult == -1;
110                $callstackBegin = $rindexResult;
111            }
112        } else {
113            # start at beginning of callstack
114            $callstackBegin = index($line, "|");
115        }
116
117        my $callstack = substr($line, $callstackBegin + 2); # + 2 skips "| "
118        for my $regexp (@mergeRegexps) {
119            if ($callstack =~ $regexp) {
120                $callstack = $regexp . "\n";
121                last;
122            }
123        }
124
125        if (!$callstacks{$callstack}) {
126            $callstacks{$callstack} = {"callCount" => 0, "byteCount" => 0};
127        }
128
129        $callstacks{$callstack}{"callCount"} += $callCount;
130        $callstacks{$callstack}{"byteCount"} += $byteCount;
131    }
132
133    my $byteCountTotalReported = 0;
134    for my $callstack (sort { $callstacks{$b}{"byteCount"} <=> $callstacks{$a}{"byteCount"} } keys %callstacks) {
135        my $callCount = $callstacks{$callstack}{"callCount"};
136        my $byteCount = $callstacks{$callstack}{"byteCount"};
137        last if ($byteMinimum && $byteCount < $byteMinimum);
138
139        $byteCountTotalReported += $byteCount;
140        print commify($callCount) . " calls for " . commify($byteCount) . " bytes: $callstack\n";
141    }
142
143    print "total: " . commify($byteCountTotalReported) . " bytes (" . commify($byteCountTotal - $byteCountTotalReported) . " bytes excluded).\n";
144}
145
146exit(main());
147
148# Copied from perldoc -- please excuse the style
149sub commify($)
150{
151    local $_  = shift;
152    1 while s/^([-+]?\d+)(\d{3})/$1,$2/;
153    return $_;
154}
155