Unify 5.008 and 5.009's B::Concise 0.56

[p5sagit/p5-mst-13.2.git] / ext / B / B / Bytecode.pm

diff --git a/ext/B/B/Bytecode.pm b/ext/B/B/Bytecode.pm
index c1fdb69..cce9948 100644 (file)
--- a/ext/B/B/Bytecode.pm
+++ b/ext/B/B/Bytecode.pm
@@ -7,6 +7,8 @@
 
 package B::Bytecode;
 
+our $VERSION = '1.01';
+
 use strict;
 use Config;
 use B qw(class main_cv main_root main_start cstring comppadlist
@@ -15,22 +17,25 @@ use B qw(class main_cv main_root main_start cstring comppadlist
        OPpLVAL_INTRO SVf_FAKE SVf_READONLY);
 use B::Asmdata qw(@specialsv_name);
 use B::Assembler qw(asm newasm endasm);
-no warnings;                                   # XXX
 
 #################################################
 
-my $ithreads = $Config{'useithreads'} eq 'define';
-my ($varix, $opix, $savebegins);
+my ($varix, $opix, $savebegins, %walked, %files, @cloop);
 my %strtab = (0,0);
 my %svtab = (0,0);
 my %optab = (0,0);
 my %spectab = (0,0);
-my %walked;
-my @cloop;
 my $tix = 1;
 sub asm;
 sub nice ($) { }
-my %files;
+
+BEGIN {
+    my $ithreads = $Config{'useithreads'} eq 'define';
+    eval qq{
+       sub ITHREADS() { $ithreads }
+       sub VERSION() { $] }
+    }; die $@ if $@;
+}
 
 #################################################
 
@@ -53,7 +58,7 @@ sub B::OP::ix {
     my $op = shift;
     my $ix = $optab{$$op};
     defined($ix) ? $ix : do {
-       nice '['.$op->name.']';
+       nice "[".$op->name." $tix]";
        asm "newopx", $op->size | $op->type <<7;
        $optab{$$op} = $opix = $ix = $tix++;
        $op->bsave($ix);
@@ -169,6 +174,7 @@ sub B::HV::ix {
                for @array;
            asm "xnv", $hv->NVX;
            asm "xmg_stash", $stashix;
+           asm "xhv_riter", $hv->RITER;
        }
        asm "sv_refcnt", $hv->REFCNT;
        $ix;
@@ -228,7 +234,7 @@ sub B::PVIV::bsave {
     $sv->ROK ?
        $sv->B::RV::bsave($ix):
        $sv->B::NULL::bsave($ix);
-    asm "xiv", !$ithreads && $sv->FLAGS & (SVf_FAKE|SVf_READONLY) ?
+    asm "xiv", !ITHREADS && $sv->FLAGS & (SVf_FAKE|SVf_READONLY) ?
        "0 but true" : $sv->IVX;
 }
 
@@ -352,7 +358,7 @@ 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;
@@ -417,7 +423,7 @@ sub B::UNOP::bsave {
     my $firstix = 
        $name =~ /fl[io]p/
                        # that's just neat
-    || (!$ithreads && $name eq 'regcomp')
+    || (!ITHREADS && $name eq 'regcomp')
                        # trick for /$a/o in pp_regcomp
     || $name eq 'rv2sv'
            && $op->flags & OPf_MOD     
@@ -450,23 +456,34 @@ sub B::BINOP::bsave {
 
 # not needed if no pseudohashes
 
-*B::BINOP::bsave = *B::OP::bsave if $] >= 5.009;
+*B::BINOP::bsave = *B::OP::bsave if VERSION >= 5.009;
 
 # deal with sort / formline 
 
 sub B::LISTOP::bsave {
     my ($op, $ix) = @_;
     my $name = $op->name;
-    if ($name eq 'sort' && $op->flags & (OPf_SPECIAL|OPf_STACKED)) {
+    sub blocksort() { OPf_SPECIAL|OPf_STACKED }
+    if ($name eq 'sort' && ($op->flags & blocksort) == blocksort) {
        my $first = $op->first;
+       my $pushmark = $first->sibling;
+       my $rvgv = $pushmark->first;
+       my $leave = $rvgv->first;
+
+       my $leaveix = $leave->ix;
+
+       my $rvgvix = $rvgv->ix;
+       asm "ldop", $rvgvix unless $rvgvix == $opix;
+       asm "op_first", $leaveix;
+
+       my $pushmarkix = $pushmark->ix;
+       asm "ldop", $pushmarkix unless $pushmarkix == $opix;
+       asm "op_first", $rvgvix;
+
        my $firstix = $first->ix;
-       my $firstsiblix = do {
-           local *B::UNOP::bsave = *B::UNOP::bsave_fat;
-           local *B::LISTOP::bsave = *B::UNOP::bsave_fat;
-           $first->sibling->ix;
-       };
        asm "ldop", $firstix unless $firstix == $opix;
-       asm "op_sibling", $firstsiblix;
+       asm "op_sibling", $pushmarkix;
+
        $op->B::OP::bsave($ix);
        asm "op_first", $firstix;
     } elsif ($name eq 'formline') {
@@ -499,7 +516,7 @@ sub B::BINOP::bsave_fat {
     my ($op,$ix) = @_;
     my $last = $op->last;
     my $lastix = $op->last->ix;
-    if ($] < 5.009 && $op->name eq 'aassign' && $last->name eq 'null') {
+    if (VERSION < 5.009 && $op->name eq 'aassign' && $last->name eq 'null') {
        asm "ldop", $lastix unless $lastix == $opix;
        asm "op_targ", $last->targ;
     }
@@ -522,7 +539,7 @@ sub B::PMOP::bsave {
 
     # my $pmnextix = $op->pmnext->ix;  # XXX
 
-    if ($ithreads) {
+    if (ITHREADS) {
        if ($op->name eq 'subst') {
            $rrop = "op_pmreplroot";
            $rrarg = $op->pmreplroot->ix;
@@ -597,7 +614,7 @@ sub B::COP::bsave {
     my ($cop,$ix) = @_;
     my $warnix = $cop->warnings->ix;
     my $ioix = $cop->io->ix;
-    if ($ithreads) {
+    if (ITHREADS) {
        $cop->B::OP::bsave($ix);
        asm "cop_stashpv", pvix $cop->stashpv;
        asm "cop_file", pvix $cop->file;
@@ -718,15 +735,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;
     }
@@ -752,10 +771,10 @@ sub compile {
            no strict 'refs';
            nice "<DATA>";
            my $dh = *{defstash->NAME."::DATA"};
-           local undef $/;
-           if (length (my $data = <$dh>)) {
+           unless (eof $dh) {
+               local undef $/;
                asm "data", ord 'D';
-               print $data;
+               print <$dh>;
            } else {
                asm "ret";
            }