memnodes.pl

   1 #!/bin/env perl
   2
   3 use strict;
   4 use warnings;
   5
   6 my $opt_json = 1;
   7
   8 my @stack;
   9 my %seqn2node;
  10
  11 sub enter_node {
  12     my $x = shift;
  13     if ($opt_json) {
  14         print "    " x $x->{depth};
  15         print qq({ "id": "$x->{seqn}", "name": "$x->{name}", "depth":$x->{depth}, "children":[ \n);
  16     }
  17     return;
  18 }
  19
  20 sub leave_node {
  21     my $x = shift;
  22     delete $seqn2node{$x->{seqn}};
  23     my $self_size = 0; $self_size += $_  for values %{$x->{leaves}};
  24     $x->{self_size} = $self_size;
  25     if (my $parent = $stack[-1]) {
  26         # link to parent
  27         $x->{parent_seqn} = $parent->{seqn};
  28         # accumulate into parent
  29         $parent->{kids_node_count} += 1 + ($x->{kids_node_count}||0);
  30         $parent->{kids_size} += $self_size + $x->{kids_size};
  31         push @{$parent->{child_seqn}}, $x->{seqn};
  32     }
  33     # output
  34     # ...
  35     if ($opt_json) {
  36         print "    " x $x->{depth};
  37         my $size = $self_size + $x->{kids_size};
  38         print qq(], "data":{ "\$area": $size } },\n);
  39     }
  40     return;
  41 }
  42
  43 print "memnodes = [" if $opt_json;
  44
  45 while (<>) {
  46     chomp;
  47     my ($type, $seqn, $val, $name, $extra) = split / /, $_, 5;
  48     if ($type eq "N") {     # Node ($val is depth)
  49         while ($val < @stack) {
  50             leave_node(my $x = pop @stack);
  51             warn "N $seqn d$val ends $x->{seqn} d$x->{depth}: size $x->{self_size}+$x->{kids_size}\n";
  52         }
  53         die 1 if $stack[$val];
  54         my $node = $stack[$val] = { seqn => $seqn, name => $name, extra => $extra, attr => [], leaves => {}, depth => $val, self_size=>0, kids_size=>0 };
  55         enter_node($node);
  56         $seqn2node{$seqn} = $node;
  57     }
  58     elsif ($type eq "L") {  # Leaf name and memory size
  59         my $node = $seqn2node{$seqn} || die;
  60         $node->{leaves}{$name} += $val;
  61     }
  62     elsif ($type eq "A") {  # Attribute name and value
  63         my $node = $seqn2node{$seqn} || die;
  64         push @{ $node->{attr} }, $name, $val; # pairs
  65     }
  66     else {
  67         warn "Invalid type '$type' on line $. ($_)";
  68     }
  69 }
  70
  71 my $x;
  72 while (@stack > 1) {
  73     leave_node($x = pop @stack) while @stack;
  74     warn "EOF ends $x->{seqn} d$x->{depth}: size $x->{self_size}+$x->{kids_size}\n";
  75 }
  76 print " ];\n" if $opt_json;
  77
  78 use Data::Dumper;
  79 warn Dumper(\$x);
  80 warn Dumper(\%seqn2node);
  81
  82 =for
  83 SV(PVAV) fill=1/1       [#1 @0]
  84 :   +64 sv =64
  85 :   +16 av_max =80
  86 :   AVelem->        [#2 @1]
  87 :   :   SV(RV)      [#3 @2]
  88 :   :   :   +24 sv =104
  89 :   :   :   RV->        [#4 @3]
  90 :   :   :   :   SV(PVAV) fill=-1/-1     [#5 @4]
  91 :   :   :   :   :   +64 sv =168
  92 :   AVelem->        [#6 @1]
  93 :   :   SV(IV)      [#7 @2]
  94 :   :   :   +24 sv =192
  95 192 at -e line 1.
  96 =cut
  97 __DATA__
  98 N 1 0 SV(PVAV) fill=1/1
  99 L 1 64 sv
 100 L 1 16 av_max
 101 N 2 1 AVelem->
 102 N 3 2 SV(RV)
 103 L 3 24 sv
 104 N 4 3 RV->
 105 N 5 4 SV(PVAV) fill=-1/-1
 106 L 5 64 sv
 107 N 6 1 AVelem->
 108 N 7 2 SV(IV)
 109 L 7 24 sv