source: memlog_analyze @ 21d3542

Revision 21d3542, 11.7 KB checked in by Hal Finkel <hfinkel@…>, 9 years ago (diff)

collect and report on mmap totals

  • Property mode set to 100755
RevLine 
[ebd57f8]1#! /usr/bin/env perl
2use strict;
3use File::Basename;
[c83befc]4use File::Path qw(make_path);
[c49b79c]5use Getopt::Long;
6
[9fcaba3]7my $find_leaks = 0;
[c49b79c]8my $print_raw_proc_name = 0;
9my $quiet = 0;
10my $help = 0;
11
12sub print_usage($) {
13  my $ec = $_[0];
14  my $usage = <<EOM;
[5df7203]15Usage: $0 [options] <memlog file or glob> [<output directory>]
[c49b79c]16  options:
[9fcaba3]17    --leaks
18      Provide information on leaks instead of peak usage
[c49b79c]19    --print-symbol-names
20      Include symbol names and offsets in the output
21    --quiet or -q
22      Don't print status messages while running
23EOM
24
25  print $usage;
26  exit($ec);
27}
28
[3533094]29GetOptions("help|h|?" => \$help,
[9fcaba3]30           "leaks" => \$find_leaks,
[c49b79c]31           "print-symbol-names" => \$print_raw_proc_name,
32           "quiet|q" => \$quiet)
33  or print_usage(1);
34
35if ($help) {
36  print_usage(0);
37}
[ebd57f8]38
[c83befc]39if (scalar(@ARGV) > 2) {
[d270799]40  print_usage(2);
41}
42
[81dea5b]43my $memlog_fn = $ARGV[0];
44my $out_dir = $ARGV[1] || '.';
45
[c83befc]46make_path($out_dir);
47
[81dea5b]48if (! -f $memlog_fn) {
[5df7203]49  my @pot_fns = glob($memlog_fn);
50  if (scalar(@pot_fns)) {
51    if (!$quiet) {
52      print "Searching all files matching '$memlog_fn'\n";
53    }
54
55    my $pot_max_rss = 0;
56    my $pos_max_rss_fn;
57    foreach my $pot_fn (@pot_fns) {
58      my $last_line = `tail -n 1 '$pot_fn'`;
59      chomp($last_line);
60
61      my @parts = split(/\t/, $last_line);
62
63      my $op = shift(@parts);
64      my $state = shift(@parts);
65
[21d3542]66      my ($time, $then_max_rss, $tid, $then_arena, $then_mmap) =
67        split(/\s+/, $state);
[5df7203]68      if ($pot_max_rss < $then_max_rss) {
69        $pot_max_rss = $then_max_rss;
70        $pos_max_rss_fn = $pot_fn;
71      }
72    }
73
74    if (defined $pos_max_rss_fn) {
75      $memlog_fn = $pos_max_rss_fn;
76      goto have_memlog_fn;
77    }
78  }
79
[c49b79c]80  print_usage(1);
[81dea5b]81}
[5df7203]82have_memlog_fn:
[81dea5b]83
[747d2b1]84# The version of addr2line and friends that you use can make a big difference,
85# especially on BE ppc64, where older versions of addr2line did not account
86# correctly for the function descriptor setup. At ALCF, on the BG/Q, we have
87# newer versions not in the default search path (from bgclang).
88my $alcf_bu_dir = '/soft/compilers/bgclang/current/binutils/bin';
89if (-d $alcf_bu_dir) {
90  $ENV{'PATH'} = $alcf_bu_dir . ':' . $ENV{'PATH'};
91}
92
[81dea5b]93open(MEMLOG, $memlog_fn) || die "Can't open $memlog_fn: $!";
94
[0edbc98]95# The first step is to determine the high-water mark.
96my $max_rss = 0;
[21d3542]97my $arena = 0;
98my $mmap = 0;
[0edbc98]99foreach my $line (<MEMLOG>) {
100  chomp($line);
101  my @parts = split(/\t/, $line);
102
103  my $op = shift(@parts);
104  my $state = shift(@parts);
105
[21d3542]106  my ($time, $then_max_rss, $tid, $then_arena, $then_mmap) =
107    split(/\s+/, $state);
[0edbc98]108  if ($max_rss < $then_max_rss) {
109    $max_rss = $then_max_rss;
[21d3542]110    $arena = $then_arena;
111    $mmap = $then_mmap;
[0edbc98]112  }
113}
114
115seek(MEMLOG, 0, 0);
116
117# Scan the log for malloc/free pairings. We're interested only in active
118# allocations at the time when the rss reaches the final maxrss.
[9fcaba3]119# If we're finding leaks, then go to the very end.
120my $active_alloc_time = 0;
[0edbc98]121my %malloc_lines;
122foreach my $line (<MEMLOG>) {
123  chomp($line);
124  my @parts = split(/\t/, $line);
125
126  my $op = shift(@parts);
127  my $state = shift(@parts);
128
129  if ($op =~ /^M:/) {
130    my ($size, $ptr) = ($op =~ /^M: (\d+) 0x(\w+)/);
131    $malloc_lines{$ptr} = $line;
132  } elsif ($op =~ /^F:/) {
133    my ($ptr) = ($op =~ /^F: 0x(\w+)/);
134    delete $malloc_lines{$ptr};
135  } else {
136    next;
137  }
138
[21d3542]139  my ($time, $then_max_rss, $tid, $then_arena, $then_mmap) =
140    split(/\s+/, $state);
[9fcaba3]141  $active_alloc_time = $time;
142
143  if (!$find_leaks) {
144    # If we've reached the max rss, we've seen all we need to see.
145    if ($then_max_rss == $max_rss) {
146      last;
147    }
[0edbc98]148  }
149}
150
151close(MEMLOG);
152
153# Convert maxrss, currently in KB, to bytes.
154$max_rss *= 1024;
[21d3542]155if (defined $arena) {
156  $arena *= 1024;
157}
158if (defined $mmap) {
159  $mmap *= 1024;
160}
[0edbc98]161
[ebd57f8]162my $total_size = 0;
163my %roots;
[c4f89cf]164my %all_nodes;
[0edbc98]165foreach my $line (values %malloc_lines) {
[ebd57f8]166  my @parts = split(/\t/, $line);
167
168  my $op = shift(@parts);
169  my $state = shift(@parts);
170
171  # Only dealing with allocations here...
172  if ($op !~ /^M:/) {
173    next;
174  }
175
176  my ($size, $ptr) = ($op =~ /^M: (\d+) 0x(\w+)/);
[21d3542]177  my ($time, $then_max_rss, $tid, $then_arena, $then_mmap) =
178    split(/\s+/, $state);
[ebd57f8]179
180  $total_size += $size;
181
182  sub level_parts($) {
183    my $level = @_[0];
184    my ($file_name, $proc_name, $off, $pc, $relpc) =
185      ($level =~ /^(.*) \((.*)\+0x(\w+)\) \[0x(\w+) \(0x(\w+)\)\]/);
186
187    return ($file_name, $proc_name, $off, $pc, $relpc);
188  }
189
190  # Put the top of the stack first.
191  @parts = reverse(@parts);
192
193  my $parent = \%roots;
194  for (my $i = 0; $i < scalar(@parts); ++$i) {
195    my $level = $parts[$i];
196    my ($file_name, $proc_name, $off, $pc, $relpc) = level_parts($level);
197
198    # Skip this level if we don't even know from what file it came.
199    if ($file_name eq '?') {
200      next;
201    }
202
203    # print STDERR "parsed: $file_name, $proc_name, $off, $pc, $relpc\n";
204
[c4f89cf]205    if (!exists $all_nodes{$pc}) {
206      $all_nodes{$pc}->{'file_name'} = $file_name;
207      $all_nodes{$pc}->{'proc_name'} = $proc_name;
208      $all_nodes{$pc}->{'off'} = $off;
209      $all_nodes{$pc}->{'pc'} = $pc;
210      $all_nodes{$pc}->{'relpc'} = $relpc;
211    }
[ebd57f8]212
[c4f89cf]213    if (!exists $parent->{$pc}) {
214      $parent->{$pc} = $all_nodes{$pc};
[ebd57f8]215    }
216
217    $parent->{$pc}->{'size'} += $size;
218
219    my ($next_file_name, $next_proc_name, $next_off, $next_pc, $next_relpc);
220    if ($i < scalar(@parts)-1) {
221     my $next_level = $parts[$i+1];
222     ($next_file_name, $next_proc_name, $next_off, $next_pc, $next_relpc) =
223       level_parts($next_level);
224      $parent->{$pc}->{'child_sizes'}->{$next_pc} += $size;
225    }
226
227    if (!exists $parent->{'children'}) {
228      $parent->{'children'} = {};
229    }
230
231    $parent = $parent->{'children'};
232  }
233}
234
[20b45de]235my $txt_fn = "$out_dir/" . basename($memlog_fn) . ".txt";
[81dea5b]236my $dot_fn = "$out_dir/" . basename($memlog_fn) . ".dot";
237my $ps_fn = "$out_dir/" . basename($memlog_fn) . ".ps";
238my $pdf_fn = "$out_dir/" . basename($memlog_fn) . ".pdf";
239
[c49b79c]240if (!$quiet) {
241  print "Creating $txt_fn\n";
242}
243
[20b45de]244open(TXT, ">$txt_fn") || die "Can't open $txt_fn: $!";
[c49b79c]245
246if (!$quiet) {
247  print "Creating $dot_fn\n";
248}
249
[81dea5b]250open(DOT, ">$dot_fn") || die "Can't open $dot_fn: $!";
251
[ebd57f8]252sub format_bytes($) {
253  my @sizes = qw( B KB MB GB TB PB );
254  my $size = $_[0];
255
256  my $i = 0;
257  while ($size > 1024) {
258    $size /= 1024;
259    ++$i;
260  }
261
[4bd7a88]262  return sprintf("%.3f $sizes[$i]", $size);
[ebd57f8]263}
264
[21d3542]265sub format_bytes_or_unk($) {
266  my $b = $_[0];
267  return defined($b) ? format_bytes($b) : "(unknown)";
268}
269
[bdaf020]270print DOT ("digraph \"memlog\" {\n");
[81dea5b]271print DOT ("size=\"8,11\";\n");
272print DOT ("node [width=0.375,height=0.25];\n");
[ebd57f8]273
[9fcaba3]274my $find_type = $find_leaks ? " (leaks)" : "";
[21d3542]275print DOT "subgraph cluster_key {\n";
276print DOT "\trank=min;\n";
277print DOT "\tlabel=\"memlog\";\n";
278print DOT "\tfontsize=100;\n";
279print DOT "\trankdir=UR;\n";
280printf DOT ("Legend [shape=box, fontsize=100, shape=plaintext," .
281            "label=\"Total: %s active$find_type at maxrss = %s after %s s\\narena: %s\\nmmap: %s\"];\n",
[9fcaba3]282            format_bytes($total_size), format_bytes($max_rss),
[21d3542]283            $active_alloc_time, format_bytes_or_unk($arena),
284            format_bytes_or_unk($mmap));
285print DOT "}\n";
[bdaf020]286
[21d3542]287printf TXT ("memlog: Total: %s active$find_type at maxrss = %s after %s s\n\tarena: %s\tmmap: %s\n\n",
[9fcaba3]288            format_bytes($total_size), format_bytes($max_rss),
[21d3542]289            $active_alloc_time, format_bytes_or_unk($arena),
290            format_bytes_or_unk($mmap));
[20b45de]291
[ebd57f8]292my %cached_names;
293sub get_name($) {
294  my $node = $_[0];
295  my $pc = $node->{'pc'};
296
297  if (exists $cached_names{$pc}) {
298    return $cached_names{$pc};
299  }
300
301  my $ret = '';
302
303  # Prefer the relative offset (that is what we want for shared libraries), but
304  # if is not available, use the full offset (which is what we want for the
305  # base executable).
306  my $exe_off = $node->{'relpc'};
307  if (!$exe_off) {
308    $exe_off = $pc;
309  }
310
311  my $file_name = $node->{'file_name'};
[518793d]312
313  # If we don't have an absolute path, this is probably the base dynamic
314  # executable, so ask the shell which one it used (not foolproof because we
315  # might not have the same PATH now, but hopefully is generally the right
316  # thing).
317  if ($file_name !~ /^\//) {
318    $file_name = `which '$file_name'`;
319    chomp($file_name);
320  }
321
322  my ($func, $loc) = `addr2line -e '$file_name' -f 0x$exe_off`;
[ebd57f8]323  chomp($func);
324  chomp($loc);
325
326  if ($func !~ /^\?/) {
[6520ef5]327    # In general, this function name might look something like:
328    #   00000329.plt_call.wcsnrtombs@@GLIBC_2.3+0
[10599da]329    $func =~ s/@.*//; # Remove trailing symbol version strings
[ebd57f8]330    $func =~ s/.*\.//;
331    $func = `c++filt '$func'`;
332    chomp($func);
333
[1bd82e0]334    # It sometimes happens that addr2line is a bit too smart: when debugging
335    # information is available, it might print a local alias for the
336    # function instead of the full name (for example, printing 'List'
337    # instead of 'Foo::List<int>::List(int, int const&)').
338    if ($node->{'proc_name'} ne '?') {
339      my $proc_name = $node->{'proc_name'};
340      $proc_name = `c++filt '$proc_name'`;
341      chomp($proc_name);
342
343      if (length($proc_name) > length($func)) {
344        $func = $proc_name;
345      }
346    }
347
[081a0fa]348    $ret .= $func . '\n';
349
[77ebdb8]350    if ($loc !~ /^[:?]/) {
[081a0fa]351      $ret .= $loc . '\n';
352    }
[4bd7a88]353  } elsif ($node->{'proc_name'} ne '?') {
354    my $proc_name = $node->{'proc_name'};
355    $proc_name = `c++filt '$proc_name'`;
356    chomp($proc_name);
357
358    $ret .= $proc_name . '\n';
[ebd57f8]359  }
360
[6bfe6a1]361  $ret .= $node->{'file_name'};
362  if ($print_raw_proc_name and $node->{'proc_name'} ne '?') {
363    $ret .= '\n' . $node->{'proc_name'} . '+0x' . $node->{'off'};
[ebd57f8]364  }
365
366  $cached_names{$pc} = $ret;
367  return $ret;
368}
369
[4bd7a88]370my $skip_frac = 0.01;
371my %skipped;
372
[c4f89cf]373foreach my $pc (keys %all_nodes) {
374  my $node = $all_nodes{$pc};
[ebd57f8]375
376  my $local_size = $node->{'size'};
[4bd7a88]377  if ($local_size * 1.0 / $total_size < $skip_frac) {
[c4f89cf]378    $skipped{$pc} = 1;
[4bd7a88]379    next;
380  }
[ebd57f8]381
382  my $fs = 8.0;
383  if ($local_size > 0) {
[4bd7a88]384    $fs = 50.0 * (abs($local_size * 1.0 / $total_size))**0.125;
[ebd57f8]385  }
386
[20b45de]387  my $name = get_name($node);
388
[81dea5b]389  printf DOT ("N%s [label=\"%s\\n%s\", shape=box, fontsize=%.1f%s];\n",
[c4f89cf]390    $pc, $name, format_bytes($local_size), $fs);
[ebd57f8]391}
392
[c4f89cf]393foreach my $pc (keys %all_nodes) {
394  if ($skipped{$pc}) {
[4bd7a88]395    next;
396  }
[ebd57f8]397
[20b45de]398  my $node = $all_nodes{$pc};
399  my $local_size = $node->{'size'};
400
[ebd57f8]401  foreach my $cpc (keys %{$node->{'child_sizes'}}) {
[4bd7a88]402    if ($skipped{$cpc}) {
403      next;
404    }
405
[ebd57f8]406    my $child_size = $node->{'child_sizes'}->{$cpc};
407    my $frac = $child_size * 1.0 / $local_size;
408
[4bd7a88]409    my $weight = 100.0 * sqrt($frac);
[6520ef5]410    my $style = sprintf("setlinewidth(%f)", 8.0 * sqrt($frac));
[ebd57f8]411
[6520ef5]412    my $fs = 40.0 * $frac**0.125;
413
[81dea5b]414    printf DOT ("N%s -> N%s [label=\"%s\", weight=%d, style=\"%s\", fontsize=%.1f];\n",
[6520ef5]415      $pc, $cpc, format_bytes($child_size), $weight, $style, $fs);
[ebd57f8]416  }
417}
418
[81dea5b]419print DOT ("}\n");
420
[20b45de]421foreach my $pc (sort { $all_nodes{$::b}->{'size'} <=>
422                       $all_nodes{$::a}->{'size'} } keys %all_nodes) {
423  if ($skipped{$pc}) {
424    next;
425  }
426
427  print TXT ('*' x 80) . "\n\n";
428
429  my $node = $all_nodes{$pc};
430
431  my $local_size = $node->{'size'};
432  printf TXT ("%s - %.1f%%\n", format_bytes($local_size),
433              $local_size * 100.0 / $total_size);
434
435  my $name = get_name($node);
436  $name =~ s/\\n/\n/g;
437
438  print TXT "$name\n$pc\n";
439
440  print TXT "\nMEMORY ALLOCATED BY CALLEES:\n";
441
442  foreach my $cpc (sort { $node->{'child_sizes'}->{$::b} <=>
443                          $node->{'child_sizes'}->{$::a} }
444                     keys %{$node->{'child_sizes'}}) {
445    if ($skipped{$cpc}) {
446      next;
447    }
448
449    my $child_node = $all_nodes{$cpc};
450    my $child_size = $node->{'child_sizes'}->{$cpc};
451
452    printf TXT ("\t%s - %.1f%%\n", format_bytes($child_size),
453                $child_size * 100.0 / $local_size);
454
455    my $child_name = get_name($child_node);
456    $child_name =~ s/\\n/\n\t/g;
457    print TXT "\t$child_name\n\t$cpc\n";
458
459    print TXT "\n";
460  }
461
462  print TXT "\n";
463}
464
465close(TXT);
[81dea5b]466close(DOT);
467
[c49b79c]468if (!$quiet) {
469  print "Creating $ps_fn\n";
470}
471
[81dea5b]472system("dot -Tps2 < '$dot_fn' > '$ps_fn'");
[c49b79c]473
474if (!$quiet) {
475  print "Creating $pdf_fn\n";
476}
477
[81dea5b]478system("ps2pdf '$ps_fn' '$pdf_fn'");
479
480exit 0;
[ebd57f8]481
Note: See TracBrowser for help on using the repository browser.