source: memlog2dot @ 081a0fa

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

don't print file:line if it is unknown (even if we have the function name)

  • 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
[081a0fa]196    $ret .= $func . '\n';
197
198    if ($loc !~ /^\?/) {
199      $ret .= $loc . '\n';
200    }
[4bd7a88]201  } elsif ($node->{'proc_name'} ne '?') {
202    my $proc_name = $node->{'proc_name'};
203    $proc_name = `c++filt '$proc_name'`;
204    chomp($proc_name);
205
206    $ret .= $proc_name . '\n';
[ebd57f8]207  }
208
[6bfe6a1]209  $ret .= $node->{'file_name'};
210  if ($print_raw_proc_name and $node->{'proc_name'} ne '?') {
211    $ret .= '\n' . $node->{'proc_name'} . '+0x' . $node->{'off'};
[ebd57f8]212  }
213
214  $cached_names{$pc} = $ret;
215  return $ret;
216}
217
[4bd7a88]218my $skip_frac = 0.01;
219my %skipped;
220
[c4f89cf]221foreach my $pc (keys %all_nodes) {
222  my $node = $all_nodes{$pc};
[ebd57f8]223  my $name = get_name($node);
224
225  my $local_size = $node->{'size'};
[4bd7a88]226  if ($local_size * 1.0 / $total_size < $skip_frac) {
[c4f89cf]227    $skipped{$pc} = 1;
[4bd7a88]228    next;
229  }
[ebd57f8]230
231  my $fs = 8.0;
232  if ($local_size > 0) {
[4bd7a88]233    $fs = 50.0 * (abs($local_size * 1.0 / $total_size))**0.125;
[ebd57f8]234  }
235
[81dea5b]236  printf DOT ("N%s [label=\"%s\\n%s\", shape=box, fontsize=%.1f%s];\n",
[c4f89cf]237    $pc, $name, format_bytes($local_size), $fs);
[ebd57f8]238}
239
[c4f89cf]240foreach my $pc (keys %all_nodes) {
241  my $node = $all_nodes{$pc};
242
[ebd57f8]243  my $local_size = $node->{'size'};
[c4f89cf]244  if ($skipped{$pc}) {
[4bd7a88]245    next;
246  }
[ebd57f8]247
248  foreach my $cpc (keys %{$node->{'child_sizes'}}) {
[4bd7a88]249    if ($skipped{$cpc}) {
250      next;
251    }
252
[ebd57f8]253    my $child_size = $node->{'child_sizes'}->{$cpc};
254    my $frac = $child_size * 1.0 / $local_size;
255
[4bd7a88]256    my $weight = 100.0 * sqrt($frac);
[6520ef5]257    my $style = sprintf("setlinewidth(%f)", 8.0 * sqrt($frac));
[ebd57f8]258
[6520ef5]259    my $fs = 40.0 * $frac**0.125;
260
[81dea5b]261    printf DOT ("N%s -> N%s [label=\"%s\", weight=%d, style=\"%s\", fontsize=%.1f];\n",
[6520ef5]262      $pc, $cpc, format_bytes($child_size), $weight, $style, $fs);
[ebd57f8]263  }
264}
265
[81dea5b]266print DOT ("}\n");
267
268close(DOT);
269
270system("dot -Tps2 < '$dot_fn' > '$ps_fn'");
271system("ps2pdf '$ps_fn' '$pdf_fn'");
272
273exit 0;
[ebd57f8]274
Note: See TracBrowser for help on using the repository browser.