X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=op.c;h=ea714ebee9d477e04667fd6cb02146affe3145a0;hb=7ada78df9739acac44e6c9a8f1e08c978571e2a0;hp=871a0f62cfb1ae53b4cb06a5457214e5858925e8;hpb=500bedb6c28d0918a4bd28632e742d0905ce8519;p=p5sagit%2Fp5-mst-13.2.git diff --git a/op.c b/op.c index 871a0f6..ea714eb 100644 --- a/op.c +++ b/op.c @@ -1,7 +1,7 @@ /* op.c * * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, - * 2000, 2001, 2002, 2003, by Larry Wall and others + * 2000, 2001, 2002, 2003, 2004, by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -216,7 +216,7 @@ Perl_op_free(pTHX_ OP *o) register OP *kid, *nextkid; OPCODE type; - if (!o || o->op_seq == (U16)-1) + if (!o || o->op_static) return; if (o->op_private & OPpREFCOUNTED) { @@ -275,17 +275,20 @@ 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 */ #ifdef USE_ITHREADS - if (cPADOPo->op_padix > 0) { - /* No GvIN_PAD_off(cGVOPo_gv) here, because other references - * may still exist on the pad */ - pad_swipe(cPADOPo->op_padix, TRUE); - cPADOPo->op_padix = 0; - } + if (cPADOPo->op_padix > 0) { + /* No GvIN_PAD_off(cGVOPo_gv) here, because other references + * may still exist on the pad */ + pad_swipe(cPADOPo->op_padix, TRUE); + cPADOPo->op_padix = 0; + } #else - SvREFCNT_dec(cSVOPo->op_sv); - cSVOPo->op_sv = Nullsv; + SvREFCNT_dec(cSVOPo->op_sv); + cSVOPo->op_sv = Nullsv; #endif + } break; case OP_METHOD_NAMED: case OP_CONST: @@ -294,7 +297,7 @@ Perl_op_clear(pTHX_ OP *o) #ifdef USE_ITHREADS /** Bug #15654 Even if op_clear does a pad_free for the target of the op, - pad_free doesn't actually remove the sv that exists in the bad + pad_free doesn't actually remove the sv that exists in the pad; instead it lives on. This results in that it could be reused as a target later on when the pad was reallocated. **/ @@ -658,6 +661,15 @@ Perl_scalarvoid(pTHX_ OP *o) useless = OP_DESC(o); break; + case OP_NOT: + kid = cUNOPo->op_first; + if (kid->op_type != OP_MATCH && kid->op_type != OP_SUBST && + kid->op_type != OP_TRANS) { + goto func_ops; + } + useless = "negative pattern binding (!~)"; + break; + case OP_RV2GV: case OP_RV2SV: case OP_RV2AV: @@ -674,10 +686,14 @@ Perl_scalarvoid(pTHX_ OP *o) else { if (ckWARN(WARN_VOID)) { useless = "a constant"; + /* don't warn on optimised away booleans, eg + * use constant Foo, 5; Foo || print; */ + if (cSVOPo->op_private & OPpCONST_SHORTCIRCUIT) + useless = 0; /* the constants 0 and 1 are permitted as they are conventionally used as dummies in constructs like 1 while some_condition_with_side_effects; */ - if (SvNIOK(sv) && (SvNV(sv) == 0.0 || SvNV(sv) == 1.0)) + else if (SvNIOK(sv) && (SvNV(sv) == 0.0 || SvNV(sv) == 1.0)) useless = 0; else if (SvPOK(sv)) { /* perl4's way of mixing documentation and code @@ -1108,7 +1124,7 @@ Perl_mod(pTHX_ OP *o, I32 type) break; case OP_AELEMFAST: - localize = 1; + localize = -1; PL_modcount++; break; @@ -1756,13 +1772,11 @@ Perl_scope(pTHX_ OP *o) return o; } +/* XXX kept for BINCOMPAT only */ void Perl_save_hints(pTHX) { - SAVEI32(PL_hints); - SAVESPTR(GvHV(PL_hintgv)); - GvHV(PL_hintgv) = newHVhv(GvHV(PL_hintgv)); - SAVEFREESV(GvHV(PL_hintgv)); + Perl_croak(aTHX_ "internal error: obsolete function save_hints() called"); } int @@ -2022,7 +2036,7 @@ Perl_gen_constant_list(pTHX_ register OP *o) o->op_ppaddr = PL_ppaddr[OP_RV2AV]; o->op_flags &= ~OPf_REF; /* treat \(1..2) like an ordinary list */ o->op_flags |= OPf_PARENS; /* and flatten \(1..2,3) */ - o->op_seq = 0; /* needs to be revisited in peep() */ + o->op_opt = 0; /* needs to be revisited in peep() */ curop = ((UNOP*)o)->op_first; ((UNOP*)o)->op_first = newSVOP(OP_CONST, 0, SvREFCNT_inc(*PL_stack_sp--)); op_free(curop); @@ -3119,6 +3133,15 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right) op_free(right); return Nullop; } + /* optimise C to C, and likewise for hashes */ + if ((left->op_type == OP_PADAV || left->op_type == OP_PADHV) + && right->op_type == OP_STUB + && (left->op_private & OPpLVAL_INTRO)) + { + op_free(right); + left->op_flags &= ~(OPf_REF|OPf_SPECIAL); + return left; + } curop = list(force_list(left)); o = newBINOP(OP_AASSIGN, flags, list(force_list(right)), curop); o->op_private = (U8)(0 | (flags >> 8)); @@ -3355,14 +3378,37 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp) no_bareword_allowed(first); else if (ckWARN(WARN_BAREWORD) && (first->op_private & OPpCONST_BARE)) Perl_warner(aTHX_ packWARN(WARN_BAREWORD), "Bareword found in conditional"); - if ((type == OP_AND) == (SvTRUE(((SVOP*)first)->op_sv))) { + if ((type == OP_AND && SvTRUE(((SVOP*)first)->op_sv)) || + (type == OP_OR && !SvTRUE(((SVOP*)first)->op_sv)) || + (type == OP_DOR && !SvOK(((SVOP*)first)->op_sv))) { op_free(first); *firstp = Nullop; + if (other->op_type == OP_CONST) + other->op_private |= OPpCONST_SHORTCIRCUIT; return other; } else { + /* check for C, or C */ + OP *o2 = other; + if ( ! (o2->op_type == OP_LIST + && (( o2 = cUNOPx(o2)->op_first)) + && o2->op_type == OP_PUSHMARK + && (( o2 = o2->op_sibling)) ) + ) + o2 = other; + if ((o2->op_type == OP_PADSV || o2->op_type == OP_PADAV + || o2->op_type == OP_PADHV) + && o2->op_private & OPpLVAL_INTRO + && ckWARN(WARN_DEPRECATED)) + { + Perl_warner(aTHX_ packWARN(WARN_DEPRECATED), + "Deprecated use of my() in false conditional"); + } + op_free(other); *otherp = Nullop; + if (first->op_type == OP_CONST) + first->op_private |= OPpCONST_SHORTCIRCUIT; return first; } } @@ -3572,6 +3618,10 @@ Perl_newLOOPOP(pTHX_ I32 flags, I32 debuggable, OP *expr, OP *block) } } + /* if block is null, the next append_elem() would put UNSTACK, a scalar + * op, in listop. This is wrong. [perl #27024] */ + if (!block) + block = newOP(OP_NULL, 0); listop = append_elem(OP_LINESEQ, block, newOP(OP_UNSTACK, 0)); o = new_logop(OP_AND, 0, &expr, &listop); @@ -3722,7 +3772,6 @@ Perl_newFOROP(pTHX_ I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *blo } else { padoff = offset; - iterpflags = OPpLVAL_INTRO; /* my $_; for () */ } } if (expr->op_type == OP_RV2AV || expr->op_type == OP_PADAV) { @@ -3882,6 +3931,8 @@ Perl_cv_ckproto(pTHX_ CV *cv, GV *gv, char *p) Perl_sv_catpvf(aTHX_ msg, " sub %"SVf, name); if (SvPOK(cv)) Perl_sv_catpvf(aTHX_ msg, " (%"SVf")", (SV *)cv); + else + Perl_sv_catpvf(aTHX_ msg, ": none"); sv_catpv(msg, " vs "); if (p) Perl_sv_catpvf(aTHX_ msg, "(%s)", p); @@ -4018,11 +4069,19 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) char *name; char *aname; GV *gv; - char *ps = proto ? SvPVx(((SVOP*)proto)->op_sv, n_a) : Nullch; + char *ps; register CV *cv=0; SV *const_sv; name = o ? SvPVx(cSVOPo->op_sv, n_a) : Nullch; + + if (proto) { + assert(proto->op_type == OP_CONST); + ps = SvPVx(((SVOP*)proto)->op_sv, n_a); + } + else + ps = Nullch; + if (!name && PERLDB_NAMEANON && CopLINE(PL_curcop)) { SV *sv = sv_newmortal(); Perl_sv_setpvf(aTHX_ sv, "%s[%s:%"IVdf"]", @@ -5047,6 +5106,7 @@ Perl_ck_ftst(pTHX_ OP *o) gv_fetchpv(SvPVx(kid->op_sv, n_a), TRUE, SVt_PVIO)); op_free(o); o = newop; + return o; } else { if ((PL_hints & HINT_FILETEST_ACCESS) && @@ -5389,7 +5449,7 @@ Perl_ck_grep(pTHX_ OP *o) OP* k; o = ck_sort(o); kid = cLISTOPo->op_first->op_sibling; - for (k = cLISTOPo->op_first->op_sibling->op_next; k; k = k->op_next) { + for (k = cUNOPx(kid)->op_first; k; k = k->op_next) { kid = k; } kid->op_next = (OP*)gwop; @@ -5562,6 +5622,19 @@ Perl_ck_sassign(pTHX_ OP *o) return kid; } } + /* optimise C to C */ + if (kid->op_type == OP_UNDEF) { + OP *kkid = kid->op_sibling; + if (kkid && kkid->op_type == OP_PADSV + && (kkid->op_private & OPpLVAL_INTRO)) + { + cLISTOPo->op_first = NULL; + kid->op_sibling = NULL; + op_free(o); + op_free(kid); + return kkid; + } + } return o; } @@ -5840,7 +5913,7 @@ S_simplify_sort(pTHX_ OP *o) { register OP *kid = cLISTOPo->op_first->op_sibling; /* get past pushmark */ OP *k; - int reversed; + int descending; GV *gv; if (!(o->op_flags & OPf_STACKED)) return; @@ -5869,11 +5942,12 @@ S_simplify_sort(pTHX_ OP *o) if (GvSTASH(gv) != PL_curstash) return; if (strEQ(GvNAME(gv), "a")) - reversed = 0; + descending = 0; else if (strEQ(GvNAME(gv), "b")) - reversed = 1; + descending = 1; else return; + kid = k; /* back to cmp */ if (kBINOP->op_last->op_type != OP_RV2SV) return; @@ -5883,13 +5957,13 @@ S_simplify_sort(pTHX_ OP *o) kid = kUNOP->op_first; /* get past rv2sv */ gv = kGVOP_gv; if (GvSTASH(gv) != PL_curstash - || ( reversed + || ( descending ? strNE(GvNAME(gv), "a") : strNE(GvNAME(gv), "b"))) return; o->op_flags &= ~(OPf_STACKED | OPf_SPECIAL); - if (reversed) - o->op_private |= OPpSORT_REVERSE; + if (descending) + o->op_private |= OPpSORT_DESCEND; if (k->op_type == OP_NCMP) o->op_private |= OPpSORT_NUMERIC; if (k->op_type == OP_I_NCMP) @@ -6268,25 +6342,21 @@ Perl_peep(pTHX_ register OP *o) { register OP* oldop = 0; - if (!o || o->op_seq) + if (!o || o->op_opt) return; ENTER; SAVEOP(); SAVEVPTR(PL_curcop); for (; o; o = o->op_next) { - if (o->op_seq) + if (o->op_opt) break; - /* The special value -1 is used by the B::C compiler backend to indicate - * that an op is statically defined and should not be freed */ - if (!PL_op_seqmax || PL_op_seqmax == (U16)-1) - PL_op_seqmax = 1; PL_op = o; switch (o->op_type) { case OP_SETSTATE: case OP_NEXTSTATE: case OP_DBSTATE: PL_curcop = ((COP*)o); /* for warnings */ - o->op_seq = PL_op_seqmax++; + o->op_opt = 1; break; case OP_CONST: @@ -6317,7 +6387,7 @@ Perl_peep(pTHX_ register OP *o) o->op_targ = ix; } #endif - o->op_seq = PL_op_seqmax++; + o->op_opt = 1; break; case OP_CONCAT: @@ -6335,11 +6405,11 @@ Perl_peep(pTHX_ register OP *o) op_null(o->op_next); } ignore_optimization: - o->op_seq = PL_op_seqmax++; + o->op_opt = 1; break; case OP_STUB: if ((o->op_flags & OPf_WANT) != OPf_WANT_LIST) { - o->op_seq = PL_op_seqmax++; + o->op_opt = 1; break; /* Scalar stub must produce undef. List stub is noop */ } goto nothin; @@ -6354,6 +6424,7 @@ Perl_peep(pTHX_ register OP *o) to peep() from mistakenly concluding that optimisation has already occurred. This doesn't fix the real problem, though (See 20010220.007). AMS 20010719 */ + /* op_seq functionality is now replaced by op_opt */ if (oldop && o->op_next) { oldop->op_next = o->op_next; continue; @@ -6367,25 +6438,17 @@ Perl_peep(pTHX_ register OP *o) oldop->op_next = o->op_next; continue; } - o->op_seq = PL_op_seqmax++; + o->op_opt = 1; break; + case OP_PADAV: case OP_GV: - 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 - | OPpOUR_INTRO); - o->op_next = o->op_next->op_next; - o->op_type = OP_GVSV; - o->op_ppaddr = PL_ppaddr[OP_GVSV]; - } - } - else if (o->op_next->op_type == OP_RV2AV) { - OP* pop = o->op_next->op_next; + if (o->op_type == OP_PADAV || o->op_next->op_type == OP_RV2AV) { + OP* pop = (o->op_type == OP_PADAV) ? + o->op_next : o->op_next->op_next; IV i; if (pop && pop->op_type == OP_CONST && - (PL_op = pop->op_next) && + ((PL_op = pop->op_next)) && pop->op_next->op_type == OP_AELEM && !(pop->op_next->op_private & (OPpLVAL_INTRO|OPpLVAL_DEFER|OPpDEREF|OPpMAYBE_LVSUB)) && @@ -6394,16 +6457,36 @@ Perl_peep(pTHX_ register OP *o) i >= 0) { GV *gv; - op_null(o->op_next); + if (cSVOPx(pop)->op_private & OPpCONST_STRICT) + no_bareword_allowed(pop); + if (o->op_type == OP_GV) + op_null(o->op_next); op_null(pop->op_next); op_null(pop); o->op_flags |= pop->op_next->op_flags & OPf_MOD; o->op_next = pop->op_next->op_next; - o->op_type = OP_AELEMFAST; o->op_ppaddr = PL_ppaddr[OP_AELEMFAST]; o->op_private = (U8)i; - gv = cGVOPo_gv; - GvAVn(gv); + if (o->op_type == OP_GV) { + gv = cGVOPo_gv; + GvAVn(gv); + } + else + o->op_flags |= OPf_SPECIAL; + o->op_type = OP_AELEMFAST; + } + o->op_opt = 1; + break; + } + + 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 + | OPpOUR_INTRO); + o->op_next = o->op_next->op_next; + o->op_type = OP_GVSV; + o->op_ppaddr = PL_ppaddr[OP_GVSV]; } } else if ((o->op_private & OPpEARLY_CV) && ckWARN(WARN_PROTOTYPE)) { @@ -6429,7 +6512,7 @@ Perl_peep(pTHX_ register OP *o) op_null(o->op_next); } - o->op_seq = PL_op_seqmax++; + o->op_opt = 1; break; case OP_MAPWHILE: @@ -6442,7 +6525,7 @@ Perl_peep(pTHX_ register OP *o) case OP_DORASSIGN: case OP_COND_EXPR: case OP_RANGE: - o->op_seq = PL_op_seqmax++; + o->op_opt = 1; while (cLOGOP->op_other->op_type == OP_NULL) cLOGOP->op_other = cLOGOP->op_other->op_next; peep(cLOGOP->op_other); /* Recursive calls are not replaced by fptr calls */ @@ -6450,7 +6533,7 @@ Perl_peep(pTHX_ register OP *o) case OP_ENTERLOOP: case OP_ENTERITER: - o->op_seq = PL_op_seqmax++; + o->op_opt = 1; while (cLOOP->op_redoop->op_type == OP_NULL) cLOOP->op_redoop = cLOOP->op_redoop->op_next; peep(cLOOP->op_redoop); @@ -6465,7 +6548,7 @@ Perl_peep(pTHX_ register OP *o) case OP_QR: case OP_MATCH: case OP_SUBST: - o->op_seq = PL_op_seqmax++; + o->op_opt = 1; while (cPMOP->op_pmreplstart && cPMOP->op_pmreplstart->op_type == OP_NULL) cPMOP->op_pmreplstart = cPMOP->op_pmreplstart->op_next; @@ -6473,7 +6556,7 @@ Perl_peep(pTHX_ register OP *o) break; case OP_EXEC: - o->op_seq = PL_op_seqmax++; + o->op_opt = 1; if (ckWARN(WARN_SYNTAX) && o->op_next && o->op_next->op_type == OP_NEXTSTATE) { if (o->op_next->op_sibling && @@ -6498,7 +6581,7 @@ Perl_peep(pTHX_ register OP *o) char *key = NULL; STRLEN keylen; - o->op_seq = PL_op_seqmax++; + o->op_opt = 1; if (((BINOP*)o)->op_last->op_type != OP_CONST) break; @@ -6516,8 +6599,217 @@ Perl_peep(pTHX_ register OP *o) break; } + case OP_SORT: { + /* will point to RV2AV or PADAV op on LHS/RHS of assign */ + OP *oleft, *oright; + OP *o2; + + /* check that RHS of sort is a single plain array */ + oright = cUNOPo->op_first; + if (!oright || oright->op_type != OP_PUSHMARK) + break; + + /* reverse sort ... can be optimised. */ + if (!cUNOPo->op_sibling) { + /* Nothing follows us on the list. */ + OP *reverse = o->op_next; + + if (reverse->op_type == OP_REVERSE && + (reverse->op_flags & OPf_WANT) == OPf_WANT_LIST) { + OP *pushmark = cUNOPx(reverse)->op_first; + if (pushmark && (pushmark->op_type == OP_PUSHMARK) + && (cUNOPx(pushmark)->op_sibling == o)) { + /* reverse -> pushmark -> sort */ + o->op_private |= OPpSORT_REVERSE; + op_null(reverse); + pushmark->op_next = oright->op_next; + op_null(oright); + } + } + } + + /* make @a = sort @a act in-place */ + + o->op_opt = 1; + + oright = cUNOPx(oright)->op_sibling; + if (!oright) + break; + if (oright->op_type == OP_NULL) { /* skip sort block/sub */ + oright = cUNOPx(oright)->op_sibling; + } + + if (!oright || + (oright->op_type != OP_RV2AV && oright->op_type != OP_PADAV) + || oright->op_next != o + || (oright->op_private & OPpLVAL_INTRO) + ) + break; + + /* o2 follows the chain of op_nexts through the LHS of the + * assign (if any) to the aassign op itself */ + o2 = o->op_next; + if (!o2 || o2->op_type != OP_NULL) + break; + o2 = o2->op_next; + if (!o2 || o2->op_type != OP_PUSHMARK) + break; + o2 = o2->op_next; + if (o2 && o2->op_type == OP_GV) + o2 = o2->op_next; + if (!o2 + || (o2->op_type != OP_PADAV && o2->op_type != OP_RV2AV) + || (o2->op_private & OPpLVAL_INTRO) + ) + break; + oleft = o2; + o2 = o2->op_next; + if (!o2 || o2->op_type != OP_NULL) + break; + o2 = o2->op_next; + if (!o2 || o2->op_type != OP_AASSIGN + || (o2->op_flags & OPf_WANT) != OPf_WANT_VOID) + break; + + /* check that the sort is the first arg on RHS of assign */ + + o2 = cUNOPx(o2)->op_first; + if (!o2 || o2->op_type != OP_NULL) + break; + o2 = cUNOPx(o2)->op_first; + if (!o2 || o2->op_type != OP_PUSHMARK) + break; + if (o2->op_sibling != o) + break; + + /* check the array is the same on both sides */ + if (oleft->op_type == OP_RV2AV) { + if (oright->op_type != OP_RV2AV + || !cUNOPx(oright)->op_first + || cUNOPx(oright)->op_first->op_type != OP_GV + || cGVOPx_gv(cUNOPx(oleft)->op_first) != + cGVOPx_gv(cUNOPx(oright)->op_first) + ) + break; + } + else if (oright->op_type != OP_PADAV + || oright->op_targ != oleft->op_targ + ) + break; + + /* transfer MODishness etc from LHS arg to RHS arg */ + oright->op_flags = oleft->op_flags; + o->op_private |= OPpSORT_INPLACE; + + /* excise push->gv->rv2av->null->aassign */ + o2 = o->op_next->op_next; + op_null(o2); /* PUSHMARK */ + o2 = o2->op_next; + if (o2->op_type == OP_GV) { + op_null(o2); /* GV */ + o2 = o2->op_next; + } + op_null(o2); /* RV2AV or PADAV */ + o2 = o2->op_next->op_next; + op_null(o2); /* AASSIGN */ + + o->op_next = o2->op_next; + + break; + } + + case OP_REVERSE: { + OP *ourmark, *theirmark, *ourlast, *iter, *expushmark, *rv2av; + OP *gvop = NULL; + LISTOP *enter, *exlist; + o->op_opt = 1; + + enter = (LISTOP *) o->op_next; + if (!enter) + break; + if (enter->op_type == OP_NULL) { + enter = (LISTOP *) enter->op_next; + if (!enter) + break; + } + /* for $a (...) will have OP_GV then OP_RV2GV here. + for (...) just has an OP_GV. */ + if (enter->op_type == OP_GV) { + gvop = (OP *) enter; + enter = (LISTOP *) enter->op_next; + if (!enter) + break; + if (enter->op_type == OP_RV2GV) { + enter = (LISTOP *) enter->op_next; + if (!enter) + break; + } + } + + if (enter->op_type != OP_ENTERITER) + break; + + iter = enter->op_next; + if (!iter || iter->op_type != OP_ITER) + break; + + expushmark = enter->op_first; + if (!expushmark || expushmark->op_type != OP_NULL + || expushmark->op_targ != OP_PUSHMARK) + break; + + exlist = (LISTOP *) expushmark->op_sibling; + if (!exlist || exlist->op_type != OP_NULL + || exlist->op_targ != OP_LIST) + break; + + if (exlist->op_last != o) { + /* Mmm. Was expecting to point back to this op. */ + break; + } + theirmark = exlist->op_first; + if (!theirmark || theirmark->op_type != OP_PUSHMARK) + break; + + if (theirmark->op_sibling != o) { + /* There's something between the mark and the reverse, eg + for (1, reverse (...)) + so no go. */ + break; + } + + ourmark = ((LISTOP *)o)->op_first; + if (!ourmark || ourmark->op_type != OP_PUSHMARK) + break; + + ourlast = ((LISTOP *)o)->op_last; + if (!ourlast || ourlast->op_next != o) + break; + + rv2av = ourmark->op_sibling; + if (rv2av && rv2av->op_type == OP_RV2AV && rv2av->op_sibling == 0 + && rv2av->op_flags == (OPf_WANT_LIST | OPf_KIDS) + && enter->op_flags == (OPf_WANT_LIST | OPf_KIDS)) { + /* We're just reversing a single array. */ + rv2av->op_flags = OPf_WANT_SCALAR | OPf_KIDS | OPf_REF; + enter->op_flags |= OPf_STACKED; + } + + /* We don't have control over who points to theirmark, so sacrifice + ours. */ + theirmark->op_next = ourmark->op_next; + theirmark->op_flags = ourmark->op_flags; + ourlast->op_next = gvop ? gvop : (OP *) enter; + op_null(ourmark); + op_null(o); + enter->op_private |= OPpITER_REVERSED; + iter->op_private |= OPpITER_REVERSED; + + break; + } + default: - o->op_seq = PL_op_seqmax++; + o->op_opt = 1; break; } oldop = o;