source: memlog2dot @ 4bd7a88

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

working on filtering nodes...

  • Property mode set to 100755
RevLine 
[ebd57f8]1#! /usr/bin/env perl
2use strict;
3use File::Basename;
4
5my $total_size = 0;
6my %roots;
7my @all_nodes;
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
48    if (!exists $parent->{$pc}) {
49      $parent->{$pc}->{'file_name'} = $file_name;
50      $parent->{$pc}->{'proc_name'} = $proc_name;
51      $parent->{$pc}->{'off'} = $off;
52      $parent->{$pc}->{'pc'} = $pc;
53      $parent->{$pc}->{'relpc'} = $relpc;
54
55      push(@all_nodes, $parent->{$pc});
56    }
57
58    $parent->{$pc}->{'size'} += $size;
59
60    my ($next_file_name, $next_proc_name, $next_off, $next_pc, $next_relpc);
61    if ($i < scalar(@parts)-1) {
62     my $next_level = $parts[$i+1];
63     ($next_file_name, $next_proc_name, $next_off, $next_pc, $next_relpc) =
64       level_parts($next_level);
65      $parent->{$pc}->{'child_sizes'}->{$next_pc} += $size;
66    }
67
68    if (!exists $parent->{'children'}) {
69      $parent->{'children'} = {};
70    }
71
72    $parent = $parent->{'children'};
73  }
74}
75
76sub format_bytes($) {
77  my @sizes = qw( B KB MB GB TB PB );
78  my $size = $_[0];
79
80  my $i = 0;
81  while ($size > 1024) {
82    $size /= 1024;
83    ++$i;
84  }
85
[4bd7a88]86  return sprintf("%.3f $sizes[$i]", $size);
[ebd57f8]87}
88
89printf("digraph \"memlog %s\" {\n", format_bytes($total_size));
[4bd7a88]90print("size=\"8,11\";\n");
[ebd57f8]91print("node [width=0.375,height=0.25];\n");
92
93my %cached_names;
94sub get_name($) {
95  my $node = $_[0];
96  my $pc = $node->{'pc'};
97
98  if (exists $cached_names{$pc}) {
99    return $cached_names{$pc};
100  }
101
102  my $ret = '';
103
104  # Prefer the relative offset (that is what we want for shared libraries), but
105  # if is not available, use the full offset (which is what we want for the
106  # base executable).
107  my $exe_off = $node->{'relpc'};
108  if (!$exe_off) {
109    $exe_off = $pc;
110  }
111
112  my $file_name = $node->{'file_name'};
113  my ($func, $loc) = `addr2line -e $file_name -f 0x$exe_off`;
114  chomp($func);
115  chomp($loc);
116
117  if ($func !~ /^\?/) {
118    $func =~ s/.*\.//;
119    $func = `c++filt '$func'`;
120    chomp($func);
121
122    $ret .= $func . '\n' . $loc . '\n';
[4bd7a88]123  } elsif ($node->{'proc_name'} ne '?') {
124    my $proc_name = $node->{'proc_name'};
125    $proc_name = `c++filt '$proc_name'`;
126    chomp($proc_name);
127
128    $ret .= $proc_name . '\n';
[ebd57f8]129  }
130
131  $ret .= basename($node->{'file_name'});
132  if ($node->{'proc_name'} ne '?') {
133    $ret .= ' (' . $node->{'proc_name'} . '+0x' . $node->{'off'} . ')';
134  }
135
136  $cached_names{$pc} = $ret;
137  return $ret;
138}
139
[4bd7a88]140my $skip_frac = 0.01;
141my %skipped;
142
[ebd57f8]143foreach my $node (@all_nodes) {
144  my $name = get_name($node);
145
146  my $local_size = $node->{'size'};
[4bd7a88]147  if ($local_size * 1.0 / $total_size < $skip_frac) {
148    $skipped{$node->{'pc'}} = 1;
149    next;
150  }
[ebd57f8]151
152  my $fs = 8.0;
153  if ($local_size > 0) {
[4bd7a88]154    $fs = 50.0 * (abs($local_size * 1.0 / $total_size))**0.125;
[ebd57f8]155  }
156
157  printf("N%s [label=\"%s\\n%s\", shape=box,fontsize=%.1f%s];\n",
158    $node->{'pc'}, $name, format_bytes($local_size), $fs);
159}
160
161foreach my $node (@all_nodes) {
162  my $local_size = $node->{'size'};
[4bd7a88]163  if ($skipped{$node->{'pc'}}) {
164    next;
165  }
[ebd57f8]166
167  foreach my $cpc (keys %{$node->{'child_sizes'}}) {
[4bd7a88]168    if ($skipped{$cpc}) {
169      next;
170    }
171
[ebd57f8]172    my $child_size = $node->{'child_sizes'}->{$cpc};
173    my $frac = $child_size * 1.0 / $local_size;
174
[4bd7a88]175    my $weight = 100.0 * sqrt($frac);
176    my $style = sprintf("setlinewidth(%f)", 3.0 * sqrt($frac));
[ebd57f8]177
178    printf("N%s -> N%s [label=\"%s\", weight=%d, style=\"%s\"];\n",
179      $node->{'pc'}, $cpc, format_bytes($child_size), $weight, $style);
180  }
181}
182
183print("}\n");
184
Note: See TracBrowser for help on using the repository browser.