memnodes.pl

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