Add memnodes.pl script to process output stream.

diff --git a/Size.xs b/Size.xs
index f736ab6..f785b2c 100644 (file)
--- a/Size.xs
+++ b/Size.xs
@@ -1017,12 +1017,12 @@ sv_size(pTHX_ struct state *const st, pPATH, const SV * const orig_thing,
           ADD_SIZE(st, "he", sizeof(HE));
          hek_size(aTHX_ st, cur_entry->hent_hek, HvSHAREKEYS(thing), NPathLink("hent_hek", NPtype_LINK));
          if (recurse >= TOTAL_SIZE_RECURSION) {
-/* I've seen a PL_strtab HeVAL == 0xC
+/* I've seen a PL_strtab HeVAL == 0xC and 0x40C etc
  * just running perl -Mblib -Mstrict -MDevel::Size=:all -MCarp -e 'warn perl_size()'
  * but it seemed like a corruption - it would change come and go with irrelevant code changes.
  * so we protect against that here, but I'd like to know the cause.
  */
-if (PTR2UV(HeVAL(cur_entry)) > 1000)
+if (PTR2UV(HeVAL(cur_entry)) > 0xFFF)
              sv_size(aTHX_ st, NPathLink("HeVAL", NPtype_LINK), HeVAL(cur_entry), recurse);
          }
           cur_entry = cur_entry->hent_next;
@@ -1246,6 +1246,7 @@ CODE:
 {
   dNPathNodes(1, NULL);
   struct state *st = new_state(aTHX);
+  dNPathSetNode("perl_size", NPtype_NAME); /* provide a root node */
   
   /* start with PL_defstash to get everything reachable from \%main::
    * this seems to include PL_defgv, PL_incgv etc but I've listed them anyway

diff --git a/memnodes.pl b/memnodes.pl
new file mode 100644 (file)
index 0000000..d9e204f
--- /dev/null
+++ b/memnodes.pl
@@ -0,0 +1,88 @@
+#!/bin/env perl
+
+use strict;
+use warnings;
+
+my @stack;
+my %seqn2node;
+
+sub pop_stack {
+    my $x = pop @stack;
+    delete $seqn2node{$x->{seqn}};
+    my $size = 0; $size += $_  for values %{$x->{leaves}};
+    $x->{self_size} = $size;
+    if (my $parent = $stack[-1]) {
+        # link to parent
+        $x->{parent_seqn} = $parent->{seqn};
+        # accumulate into parent
+        $parent->{kids_node_count} += 1 + ($x->{kids_node_count}||0);
+        $parent->{kids_size} += $size + $x->{kids_size};
+        push @{$parent->{child_seqn}}, $x->{seqn};
+    }
+    # output
+    # ...
+    return $x;
+}
+
+while (<>) {
+    chomp;
+    my ($type, $seqn, $val, $name, $extra) = split / /, $_, 5;
+    if ($type eq "N") {     # Node ($val is depth)
+        while ($val < @stack) {
+            my $x = pop_stack();
+            warn "N $seqn d$val ends $x->{seqn} d$x->{depth}: size $x->{self_size}+$x->{kids_size}\n";
+        }
+        die 1 if $stack[$val];
+        my $node = $stack[$val] = { seqn => $seqn, name => $name, extra => $extra, attr => [], leaves => {}, depth => $val, self_size=>0, kids_size=>0 };
+        $seqn2node{$seqn} = $node;
+    }
+    elsif ($type eq "L") {  # Leaf name and memory size
+        my $node = $seqn2node{$seqn} || die;
+        $node->{leaves}{$name} += $val;
+    }
+    elsif ($type eq "A") {  # Attribute name and value
+        my $node = $seqn2node{$seqn} || die;
+        push @{ $node->{attr} }, $name, $val; # pairs
+    }
+    else {
+        warn "Invalid type '$type' on line $. ($_)";
+    }
+}
+
+my $x;
+while (@stack > 1) {
+    $x = pop_stack() while @stack;
+    warn "EOF ends $x->{seqn} d$x->{depth}: size $x->{self_size}+$x->{kids_size}\n";
+}
+use Data::Dumper;
+warn Dumper(\$x);
+warn Dumper(\%seqn2node);
+
+=for
+SV(PVAV) fill=1/1       [#1 @0] 
+:   +64 sv =64 
+:   +16 av_max =80 
+:   AVelem->        [#2 @1] 
+:   :   SV(RV)      [#3 @2] 
+:   :   :   +24 sv =104 
+:   :   :   RV->        [#4 @3] 
+:   :   :   :   SV(PVAV) fill=-1/-1     [#5 @4] 
+:   :   :   :   :   +64 sv =168 
+:   AVelem->        [#6 @1] 
+:   :   SV(IV)      [#7 @2] 
+:   :   :   +24 sv =192 
+192 at -e line 1.
+=cut
+__DATA__
+N 1 0 SV(PVAV) fill=1/1
+L 1 64 sv
+L 1 16 av_max
+N 2 1 AVelem->
+N 3 2 SV(RV)
+L 3 24 sv
+N 4 3 RV->
+N 5 4 SV(PVAV) fill=-1/-1
+L 5 64 sv
+N 6 1 AVelem->
+N 7 2 SV(IV)
+L 7 24 sv