BC: work on 5.17.5 PADLIST support (broken)

rurban · Oct 12, 2012 · eb5a04c · eb5a04c
1 parent e3e9471
commit eb5a04c
Show file tree

Hide file tree

Showing 3 changed files with 31 additions and 22 deletions.
diff --git a/ByteLoader/bytecode.h b/ByteLoader/bytecode.h
@@ -749,10 +749,17 @@ static int bget_swab = 0;
       }									\
     } STMT_END
 
+#if PERL_VERSION >= 17
+#define BSET_padl_new(padlist,flag)					\
+    STMT_START {							\
+      bstate->bs_sv = (SV*)Perl_pad_new(flag);				\
+    } STMT_END
+#endif
+
 
 /* NOTE: The bytecode header only sanity-checks the bytecode. If a script cares about
  * what version of Perl it's being called under, it should do a 'use 5.006_001' or
- * equivalent. However, since the header includes checks required an exact match in
+ * equivalent. However, since the header includes checks for a match in
  * ByteLoader versions (we can't guarantee forward compatibility), you don't 
  * need to specify one.
  * 	use ByteLoader;

diff --git a/bytecode.pl b/bytecode.pl
@@ -1037,3 +1037,6 @@ =head1 AUTHOR
 # restore dup to stdio handles 0-2
 158 0 	xio_ifp		bstate->bs_sv	  		char		x
 159 10 	xpvshared	bstate->bs_sv			none		x
+160 17.005 padl_new	bstate->bs_sv			U8		x
+161 17.005 padl_name	PadlistARRAY((PADLIST*)bstate->bs_sv)[0]  svindex
+162 17.005 padl_set	PadlistARRAY((PADLIST*)bstate->bs_sv)[1]  svindex
diff --git a/lib/B/Bytecode.pm b/lib/B/Bytecode.pm
@@ -10,6 +10,7 @@
 # Reviving 5.6 support here is work in progress, and not yet enabled.
 # So far the original is used instead, even if the list of failed tests
 # is impressive: 3,6,8..10,12,15,16,18,25..28. Pretty broken.
+# 5.17.5 is also not supported yet (new PADLIST type)
 
 package B::Bytecode;
 
@@ -124,13 +125,17 @@ sub sv_flags {
   return '' unless $debug{Comment};
   return 'B::SPECIAL' if $_[0]->isa('B::SPECIAL');
   return 'B::PADLIST' if $_[0]->isa('B::PADLIST');
+  return 'B::NULL'    if $_[0]->isa('B::NULL');
   my ($sv) = @_;
   my %h;
 
   # TODO: Check with which Concise and B versions this works. 5.10.0 fails.
   # B::Concise 0.66 fails also
   sub B::Concise::fmt_line { return shift; }
-  %h = B::Concise::concise_op( $ops{ $tix - 1 } ) if ref $ops{ $tix - 1 };
+  my $op = $ops{ $tix - 1 };
+  if (ref $op and !$op->targ) { # targ assumes a valid curcv
+    %h = B::Concise::concise_op( $op );
+  }
   B::Concise::concise_sv( $_[0], \%h, 0 );
 }
 
@@ -235,17 +240,14 @@ sub B::SV::ix {
 }
 
 sub B::PADLIST::ix {
-  my $sv = shift;
-  my $ix = $svtab{$$sv};
+  my $padl = shift;
+  my $ix = $svtab{$$padl};
   defined($ix) ? $ix : do {
-    nice '[' . class($sv) . " $tix]";
+    nice '[' . class($padl) . " $tix]";
     B::Assembler::maxsvix($tix) if $debug{A};
-    my $type = 0xff; # SVTYPEMASK
-    asm "newsvx", 0,
-     $debug{Comment} ? sprintf("type=%d", $type) : "";
-    asm "stsv", $tix if $PERL56;
-    $svtab{$$sv} = $varix = $ix = $tix++;
-    $sv->bsave($ix);
+    asm "padl_new", 0;
+    $svtab{$$padl} = $varix = $ix = $tix++;
+    $padl->bsave($ix);
     $ix;
   }
 }
@@ -684,16 +686,13 @@ sub B::AV::bsave {
 }
 
 sub B::PADLIST::bsave {
-  my ( $av, $ix ) = @_;
-  my @array = $av->ARRAY;
-  $_ = $_->ix for @array; # hack. walks the ->ix methods to save the elements
-  # my $stashix = $av->SvSTASH->ix;
-  nice "-AV-",
-    asm "ldsv", $varix = $ix, sv_flags($av) unless $ix == $varix;
-  asm "av_extend", $av->MAX if $av->MAX >= 0;
-  asm "av_pushx", $_ for @array;
-  asm "sv_refcnt", $av->REFCNT;
-  # asm "xmg_stash", $stashix;
+  my ( $padl, $ix ) = @_;
+  my @array = $padl->ARRAY;
+  $_ = $_->ix for @array; # hack. call ->ix methods to save the pad array elements
+  nice "-PADLIST-",
+    asm "ldsv", $varix = $ix unless $ix == $varix;
+  asm "padl_name", $array[0]; # comppad_name
+  asm "padl_set",  $array[1]; # comppad
 }
 
 sub B::GV::desired {
@@ -1494,7 +1493,7 @@ modified by Benjamin Stuhl <sho_pi@hotmail.com>.
 
 Rewritten by Enache Adrian <enache@rdslink.ro>, 2003 a.d.
 
-Enhanced by Reini Urban <rurban@cpan.org>, 2008-2011
+Enhanced by Reini Urban <rurban@cpan.org>, 2008-2012
 
 =cut