source: memlog2dot @ c4f89cf

Revision c4f89cf, 4.3 KB checked in by Hal Finkel <hfinkel@…>, 9 years ago (diff)

common nodes correctly

  • 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 !~ /^\?/) {
120    $func =~ s/.*\.//;
121    $func = `c++filt '$func'`;
122    chomp($func);
123
124    $ret .= $func . '\n' . $loc . '\n';
[4bd7a88]125  } elsif ($node->{'proc_name'} ne '?') {
126    my $proc_name = $node->{'proc_name'};
127    $proc_name = `c++filt '$proc_name'`;
128    chomp($proc_name);
129
130    $ret .= $proc_name . '\n';
[ebd57f8]131  }
132
133  $ret .= basename($node->{'file_name'});
134  if ($node->{'proc_name'} ne '?') {
135    $ret .= ' (' . $node->{'proc_name'} . '+0x' . $node->{'off'} . ')';
136  }
137
138  $cached_names{$pc} = $ret;
139  return $ret;
140}
141
[4bd7a88]142my $skip_frac = 0.01;
143my %skipped;
144
[c4f89cf]145foreach my $pc (keys %all_nodes) {
146  my $node = $all_nodes{$pc};
[ebd57f8]147  my $name = get_name($node);
148
149  my $local_size = $node->{'size'};
[4bd7a88]150  if ($local_size * 1.0 / $total_size < $skip_frac) {
[c4f89cf]151    $skipped{$pc} = 1;
[4bd7a88]152    next;
153  }
[ebd57f8]154
155  my $fs = 8.0;
156  if ($local_size > 0) {
[4bd7a88]157    $fs = 50.0 * (abs($local_size * 1.0 / $total_size))**0.125;
[ebd57f8]158  }
159
160  printf("N%s [label=\"%s\\n%s\", shape=box,fontsize=%.1f%s];\n",
[c4f89cf]161    $pc, $name, format_bytes($local_size), $fs);
[ebd57f8]162}
163
[c4f89cf]164foreach my $pc (keys %all_nodes) {
165  my $node = $all_nodes{$pc};
166
[ebd57f8]167  my $local_size = $node->{'size'};
[c4f89cf]168  if ($skipped{$pc}) {
[4bd7a88]169    next;
170  }
[ebd57f8]171
172  foreach my $cpc (keys %{$node->{'child_sizes'}}) {
[4bd7a88]173    if ($skipped{$cpc}) {
174      next;
175    }
176
[ebd57f8]177    my $child_size = $node->{'child_sizes'}->{$cpc};
178    my $frac = $child_size * 1.0 / $local_size;
179
[4bd7a88]180    my $weight = 100.0 * sqrt($frac);
181    my $style = sprintf("setlinewidth(%f)", 3.0 * sqrt($frac));
[ebd57f8]182
183    printf("N%s -> N%s [label=\"%s\", weight=%d, style=\"%s\"];\n",
[c4f89cf]184      $pc, $cpc, format_bytes($child_size), $weight, $style);
[ebd57f8]185  }
186}
187
188print("}\n");
189
Note: See TracBrowser for help on using the repository browser.