Split OP_AELEMFAST_LEX out from OP_AELEMFAST.

6a077020aea1c5f0 extended the OP_AELEMFAST optimisation to lexical arrays.
Previously OP_AELEMFAST was only used as an optimisation for OP_GV, which is a
PADOP/SVOP.

However, by reusing the same opcode, and signalling (pad) lexical vs package,
it introduced a myriad of special cases, because OP_PADAV is a BASEOP (not a
PADOP), whilst OP_AELEMFAST is a PADOP/SVOP (which is larger).

Using two OP numbers allows each variant to have the correct OP flags in
PL_opargs. Both can continue to share the same C code.

diff --git a/dist/B-Deparse/Deparse.pm b/dist/B-Deparse/Deparse.pm
index e3079ad..7496525 100644 (file)
--- a/dist/B-Deparse/Deparse.pm
+++ b/dist/B-Deparse/Deparse.pm
@@ -2917,22 +2917,25 @@ sub pp_gv {
     return $self->gv_name($gv);
 }
 
+sub pp_aelemfast_lex {
+    my $self = shift;
+    my($op, $cx) = @_;
+    my $name = $self->padname($op->targ);
+    $name =~ s/^@/\$/;
+    return $name . "[" .  ($op->private + $self->{'arybase'}) . "]";
+}
+
 sub pp_aelemfast {
     my $self = shift;
     my($op, $cx) = @_;
-    my $name;
-    if ($op->flags & OPf_SPECIAL) { # optimised PADAV
-       $name = $self->padname($op->targ);
-       $name =~ s/^@/\$/;
-    }
-    else {
-       my $gv = $self->gv_or_padgv($op);
-       $name = $self->gv_name($gv);
-       $name = $self->{'curstash'}."::$name"
-           if $name !~ /::/ && $self->lex_in_scope('@'.$name);
-       $name = '$' . $name;
-    }
+    # optimised PADAV, pre 5.15
+    return $self->pp_aelemfast_lex(@_) if ($op->flags & OPf_SPECIAL);
 
+    my $gv = $self->gv_or_padgv($op);
+    my $name = $self->gv_name($gv);
+    $name = $self->{'curstash'}."::$name"
+       if $name !~ /::/ && $self->lex_in_scope('@'.$name);
+    $name = '$' . $name;
     return $name . "[" .  ($op->private + $self->{'arybase'}) . "]";
 }
 

diff --git a/dist/B-Deparse/t/deparse.t b/dist/B-Deparse/t/deparse.t
index cb0faad..7249846 100644 (file)
--- a/dist/B-Deparse/t/deparse.t
+++ b/dist/B-Deparse/t/deparse.t
@@ -731,3 +731,10 @@ values $!;
 ####
 # readpipe with complex expression
 readpipe $a + $b;
+####
+# aelemfast
+$b::a[0] = 1;
+####
+# aelemfast for a lexical
+my @a;
+$a[0] = 1;

