source: memlog_analyze @ 3533094

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

take -h for help too

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