This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
PVFMs don't need CvDEPTH, and PVCVs don't use SvIVX, so moving
[perl5.git] / ext / B / B / Bytecode.pm
index 83533c2..4497d44 100644 (file)
@@ -7,7 +7,7 @@
 
 package B::Bytecode;
 
-our $VERSION = '1.01';
+our $VERSION = '1.02';
 
 use strict;
 use Config;
@@ -172,8 +172,11 @@ sub B::HV::ix {
            asm "ldsv", $varix = $ix unless $ix == $varix;
            ($i = not $i) ? asm ("newpv", pvstring $_) : asm("hv_store", $_)
                for @array;
-           asm "xnv", $hv->NVX;
+           if (VERSION < 5.009) {
+               asm "xnv", $hv->NVX;
+           }
            asm "xmg_stash", $stashix;
+           asm "xhv_riter", $hv->RITER;
        }
        asm "sv_refcnt", $hv->REFCNT;
        $ix;
@@ -233,6 +236,12 @@ sub B::PVIV::bsave {
     $sv->ROK ?
        $sv->B::RV::bsave($ix):
        $sv->B::NULL::bsave($ix);
+    if (VERSION >= 5.009) {
+       # See note below in B::PVNV::bsave
+       return if $sv->isa('B::AV');
+       return if $sv->isa('B::HV');
+       return if $sv->isa('B::CV');
+    }
     asm "xiv", !ITHREADS && $sv->FLAGS & (SVf_FAKE|SVf_READONLY) ?
        "0 but true" : $sv->IVX;
 }
@@ -240,6 +249,15 @@ sub B::PVIV::bsave {
 sub B::PVNV::bsave {
     my ($sv,$ix) = @_;
     $sv->B::PVIV::bsave($ix);
+    if (VERSION >= 5.009) {
+       # Magical AVs end up here, but AVs now don't have an NV slot actually
+       # allocated. Hence don't write out assembly to store the NV slot if
+       # we're actually an array.
+       return if $sv->isa('B::AV');
+       # Likewise HVs have no NV slot actually allocated.
+       # I don't think that they can get here, but better safe than sorry
+       return if $sv->isa('B::HV');
+    }
     asm "xnv", sprintf "%.40g", $sv->NVX;
 }
 
@@ -357,10 +375,12 @@ sub B::AV::bsave {
 
     nice "-AV-",
     asm "ldsv", $varix = $ix unless $ix == $varix;
-    asm "av_extend", $av->MAX;
+    asm "av_extend", $av->MAX if $av->MAX >= 0;
     asm "av_pushx", $_ for @array;
     asm "sv_refcnt", $av->REFCNT;
-    asm "xav_flags", $av->AvFLAGS;
+    if (VERSION < 5.009) {
+       asm "xav_flags", $av->AvFLAGS;
+    }
     asm "xmg_stash", $stashix;
 }
 
@@ -734,15 +754,17 @@ sub compile {
     }
     if ($scan) {
        my $f;
-       open $f, $scan
-           or bwarn("cannot rescan '$_'"), next;
-       while (<$f>) {
-           /^#\s*line\s+\d+\s+("?)(.*)\1/ and $files{$2} = 1;
-           /^#/ and next;
-           if (/\bgoto\b/ && !$keep_syn) {
-               bwarn "keeping the syntax tree: \"goto\" op found";
-               keep_syn;
+       if (open $f, $scan) {
+           while (<$f>) {
+               /^#\s*line\s+\d+\s+("?)(.*)\1/ and $files{$2} = 1;
+               /^#/ and next;
+               if (/\bgoto\b\s*[^&]/ && !$keep_syn) {
+                   bwarn "keeping the syntax tree: \"goto\" op found";
+                   keep_syn;
+               }
            }
+       } else {
+           bwarn "cannot rescan '$scan'";
        }
        close $f;
     }