source: memlog2dot @ 20b45de

Revision 20b45de, 8.8 KB checked in by Hal Finkel <hfinkel@…>, 9 years ago (diff)

add a txt output too for analysis

  • 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'};
201  my ($func, $loc) = `addr2line -e $file_name -f 0x$exe_off`;
202  chomp($func);
203  chomp($loc);
204
205  if ($func !~ /^\?/) {
[6520ef5]206    # In general, this function name might look something like:
207    #   00000329.plt_call.wcsnrtombs@@GLIBC_2.3+0
[10599da]208    $func =~ s/@.*//; # Remove trailing symbol version strings
[ebd57f8]209    $func =~ s/.*\.//;
210    $func = `c++filt '$func'`;
211    chomp($func);
212
[1bd82e0]213    # It sometimes happens that addr2line is a bit too smart: when debugging
214    # information is available, it might print a local alias for the
215    # function instead of the full name (for example, printing 'List'
216    # instead of 'Foo::List<int>::List(int, int const&)').
217    if ($node->{'proc_name'} ne '?') {
218      my $proc_name = $node->{'proc_name'};
219      $proc_name = `c++filt '$proc_name'`;
220      chomp($proc_name);
221
222      if (length($proc_name) > length($func)) {
223        $func = $proc_name;
224      }
225    }
226
[081a0fa]227    $ret .= $func . '\n';
228
229    if ($loc !~ /^\?/) {
230      $ret .= $loc . '\n';
231    }
[4bd7a88]232  } elsif ($node->{'proc_name'} ne '?') {
233    my $proc_name = $node->{'proc_name'};
234    $proc_name = `c++filt '$proc_name'`;
235    chomp($proc_name);
236
237    $ret .= $proc_name . '\n';
[ebd57f8]238  }
239
[6bfe6a1]240  $ret .= $node->{'file_name'};
241  if ($print_raw_proc_name and $node->{'proc_name'} ne '?') {
242    $ret .= '\n' . $node->{'proc_name'} . '+0x' . $node->{'off'};
[ebd57f8]243  }
244
245  $cached_names{$pc} = $ret;
246  return $ret;
247}
248
[4bd7a88]249my $skip_frac = 0.01;
250my %skipped;
251
[c4f89cf]252foreach my $pc (keys %all_nodes) {
253  my $node = $all_nodes{$pc};
[ebd57f8]254
255  my $local_size = $node->{'size'};
[4bd7a88]256  if ($local_size * 1.0 / $total_size < $skip_frac) {
[c4f89cf]257    $skipped{$pc} = 1;
[4bd7a88]258    next;
259  }
[ebd57f8]260
261  my $fs = 8.0;
262  if ($local_size > 0) {
[4bd7a88]263    $fs = 50.0 * (abs($local_size * 1.0 / $total_size))**0.125;
[ebd57f8]264  }
265
[20b45de]266  my $name = get_name($node);
267
[81dea5b]268  printf DOT ("N%s [label=\"%s\\n%s\", shape=box, fontsize=%.1f%s];\n",
[c4f89cf]269    $pc, $name, format_bytes($local_size), $fs);
[ebd57f8]270}
271
[c4f89cf]272foreach my $pc (keys %all_nodes) {
273  if ($skipped{$pc}) {
[4bd7a88]274    next;
275  }
[ebd57f8]276
[20b45de]277  my $node = $all_nodes{$pc};
278  my $local_size = $node->{'size'};
279
[ebd57f8]280  foreach my $cpc (keys %{$node->{'child_sizes'}}) {
[4bd7a88]281    if ($skipped{$cpc}) {
282      next;
283    }
284
[ebd57f8]285    my $child_size = $node->{'child_sizes'}->{$cpc};
286    my $frac = $child_size * 1.0 / $local_size;
287
[4bd7a88]288    my $weight = 100.0 * sqrt($frac);
[6520ef5]289    my $style = sprintf("setlinewidth(%f)", 8.0 * sqrt($frac));
[ebd57f8]290
[6520ef5]291    my $fs = 40.0 * $frac**0.125;
292
[81dea5b]293    printf DOT ("N%s -> N%s [label=\"%s\", weight=%d, style=\"%s\", fontsize=%.1f];\n",
[6520ef5]294      $pc, $cpc, format_bytes($child_size), $weight, $style, $fs);
[ebd57f8]295  }
296}
297
[81dea5b]298print DOT ("}\n");
299
[20b45de]300foreach my $pc (sort { $all_nodes{$::b}->{'size'} <=>
301                       $all_nodes{$::a}->{'size'} } keys %all_nodes) {
302  if ($skipped{$pc}) {
303    next;
304  }
305
306  print TXT ('*' x 80) . "\n\n";
307
308  my $node = $all_nodes{$pc};
309
310  my $local_size = $node->{'size'};
311  printf TXT ("%s - %.1f%%\n", format_bytes($local_size),
312              $local_size * 100.0 / $total_size);
313
314  my $name = get_name($node);
315  $name =~ s/\\n/\n/g;
316
317  print TXT "$name\n$pc\n";
318
319  print TXT "\nMEMORY ALLOCATED BY CALLEES:\n";
320
321  foreach my $cpc (sort { $node->{'child_sizes'}->{$::b} <=>
322                          $node->{'child_sizes'}->{$::a} }
323                     keys %{$node->{'child_sizes'}}) {
324    if ($skipped{$cpc}) {
325      next;
326    }
327
328    my $child_node = $all_nodes{$cpc};
329    my $child_size = $node->{'child_sizes'}->{$cpc};
330
331    printf TXT ("\t%s - %.1f%%\n", format_bytes($child_size),
332                $child_size * 100.0 / $local_size);
333
334    my $child_name = get_name($child_node);
335    $child_name =~ s/\\n/\n\t/g;
336    print TXT "\t$child_name\n\t$cpc\n";
337
338    print TXT "\n";
339  }
340
341  print TXT "\n";
342}
343
344close(TXT);
[81dea5b]345close(DOT);
346
347system("dot -Tps2 < '$dot_fn' > '$ps_fn'");
348system("ps2pdf '$ps_fn' '$pdf_fn'");
349
350exit 0;
[ebd57f8]351
Note: See TracBrowser for help on using the repository browser.