From 93bad3fd55489cbd2d3157da1fcb3b524e960dd2 Mon Sep 17 00:00:00 2001 From: Nicholas Clark Date: Sun, 24 Apr 2011 16:37:17 +0100 Subject: [PATCH] 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. --- dist/B-Deparse/Deparse.pm | 27 +++++++++++++++------------ dist/B-Deparse/t/deparse.t | 7 +++++++ ext/B/B.xs | 2 ++ ext/B/t/optree_misc.t | 8 +++++--- ext/Opcode/Opcode.pm | 4 ++-- op.c | 9 +++++---- op.h | 1 - opcode.h | 6 ++++++ opnames.h | 3 ++- pp_hot.c | 2 +- regen/opcode.pl | 1 + regen/opcodes | 2 ++ sv.c | 27 +++++++++++++-------------- 13 files changed, 61 insertions(+), 38 deletions(-) diff --git a/dist/B-Deparse/Deparse.pm b/dist/B-Deparse/Deparse.pm index e3079ad..7496525 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 cb0faad..7249846 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 44f8402..9015549 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 5e16b92..0af382a 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 21d9079..b79256e 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 b91f322..bd403ab 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 ae79603..0d03efd 100644 --- a/op.h +++ b/op.h @@ -130,7 +130,6 @@ Deprecated. Use C 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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; -- 1.8.3.1