source: memlog_analyze @ 4598848

Revision 4598848, 9.2 KB checked in by Hal Finkel <hfinkel@…>, 9 years ago (diff)

rename memlog2dot to memlog_analyze

  • Property mode set to 100755
RevLine 
[ebd57f8]1#! /usr/bin/env perl
2use strict;
3use File::Basename;
4
[81dea5b]5my $memlog_fn = $ARGV[0];
6my $out_dir = $ARGV[1] || '.';
7
[6bfe6a1]8my $print_raw_proc_name = 0;
9
[81dea5b]10if (! -f $memlog_fn) {
11  print "Usage: $0 <memlog file> [<output directory>]\n";
12  exit 1;
13}
14
[747d2b1]15# The version of addr2line and friends that you use can make a big difference,
16# especially on BE ppc64, where older versions of addr2line did not account
17# correctly for the function descriptor setup. At ALCF, on the BG/Q, we have
18# newer versions not in the default search path (from bgclang).
19my $alcf_bu_dir = '/soft/compilers/bgclang/current/binutils/bin';
20if (-d $alcf_bu_dir) {
21  $ENV{'PATH'} = $alcf_bu_dir . ':' . $ENV{'PATH'};
22}
23
[81dea5b]24open(MEMLOG, $memlog_fn) || die "Can't open $memlog_fn: $!";
25
[0edbc98]26# The first step is to determine the high-water mark.
27my $max_rss = 0;
28foreach my $line (<MEMLOG>) {
29  chomp($line);
30  my @parts = split(/\t/, $line);
31
32  my $op = shift(@parts);
33  my $state = shift(@parts);
34
35  my ($time, $then_max_rss, $tid) = split(/\s+/, $state);
36  if ($max_rss < $then_max_rss) {
37    $max_rss = $then_max_rss;
38  }
39}
40
41seek(MEMLOG, 0, 0);
42
43# Scan the log for malloc/free pairings. We're interested only in active
44# allocations at the time when the rss reaches the final maxrss.
45my $max_rss_time = 0;
46my %malloc_lines;
47foreach my $line (<MEMLOG>) {
48  chomp($line);
49  my @parts = split(/\t/, $line);
50
51  my $op = shift(@parts);
52  my $state = shift(@parts);
53
54  if ($op =~ /^M:/) {
55    my ($size, $ptr) = ($op =~ /^M: (\d+) 0x(\w+)/);
56    $malloc_lines{$ptr} = $line;
57  } elsif ($op =~ /^F:/) {
58    my ($ptr) = ($op =~ /^F: 0x(\w+)/);
59    delete $malloc_lines{$ptr};
60  } else {
61    next;
62  }
63
64  # If we've reached the max rss, we've seen all we need to see.
65  my ($time, $then_max_rss, $tid) = split(/\s+/, $state);
66  $max_rss_time = $time;
67  if ($then_max_rss == $max_rss) {
68    last;
69  }
70}
71
72close(MEMLOG);
73
74# Convert maxrss, currently in KB, to bytes.
75$max_rss *= 1024;
76
[ebd57f8]77my $total_size = 0;
78my %roots;
[c4f89cf]79my %all_nodes;
[0edbc98]80foreach my $line (values %malloc_lines) {
[ebd57f8]81  my @parts = split(/\t/, $line);
82
83  my $op = shift(@parts);
84  my $state = shift(@parts);
85
86  # Only dealing with allocations here...
87  if ($op !~ /^M:/) {
88    next;
89  }
90
91  my ($size, $ptr) = ($op =~ /^M: (\d+) 0x(\w+)/);
[0edbc98]92  my ($time, $then_max_rss, $tid) = split(/\s+/, $state);
[ebd57f8]93
94  $total_size += $size;
95
96  sub level_parts($) {
97    my $level = @_[0];
98    my ($file_name, $proc_name, $off, $pc, $relpc) =
99      ($level =~ /^(.*) \((.*)\+0x(\w+)\) \[0x(\w+) \(0x(\w+)\)\]/);
100
101    return ($file_name, $proc_name, $off, $pc, $relpc);
102  }
103
104  # Put the top of the stack first.
105  @parts = reverse(@parts);
106
107  my $parent = \%roots;
108  for (my $i = 0; $i < scalar(@parts); ++$i) {
109    my $level = $parts[$i];
110    my ($file_name, $proc_name, $off, $pc, $relpc) = level_parts($level);
111
112    # Skip this level if we don't even know from what file it came.
113    if ($file_name eq '?') {
114      next;
115    }
116
117    # print STDERR "parsed: $file_name, $proc_name, $off, $pc, $relpc\n";
118
[c4f89cf]119    if (!exists $all_nodes{$pc}) {
120      $all_nodes{$pc}->{'file_name'} = $file_name;
121      $all_nodes{$pc}->{'proc_name'} = $proc_name;
122      $all_nodes{$pc}->{'off'} = $off;
123      $all_nodes{$pc}->{'pc'} = $pc;
124      $all_nodes{$pc}->{'relpc'} = $relpc;
125    }
[ebd57f8]126
[c4f89cf]127    if (!exists $parent->{$pc}) {
128      $parent->{$pc} = $all_nodes{$pc};
[ebd57f8]129    }
130
131    $parent->{$pc}->{'size'} += $size;
132
133    my ($next_file_name, $next_proc_name, $next_off, $next_pc, $next_relpc);
134    if ($i < scalar(@parts)-1) {
135     my $next_level = $parts[$i+1];
136     ($next_file_name, $next_proc_name, $next_off, $next_pc, $next_relpc) =
137       level_parts($next_level);
138      $parent->{$pc}->{'child_sizes'}->{$next_pc} += $size;
139    }
140
141    if (!exists $parent->{'children'}) {
142      $parent->{'children'} = {};
143    }
144
145    $parent = $parent->{'children'};
146  }
147}
148
[20b45de]149my $txt_fn = "$out_dir/" . basename($memlog_fn) . ".txt";
[81dea5b]150my $dot_fn = "$out_dir/" . basename($memlog_fn) . ".dot";
151my $ps_fn = "$out_dir/" . basename($memlog_fn) . ".ps";
152my $pdf_fn = "$out_dir/" . basename($memlog_fn) . ".pdf";
153
[20b45de]154open(TXT, ">$txt_fn") || die "Can't open $txt_fn: $!";
[81dea5b]155open(DOT, ">$dot_fn") || die "Can't open $dot_fn: $!";
156
[ebd57f8]157sub format_bytes($) {
158  my @sizes = qw( B KB MB GB TB PB );
159  my $size = $_[0];
160
161  my $i = 0;
162  while ($size > 1024) {
163    $size /= 1024;
164    ++$i;
165  }
166
[4bd7a88]167  return sprintf("%.3f $sizes[$i]", $size);
[ebd57f8]168}
169
[bdaf020]170print DOT ("digraph \"memlog\" {\n");
[81dea5b]171print DOT ("size=\"8,11\";\n");
172print DOT ("node [width=0.375,height=0.25];\n");
[ebd57f8]173
[bdaf020]174printf DOT ("Legend [shape=box, fontsize=100, shape=oval," .
175            "label=\"Total: %s active at maxrss = %s after %s s\"];\n",
176            format_bytes($total_size), format_bytes($max_rss), $max_rss_time);
177
[20b45de]178printf TXT ("memlog: Total: %s active at maxrss = %s after %s s\n\n",
179            format_bytes($total_size), format_bytes($max_rss), $max_rss_time);
180
[ebd57f8]181my %cached_names;
182sub get_name($) {
183  my $node = $_[0];
184  my $pc = $node->{'pc'};
185
186  if (exists $cached_names{$pc}) {
187    return $cached_names{$pc};
188  }
189
190  my $ret = '';
191
192  # Prefer the relative offset (that is what we want for shared libraries), but
193  # if is not available, use the full offset (which is what we want for the
194  # base executable).
195  my $exe_off = $node->{'relpc'};
196  if (!$exe_off) {
197    $exe_off = $pc;
198  }
199
200  my $file_name = $node->{'file_name'};
[518793d]201
202  # If we don't have an absolute path, this is probably the base dynamic
203  # executable, so ask the shell which one it used (not foolproof because we
204  # might not have the same PATH now, but hopefully is generally the right
205  # thing).
206  if ($file_name !~ /^\//) {
207    $file_name = `which '$file_name'`;
208    chomp($file_name);
209  }
210
211  my ($func, $loc) = `addr2line -e '$file_name' -f 0x$exe_off`;
[ebd57f8]212  chomp($func);
213  chomp($loc);
214
215  if ($func !~ /^\?/) {
[6520ef5]216    # In general, this function name might look something like:
217    #   00000329.plt_call.wcsnrtombs@@GLIBC_2.3+0
[10599da]218    $func =~ s/@.*//; # Remove trailing symbol version strings
[ebd57f8]219    $func =~ s/.*\.//;
220    $func = `c++filt '$func'`;
221    chomp($func);
222
[1bd82e0]223    # It sometimes happens that addr2line is a bit too smart: when debugging
224    # information is available, it might print a local alias for the
225    # function instead of the full name (for example, printing 'List'
226    # instead of 'Foo::List<int>::List(int, int const&)').
227    if ($node->{'proc_name'} ne '?') {
228      my $proc_name = $node->{'proc_name'};
229      $proc_name = `c++filt '$proc_name'`;
230      chomp($proc_name);
231
232      if (length($proc_name) > length($func)) {
233        $func = $proc_name;
234      }
235    }
236
[081a0fa]237    $ret .= $func . '\n';
238
239    if ($loc !~ /^\?/) {
240      $ret .= $loc . '\n';
241    }
[4bd7a88]242  } elsif ($node->{'proc_name'} ne '?') {
243    my $proc_name = $node->{'proc_name'};
244    $proc_name = `c++filt '$proc_name'`;
245    chomp($proc_name);
246
247    $ret .= $proc_name . '\n';
[ebd57f8]248  }
249
[6bfe6a1]250  $ret .= $node->{'file_name'};
251  if ($print_raw_proc_name and $node->{'proc_name'} ne '?') {
252    $ret .= '\n' . $node->{'proc_name'} . '+0x' . $node->{'off'};
[ebd57f8]253  }
254
255  $cached_names{$pc} = $ret;
256  return $ret;
257}
258
[4bd7a88]259my $skip_frac = 0.01;
260my %skipped;
261
[c4f89cf]262foreach my $pc (keys %all_nodes) {
263  my $node = $all_nodes{$pc};
[ebd57f8]264
265  my $local_size = $node->{'size'};
[4bd7a88]266  if ($local_size * 1.0 / $total_size < $skip_frac) {
[c4f89cf]267    $skipped{$pc} = 1;
[4bd7a88]268    next;
269  }
[ebd57f8]270
271  my $fs = 8.0;
272  if ($local_size > 0) {
[4bd7a88]273    $fs = 50.0 * (abs($local_size * 1.0 / $total_size))**0.125;
[ebd57f8]274  }
275
[20b45de]276  my $name = get_name($node);
277
[81dea5b]278  printf DOT ("N%s [label=\"%s\\n%s\", shape=box, fontsize=%.1f%s];\n",
[c4f89cf]279    $pc, $name, format_bytes($local_size), $fs);
[ebd57f8]280}
281
[c4f89cf]282foreach my $pc (keys %all_nodes) {
283  if ($skipped{$pc}) {
[4bd7a88]284    next;
285  }
[ebd57f8]286
[20b45de]287  my $node = $all_nodes{$pc};
288  my $local_size = $node->{'size'};
289
[ebd57f8]290  foreach my $cpc (keys %{$node->{'child_sizes'}}) {
[4bd7a88]291    if ($skipped{$cpc}) {
292      next;
293    }
294
[ebd57f8]295    my $child_size = $node->{'child_sizes'}->{$cpc};
296    my $frac = $child_size * 1.0 / $local_size;
297
[4bd7a88]298    my $weight = 100.0 * sqrt($frac);
[6520ef5]299    my $style = sprintf("setlinewidth(%f)", 8.0 * sqrt($frac));
[ebd57f8]300
[6520ef5]301    my $fs = 40.0 * $frac**0.125;
302
[81dea5b]303    printf DOT ("N%s -> N%s [label=\"%s\", weight=%d, style=\"%s\", fontsize=%.1f];\n",
[6520ef5]304      $pc, $cpc, format_bytes($child_size), $weight, $style, $fs);
[ebd57f8]305  }
306}
307
[81dea5b]308print DOT ("}\n");
309
[20b45de]310foreach my $pc (sort { $all_nodes{$::b}->{'size'} <=>
311                       $all_nodes{$::a}->{'size'} } keys %all_nodes) {
312  if ($skipped{$pc}) {
313    next;
314  }
315
316  print TXT ('*' x 80) . "\n\n";
317
318  my $node = $all_nodes{$pc};
319
320  my $local_size = $node->{'size'};
321  printf TXT ("%s - %.1f%%\n", format_bytes($local_size),
322              $local_size * 100.0 / $total_size);
323
324  my $name = get_name($node);
325  $name =~ s/\\n/\n/g;
326
327  print TXT "$name\n$pc\n";
328
329  print TXT "\nMEMORY ALLOCATED BY CALLEES:\n";
330
331  foreach my $cpc (sort { $node->{'child_sizes'}->{$::b} <=>
332                          $node->{'child_sizes'}->{$::a} }
333                     keys %{$node->{'child_sizes'}}) {
334    if ($skipped{$cpc}) {
335      next;
336    }
337
338    my $child_node = $all_nodes{$cpc};
339    my $child_size = $node->{'child_sizes'}->{$cpc};
340
341    printf TXT ("\t%s - %.1f%%\n", format_bytes($child_size),
342                $child_size * 100.0 / $local_size);
343
344    my $child_name = get_name($child_node);
345    $child_name =~ s/\\n/\n\t/g;
346    print TXT "\t$child_name\n\t$cpc\n";
347
348    print TXT "\n";
349  }
350
351  print TXT "\n";
352}
353
354close(TXT);
[81dea5b]355close(DOT);
356
357system("dot -Tps2 < '$dot_fn' > '$ps_fn'");
358system("ps2pdf '$ps_fn' '$pdf_fn'");
359
360exit 0;
[ebd57f8]361
Note: See TracBrowser for help on using the repository browser.