The Tor Browser / file comparison

comparison: tools/trace-malloc/blame.pl

tools/trace-malloc/blame.pl

branch
TOR_BUG_9701
changeset 8
97036ab72558
equal deleted inserted replaced
-1:000000000000 0:eb4a7cf92c3b
1 #!/usr/bin/perl -w
2 #
3 # This Source Code Form is subject to the terms of the Mozilla Public
4 # License, v. 2.0. If a copy of the MPL was not distributed with this
5 # file, You can obtain one at http://mozilla.org/MPL/2.0/.
6
7 #
8 # Process output of TraceMallocDumpAllocations() to produce a table
9 # that attributes memory to the allocators using call stack.
10 #
11
12 use 5.004;
13 use strict;
14
15 # A table of all ancestors. Key is function name, value is an
16 # array of ancestors, each attributed with a number of calls and
17 # the amount of memory allocated.
18 my %Ancestors;
19
20 # Ibid, for descendants.
21 my %Descendants;
22
23 # A table that keeps the total amount of memory allocated by each
24 # function
25 my %Totals;
26 $Totals{".root"} = { "#memory#" => 0, "#calls#" => 0 };
27
28 # A table that maps the long ugly function name to a unique number so
29 # that the HTML we generate isn't too fat
30 my %Ids;
31 my $NextId = 0;
32
33 $Ids{".root"} = ++$NextId;
34
35
36 LINE: while (<>) {
37 # The line'll look like:
38 #
39 # 0x4000a008 16 PR_Malloc+16; nsMemoryImpl::Alloc(unsigned int)+12; ...
40
41 # Ignore any lines that don't start with an address
42 next LINE unless /^0x/;
43
44 # Parse it
45 my ($address, $size, $rest) = /^(0x\S*)\s*(\d+)\s*(.*)$/;
46 my @stack = reverse(split /; /, $rest);
47
48 # Accumulate at the root
49 $Totals{".root"}->{"#memory#"} += $size;
50 ++$Totals{".root"}->{"#calls#"};
51
52 my $caller = ".root";
53 foreach my $callee (@stack) {
54 # Strip the offset from the callsite information. I don't
55 # think we care.
56 $callee =~ s/\+\d+$//g;
57
58 # Accumulate the total for the callee
59 if (! $Totals{$callee}) {
60 $Totals{$callee} = { "#memory#" => 0, "#calls#" => 0 };
61 }
62
63 $Totals{$callee}->{"#memory#"} += $size;
64 ++$Totals{$callee}->{"#calls#"};
65
66 # Descendants
67 my $descendants = $Descendants{$caller};
68 if (! $descendants) {
69 $descendants = $Descendants{$caller} = [ ];
70 }
71
72 # Manage the list of descendants
73 {
74 my $wasInserted = 0;
75 DESCENDANT: foreach my $item (@$descendants) {
76 if ($item->{"#name#"} eq $callee) {
77 $item->{"#memory#"} += $size;
78 ++$item->{"#calls#"};
79 $wasInserted = 1;
80 last DESCENDANT;
81 }
82 }
83
84 if (! $wasInserted) {
85 $descendants->[@$descendants] = {
86 "#name#" => $callee,
87 "#memory#" => $size,
88 "#calls#" => 1
89 };
90 }
91 }
92
93 # Ancestors
94 my $ancestors = $Ancestors{$callee};
95 if (! $ancestors) {
96 $ancestors = $Ancestors{$callee} = [ ];
97 }
98
99 # Manage the list of ancestors
100 {
101 my $wasInserted = 0;
102 ANCESTOR: foreach my $item (@$ancestors) {
103 if ($item->{"#name#"} eq $caller) {
104 $item->{"#memory#"} += $size;
105 ++$item->{"#calls#"};
106 $wasInserted = 1;
107 last ANCESTOR;
108 }
109 }
110
111 if (! $wasInserted) {
112 $ancestors->[@$ancestors] = {
113 "#name#" => $caller,
114 "#memory#" => $size,
115 "#calls#" => 1
116 };
117 }
118 }
119
120 # Make a new "id", if necessary
121 if (! $Ids{$callee}) {
122 $Ids{$callee} = ++$NextId;
123 }
124
125 # On to the next one...
126 $caller = $callee;
127 }
128 }
129
130
131 # Change the manky looking callsite into a pretty function; strip argument
132 # types and offset information.
133 sub pretty($) {
134 $_ = $_[0];
135 s/&/&amp;/g;
136 s/</&lt;/g;
137 s/>/&gt;/g;
138
139 if (/([^\(]*)(\(.*\))/) {
140 return $1 . "()";
141 }
142 else {
143 return $_[0];
144 }
145 }
146
147 # Dump a web page!
148 print "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0//EN\">\n";
149 print "<html><head>\n";
150 print "<title>Live Bloat Blame</title>\n";
151 print "<link rel=\"stylesheet\" type=\"text/css\" href=\"blame.css\">\n";
152 print "</head>\n";
153 print "<body>\n";
154
155 # At most 100 rows per table so as not to kill the browser.
156 my $maxrows = 100;
157
158 print "<table>\n";
159 print "<thead><tr><td>Function</td><td>Ancestors</td><td>Descendants</td></tr></thead>\n";
160
161 foreach my $node (sort(keys(%Ids))) {
162 print "<tr>\n";
163
164 # Print the current node
165 {
166 my ($memory, $calls) =
167 ($Totals{$node}->{"#memory#"},
168 $Totals{$node}->{"#calls#"});
169
170 my $pretty = pretty($node);
171 print " <td><a name=\"$Ids{$node}\">$pretty&nbsp;$memory&nbsp;($calls)</a></td>\n";
172 }
173
174 # Ancestors, sorted descending by amount of memory allocated
175 print " <td>\n";
176 my $ancestors = $Ancestors{$node};
177 if ($ancestors) {
178 foreach my $ancestor (sort { $b->{"#memory#"} <=> $a->{"#memory#"} } @$ancestors) {
179 my ($name, $memory, $calls) =
180 ($ancestor->{"#name#"},
181 $ancestor->{"#memory#"},
182 $ancestor->{"#calls#"});
183
184 my $pretty = pretty($name);
185
186 print " <a href=\"#$Ids{$name}\">$pretty</a>&nbsp;$memory&nbsp;($calls)<br>\n";
187 }
188 }
189
190 print " </td>\n";
191
192 # Descendants, sorted descending by amount of memory allocated
193 print " <td>\n";
194 my $descendants = $Descendants{$node};
195 if ($descendants) {
196 foreach my $descendant (sort { $b->{"#memory#"} <=> $a->{"#memory#"} } @$descendants) {
197 my ($name, $memory, $calls) =
198 ($descendant->{"#name#"},
199 $descendant->{"#memory#"},
200 $descendant->{"#calls#"});
201
202 my $pretty = pretty($name);
203
204 print " <a href=\"#$Ids{$name}\">$pretty</a>&nbsp;$memory&nbsp;($calls)<br>\n";
205 }
206 }
207 print " </td></tr>\n";
208
209 if (--$maxrows == 0) {
210 print "</table>\n";
211 print "<table>\n";
212 print "<thead><tr><td>Function</td><td>Ancestors</td><td>Descendants</td></tr></thead>\n";
213 $maxrows = 100;
214 }
215 }
216
217 # Footer
218 print "</table>\n";
219 print "</body></html>\n";

Mercurial Repository: The Tor Browser

Europalab SCM Repository Server

mercurial