void
Perl_op_free(pTHX_ OP *o)
{
-#ifdef USE_ITHREADS
dVAR;
-#endif
OPCODE type;
/* Though ops may be freed twice, freeing the op after its slab is a
/* an op should only ever acquire op_private flags that we know about.
* If this fails, you may need to fix something in regen/op_private */
- assert(!(o->op_private & ~PL_op_private_valid[type]));
+ if (o->op_ppaddr == PL_ppaddr[o->op_type]) {
+ assert(!(o->op_private & ~PL_op_private_valid[type]));
+ }
if (o->op_private & OPpREFCOUNTED) {
switch (type) {
static void
S_lvref(pTHX_ OP *o, I32 type)
{
+ dVAR;
OP *kid;
switch (o->op_type) {
case OP_COND_EXPR:
const U8 ec = PL_parser ? PL_parser->error_count : 0;
S_lvref(aTHX_ kid, type);
if (!PL_parser || PL_parser->error_count == ec) {
- if (!FEATURE_LVREF_IS_ENABLED)
+ if (!FEATURE_REFALIASING_IS_ENABLED)
Perl_croak(aTHX_
- "Experimental lvalue references not enabled");
+ "Experimental aliasing via reference not enabled");
Perl_ck_warner_d(aTHX_
- packWARN(WARN_EXPERIMENTAL__LVALUE_REFS),
- "Lvalue references are experimental");
+ packWARN(WARN_EXPERIMENTAL__REFALIASING),
+ "Aliasing via reference is experimental");
}
}
if (o->op_type == OP_REFGEN)
else if (curop->op_type == OP_PADSV ||
curop->op_type == OP_PADAV ||
curop->op_type == OP_PADHV ||
+ curop->op_type == OP_AELEMFAST_LEX ||
curop->op_type == OP_PADANY)
{
padcheck:
if ((curop->op_type == OP_PADSV ||
curop->op_type == OP_PADAV ||
curop->op_type == OP_PADHV ||
+ curop->op_type == OP_AELEMFAST_LEX ||
curop->op_type == OP_PADANY)
&& PAD_COMPNAME_GEN(curop->op_targ) == PERL_INT_MAX)
return TRUE;
if (right && right->op_type == OP_SPLIT
&& !(right->op_flags & OPf_STACKED)) {
OP* tmpop = ((LISTOP*)right)->op_first;
- if (tmpop && (tmpop->op_type == OP_PUSHRE)) {
- PMOP * const pm = (PMOP*)tmpop;
- if (
+ PMOP * const pm = (PMOP*)tmpop;
+ assert (tmpop && (tmpop->op_type == OP_PUSHRE));
+ if (
#ifdef USE_ITHREADS
!pm->op_pmreplrootu.op_pmtargetoff
#else
}
}
}
- }
}
}
return o;
OP_DESC(varop)));
return o;
}
- if (!FEATURE_LVREF_IS_ENABLED)
+ if (!FEATURE_REFALIASING_IS_ENABLED)
Perl_croak(aTHX_
- "Experimental lvalue references not enabled");
+ "Experimental aliasing via reference not enabled");
Perl_ck_warner_d(aTHX_
- packWARN(WARN_EXPERIMENTAL__LVALUE_REFS),
- "Lvalue references are experimental");
+ packWARN(WARN_EXPERIMENTAL__REFALIASING),
+ "Aliasing via reference is experimental");
o->op_private |= varop->op_private & (OPpLVAL_INTRO|OPpPAD_STATE);
if (stacked) o->op_flags |= OPf_STACKED;
else {
STATIC void
S_null_listop_in_list_context(pTHX_ OP *o)
{
- OP *kid;
-
PERL_ARGS_ASSERT_NULL_LISTOP_IN_LIST_CONTEXT;
- /* This is an OP_LIST in list context. That means we
+ /* This is an OP_LIST in list (or void) context. That means we
* can ditch the OP_LIST and the OP_PUSHMARK within. */
- kid = cLISTOPo->op_first;
- /* Find the end of the chain of OPs executed within the OP_LIST. */
- while (kid->op_next != o)
- kid = kid->op_next;
-
- kid->op_next = o->op_next; /* patch list out of exec chain */
op_null(cUNOPo->op_first); /* NULL the pushmark */
op_null(o); /* NULL the list */
}
break;
}
+ redo:
/* By default, this op has now been optimised. A couple of cases below
clear this again. */
o->op_opt = 1;
/* The following will have the OP_LIST and OP_PUSHMARK
- * patched out later IF the OP_LIST is in list context.
+ * patched out later IF the OP_LIST is in list context, or
+ * if it is in void context and padrange is not possible.
* So in that case, we can set the this OP's op_next
* to skip to after the OP_PUSHMARK:
* a THIS -> b
{
OP *sibling;
OP *other_pushmark;
+ OP *pushsib;
if (OP_TYPE_IS(o->op_next, OP_PUSHMARK)
&& (sibling = OP_SIBLING(o))
&& sibling->op_type == OP_LIST
/* This KIDS check is likely superfluous since OP_LIST
* would otherwise be an OP_STUB. */
&& sibling->op_flags & OPf_KIDS
- && (sibling->op_flags & OPf_WANT) == OPf_WANT_LIST
&& (other_pushmark = cLISTOPx(sibling)->op_first)
/* Pointer equality also effectively checks that it's a
* pushmark. */
- && other_pushmark == o->op_next)
+ && other_pushmark == o->op_next
+ /* List context */
+ && ( (sibling->op_flags & OPf_WANT) == OPf_WANT_LIST
+ /* ... or void context... */
+ || ( (sibling->op_flags & OPf_WANT) == OPf_WANT_VOID
+ /* ...and something padrange would reject */
+ && ( !(pushsib = OP_SIBLING(other_pushmark))
+ || ( pushsib->op_type != OP_PADSV
+ && pushsib->op_type != OP_PADAV
+ && pushsib->op_type != OP_PADHV)
+ || pushsib->op_private & ~OPpLVAL_INTRO))
+ ))
{
o->op_next = other_pushmark->op_next;
null_listop_in_list_context(sibling);
nextop = nextop->op_next;
if (nextop && (nextop->op_type == OP_NEXTSTATE)) {
- COP *firstcop = (COP *)o;
- COP *secondcop = (COP *)nextop;
- /* We want the COP pointed to by o (and anything else) to
- become the next COP down the line. */
- cop_free(firstcop);
-
- firstcop->op_next = secondcop->op_next;
-
- /* Now steal all its pointers, and duplicate the other
- data. */
- firstcop->cop_line = secondcop->cop_line;
-#ifdef USE_ITHREADS
- firstcop->cop_stashoff = secondcop->cop_stashoff;
- firstcop->cop_file = secondcop->cop_file;
-#else
- firstcop->cop_stash = secondcop->cop_stash;
- firstcop->cop_filegv = secondcop->cop_filegv;
-#endif
- firstcop->cop_hints = secondcop->cop_hints;
- firstcop->cop_seq = secondcop->cop_seq;
- firstcop->cop_warnings = secondcop->cop_warnings;
- firstcop->cop_hints_hash = secondcop->cop_hints_hash;
-
-#ifdef USE_ITHREADS
- secondcop->cop_stashoff = 0;
- secondcop->cop_file = NULL;
-#else
- secondcop->cop_stash = NULL;
- secondcop->cop_filegv = NULL;
-#endif
- secondcop->cop_warnings = NULL;
- secondcop->cop_hints_hash = NULL;
-
- /* If we use op_null(), and hence leave an ex-COP, some
- warnings are misreported. For example, the compile-time
- error in 'use strict; no strict refs;' */
- secondcop->op_type = OP_NULL;
- secondcop->op_ppaddr = PL_ppaddr[OP_NULL];
+ op_null(o);
+ if (oldop)
+ oldop->op_next = nextop;
}
}
break;
followop = p->op_next;
}
- if (count < 1)
+ if (count < 1 || (count == 1 && !defav))
break;
/* pp_padrange in specifically compile-time void context
* padrange.
* In particular in void context, we can only optimise to
* a padrange if see see the complete sequence
- * pushmark, pad*v, ...., list, nextstate
- * which has the net effect of of leaving the stack empty
- * (for now we leave the nextstate in the execution chain, for
- * its other side-effects).
+ * pushmark, pad*v, ...., list
+ * which has the net effect of of leaving the markstack as it
+ * was. Not pushing on to the stack (whereas padsv does touch
+ * the stack) makes no difference in void context.
*/
assert(followop);
if (gimme == OPf_WANT_VOID) {
- if (OP_TYPE_IS_OR_WAS(followop, OP_LIST)
+ if (followop->op_type == OP_LIST
&& gimme == (followop->op_flags & OPf_WANT)
- && ( followop->op_next->op_type == OP_NEXTSTATE
- || followop->op_next->op_type == OP_DBSTATE))
+ )
{
followop = followop->op_next; /* skip OP_LIST */
else
o->op_type = OP_AELEMFAST_LEX;
}
- break;
+ if (o->op_type != OP_GV)
+ break;
}
- if (o->op_next->op_type == OP_RV2SV) {
+ /* Remove $foo from the op_next chain in void context. */
+ if (oldop
+ && ( o->op_next->op_type == OP_RV2SV
+ || o->op_next->op_type == OP_RV2AV
+ || o->op_next->op_type == OP_RV2HV )
+ && (o->op_next->op_flags & OPf_WANT) == OPf_WANT_VOID
+ && !(o->op_next->op_private & OPpLVAL_INTRO))
+ {
+ oldop->op_next = o->op_next->op_next;
+ /* Reprocess the previous op if it is a nextstate, to
+ allow double-nextstate optimisation. */
+ if (oldop->op_type == OP_NEXTSTATE) {
+ oldop->op_opt = 0;
+ o = oldop;
+ oldop = oldoldop;
+ oldoldop = NULL;
+ goto redo;
+ }
+ o = oldop;
+ }
+ else if (o->op_next->op_type == OP_RV2SV) {
if (!(o->op_next->op_private & OPpDEREF)) {
op_null(o->op_next);
o->op_private |= o->op_next->op_private & (OPpLVAL_INTRO
https://perl5.git.perl.org / perl5.git / blobdiff