summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--dist/B-Deparse/Deparse.pm27
-rw-r--r--dist/B-Deparse/t/deparse.t7
-rw-r--r--ext/B/B.xs2
-rw-r--r--ext/B/t/optree_misc.t8
-rw-r--r--ext/Opcode/Opcode.pm4
-rw-r--r--op.c9
-rw-r--r--op.h1
-rw-r--r--opcode.h6
-rw-r--r--opnames.h3
-rw-r--r--pp_hot.c2
-rwxr-xr-xregen/opcode.pl1
-rw-r--r--regen/opcodes2
-rw-r--r--sv.c27
13 files changed, 61 insertions, 38 deletions
diff --git a/dist/B-Deparse/Deparse.pm b/dist/B-Deparse/Deparse.pm
index e3079ad20b..7496525a78 100644
--- 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 cb0faadd28..72498465a2 100644
--- 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 44f8402691..901554968f 100644
--- 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 5e16b9262f..0af382a69f 100644
--- 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 21d9079799..b79256e161 100644
--- 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 b91f32284e..bd403abca9 100644
--- 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 ae79603a16..0d03efda6f 100644
--- 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 4f0e1c658a..03539b78a5 100644
--- 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 f3fab8b1f8..ad712408af 100644
--- 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 8d02826249..6adb5beacb 100644
--- 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 ed3875e678..791de9f4be 100755
--- 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 20087d1ef3..d6b778b1bc 100644
--- 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 86b10208e0..faddfdc8aa 100644
--- 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;
View Lorry Controller Status