source: memlog2dot @ 81dea5b

Revision 81dea5b, 5.1 KB checked in by Hal Finkel <hfinkel@…>, 9 years ago (diff)

do the whole pdf conversion

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