diff --git a/ext/B/B.xs b/ext/B/B.xs
index 44f8402..9015549 100644 (file)
--- a/ext/B/B.xs
+++ b/ext/B/B.xs
@@ -125,9 +125,11 @@ cc_opclass(pTHX_ const OP *o)
        return ((o->op_private & OPpASSIGN_BACKWARDS) ? OPc_UNOP : OPc_BINOP);
 
     if (o->op_type == OP_AELEMFAST) {
+#if PERL_VERSION <= 14
        if (o->op_flags & OPf_SPECIAL)
            return OPc_BASEOP;
        else
+#endif
 #ifdef USE_ITHREADS
            return OPc_PADOP;
 #else

diff --git a/ext/B/t/optree_misc.t b/ext/B/t/optree_misc.t
index 5e16b92..0af382a 100644 (file)
--- a/ext/B/t/optree_misc.t
+++ b/ext/B/t/optree_misc.t
@@ -15,12 +15,14 @@ plan tests => 6;
 SKIP: {
 skip "no perlio in this build", 4 unless $Config::Config{useperlio};
 
-# The regression this is testing is that the first aelemfast, derived
+# The regression this was testing is that the first aelemfast, derived
 # from a lexical array, is supposed to be a BASEOP "<0>", while the
 # second, from a global, is an SVOP "<$>" or a PADOP "<#>" depending
 # on threading. In buggy versions, both showed up as SVOPs/PADOPs. See
 # B.xs:cc_opclass() for the relevant code.
 
+# All this is much simpler, now that aelemfast_lex has been broken out from
+# aelemfast
 checkOptree ( name     => 'OP_AELEMFAST opclass',
              code      => sub { my @x; our @y; $x[0] + $y[0]},
              strip_open_hints => 1,
@@ -35,7 +37,7 @@ checkOptree ( name    => 'OP_AELEMFAST opclass',
 # 6        <;> nextstate(main 636 optree_misc.t:25) v:>,<,%,{ ->7
 # 9        <2> add[t6] sK/2 ->a
 # -           <1> ex-aelem sK/2 ->8
-# 7              <0> aelemfast[@x:634,636] sR* ->8
+# 7              <0> aelemfast_lex[@x:634,636] sR ->8
 # -              <0> ex-const s ->-
 # -           <1> ex-aelem sK/2 ->9
 # -              <1> ex-rv2av sKR/1 ->-
@@ -52,7 +54,7 @@ EOT_EOT
 # 6        <;> nextstate(main 636 optree_misc.t:27) v:>,<,%,{ ->7
 # 9        <2> add[t4] sK/2 ->a
 # -           <1> ex-aelem sK/2 ->8
-# 7              <0> aelemfast[@x:634,636] sR* ->8
+# 7              <0> aelemfast_lex[@x:634,636] sR ->8
 # -              <0> ex-const s ->-
 # -           <1> ex-aelem sK/2 ->9
 # -              <1> ex-rv2av sKR/1 ->-

diff --git a/ext/Opcode/Opcode.pm b/ext/Opcode/Opcode.pm
index 21d9079..b79256e 100644 (file)
--- a/ext/Opcode/Opcode.pm
+++ b/ext/Opcode/Opcode.pm
@@ -6,7 +6,7 @@ use strict;
 
 our($VERSION, @ISA, @EXPORT_OK);
 
-$VERSION = "1.18";
+$VERSION = "1.19";
 
 use Carp;
 use Exporter ();
@@ -308,7 +308,7 @@ invert_opset function.
 
     rv2sv sassign
 
-    rv2av aassign aelem aelemfast aslice av2arylen
+    rv2av aassign aelem aelemfast aelemfast_lex aslice av2arylen
 
     rv2hv helem hslice each values keys exists delete aeach akeys avalues
     boolkeys reach rvalues rkeys

diff --git a/op.c b/op.c
index b91f322..bd403ab 100644 (file)
--- a/op.c
+++ b/op.c
@@ -571,8 +571,7 @@ Perl_op_clear(pTHX_ OP *o)
     case OP_GVSV:
     case OP_GV:
     case OP_AELEMFAST:
-       if (! (o->op_type == OP_AELEMFAST && o->op_flags & OPf_SPECIAL)) {
-           /* not an OP_PADAV replacement */
+       {
            GV *gv = (o->op_type == OP_GV || o->op_type == OP_GVSV)
 #ifdef USE_ITHREADS
                        && PL_curpad
@@ -1069,6 +1068,7 @@ Perl_scalarvoid(pTHX_ OP *o)
     case OP_SPRINTF:
     case OP_AELEM:
     case OP_AELEMFAST:
+    case OP_AELEMFAST_LEX:
     case OP_ASLICE:
     case OP_HELEM:
     case OP_HSLICE:
@@ -1654,6 +1654,7 @@ Perl_op_lvalue(pTHX_ OP *o, I32 type)
        break;
 
     case OP_AELEMFAST:
+    case OP_AELEMFAST_LEX:
        localize = -1;
        PL_modcount++;
        break;
@@ -9538,10 +9539,10 @@ Perl_rpeep(pTHX_ register OP *o)
                    if (o->op_type == OP_GV) {
                        gv = cGVOPo_gv;
                        GvAVn(gv);
+                       o->op_type = OP_AELEMFAST;
                    }
                    else
-                       o->op_flags |= OPf_SPECIAL;
-                   o->op_type = OP_AELEMFAST;
+                       o->op_type = OP_AELEMFAST_LEX;
                }
                break;
            }

diff --git a/op.h b/op.h
index ae79603..0d03efd 100644 (file)
--- a/op.h
+++ b/op.h
@@ -130,7 +130,6 @@ Deprecated.  Use C<GIMME_V> instead.
                                    defined()*/
                                /*  On OP_DBSTATE, indicates breakpoint
                                 *    (runtime property) */
-                               /*  On OP_AELEMFAST, indicates pad var */
                                /*  On OP_REQUIRE, was seen as CORE::require */
                                /*  On OP_ENTERWHEN, there's no condition */
                                /*  On OP_BREAK, an implicit break */

diff --git a/opcode.h b/opcode.h
index 4f0e1c6..03539b7 100644 (file)
--- a/opcode.h
+++ b/opcode.h
@@ -139,6 +139,7 @@
 #define Perl_pp_reach Perl_pp_rkeys
 #define Perl_pp_rvalues Perl_pp_rkeys
 #define Perl_pp_transr Perl_pp_trans
+#define Perl_pp_aelemfast_lex Perl_pp_aelemfast
 START_EXTERN_C
 
 #ifndef DOINIT
@@ -515,6 +516,7 @@ EXTCONST char* const PL_op_name[] = {
        "rkeys",
        "rvalues",
        "transr",
+       "aelemfast_lex",
 };
 #endif
 
@@ -892,6 +894,7 @@ EXTCONST char* const PL_op_desc[] = {
        "keys on reference",
        "values on reference",
        "transliteration (tr///)",
+       "constant lexical array element",
 };
 #endif
 
@@ -1283,6 +1286,7 @@ EXT Perl_ppaddr_t PL_ppaddr[] /* or perlvars.h */
        Perl_pp_rkeys,
        Perl_pp_rvalues,        /* implemented by Perl_pp_rkeys */
        Perl_pp_transr, /* implemented by Perl_pp_trans */
+       Perl_pp_aelemfast_lex,  /* implemented by Perl_pp_aelemfast */
 }
 #endif
 #ifdef PERL_PPADDR_INITED
@@ -1671,6 +1675,7 @@ EXT Perl_check_t PL_check[] /* or perlvars.h */
        Perl_ck_each,           /* rkeys */
        Perl_ck_each,           /* rvalues */
        Perl_ck_match,          /* transr */
+       Perl_ck_null,           /* aelemfast_lex */
 }
 #endif
 #ifdef PERL_CHECK_INITED
@@ -2053,6 +2058,7 @@ EXTCONST U32 PL_opargs[] = {
        0x00001b08,     /* rkeys */
        0x00001b08,     /* rvalues */
        0x00001804,     /* transr */
+       0x00013040,     /* aelemfast_lex */
 };
 #endif
 

diff --git a/opnames.h b/opnames.h
index f3fab8b..ad71240 100644 (file)
--- a/opnames.h
+++ b/opnames.h
@@ -384,10 +384,11 @@ typedef enum opcode {
        OP_RKEYS         = 367,
        OP_RVALUES       = 368,
        OP_TRANSR        = 369,
+       OP_AELEMFAST_LEX = 370,
        OP_max          
 } opcode;
 
-#define MAXO 370
+#define MAXO 371
 
 /* the OP_IS_(SOCKET|FILETEST) macros are optimized to a simple range
     check because all the member OPs are contiguous in opcode.pl

diff --git a/pp_hot.c b/pp_hot.c
index 8d02826..6adb5be 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -671,7 +671,7 @@ PP(pp_add)
 PP(pp_aelemfast)
 {
     dVAR; dSP;
-    AV * const av = PL_op->op_flags & OPf_SPECIAL
+    AV * const av = PL_op->op_type == OP_AELEMFAST_LEX
        ? MUTABLE_AV(PAD_SV(PL_op->op_targ)) : GvAVn(cGVOP_gv);
     const U32 lval = PL_op->op_flags & OPf_MOD;
     SV** const svp = av_fetch(av, PL_op->op_private, lval);

diff --git a/regen/opcode.pl b/regen/opcode.pl
index ed3875e..791de9f 100755 (executable)
--- a/regen/opcode.pl
+++ b/regen/opcode.pl
@@ -123,6 +123,7 @@ my @raw_alias = (
                 Perl_pp_ehostent => [qw(enetent eprotoent eservent
                                         spwent epwent sgrent egrent)],
                 Perl_pp_shostent => [qw(snetent sprotoent sservent)],
+                Perl_pp_aelemfast => ['aelemfast_lex'],
                );
 
 while (my ($func, $names) = splice @raw_alias, 0, 2) {

diff --git a/regen/opcodes b/regen/opcodes
index 20087d1..d6b778b 100644 (file)
--- a/regen/opcodes
+++ b/regen/opcodes
@@ -540,3 +540,5 @@ rvalues             values on reference                     ck_each         t%      S
 
 # y///r
 transr         transliteration (tr///) ck_match        is"     S
+
+aelemfast_lex  constant lexical array element  ck_null         d0      A S

diff --git a/sv.c b/sv.c
index 86b1020..faddfdc 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -13865,21 +13865,20 @@ S_find_uninit_var(pTHX_ const OP *const obase, const SV *const uninit_sv,
            break;
        return varname(gv, '$', 0, NULL, 0, FUV_SUBSCRIPT_NONE);
 
-    case OP_AELEMFAST:
-       if (obase->op_flags & OPf_SPECIAL) { /* lexical array */
-           if (match) {
-               SV **svp;
-               AV *av = MUTABLE_AV(PAD_SV(obase->op_targ));
-               if (!av || SvRMAGICAL(av))
-                   break;
-               svp = av_fetch(av, (I32)obase->op_private, FALSE);
-               if (!svp || *svp != uninit_sv)
-                   break;
-           }
-           return varname(NULL, '$', obase->op_targ,
-                   NULL, (I32)obase->op_private, FUV_SUBSCRIPT_ARRAY);
+    case OP_AELEMFAST_LEX:
+       if (match) {
+           SV **svp;
+           AV *av = MUTABLE_AV(PAD_SV(obase->op_targ));
+           if (!av || SvRMAGICAL(av))
+               break;
+           svp = av_fetch(av, (I32)obase->op_private, FALSE);
+           if (!svp || *svp != uninit_sv)
+               break;
        }
-       else {
+       return varname(NULL, '$', obase->op_targ,
+                      NULL, (I32)obase->op_private, FUV_SUBSCRIPT_ARRAY);
+    case OP_AELEMFAST:
+       {
            gv = cGVOPx_gv(obase);
            if (!gv)
                break;