source: memlog2dot @ 0edbc98

Revision 0edbc98, 6.4 KB checked in by Hal Finkel <hfinkel@…>, 9 years ago (diff)

only process allocations at the high-water mark

  • 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
15open(MEMLOG, $memlog_fn) || die "Can't open $memlog_fn: $!";
16
[0edbc98]17# The first step is to determine the high-water mark.
18my $max_rss = 0;
19foreach my $line (<MEMLOG>) {
20  chomp($line);
21  my @parts = split(/\t/, $line);
22
23  my $op = shift(@parts);
24  my $state = shift(@parts);
25
26  my ($time, $then_max_rss, $tid) = split(/\s+/, $state);
27  if ($max_rss < $then_max_rss) {
28    $max_rss = $then_max_rss;
29  }
30}
31
32seek(MEMLOG, 0, 0);
33
34# Scan the log for malloc/free pairings. We're interested only in active
35# allocations at the time when the rss reaches the final maxrss.
36my $max_rss_time = 0;
37my %malloc_lines;
38foreach my $line (<MEMLOG>) {
39  chomp($line);
40  my @parts = split(/\t/, $line);
41
42  my $op = shift(@parts);
43  my $state = shift(@parts);
44
45  if ($op =~ /^M:/) {
46    my ($size, $ptr) = ($op =~ /^M: (\d+) 0x(\w+)/);
47    $malloc_lines{$ptr} = $line;
48  } elsif ($op =~ /^F:/) {
49    my ($ptr) = ($op =~ /^F: 0x(\w+)/);
50    delete $malloc_lines{$ptr};
51  } else {
52    next;
53  }
54
55  # If we've reached the max rss, we've seen all we need to see.
56  my ($time, $then_max_rss, $tid) = split(/\s+/, $state);
57  $max_rss_time = $time;
58  if ($then_max_rss == $max_rss) {
59    last;
60  }
61}
62
63close(MEMLOG);
64
65# Convert maxrss, currently in KB, to bytes.
66$max_rss *= 1024;
67
[ebd57f8]68my $total_size = 0;
69my %roots;
[c4f89cf]70my %all_nodes;
[0edbc98]71foreach my $line (values %malloc_lines) {
[ebd57f8]72  my @parts = split(/\t/, $line);
73
74  my $op = shift(@parts);
75  my $state = shift(@parts);
76
77  # Only dealing with allocations here...
78  if ($op !~ /^M:/) {
79    next;
80  }
81
82  my ($size, $ptr) = ($op =~ /^M: (\d+) 0x(\w+)/);
[0edbc98]83  my ($time, $then_max_rss, $tid) = split(/\s+/, $state);
[ebd57f8]84
85  $total_size += $size;
86
87  sub level_parts($) {
88    my $level = @_[0];
89    my ($file_name, $proc_name, $off, $pc, $relpc) =
90      ($level =~ /^(.*) \((.*)\+0x(\w+)\) \[0x(\w+) \(0x(\w+)\)\]/);
91
92    return ($file_name, $proc_name, $off, $pc, $relpc);
93  }
94
95  # Put the top of the stack first.
96  @parts = reverse(@parts);
97
98  my $parent = \%roots;
99  for (my $i = 0; $i < scalar(@parts); ++$i) {
100    my $level = $parts[$i];
101    my ($file_name, $proc_name, $off, $pc, $relpc) = level_parts($level);
102
103    # Skip this level if we don't even know from what file it came.
104    if ($file_name eq '?') {
105      next;
106    }
107
108    # print STDERR "parsed: $file_name, $proc_name, $off, $pc, $relpc\n";
109
[c4f89cf]110    if (!exists $all_nodes{$pc}) {
111      $all_nodes{$pc}->{'file_name'} = $file_name;
112      $all_nodes{$pc}->{'proc_name'} = $proc_name;
113      $all_nodes{$pc}->{'off'} = $off;
114      $all_nodes{$pc}->{'pc'} = $pc;
115      $all_nodes{$pc}->{'relpc'} = $relpc;
116    }
[ebd57f8]117
[c4f89cf]118    if (!exists $parent->{$pc}) {
119      $parent->{$pc} = $all_nodes{$pc};
[ebd57f8]120    }
121
122    $parent->{$pc}->{'size'} += $size;
123
124    my ($next_file_name, $next_proc_name, $next_off, $next_pc, $next_relpc);
125    if ($i < scalar(@parts)-1) {
126     my $next_level = $parts[$i+1];
127     ($next_file_name, $next_proc_name, $next_off, $next_pc, $next_relpc) =
128       level_parts($next_level);
129      $parent->{$pc}->{'child_sizes'}->{$next_pc} += $size;
130    }
131
132    if (!exists $parent->{'children'}) {
133      $parent->{'children'} = {};
134    }
135
136    $parent = $parent->{'children'};
137  }
138}
139
[81dea5b]140my $dot_fn = "$out_dir/" . basename($memlog_fn) . ".dot";
141my $ps_fn = "$out_dir/" . basename($memlog_fn) . ".ps";
142my $pdf_fn = "$out_dir/" . basename($memlog_fn) . ".pdf";
143
144open(DOT, ">$dot_fn") || die "Can't open $dot_fn: $!";
145
[ebd57f8]146sub format_bytes($) {
147  my @sizes = qw( B KB MB GB TB PB );
148  my $size = $_[0];
149
150  my $i = 0;
151  while ($size > 1024) {
152    $size /= 1024;
153    ++$i;
154  }
155
[4bd7a88]156  return sprintf("%.3f $sizes[$i]", $size);
[ebd57f8]157}
158
[0edbc98]159printf DOT ("digraph \"memlog %s (maxrss = %s after %s s)\" {\n",
160            format_bytes($total_size), format_bytes($max_rss), $max_rss_time);
[81dea5b]161print DOT ("size=\"8,11\";\n");
162print DOT ("node [width=0.375,height=0.25];\n");
[ebd57f8]163
164my %cached_names;
165sub get_name($) {
166  my $node = $_[0];
167  my $pc = $node->{'pc'};
168
169  if (exists $cached_names{$pc}) {
170    return $cached_names{$pc};
171  }
172
173  my $ret = '';
174
175  # Prefer the relative offset (that is what we want for shared libraries), but
176  # if is not available, use the full offset (which is what we want for the
177  # base executable).
178  my $exe_off = $node->{'relpc'};
179  if (!$exe_off) {
180    $exe_off = $pc;
181  }
182
183  my $file_name = $node->{'file_name'};
184  my ($func, $loc) = `addr2line -e $file_name -f 0x$exe_off`;
185  chomp($func);
186  chomp($loc);
187
188  if ($func !~ /^\?/) {
[6520ef5]189    # In general, this function name might look something like:
190    #   00000329.plt_call.wcsnrtombs@@GLIBC_2.3+0
191    $func =~ s/@.*//;
[ebd57f8]192    $func =~ s/.*\.//;
193    $func = `c++filt '$func'`;
194    chomp($func);
195
196    $ret .= $func . '\n' . $loc . '\n';
[4bd7a88]197  } elsif ($node->{'proc_name'} ne '?') {
198    my $proc_name = $node->{'proc_name'};
199    $proc_name = `c++filt '$proc_name'`;
200    chomp($proc_name);
201
202    $ret .= $proc_name . '\n';
[ebd57f8]203  }
204
[6bfe6a1]205  $ret .= $node->{'file_name'};
206  if ($print_raw_proc_name and $node->{'proc_name'} ne '?') {
207    $ret .= '\n' . $node->{'proc_name'} . '+0x' . $node->{'off'};
[ebd57f8]208  }
209
210  $cached_names{$pc} = $ret;
211  return $ret;
212}
213
[4bd7a88]214my $skip_frac = 0.01;
215my %skipped;
216
[c4f89cf]217foreach my $pc (keys %all_nodes) {
218  my $node = $all_nodes{$pc};
[ebd57f8]219  my $name = get_name($node);
220
221  my $local_size = $node->{'size'};
[4bd7a88]222  if ($local_size * 1.0 / $total_size < $skip_frac) {
[c4f89cf]223    $skipped{$pc} = 1;
[4bd7a88]224    next;
225  }
[ebd57f8]226
227  my $fs = 8.0;
228  if ($local_size > 0) {
[4bd7a88]229    $fs = 50.0 * (abs($local_size * 1.0 / $total_size))**0.125;
[ebd57f8]230  }
231
[81dea5b]232  printf DOT ("N%s [label=\"%s\\n%s\", shape=box, fontsize=%.1f%s];\n",
[c4f89cf]233    $pc, $name, format_bytes($local_size), $fs);
[ebd57f8]234}
235
[c4f89cf]236foreach my $pc (keys %all_nodes) {
237  my $node = $all_nodes{$pc};
238
[ebd57f8]239  my $local_size = $node->{'size'};
[c4f89cf]240  if ($skipped{$pc}) {
[4bd7a88]241    next;
242  }
[ebd57f8]243
244  foreach my $cpc (keys %{$node->{'child_sizes'}}) {
[4bd7a88]245    if ($skipped{$cpc}) {
246      next;
247    }
248
[ebd57f8]249    my $child_size = $node->{'child_sizes'}->{$cpc};
250    my $frac = $child_size * 1.0 / $local_size;
251
[4bd7a88]252    my $weight = 100.0 * sqrt($frac);
[6520ef5]253    my $style = sprintf("setlinewidth(%f)", 8.0 * sqrt($frac));
[ebd57f8]254
[6520ef5]255    my $fs = 40.0 * $frac**0.125;
256
[81dea5b]257    printf DOT ("N%s -> N%s [label=\"%s\", weight=%d, style=\"%s\", fontsize=%.1f];\n",
[6520ef5]258      $pc, $cpc, format_bytes($child_size), $weight, $style, $fs);
[ebd57f8]259  }
260}
261
[81dea5b]262print DOT ("}\n");
263
264close(DOT);
265
266system("dot -Tps2 < '$dot_fn' > '$ps_fn'");
267system("ps2pdf '$ps_fn' '$pdf_fn'");
268
269exit 0;
[ebd57f8]270
Note: See TracBrowser for help on using the repository browser.