add TODO

[p5sagit/Devel-Size.git] / memnodes.pl

diff --git a/memnodes.pl b/memnodes.pl
index 7ca2877..16f7e48 100755 (executable)
--- a/memnodes.pl
+++ b/memnodes.pl
@@ -24,6 +24,7 @@ use constant NPattr_PADFAKE  => 0x02;
 use constant NPattr_PADNAME  => 0x03;
 use constant NPattr_PADTMP   => 0x04;
 use constant NPattr_NOTE     => 0x05;
+use constant NPattr_PRE_ATTR => 0x06;
 
 
 GetOptions(
@@ -99,12 +100,23 @@ sub enter_node {
     my $parent = $stack[-1];
     if ($parent) {
 
-        # If node is an AVelem of a CvPADLIST propagate pad name to AVelem
-        if ($parent->{name} eq 'SV(PVAV)' && @stack >= 4) {
-            if ((my $cvpl = $stack[-4])->{name} eq 'CvPADLIST') {
-                my $padnames = $cvpl->{attr}{+NPattr_PADNAME} || [];
-                warn "@$padnames";
-                $x->{name} = "pad";
+        if ($x->{name} eq 'AVelem' and $parent->{name} eq 'SV(PVAV)') {
+            my $index = $x->{attr}{index};
+            # If node is an AVelem of a CvPADLIST propagate pad name to AVelem
+            if (@stack >= 4 and (my $cvpl = $stack[-4])->{name} eq 'CvPADLIST') {
+                # cache the pad names so we can eat them in order
+                my $padnames = $cvpl->{_cached}{padnames} ||= do {
+                    my @names = @{ $cvpl->{attr}{+NPattr_PADNAME} || []};
+                    $_ = "my(".($_||'').")" for @names;
+                    $names[0] = '@_';
+                    \@names;
+                };
+                #die Dwarn $x;
+                $x->{name} = $padnames->[$index] || "?";
+                $x->{name} =~ s/my\(SVs_PADTMP\)/PADTMP/; # XXX hack for neatness
+            }
+            else {
+                $x->{name} = "[$index]";
             }
         }
     }
@@ -185,6 +197,7 @@ sub leave_node {
 
 my $indent = ":   ";
 my @attr_type_name = (qw(size NAME PADFAKE my PADTMP NOTE));
+my $pending_pre_attr = {};
 
 while (<>) {
     chomp;
@@ -192,7 +205,9 @@ while (<>) {
     my ($type, $id, $val, $name, $extra) = split / /, $_, 5;
 
     if ($type =~ s/^-//) {     # Node type ($val is depth)
-        printf "%s%s %s [#%d @%d]\n", $indent x $val, $name, $extra||'', $id, $val
+        printf "%s%s%s %s [#%d @%d]\n", $indent x $val, $name,
+                ($type == NPtype_LINK) ? "->" : "",
+                $extra||'', $id, $val
             if $opt_text;
         while ($val < @stack) {
             leave_node(my $x = pop @stack);
@@ -203,8 +218,10 @@ while (<>) {
             if $stack[$val];
         my $node = enter_node({
             id => $id, type => $type, name => $name, extra => $extra,
-            attr => {}, leaves => {}, depth => $val, self_size=>0, kids_size=>0
+            attr => { %$pending_pre_attr },
+            leaves => {}, depth => $val, self_size=>0, kids_size=>0
         });
+        %$pending_pre_attr = ();
         $stack[$val] = $node;
         $seqn2node{$id} = $node;
     }
@@ -220,7 +237,12 @@ while (<>) {
         my $node = $seqn2node{$id} || die;
         my $attr = $node->{attr} || die;
 
-        if ($type == NPattr_NAME or $type == NPattr_NOTE) {
+        # attributes to queue up and apply to the next node
+        if (NPattr_PRE_ATTR == $type) {
+            $pending_pre_attr->{$name} = $val;
+        }
+        # attributes where the string is a key (or always empty and the type is the key)
+        elsif ($type == NPattr_NAME or $type == NPattr_NOTE) {
             printf "%s~%s(%s) %d [t%d]\n", $indent x ($node->{depth}+1), $attr_type_name[$type], $name, $val, $type
                 if $opt_text;
             warn "Node $id already has attribute $type:$name (value $attr->{$type}{$name})\n"
@@ -228,13 +250,13 @@ while (<>) {
             $attr->{$type}{$name} = $val || $id;
             $node->{title} = $name if $type == 1 and !$val;
         }
+        # attributes where the number is a key (or always zero)
         elsif (NPattr_PADFAKE==$type or NPattr_PADTMP==$type or NPattr_PADNAME==$type) {
             printf "%s~%s('%s') %d [t%d]\n", $indent x ($node->{depth}+1), $attr_type_name[$type], $name, $val, $type
                 if $opt_text;
             warn "Node $id already has attribute $type:$name (value $attr->{$type}[$val])\n"
                 if defined $attr->{$type}[$val];
             $attr->{+NPattr_PADNAME}[$val] = $name; # store all as NPattr_PADNAME
-            Dwarn $attr;
         }
         else {
             printf "%s~%s %d [t%d]\n", $indent x ($node->{depth}+1), $name, $val, $type