source: memlog2dot @ 6520ef5

Revision 6520ef5, 4.5 KB checked in by Hal Finkel <hfinkel@…>, 9 years ago (diff)

fix edge font sizes and function printing

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