move body of pp_concat() to S_do_concat()

[perl5.git] / pp_hot.c

/*    pp_hot.c
 *
 *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
 *    2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 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.
 *
 */

/*
 * Then he heard Merry change the note, and up went the Horn-cry of Buckland,
 * shaking the air.
 *
 *                  Awake!  Awake!  Fear, Fire, Foes!  Awake!
 *                               Fire, Foes!  Awake!
 *
 *     [p.1007 of _The Lord of the Rings_, VI/viii: "The Scouring of the Shire"]
 */

/* This file contains 'hot' pp ("push/pop") functions that
 * execute the opcodes that make up a perl program. A typical pp function
 * expects to find its arguments on the stack, and usually pushes its
 * results onto the stack, hence the 'pp' terminology. Each OP structure
 * contains a pointer to the relevant pp_foo() function.
 *
 * By 'hot', we mean common ops whose execution speed is critical.
 * By gathering them together into a single file, we encourage
 * CPU cache hits on hot code. Also it could be taken as a warning not to
 * change any code in this file unless you're sure it won't affect
 * performance.
 */

#include "EXTERN.h"
#define PERL_IN_PP_HOT_C
#include "perl.h"

/* Hot code. */

PP(pp_const)
{
    dSP;
    XPUSHs(cSVOP_sv);
    RETURN;
}

PP(pp_nextstate)
{
    PL_curcop = (COP*)PL_op;
    TAINT_NOT;		/* Each statement is presumed innocent */
    PL_stack_sp = PL_stack_base + CX_CUR()->blk_oldsp;
    FREETMPS;
    PERL_ASYNC_CHECK();
    return NORMAL;
}

PP(pp_gvsv)
{
    dSP;
    EXTEND(SP,1);
    if (UNLIKELY(PL_op->op_private & OPpLVAL_INTRO))
	PUSHs(save_scalar(cGVOP_gv));
    else
	PUSHs(GvSVn(cGVOP_gv));
    RETURN;
}


/* also used for: pp_lineseq() pp_regcmaybe() pp_scalar() pp_scope() */

PP(pp_null)
{
    return NORMAL;
}

/* This is sometimes called directly by pp_coreargs, pp_grepstart and
   amagic_call. */
PP(pp_pushmark)
{
    PUSHMARK(PL_stack_sp);
    return NORMAL;
}

PP(pp_stringify)
{
    dSP; dTARGET;
    SV * const sv = TOPs;
    SETs(TARG);
    sv_copypv(TARG, sv);
    SvSETMAGIC(TARG);
    /* no PUTBACK, SETs doesn't inc/dec SP */
    return NORMAL;
}

PP(pp_gv)
{
    dSP;
    XPUSHs(MUTABLE_SV(cGVOP_gv));
    RETURN;
}


/* also used for: pp_andassign() */

PP(pp_and)
{
    PERL_ASYNC_CHECK();
    {
	/* SP is not used to remove a variable that is saved across the
	  sv_2bool_flags call in SvTRUE_NN, if a RISC/CISC or low/high machine
	  register or load/store vs direct mem ops macro is introduced, this
	  should be a define block between direct PL_stack_sp and dSP operations,
	  presently, using PL_stack_sp is bias towards CISC cpus */
	SV * const sv = *PL_stack_sp;
	if (!SvTRUE_NN(sv))
	    return NORMAL;
	else {
	    if (PL_op->op_type == OP_AND)
		--PL_stack_sp;
	    return cLOGOP->op_other;
	}
    }
}

PP(pp_sassign)
{
    dSP;
    /* sassign keeps its args in the optree traditionally backwards.
       So we pop them differently.
    */
    SV *left = POPs; SV *right = TOPs;

    if (PL_op->op_private & OPpASSIGN_BACKWARDS) { /* {or,and,dor}assign */
	SV * const temp = left;
	left = right; right = temp;
    }
    assert(TAINTING_get || !TAINT_get);
    if (UNLIKELY(TAINT_get) && !SvTAINTED(right))
	TAINT_NOT;
    if (UNLIKELY(PL_op->op_private & OPpASSIGN_CV_TO_GV)) {
        /* *foo =\&bar */
	SV * const cv = SvRV(right);
	const U32 cv_type = SvTYPE(cv);
	const bool is_gv = isGV_with_GP(left);
	const bool got_coderef = cv_type == SVt_PVCV || cv_type == SVt_PVFM;

	if (!got_coderef) {
	    assert(SvROK(cv));
	}

	/* Can do the optimisation if left (LVALUE) is not a typeglob,
	   right (RVALUE) is a reference to something, and we're in void
	   context. */
	if (!got_coderef && !is_gv && GIMME_V == G_VOID) {
	    /* Is the target symbol table currently empty?  */
	    GV * const gv = gv_fetchsv_nomg(left, GV_NOINIT, SVt_PVGV);
	    if (SvTYPE(gv) != SVt_PVGV && !SvOK(gv)) {
		/* Good. Create a new proxy constant subroutine in the target.
		   The gv becomes a(nother) reference to the constant.  */
		SV *const value = SvRV(cv);

		SvUPGRADE(MUTABLE_SV(gv), SVt_IV);
		SvPCS_IMPORTED_on(gv);
		SvRV_set(gv, value);
		SvREFCNT_inc_simple_void(value);
		SETs(left);
		RETURN;
	    }
	}

	/* Need to fix things up.  */
	if (!is_gv) {
	    /* Need to fix GV.  */
	    left = MUTABLE_SV(gv_fetchsv_nomg(left,GV_ADD, SVt_PVGV));
	}

	if (!got_coderef) {
	    /* We've been returned a constant rather than a full subroutine,
	       but they expect a subroutine reference to apply.  */
	    if (SvROK(cv)) {
		ENTER_with_name("sassign_coderef");
		SvREFCNT_inc_void(SvRV(cv));
		/* newCONSTSUB takes a reference count on the passed in SV
		   from us.  We set the name to NULL, otherwise we get into
		   all sorts of fun as the reference to our new sub is
		   donated to the GV that we're about to assign to.
		*/
		SvRV_set(right, MUTABLE_SV(newCONSTSUB(GvSTASH(left), NULL,
						      SvRV(cv))));
		SvREFCNT_dec_NN(cv);
		LEAVE_with_name("sassign_coderef");
	    } else {
		/* What can happen for the corner case *{"BONK"} = \&{"BONK"};
		   is that
		   First:   ops for \&{"BONK"}; return us the constant in the
			    symbol table
		   Second:  ops for *{"BONK"} cause that symbol table entry
			    (and our reference to it) to be upgraded from RV
			    to typeblob)
		   Thirdly: We get here. cv is actually PVGV now, and its
			    GvCV() is actually the subroutine we're looking for

		   So change the reference so that it points to the subroutine
		   of that typeglob, as that's what they were after all along.
		*/
		GV *const upgraded = MUTABLE_GV(cv);
		CV *const source = GvCV(upgraded);

		assert(source);
		assert(CvFLAGS(source) & CVf_CONST);

		SvREFCNT_inc_simple_void_NN(source);
		SvREFCNT_dec_NN(upgraded);
		SvRV_set(right, MUTABLE_SV(source));
	    }
	}

    }
    if (
      UNLIKELY(SvTEMP(left)) && !SvSMAGICAL(left) && SvREFCNT(left) == 1 &&
      (!isGV_with_GP(left) || SvFAKE(left)) && ckWARN(WARN_MISC)
    )
	Perl_warner(aTHX_
	    packWARN(WARN_MISC), "Useless assignment to a temporary"
	);
    SvSetMagicSV(left, right);
    SETs(left);
    RETURN;
}

PP(pp_cond_expr)
{
    dSP;
    SV *sv;

    PERL_ASYNC_CHECK();
    sv = POPs;
    RETURNOP(SvTRUE_NN(sv) ? cLOGOP->op_other : cLOGOP->op_next);
}

PP(pp_unstack)
{
    PERL_CONTEXT *cx;
    PERL_ASYNC_CHECK();
    TAINT_NOT;		/* Each statement is presumed innocent */
    cx  = CX_CUR();
    PL_stack_sp = PL_stack_base + cx->blk_oldsp;
    FREETMPS;
    if (!(PL_op->op_flags & OPf_SPECIAL)) {
        assert(CxTYPE(cx) == CXt_BLOCK || CxTYPE_is_LOOP(cx));
	CX_LEAVE_SCOPE(cx);
    }
    return NORMAL;
}


/* The main body of pp_concat, not including the magic/overload and
 * stack handling.
 * It does targ = left . right.
 * Moved into a separate function so that pp_multiconcat() can use it
 * too.
 */

PERL_STATIC_INLINE void
S_do_concat(pTHX_ SV *left, SV *right, SV *targ, U8 targmy)
{
    bool lbyte;
    STRLEN rlen;
    const char *rpv = NULL;
    bool rbyte = FALSE;
    bool rcopied = FALSE;

    if (TARG == right && right != left) { /* $r = $l.$r */
	rpv = SvPV_nomg_const(right, rlen);
	rbyte = !DO_UTF8(right);
	right = newSVpvn_flags(rpv, rlen, SVs_TEMP);
	rpv = SvPV_const(right, rlen);	/* no point setting UTF-8 here */
	rcopied = TRUE;
    }

    if (TARG != left) { /* not $l .= $r */
        STRLEN llen;
        const char* const lpv = SvPV_nomg_const(left, llen);
	lbyte = !DO_UTF8(left);
	sv_setpvn(TARG, lpv, llen);
	if (!lbyte)
	    SvUTF8_on(TARG);
	else
	    SvUTF8_off(TARG);
    }
    else { /* $l .= $r   and   left == TARG */
	if (!SvOK(left)) {
            if ((left == right                          /* $l .= $l */
                 || targmy)                             /* $l = $l . $r */
                && ckWARN(WARN_UNINITIALIZED)
                )
                report_uninit(left);
            SvPVCLEAR(left);
	}
        else {
            SvPV_force_nomg_nolen(left);
        }
	lbyte = !DO_UTF8(left);
	if (IN_BYTES)
	    SvUTF8_off(left);
    }

    if (!rcopied) {
	rpv = SvPV_nomg_const(right, rlen);
	rbyte = !DO_UTF8(right);
    }
    if (lbyte != rbyte) {
	if (lbyte)
	    sv_utf8_upgrade_nomg(TARG);
	else {
	    if (!rcopied)
		right = newSVpvn_flags(rpv, rlen, SVs_TEMP);
	    sv_utf8_upgrade_nomg(right);
	    rpv = SvPV_nomg_const(right, rlen);
	}
    }
    sv_catpvn_nomg(TARG, rpv, rlen);
    SvSETMAGIC(TARG);
}


PP(pp_concat)
{
  dSP; dATARGET; tryAMAGICbin_MG(concat_amg, AMGf_assign);
  {
    dPOPTOPssrl;
    S_do_concat(aTHX_ left, right, targ, PL_op->op_private & OPpTARGET_MY);
    SETs(TARG);
    RETURN;
  }
}


/* pp_multiconcat()

Concatenate one or more args, possibly interleaved with constant string
segments. The result may be assigned to, or appended to, a variable or
expression.

Several op_flags and/or op_private bits indicate what the target is, and
whether it's appended to. Valid permutations are:

    -                                  (PADTMP) = (A.B.C....)
    OPpTARGET_MY                       $lex     = (A.B.C....)
    OPpTARGET_MY,OPpLVAL_INTRO         my $lex  = (A.B.C....)
    OPpTARGET_MY,OPpMULTICONCAT_APPEND $lex    .= (A.B.C....)
    OPf_STACKED                        expr     = (A.B.C....)
    OPf_STACKED,OPpMULTICONCAT_APPEND  expr    .= (A.B.C....)

Other combinations like (A.B).(C.D) are not optimised into a multiconcat
op, as it's too hard to get the correct ordering of ties, overload etc.

In addition:

    OPpMULTICONCAT_FAKE:       not a real concat, instead an optimised
                               sprintf "...%s...". Don't call '.'
                               overloading: only use '""' overloading.

    OPpMULTICONCAT_STRINGIFY:  (for Deparse's benefit) the RHS was of the
                               form "...$a...$b..." rather than
                               "..." . $a . "..." . $b . "..."

An OP_MULTICONCAT is of type UNOP_AUX. The fixed slots of the aux array are
defined with PERL_MULTICONCAT_IX_FOO constants, where:


    FOO       index description
    --------  ----- ----------------------------------
    NARGS     0     number of arguments
    PLAIN_PV  1     non-utf8 constant string
    PLAIN_LEN 2     non-utf8 constant string length
    UTF8_PV   3     utf8 constant string
    UTF8_LEN  4     utf8 constant string length
    LENGTHS   5     first of nargs+1 const segment lengths

The idea is that a general string concatenation will have a fixed (known
at compile time) number of variable args, interspersed with constant
strings, e.g. "a=$a b=$b\n"

All the constant string segments "a=", " b=" and "\n" are stored as a
single string "a= b=\n", pointed to from the PLAIN_PV/UTF8_PV slot, along
with a series of segment lengths: e.g. 2,3,1. In the case where the
constant string is plain but has a different utf8 representation, both
variants are stored, and two sets of (nargs+1) segments lengths are stored
in the slots beginning at PERL_MULTICONCAT_IX_LENGTHS.

A segment length of -1 indicates that there is no constant string at that
point; this distinguishes between e.g. ($a . $b) and ($a . "" . $b), which
have differing overloading behaviour.

*/

PP(pp_multiconcat)
{
    dSP;
    SV *targ;                /* The SV to be assigned or appended to */
    SV *dsv;                 /* the SV to concat args to (often == targ) */
    char *dsv_pv;            /* where within SvPVX(dsv) we're writing to */
    STRLEN targ_len;         /* SvCUR(targ) */
    SV **toparg;             /* the highest arg position on the stack */
    UNOP_AUX_item *aux;      /* PL_op->op_aux buffer */
    UNOP_AUX_item *const_lens; /* the segment length array part of aux */
    const char *const_pv;    /* the current segment of the const string buf */
    SSize_t nargs;           /* how many args were expected */
    SSize_t stack_adj;       /* how much to adjust SP on return */
    STRLEN grow;             /* final size of destination string (dsv) */
    UV targ_count;           /* how many times targ has appeared on the RHS */
    bool is_append;          /* OPpMULTICONCAT_APPEND flag is set */
    bool slow_concat;        /* args too complex for quick concat */
    U32  dst_utf8;           /* the result will be utf8 (indicate this with
                                SVf_UTF8 in a U32, rather than using bool,
                                for ease of testing and setting) */
    /* for each arg, holds the result of an SvPV() call */
    struct multiconcat_svpv {
        char          *pv;
        SSize_t       len;
    }
        *targ_chain,         /* chain of slots where targ has appeared on RHS */
        *svpv_p,             /* ptr for looping through svpv_buf */
        *svpv_base,          /* first slot (may be greater than svpv_buf), */
        *svpv_end,           /* and slot after highest result so far, of: */
        svpv_buf[PERL_MULTICONCAT_MAXARG]; /* buf for storing SvPV() results */

    aux   = cUNOP_AUXx(PL_op)->op_aux;
    stack_adj = nargs = aux[PERL_MULTICONCAT_IX_NARGS].ssize;
    is_append = cBOOL(PL_op->op_private & OPpMULTICONCAT_APPEND);

    /* get targ from the stack or pad */

    if (PL_op->op_flags & OPf_STACKED) {
        if (is_append) {
            /* for 'expr .= ...', expr is the bottom item on the stack */
            targ = SP[-nargs];
            stack_adj++;
        }
        else
            /* for 'expr = ...', expr is the top item on the stack */
            targ = POPs;
    }
    else {
        SV **svp = &(PAD_SVl(PL_op->op_targ));
        targ = *svp;
        if (PL_op->op_private & OPpLVAL_INTRO) {
            assert(PL_op->op_private & OPpTARGET_MY);
            save_clearsv(svp);
        }
        if (!nargs)
            /* $lex .= "const" doesn't cause anything to be pushed */
            EXTEND(SP,1);
    }

    toparg = SP;
    SP -= (nargs - 1);
    dsv           = targ; /* Set the destination for all concats. This is
                             initially targ; later on, dsv may be switched
                             to point to a TEMP SV if overloading is
                             encountered.  */
    grow          = 1;    /* allow for '\0' at minimum */
    targ_count    = 0;
    targ_chain    = NULL;
    targ_len      = 0;
    svpv_end      = svpv_buf;
                    /* only utf8 variants of the const strings? */
    dst_utf8      = aux[PERL_MULTICONCAT_IX_PLAIN_PV].pv ? 0 : SVf_UTF8;


    /* --------------------------------------------------------------
     * Phase 1:
     *
     * stringify (i.e. SvPV()) every arg and store the resultant pv/len/utf8
     * triplets in svpv_buf[]. Also increment 'grow' by the args' lengths.
     *
     * utf8 is indicated by storing a negative length.
     *
     * Where an arg is actually targ, the stringification is deferred:
     * the length is set to 0, and the slot is added to targ_chain.
     *
     * If an overloaded arg is found, the loop is abandoned at that point,
     * and dsv is set to an SvTEMP SV where the results-so-far will be
     * accumulated.
     */

    for (; SP <= toparg; SP++, svpv_end++) {
        bool simple_flags;
        U32 utf8;
        STRLEN len;
        SV *sv;

        assert(svpv_end - svpv_buf < PERL_MULTICONCAT_MAXARG);

        sv = *SP;
        simple_flags = (SvFLAGS(sv) & (SVs_GMG|SVf_ROK|SVf_POK)) == SVf_POK;

        /* this if/else chain is arranged so that common/simple cases
         * take few conditionals */

        if (LIKELY(simple_flags && (sv != targ))) {
            /* common case: sv is a simple PV and not the targ */
            svpv_end->pv  = SvPVX(sv);
            len           = SvCUR(sv);
        }
        else if (simple_flags) {
            /* sv is targ (but can't be magic or overloaded).
             * Delay storing PV pointer; instead, add slot to targ_chain
             * so it can be populated later, after targ has been grown and
             * we know its final SvPVX() address.
             */
          targ_on_rhs:
            svpv_end->len = 0; /* zerojng here means we can skip
                                  updating later if targ_len == 0 */
            svpv_end->pv  = (char*)targ_chain;
            targ_chain    = svpv_end;
            targ_count++;
            continue;
        }
        else {
            if (UNLIKELY(SvFLAGS(sv) & (SVs_GMG|SVf_ROK))) {
                /* its got magic, is tied, and/or is overloaded */
                SvGETMAGIC(sv);

                if (UNLIKELY(SvAMAGIC(sv))
                    && !(PL_op->op_private & OPpMULTICONCAT_FAKE))
                {
                    /* One of the RHS args is overloaded. Abandon stringifying
                     * the args at this point, then in the concat loop later
                     * on, concat the plain args stringified so far into a
                     * TEMP SV. At the end of this function the remaining
                     * args (including the current one) will be handled
                     * specially, using overload calls.
                     * FAKE implies an optimised sprintf which doesn't use
                     * concat overloading, only "" overloading.
                     */

                    if (   svpv_end == svpv_buf + 1
                           /* no const string segments */
                        && aux[PERL_MULTICONCAT_IX_LENGTHS].ssize     == -1
                        && aux[PERL_MULTICONCAT_IX_LENGTHS + 1].ssize == -1
                    ) {
                        /* special case: if the overloaded sv is the
                         * second arg in the concat chain, stop at the
                         * first arg rather than this, so that
                         *
                         *   $arg1 . $arg2
                         *
                         * invokes overloading as
                         *
                         *    concat($arg2, $arg1, 1)
                         *
                         * rather than
                         *
                         *    concat($arg2, "$arg1", 1)
                         *
                         * This means that if for example arg1 is a ref,
                         * it gets passed as-is to the concat method
                         * rather than a stringified copy. If it's not the
                         * first arg, it doesn't matter, as in $arg0 .
                         * $arg1 .  $arg2, where the result of ($arg0 .
                         * $arg1) will already be a string.
                         * THis isn't perfect: we'll have already
                         * done SvPV($arg1) on the previous iteration;
                         * and are now throwing away that result and
                         * hoping arg1 hasn;t been affected.
                         */
                        svpv_end--;
                        SP--;
                    }

                  setup_overload:
                    dsv = newSVpvn_flags("", 0, SVs_TEMP);

                    if (targ_chain) {
                        /* Get the string value of targ and populate any
                         * RHS slots which use it */
                        char *pv = SvPV_nomg(targ, len);
                        dst_utf8 |= (SvFLAGS(targ) & SVf_UTF8);
                        grow += len * targ_count;
                        do {
                            struct multiconcat_svpv *p = targ_chain;
                            targ_chain = (struct multiconcat_svpv *)(p->pv);
                            p->pv  = pv;
                            p->len = len;
                        } while (targ_chain);
                    }
                    else if (is_append)
                        SvGETMAGIC(targ);

                    goto phase3;
                }

                if (SvFLAGS(sv) & SVs_RMG) {
                    /* probably tied; copy it to guarantee separate values
                     * each time it's used, e.g. "-$tied-$tied-$tied-",
                     * since FETCH() isn't necessarily idempotent */
                    SV *nsv = newSV(0);
                    sv_setsv_flags(nsv, sv, SV_NOSTEAL);
                    sv_2mortal(nsv);
                    if (   sv == targ
                        && is_append
                        && nargs == 1
                        /* no const string segments */
                        && aux[PERL_MULTICONCAT_IX_LENGTHS].ssize   == -1
                        && aux[PERL_MULTICONCAT_IX_LENGTHS+1].ssize == -1)
                    {
                        /* special-case $tied .= $tied.
                         *
                         * For something like
                         *    sub FETCH { $i++ }
                         * then
                         *    $tied .= $tied . $tied . $tied;
                         * will STORE "4123"
                         * while
                         *    $tied .= $tied
                         * will STORE "12"
                         *
                         * i.e. for a single mutator concat, the LHS is
                         * retrieved first; in all other cases it is
                         * retrieved last. Whether this is sane behaviour
                         * is open to debate; but for now, multiconcat (as
                         * it is an optimisation) tries to reproduce
                         * existing behaviour.
                         */
                        sv_catsv(nsv, sv);
                        sv_setsv(sv,nsv);
                        SP++;
                        goto phase7; /* just return targ as-is */
                    }

                    sv = nsv;
                }
            }

            if (sv == targ) {
                /* must warn for each RH usage of targ, except that
                 * we will later get one warning when doing
                 * SvPV_force(targ), *except* on '.=' */
                if (   !SvOK(sv)
                    && (targ_chain || is_append)
                    && ckWARN(WARN_UNINITIALIZED)
                )
                    report_uninit(sv);
                goto targ_on_rhs;
            }

            /* stringify general SV */
            svpv_end->pv = sv_2pv_flags(sv, &len, 0);
        }

        utf8 = (SvFLAGS(sv) & SVf_UTF8);
        dst_utf8   |= utf8;
        ASSUME(len < SSize_t_MAX);
        svpv_end->len = utf8 ? -(SSize_t)len : (SSize_t)len;
        grow += len;
    }

    /* --------------------------------------------------------------
     * Phase 2:
     *
     * Stringify targ:
     *
     * if targ appears on the RHS or is appended to, force stringify it;
     * otherwise set it to "". Then set targ_len.
     */

    if (is_append) {
        if (UNLIKELY(SvFLAGS(targ) & (SVs_GMG|SVf_ROK))) {
            SvGETMAGIC(targ); /* must do before SvAMAGIC() check */
            if (UNLIKELY(SvAMAGIC(targ))) {
                /* $overloaded .= ....;
                 * accumulate RHS in a temp SV rather than targ,
                 * then append tmp to targ at the end using overload
                 */
                assert(!targ_chain);
                dsv = newSVpvn_flags("", 0, SVs_TEMP);

                if (   svpv_end == svpv_buf + 1
                       /* no const string segments */
                    && aux[PERL_MULTICONCAT_IX_LENGTHS].ssize == -1
                ) {
                    /* special case $overloaded .= $arg1:
                     * avoid stringifying $arg1.
                     * Similar to the $arg1 . $arg2 case in phase1
                     */
                    svpv_end--;
                    SP--;
                }

                goto phase3;
            }
        }

        if (SvOK(targ)) {
            U32 targ_utf8;
          stringify_targ:
            SvPV_force_nomg_nolen(targ);
            targ_utf8 = SvFLAGS(targ) & SVf_UTF8;
            if (UNLIKELY(dst_utf8 & ~targ_utf8)) {
                 if (LIKELY(!IN_BYTES))
                    sv_utf8_upgrade_nomg(targ);
            }
            else
                dst_utf8 |= targ_utf8;

            targ_len = SvCUR(targ);
            grow += targ_len * (targ_count + is_append);
            goto phase3;
        }
    }
    else if (UNLIKELY(SvTYPE(targ) >= SVt_REGEXP)) {
        /* Assigning to some weird LHS type. Don't force the LHS to be an
         * empty string; instead, do things 'long hand' by using the
         * overload code path, which concats to a TEMP sv and does
         * sv_catsv() calls rather than COPY()s. This ensures that even
         * bizarre code like this doesn't break or crash:
         *    *F = *F . *F.
         * (which makes the 'F' typeglob an alias to the
         * '*main::F*main::F' typeglob).
         */
        goto setup_overload;
    }
    else if (targ_chain) {
        /* targ was found on RHS.
         * We don't need the SvGETMAGIC() call and SvAMAGIC() test as
         * both were already done earlier in the SvPV() loop; other
         * than that we can share the same code with the append
         * branch below.
         * Note that this goto jumps directly into the SvOK() branch
         * even if targ isn't SvOK(), to force an 'uninitialised'
         * warning; e.g.
         *   $undef .= ....           targ only on LHS: don't warn
         *   $undef .= $undef ....    targ on RHS too:  warn
         */
        assert(!SvAMAGIC(targ));
        goto stringify_targ;
    }


    /* unrolled SvPVCLEAR() - mostly: no need to grow or set SvCUR() to 0;
     * those will be done later. */
    assert(targ == dsv);
    SV_CHECK_THINKFIRST_COW_DROP(targ);
    SvUPGRADE(targ, SVt_PV);
    SvFLAGS(targ) &= ~(SVf_OK|SVf_IVisUV|SVf_UTF8);
    SvFLAGS(targ) |= (SVf_POK|SVp_POK|dst_utf8);

  phase3:

    /* --------------------------------------------------------------
     * Phase 3:
     *
     * UTF-8 tweaks and grow dsv:
     *
     * Now that we know the length and utf8-ness of both the targ and
     * args, grow dsv to the size needed to accumulate all the args, based
     * on whether targ appears on the RHS, whether we're appending, and
     * whether any non-utf8 args expand in size if converted to utf8.
     *
     * For the latter, if dst_utf8 we scan non-utf8 args looking for
     * variant chars, and adjust the svpv->len value of those args to the
     * utf8 size and negate it to flag them. At the same time we un-negate
     * the lens of any utf8 args since after this phase we no longer care
     * whether an arg is utf8 or not.
     *
     * Finally, initialise const_lens and const_pv based on utf8ness.
     * Note that there are 3 permutations:
     *
     * * If the constant string is invariant whether utf8 or not (e.g. "abc"),
     *   then aux[PERL_MULTICONCAT_IX_PLAIN_PV/LEN] are the same as
     *        aux[PERL_MULTICONCAT_IX_UTF8_PV/LEN] and there is one set of
     *   segment lengths.
     *
     * * If the string is fully utf8, e.g. "\x{100}", then
     *   aux[PERL_MULTICONCAT_IX_PLAIN_PV/LEN] == (NULL,0) and there is
     *   one set of segment lengths.
     *
     * * If the string has different plain and utf8 representations
     *   (e.g. "\x80"), then then aux[PERL_MULTICONCAT_IX_PLAIN_PV/LEN]]
     *   holds the plain rep, while aux[PERL_MULTICONCAT_IX_UTF8_PV/LEN]
     *   holds the utf8 rep, and there are 2 sets of segment lengths,
     *   with the utf8 set following after the plain set.
     *
     * On entry to this section the (pv,len) pairs in svpv_buf have the
     * following meanings:
     *    (pv,  len) a plain string
     *    (pv, -len) a utf8 string
     *    (NULL,  0) left-most targ \ linked together R-to-L
     *    (next,  0) other targ     / in targ_chain
     */

    /* turn off utf8 handling if 'use bytes' is in scope */
    if (UNLIKELY(dst_utf8 && IN_BYTES)) {
        dst_utf8 = 0;
        SvUTF8_off(dsv);
        /* undo all the negative lengths which flag utf8-ness */
        for (svpv_p = svpv_buf; svpv_p < svpv_end; svpv_p++) {
            SSize_t len = svpv_p->len;
            if (len < 0)
                svpv_p->len = -len;
        }
    }

    /* grow += total of lengths of constant string segments */
    {
        SSize_t len;
        len = aux[dst_utf8 ? PERL_MULTICONCAT_IX_UTF8_LEN
                           : PERL_MULTICONCAT_IX_PLAIN_LEN].ssize;
        slow_concat = cBOOL(len);
        grow += len;
    }

    const_lens = aux + PERL_MULTICONCAT_IX_LENGTHS;

    if (dst_utf8) {
        const_pv = aux[PERL_MULTICONCAT_IX_UTF8_PV].pv;
        if (   aux[PERL_MULTICONCAT_IX_PLAIN_PV].pv
            && const_pv != aux[PERL_MULTICONCAT_IX_PLAIN_PV].pv)
            /* separate sets of lengths for plain and utf8 */
            const_lens += nargs + 1;

        /* If the result is utf8 but some of the args aren't,
         * calculate how much extra growth is needed for all the chars
         * which will expand to two utf8 bytes.
         * Also, if the growth is non-zero, negate the length to indicate
         * that this this is a variant string. Conversely, un-negate the
         * length on utf8 args (which was only needed to flag non-utf8
         * args in this loop */
        for (svpv_p = svpv_buf; svpv_p < svpv_end; svpv_p++) {
            SSize_t len, extra;

            len = svpv_p->len;
            if (len <= 0) {
                svpv_p->len = -len;
                continue;
            }

            extra = variant_under_utf8_count((U8 *) svpv_p->pv,
                                             (U8 *) svpv_p->pv + len);
            if (UNLIKELY(extra)) {
                grow       += extra;
                              /* -ve len indicates special handling */
                svpv_p->len = -(len + extra);
                slow_concat = TRUE;
            }
        }
    }
    else
        const_pv = aux[PERL_MULTICONCAT_IX_PLAIN_PV].pv;

    /* unrolled SvGROW(), except don't check for SVf_IsCOW, which should
     * already have been dropped */
    assert(!SvIsCOW(dsv));
    dsv_pv = (SvLEN(dsv) < (grow) ? sv_grow(dsv,grow) : SvPVX(dsv));


    /* --------------------------------------------------------------
     * Phase 4:
     *
     * Now that dsv (which is probably targ) has been grown, we know the
     * final address of the targ PVX, if needed. Preserve / move targ
     * contents if appending or if targ appears on RHS.
     *
     * Also update svpv_buf slots in targ_chain.
     *
     * Don't bother with any of this if the target length is zero:
     * targ_len is set to zero unless we're appending or targ appears on
     * RHS.  And even if it is, we can optimise by skipping this chunk of
     * code for zero targ_len. In the latter case, we don't need to update
     * the slots in targ_chain with the (zero length) target string, since
     * we set the len in such slots to 0 earlier, and since the Copy() is
     * skipped on zero length, it doesn't matter what svpv_p->pv contains.
     *
     * On entry to this section the (pv,len) pairs in svpv_buf have the
     * following meanings:
     *    (pv,  len)         a pure-plain or utf8 string
     *    (pv, -(len+extra)) a plain string which will expand by 'extra'
     *                         bytes when converted to utf8
     *    (NULL,  0)         left-most targ \ linked together R-to-L
     *    (next,  0)         other targ     / in targ_chain
     *
     * On exit, the targ contents will have been moved to the
     * earliest place they are needed (e.g. $x = "abc$x" will shift them
     * 3 bytes, while $x .= ... will leave them at the beginning);
     * and dst_pv will point to the location within SvPVX(dsv) where the
     * next arg should be copied.
     */

    svpv_base = svpv_buf;

    if (targ_len) {
        struct multiconcat_svpv *tc_stop;
        char *targ_pv = dsv_pv;

        assert(targ == dsv);
        assert(is_append || targ_count);

        if (is_append) {
            dsv_pv += targ_len;
            tc_stop = NULL;
        }
        else {
            /* The targ appears on RHS, e.g. '$t = $a . $t . $t'.
             * Move the current contents of targ to the first
             * position where it's needed, and use that as the src buffer
             * for any further uses (such as the second RHS $t above).
             * In calculating the first position, we need to sum the
             * lengths of all consts and args before that.
             */

            UNOP_AUX_item *lens = const_lens;
                                /* length of first const string segment */
            STRLEN offset       = lens->ssize > 0 ? lens->ssize : 0;

            assert(targ_chain);
            svpv_p = svpv_base;

            for (;;) {
                SSize_t len;
                if (!svpv_p->pv)
                    break; /* the first targ argument */
                /* add lengths of the next arg and const string segment */
                len = svpv_p->len;
                if (len < 0)  /* variant args have this */
                    len = -len;
                offset += (STRLEN)len;
                len = (++lens)->ssize;
                offset += (len >= 0) ? (STRLEN)len : 0;
                if (!offset) {
                    /* all args and consts so far are empty; update
                     * the start position for the concat later */
                    svpv_base++;
                    const_lens++;
                }
                svpv_p++;
                assert(svpv_p < svpv_end);
            }

            if (offset) {
                targ_pv += offset;
                Move(dsv_pv, targ_pv, targ_len, char);
                /* a negative length implies don't Copy(), but do increment */
                svpv_p->len = -((SSize_t)targ_len);
                slow_concat = TRUE;
            }
            else {
                /* skip the first targ copy */
                svpv_base++;
                const_lens++;
                dsv_pv += targ_len;
            }

            /* Don't populate the first targ slot in the loop below; it's
             * either not used because we advanced svpv_base beyond it, or
             * we already stored the special -targ_len value in it
             */
            tc_stop = svpv_p;
        }

        /* populate slots in svpv_buf representing targ on RHS */
        while (targ_chain != tc_stop) {
            struct multiconcat_svpv *p = targ_chain;
            targ_chain = (struct multiconcat_svpv *)(p->pv);
            p->pv  = targ_pv;
            p->len = (SSize_t)targ_len;
        }
    }


    /* --------------------------------------------------------------
     * Phase 5:
     *
     * Append all the args in svpv_buf, plus the const strings, to dsv.
     *
     * On entry to this section the (pv,len) pairs in svpv_buf have the
     * following meanings:
     *    (pv,  len)         a pure-plain or utf8 string (which may be targ)
     *    (pv, -(len+extra)) a plain string which will expand by 'extra'
     *                         bytes when converted to utf8
     *    (0,  -len)         left-most targ, whose content has already
     *                         been copied. Just advance dsv_pv by len.
     */

    /* If there are no constant strings and no special case args
     * (svpv_p->len < 0), use a simpler, more efficient concat loop
     */
    if (!slow_concat) {
        for (svpv_p = svpv_base; svpv_p < svpv_end; svpv_p++) {
            SSize_t len = svpv_p->len;
            if (!len)
                continue;
            Copy(svpv_p->pv, dsv_pv, len, char);
            dsv_pv += len;
        }
        const_lens += (svpv_end - svpv_base + 1);
    }
    else {
        /* Note that we iterate the loop nargs+1 times: to append nargs
         * arguments and nargs+1 constant strings. For example, "-$a-$b-"
         */
        svpv_p = svpv_base - 1;

        for (;;) {
            SSize_t len = (const_lens++)->ssize;

            /* append next const string segment */
            if (len > 0) {
                Copy(const_pv, dsv_pv, len, char);
                dsv_pv   += len;
                const_pv += len;
            }

            if (++svpv_p == svpv_end)
                break;

            /* append next arg */
            len = svpv_p->len;

            if (LIKELY(len > 0)) {
                Copy(svpv_p->pv, dsv_pv, len, char);
                dsv_pv += len;
            }
            else if (UNLIKELY(len < 0)) {
                /* negative length indicates two special cases */
                const char *p = svpv_p->pv;
                len = -len;
                if (UNLIKELY(p)) {
                    /* copy plain-but-variant pv to a utf8 targ */
                    char * end_pv = dsv_pv + len;
                    assert(dst_utf8);
                    while (dsv_pv < end_pv) {
                        U8 c = (U8) *p++;
                        append_utf8_from_native_byte(c, (U8**)&dsv_pv);
                    }
                }
                else
                    /* arg is already-copied targ */
                    dsv_pv += len;
            }

        }
    }

    *dsv_pv = '\0';
    SvCUR_set(dsv, dsv_pv - SvPVX(dsv));
    assert(grow >= SvCUR(dsv) + 1);
    assert(SvLEN(dsv) >= SvCUR(dsv) + 1);

    /* --------------------------------------------------------------
     * Phase 6:
     *
     * Handle overloading. If an overloaded arg or targ was detected
     * earlier, dsv will have been set to a new mortal, and any args and
     * consts to the left of the first overloaded arg will have been
     * accumulated to it. This section completes any further concatenation
     * steps with overloading handled.
     */

    if (UNLIKELY(dsv != targ)) {
        SV *res;

        SvFLAGS(dsv) |= dst_utf8;

        if (SP <= toparg) {
            /* Stringifying the RHS was abandoned because *SP
             * is overloaded. dsv contains all the concatted strings
             * before *SP. Apply the rest of the args using overloading.
             */
            SV *left, *right, *res;
            int i;
            bool getmg = FALSE;
                               /* number of args already concatted */
            SSize_t n         = (nargs - 1) - (toparg - SP);
                               /* current arg is either the first
                                * or second value to be concatted
                                * (including constant strings), so would
                                * form part of the first concat */
            bool first_concat = (    n == 0
                                 || (n == 1 && const_lens[-2].ssize < 0
                                            && const_lens[-1].ssize < 0));
            int  f_assign     = first_concat ? 0 : AMGf_assign;

            left = dsv;

            for (; n < nargs; n++) {
                /* loop twice, first applying the arg, then the const segment */
                for (i = 0; i < 2; i++) {
                    if (i) {
                        /* append next const string segment */
                        STRLEN len = (STRLEN)((const_lens++)->ssize);
                        /* a length of -1 implies no constant string
                         * rather than a zero-length one, e.g.
                         * ($a . $b) versus ($a . "" . $b)
                         */
                        if ((SSize_t)len < 0)
                            continue;

                        /* set right to the next constant string segment */
                        right = newSVpvn_flags(const_pv, len,
                                                    (dst_utf8 | SVs_TEMP));
                        const_pv += len;
                    }
                    else {
                        /* append next arg */
                        right = *SP++;
                        if (getmg)
                            SvGETMAGIC(right);
                        else
                            /* SvGETMAGIC already called on this SV just
                             * before we broke from the loop earlier */
                            getmg = TRUE;

                        if (first_concat && n == 0 && const_lens[-1].ssize < 0) {
                            /* nothing before the current arg; repeat the
                             * loop to get a second arg */
                            left = right;
                            first_concat = FALSE;
                            continue;
                        }
                    }

                    if ((SvAMAGIC(left) || SvAMAGIC(right))
                        && (res = amagic_call(left, right, concat_amg, f_assign))
                    )
                        left = res;
                    else {
                        if (left != dsv) {
                            sv_setsv(dsv, left);
                            left = dsv;
                        }
                        sv_catsv_nomg(left, right);
                    }
                    f_assign = AMGf_assign;
                }
            }
            dsv = left;
        }

        /* assign/append RHS (dsv) to LHS (targ) */
        if (is_append)  {
            if ((SvAMAGIC(targ) || SvAMAGIC(dsv))
                && (res = amagic_call(targ, dsv, concat_amg, AMGf_assign))
            )
                sv_setsv(targ, res);
            else
                sv_catsv_nomg(targ, dsv);
        }
        else
            sv_setsv(targ, dsv);
    }

    /* --------------------------------------------------------------
     * Phase 7:
     *
     * return result
     */

  phase7:

    SP -= stack_adj;
    SvTAINT(targ);
    SETTARG;
    RETURN;
}


/* push the elements of av onto the stack.
 * Returns PL_op->op_next to allow tail-call optimisation of its callers */

STATIC OP*
S_pushav(pTHX_ AV* const av)
{
    dSP;
    const SSize_t maxarg = AvFILL(av) + 1;
    EXTEND(SP, maxarg);
    if (UNLIKELY(SvRMAGICAL(av))) {
        PADOFFSET i;
        for (i=0; i < (PADOFFSET)maxarg; i++) {
            SV ** const svp = av_fetch(av, i, FALSE);
            SP[i+1] = LIKELY(svp)
                       ? *svp
                       : UNLIKELY(PL_op->op_flags & OPf_MOD)
                          ? av_nonelem(av,i)
                          : &PL_sv_undef;
        }
    }
    else {
        PADOFFSET i;
        for (i=0; i < (PADOFFSET)maxarg; i++) {
            SV *sv = AvARRAY(av)[i];
	    SP[i+1] = LIKELY(sv)
                       ? sv
                       : UNLIKELY(PL_op->op_flags & OPf_MOD)
                          ? av_nonelem(av,i)
                          : &PL_sv_undef;
        }
    }
    SP += maxarg;
    PUTBACK;
    return NORMAL;
}


/* ($lex1,@lex2,...)   or my ($lex1,@lex2,...)  */

PP(pp_padrange)
{
    dSP;
    PADOFFSET base = PL_op->op_targ;
    int count = (int)(PL_op->op_private) & OPpPADRANGE_COUNTMASK;
    if (PL_op->op_flags & OPf_SPECIAL) {
        /* fake the RHS of my ($x,$y,..) = @_ */
        PUSHMARK(SP);
        (void)S_pushav(aTHX_ GvAVn(PL_defgv));
        SPAGAIN;
    }

    /* note, this is only skipped for compile-time-known void cxt */
    if ((PL_op->op_flags & OPf_WANT) != OPf_WANT_VOID) {
        int i;

        EXTEND(SP, count);
        PUSHMARK(SP);
        for (i = 0; i <count; i++)
            *++SP = PAD_SV(base+i);
    }
    if (PL_op->op_private & OPpLVAL_INTRO) {
        SV **svp = &(PAD_SVl(base));
        const UV payload = (UV)(
                      (base << (OPpPADRANGE_COUNTSHIFT + SAVE_TIGHT_SHIFT))
                    | (count << SAVE_TIGHT_SHIFT)
                    | SAVEt_CLEARPADRANGE);
        int i;

        STATIC_ASSERT_STMT(OPpPADRANGE_COUNTMASK + 1 == (1 << OPpPADRANGE_COUNTSHIFT));
        assert((payload >> (OPpPADRANGE_COUNTSHIFT+SAVE_TIGHT_SHIFT))
                == (Size_t)base);
        {
            dSS_ADD;
            SS_ADD_UV(payload);
            SS_ADD_END(1);
        }

        for (i = 0; i <count; i++)
            SvPADSTALE_off(*svp++); /* mark lexical as active */
    }
    RETURN;
}


PP(pp_padsv)
{
    dSP;
    EXTEND(SP, 1);
    {
	OP * const op = PL_op;
	/* access PL_curpad once */
	SV ** const padentry = &(PAD_SVl(op->op_targ));
	{
	    dTARG;
	    TARG = *padentry;
	    PUSHs(TARG);
	    PUTBACK; /* no pop/push after this, TOPs ok */
	}
	if (op->op_flags & OPf_MOD) {
	    if (op->op_private & OPpLVAL_INTRO)
		if (!(op->op_private & OPpPAD_STATE))
		    save_clearsv(padentry);
	    if (op->op_private & OPpDEREF) {
		/* TOPs is equivalent to TARG here.  Using TOPs (SP) rather
		   than TARG reduces the scope of TARG, so it does not
		   span the call to save_clearsv, resulting in smaller
		   machine code. */
		TOPs = vivify_ref(TOPs, op->op_private & OPpDEREF);
	    }
	}
	return op->op_next;
    }
}

PP(pp_readline)
{
    dSP;
    /* pp_coreargs pushes a NULL to indicate no args passed to
     * CORE::readline() */
    if (TOPs) {
	SvGETMAGIC(TOPs);
	tryAMAGICunTARGETlist(iter_amg, 0);
	PL_last_in_gv = MUTABLE_GV(*PL_stack_sp--);
    }
    else PL_last_in_gv = PL_argvgv, PL_stack_sp--;
    if (!isGV_with_GP(PL_last_in_gv)) {
	if (SvROK(PL_last_in_gv) && isGV_with_GP(SvRV(PL_last_in_gv)))
	    PL_last_in_gv = MUTABLE_GV(SvRV(PL_last_in_gv));
	else {
	    dSP;
	    XPUSHs(MUTABLE_SV(PL_last_in_gv));
	    PUTBACK;
	    Perl_pp_rv2gv(aTHX);
	    PL_last_in_gv = MUTABLE_GV(*PL_stack_sp--);
            assert((SV*)PL_last_in_gv == &PL_sv_undef || isGV_with_GP(PL_last_in_gv));
	}
    }
    return do_readline();
}

PP(pp_eq)
{
    dSP;
    SV *left, *right;

    tryAMAGICbin_MG(eq_amg, AMGf_set|AMGf_numeric);
    right = POPs;
    left  = TOPs;
    SETs(boolSV(
	(SvIOK_notUV(left) && SvIOK_notUV(right))
	? (SvIVX(left) == SvIVX(right))
	: ( do_ncmp(left, right) == 0)
    ));
    RETURN;
}


/* also used for: pp_i_preinc() */

PP(pp_preinc)
{
    SV *sv = *PL_stack_sp;

    if (LIKELY(((sv->sv_flags &
                        (SVf_THINKFIRST|SVs_GMG|SVf_IVisUV|
                         SVf_IOK|SVf_NOK|SVf_POK|SVp_NOK|SVp_POK|SVf_ROK))
                == SVf_IOK))
        && SvIVX(sv) != IV_MAX)
    {
	SvIV_set(sv, SvIVX(sv) + 1);
    }
    else /* Do all the PERL_PRESERVE_IVUV and hard cases in sv_inc */
	sv_inc(sv);
    SvSETMAGIC(sv);
    return NORMAL;
}


/* also used for: pp_i_predec() */

PP(pp_predec)
{
    SV *sv = *PL_stack_sp;

    if (LIKELY(((sv->sv_flags &
                        (SVf_THINKFIRST|SVs_GMG|SVf_IVisUV|
                         SVf_IOK|SVf_NOK|SVf_POK|SVp_NOK|SVp_POK|SVf_ROK))
                == SVf_IOK))
        && SvIVX(sv) != IV_MIN)
    {
	SvIV_set(sv, SvIVX(sv) - 1);
    }
    else /* Do all the PERL_PRESERVE_IVUV and hard cases  in sv_dec */
	sv_dec(sv);
    SvSETMAGIC(sv);
    return NORMAL;
}


/* also used for: pp_orassign() */

PP(pp_or)
{
    dSP;
    SV *sv;
    PERL_ASYNC_CHECK();
    sv = TOPs;
    if (SvTRUE_NN(sv))
	RETURN;
    else {
	if (PL_op->op_type == OP_OR)
            --SP;
	RETURNOP(cLOGOP->op_other);
    }
}


/* also used for: pp_dor() pp_dorassign() */

PP(pp_defined)
{
    dSP;
    SV* sv;
    bool defined;
    const int op_type = PL_op->op_type;
    const bool is_dor = (op_type == OP_DOR || op_type == OP_DORASSIGN);

    if (is_dor) {
	PERL_ASYNC_CHECK();
        sv = TOPs;
        if (UNLIKELY(!sv || !SvANY(sv))) {
	    if (op_type == OP_DOR)
		--SP;
            RETURNOP(cLOGOP->op_other);
        }
    }
    else {
	/* OP_DEFINED */
        sv = POPs;
        if (UNLIKELY(!sv || !SvANY(sv)))
            RETPUSHNO;
    }

    defined = FALSE;
    switch (SvTYPE(sv)) {
    case SVt_PVAV:
	if (AvMAX(sv) >= 0 || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied)))
	    defined = TRUE;
	break;
    case SVt_PVHV:
	if (HvARRAY(sv) || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied)))
	    defined = TRUE;
	break;
    case SVt_PVCV:
	if (CvROOT(sv) || CvXSUB(sv))
	    defined = TRUE;
	break;
    default:
	SvGETMAGIC(sv);
	if (SvOK(sv))
	    defined = TRUE;
	break;
    }

    if (is_dor) {
        if(defined) 
            RETURN; 
        if(op_type == OP_DOR)
            --SP;
        RETURNOP(cLOGOP->op_other);
    }
    /* assuming OP_DEFINED */
    if(defined) 
        RETPUSHYES;
    RETPUSHNO;
}



PP(pp_add)
{
    dSP; dATARGET; bool useleft; SV *svl, *svr;

    tryAMAGICbin_MG(add_amg, AMGf_assign|AMGf_numeric);
    svr = TOPs;
    svl = TOPm1s;

#ifdef PERL_PRESERVE_IVUV

    /* special-case some simple common cases */
    if (!((svl->sv_flags|svr->sv_flags) & (SVf_IVisUV|SVs_GMG))) {
        IV il, ir;
        U32 flags = (svl->sv_flags & svr->sv_flags);
        if (flags & SVf_IOK) {
            /* both args are simple IVs */
            UV topl, topr;
            il = SvIVX(svl);
            ir = SvIVX(svr);
          do_iv:
            topl = ((UV)il) >> (UVSIZE * 8 - 2);
            topr = ((UV)ir) >> (UVSIZE * 8 - 2);

            /* if both are in a range that can't under/overflow, do a
             * simple integer add: if the top of both numbers
             * are 00  or 11, then it's safe */
            if (!( ((topl+1) | (topr+1)) & 2)) {
                SP--;
                TARGi(il + ir, 0); /* args not GMG, so can't be tainted */
                SETs(TARG);
                RETURN;
            }
            goto generic;
        }
        else if (flags & SVf_NOK) {
            /* both args are NVs */
            NV nl = SvNVX(svl);
            NV nr = SvNVX(svr);

            if (
#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan)
                !Perl_isnan(nl) && nl == (NV)(il = (IV)nl)
                && !Perl_isnan(nr) && nr == (NV)(ir = (IV)nr)
#else
                nl == (NV)(il = (IV)nl) && nr == (NV)(ir = (IV)nr)
#endif
                )
                /* nothing was lost by converting to IVs */
                goto do_iv;
            SP--;
            TARGn(nl + nr, 0); /* args not GMG, so can't be tainted */
            SETs(TARG);
            RETURN;
        }
    }

  generic:

    useleft = USE_LEFT(svl);
    /* We must see if we can perform the addition with integers if possible,
       as the integer code detects overflow while the NV code doesn't.
       If either argument hasn't had a numeric conversion yet attempt to get
       the IV. It's important to do this now, rather than just assuming that
       it's not IOK as a PV of "9223372036854775806" may not take well to NV
       addition, and an SV which is NOK, NV=6.0 ought to be coerced to
       integer in case the second argument is IV=9223372036854775806
       We can (now) rely on sv_2iv to do the right thing, only setting the
       public IOK flag if the value in the NV (or PV) slot is truly integer.

       A side effect is that this also aggressively prefers integer maths over
       fp maths for integer values.

       How to detect overflow?

       C 99 section 6.2.6.1 says

       The range of nonnegative values of a signed integer type is a subrange
       of the corresponding unsigned integer type, and the representation of
       the same value in each type is the same. A computation involving
       unsigned operands can never overflow, because a result that cannot be
       represented by the resulting unsigned integer type is reduced modulo
       the number that is one greater than the largest value that can be
       represented by the resulting type.

       (the 9th paragraph)

       which I read as "unsigned ints wrap."

       signed integer overflow seems to be classed as "exception condition"

       If an exceptional condition occurs during the evaluation of an
       expression (that is, if the result is not mathematically defined or not
       in the range of representable values for its type), the behavior is
       undefined.

       (6.5, the 5th paragraph)

       I had assumed that on 2s complement machines signed arithmetic would
       wrap, hence coded pp_add and pp_subtract on the assumption that
       everything perl builds on would be happy.  After much wailing and
       gnashing of teeth it would seem that irix64 knows its ANSI spec well,
       knows that it doesn't need to, and doesn't.  Bah.  Anyway, the all-
       unsigned code below is actually shorter than the old code. :-)
    */

    if (SvIV_please_nomg(svr)) {
	/* Unless the left argument is integer in range we are going to have to
	   use NV maths. Hence only attempt to coerce the right argument if
	   we know the left is integer.  */
	UV auv = 0;
	bool auvok = FALSE;
	bool a_valid = 0;

	if (!useleft) {
	    auv = 0;
	    a_valid = auvok = 1;
	    /* left operand is undef, treat as zero. + 0 is identity,
	       Could SETi or SETu right now, but space optimise by not adding
	       lots of code to speed up what is probably a rarish case.  */
	} else {
	    /* Left operand is defined, so is it IV? */
	    if (SvIV_please_nomg(svl)) {
		if ((auvok = SvUOK(svl)))
		    auv = SvUVX(svl);
		else {
		    const IV aiv = SvIVX(svl);
		    if (aiv >= 0) {
			auv = aiv;
			auvok = 1;	/* Now acting as a sign flag.  */
		    } else {
			auv = (aiv == IV_MIN) ? (UV)aiv : (UV)(-aiv);
		    }
		}
		a_valid = 1;
	    }
	}
	if (a_valid) {
	    bool result_good = 0;
	    UV result;
	    UV buv;
	    bool buvok = SvUOK(svr);
	
	    if (buvok)
		buv = SvUVX(svr);
	    else {
		const IV biv = SvIVX(svr);
		if (biv >= 0) {
		    buv = biv;
		    buvok = 1;
		} else
                    buv = (biv == IV_MIN) ? (UV)biv : (UV)(-biv);
	    }
	    /* ?uvok if value is >= 0. basically, flagged as UV if it's +ve,
	       else "IV" now, independent of how it came in.
	       if a, b represents positive, A, B negative, a maps to -A etc
	       a + b =>  (a + b)
	       A + b => -(a - b)
	       a + B =>  (a - b)
	       A + B => -(a + b)
	       all UV maths. negate result if A negative.
	       add if signs same, subtract if signs differ. */

	    if (auvok ^ buvok) {
		/* Signs differ.  */
		if (auv >= buv) {
		    result = auv - buv;
		    /* Must get smaller */
		    if (result <= auv)
			result_good = 1;
		} else {
		    result = buv - auv;
		    if (result <= buv) {
			/* result really should be -(auv-buv). as its negation
			   of true value, need to swap our result flag  */
			auvok = !auvok;
			result_good = 1;
		    }
		}
	    } else {
		/* Signs same */
		result = auv + buv;
		if (result >= auv)
		    result_good = 1;
	    }
	    if (result_good) {
		SP--;
		if (auvok)
		    SETu( result );
		else {
		    /* Negate result */
		    if (result <= (UV)IV_MIN)
                        SETi(result == (UV)IV_MIN
                                ? IV_MIN : -(IV)result);
		    else {
			/* result valid, but out of range for IV.  */
			SETn( -(NV)result );
		    }
		}
		RETURN;
	    } /* Overflow, drop through to NVs.  */
	}
    }

#else
    useleft = USE_LEFT(svl);
#endif

    {
	NV value = SvNV_nomg(svr);
	(void)POPs;
	if (!useleft) {
	    /* left operand is undef, treat as zero. + 0.0 is identity. */
	    SETn(value);
	    RETURN;
	}
	SETn( value + SvNV_nomg(svl) );
	RETURN;
    }
}


/* also used for: pp_aelemfast_lex() */

PP(pp_aelemfast)
{
    dSP;
    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;
    const I8 key   = (I8)PL_op->op_private;
    SV** svp;
    SV *sv;

    assert(SvTYPE(av) == SVt_PVAV);

    EXTEND(SP, 1);

    /* inlined av_fetch() for simple cases ... */
    if (!SvRMAGICAL(av) && key >= 0 && key <= AvFILLp(av)) {
        sv = AvARRAY(av)[key];
        if (sv) {
            PUSHs(sv);
            RETURN;
        }
    }

    /* ... else do it the hard way */
    svp = av_fetch(av, key, lval);
    sv = (svp ? *svp : &PL_sv_undef);

    if (UNLIKELY(!svp && lval))
        DIE(aTHX_ PL_no_aelem, (int)key);

    if (!lval && SvRMAGICAL(av) && SvGMAGICAL(sv)) /* see note in pp_helem() */
	mg_get(sv);
    PUSHs(sv);
    RETURN;
}

PP(pp_join)
{
    dSP; dMARK; dTARGET;
    MARK++;
    do_join(TARG, *MARK, MARK, SP);
    SP = MARK;
    SETs(TARG);
    RETURN;
}

/* Oversized hot code. */

/* also used for: pp_say() */

PP(pp_print)
{
    dSP; dMARK; dORIGMARK;
    PerlIO *fp;
    MAGIC *mg;
    GV * const gv
	= (PL_op->op_flags & OPf_STACKED) ? MUTABLE_GV(*++MARK) : PL_defoutgv;
    IO *io = GvIO(gv);

    if (io
	&& (mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar)))
    {
      had_magic:
	if (MARK == ORIGMARK) {
	    /* If using default handle then we need to make space to
	     * pass object as 1st arg, so move other args up ...
	     */
	    MEXTEND(SP, 1);
	    ++MARK;
	    Move(MARK, MARK + 1, (SP - MARK) + 1, SV*);
	    ++SP;
	}
	return Perl_tied_method(aTHX_ SV_CONST(PRINT), mark - 1, MUTABLE_SV(io),
				mg,
				(G_SCALAR | TIED_METHOD_ARGUMENTS_ON_STACK
				 | (PL_op->op_type == OP_SAY
				    ? TIED_METHOD_SAY : 0)), sp - mark);
    }
    if (!io) {
        if ( gv && GvEGVx(gv) && (io = GvIO(GvEGV(gv)))
	    && (mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar)))
            goto had_magic;
	report_evil_fh(gv);
	SETERRNO(EBADF,RMS_IFI);
	goto just_say_no;
    }
    else if (!(fp = IoOFP(io))) {
	if (IoIFP(io))
	    report_wrongway_fh(gv, '<');
	else
	    report_evil_fh(gv);
	SETERRNO(EBADF,IoIFP(io)?RMS_FAC:RMS_IFI);
	goto just_say_no;
    }
    else {
	SV * const ofs = GvSV(PL_ofsgv); /* $, */
	MARK++;
	if (ofs && (SvGMAGICAL(ofs) || SvOK(ofs))) {
	    while (MARK <= SP) {
		if (!do_print(*MARK, fp))
		    break;
		MARK++;
		if (MARK <= SP) {
		    /* don't use 'ofs' here - it may be invalidated by magic callbacks */
		    if (!do_print(GvSV(PL_ofsgv), fp)) {
			MARK--;
			break;
		    }
		}
	    }
	}
	else {
	    while (MARK <= SP) {
		if (!do_print(*MARK, fp))
		    break;
		MARK++;
	    }
	}
	if (MARK <= SP)
	    goto just_say_no;
	else {
	    if (PL_op->op_type == OP_SAY) {
		if (PerlIO_write(fp, "\n", 1) == 0 || PerlIO_error(fp))
		    goto just_say_no;
	    }
            else if (PL_ors_sv && SvOK(PL_ors_sv))
		if (!do_print(PL_ors_sv, fp)) /* $\ */
		    goto just_say_no;

	    if (IoFLAGS(io) & IOf_FLUSH)
		if (PerlIO_flush(fp) == EOF)
		    goto just_say_no;
	}
    }
    SP = ORIGMARK;
    XPUSHs(&PL_sv_yes);
    RETURN;

  just_say_no:
    SP = ORIGMARK;
    XPUSHs(&PL_sv_undef);
    RETURN;
}


/* do the common parts of pp_padhv() and pp_rv2hv()
 * It assumes the caller has done EXTEND(SP, 1) or equivalent.
 * 'is_keys' indicates the OPpPADHV_ISKEYS/OPpRV2HV_ISKEYS flag is set.
 * 'has_targ' indicates that the op has a target - this should
 * be a compile-time constant so that the code can constant-folded as
 * appropriate
 * */

PERL_STATIC_INLINE OP*
S_padhv_rv2hv_common(pTHX_ HV *hv, U8 gimme, bool is_keys, bool has_targ)
{
    bool is_tied;
    bool is_bool;
    MAGIC *mg;
    dSP;
    IV  i;
    SV *sv;

    assert(PL_op->op_type == OP_PADHV || PL_op->op_type == OP_RV2HV);

    if (gimme == G_ARRAY) {
        hv_pushkv(hv, 3);
        return NORMAL;
    }

    if (is_keys)
        /* 'keys %h' masquerading as '%h': reset iterator */
        (void)hv_iterinit(hv);

    if (gimme == G_VOID)
        return NORMAL;

    is_bool = (     PL_op->op_private & OPpTRUEBOOL
              || (  PL_op->op_private & OPpMAYBE_TRUEBOOL
                  && block_gimme() == G_VOID));
    is_tied = SvRMAGICAL(hv) && (mg = mg_find(MUTABLE_SV(hv), PERL_MAGIC_tied));

    if (UNLIKELY(is_tied)) {
        if (is_keys && !is_bool) {
            i = 0;
            while (hv_iternext(hv))
                i++;
            goto push_i;
        }
        else {
            sv = magic_scalarpack(hv, mg);
            goto push_sv;
        }
    }
    else {
        i = HvUSEDKEYS(hv);
        if (is_bool) {
            sv = i ? &PL_sv_yes : &PL_sv_zero;
          push_sv:
            PUSHs(sv);
        }
        else {
          push_i:
            if (has_targ) {
                dTARGET;
                PUSHi(i);
            }
            else
#ifdef PERL_OP_PARENT
            if (is_keys) {
                /* parent op should be an unused OP_KEYS whose targ we can
                 * use */
                dTARG;
                OP *k;

                assert(!OpHAS_SIBLING(PL_op));
                k = PL_op->op_sibparent;
                assert(k->op_type == OP_KEYS);
                TARG = PAD_SV(k->op_targ);
                PUSHi(i);
            }
            else
#endif
                mPUSHi(i);
        }
    }

    PUTBACK;
    return NORMAL;
}


/* This is also called directly by pp_lvavref.  */
PP(pp_padav)
{
    dSP; dTARGET;
    U8 gimme;
    assert(SvTYPE(TARG) == SVt_PVAV);
    if (UNLIKELY( PL_op->op_private & OPpLVAL_INTRO ))
	if (LIKELY( !(PL_op->op_private & OPpPAD_STATE) ))
	    SAVECLEARSV(PAD_SVl(PL_op->op_targ));
    EXTEND(SP, 1);

    if (PL_op->op_flags & OPf_REF) {
	PUSHs(TARG);
	RETURN;
    }
    else if (PL_op->op_private & OPpMAYBE_LVSUB) {
        const I32 flags = is_lvalue_sub();
        if (flags && !(flags & OPpENTERSUB_INARGS)) {
	    if (GIMME_V == G_SCALAR)
                /* diag_listed_as: Can't return %s to lvalue scalar context */
                Perl_croak(aTHX_ "Can't return array to lvalue scalar context");
            PUSHs(TARG);
            RETURN;
       }
    }

    gimme = GIMME_V;
    if (gimme == G_ARRAY)
        return S_pushav(aTHX_ (AV*)TARG);

    if (gimme == G_SCALAR) {
	const SSize_t maxarg = AvFILL(MUTABLE_AV(TARG)) + 1;
        if (!maxarg)
            PUSHs(&PL_sv_zero);
        else if (PL_op->op_private & OPpTRUEBOOL)
            PUSHs(&PL_sv_yes);
        else
            mPUSHi(maxarg);
    }
    RETURN;
}


PP(pp_padhv)
{
    dSP; dTARGET;
    U8 gimme;

    assert(SvTYPE(TARG) == SVt_PVHV);
    if (UNLIKELY( PL_op->op_private & OPpLVAL_INTRO ))
	if (LIKELY( !(PL_op->op_private & OPpPAD_STATE) ))
	    SAVECLEARSV(PAD_SVl(PL_op->op_targ));

    EXTEND(SP, 1);

    if (PL_op->op_flags & OPf_REF) {
        PUSHs(TARG);
	RETURN;
    }
    else if (PL_op->op_private & OPpMAYBE_LVSUB) {
        const I32 flags = is_lvalue_sub();
        if (flags && !(flags & OPpENTERSUB_INARGS)) {
            if (GIMME_V == G_SCALAR)
                /* diag_listed_as: Can't return %s to lvalue scalar context */
                Perl_croak(aTHX_ "Can't return hash to lvalue scalar context");
            PUSHs(TARG);
            RETURN;
        }
    }

    gimme = GIMME_V;

    return S_padhv_rv2hv_common(aTHX_ (HV*)TARG, gimme,
                        cBOOL(PL_op->op_private & OPpPADHV_ISKEYS),
                        0 /* has_targ*/);
}


/* also used for: pp_rv2hv() */
/* also called directly by pp_lvavref */

PP(pp_rv2av)
{
    dSP; dTOPss;
    const U8 gimme = GIMME_V;
    static const char an_array[] = "an ARRAY";
    static const char a_hash[] = "a HASH";
    const bool is_pp_rv2av = PL_op->op_type == OP_RV2AV
			  || PL_op->op_type == OP_LVAVREF;
    const svtype type = is_pp_rv2av ? SVt_PVAV : SVt_PVHV;

    SvGETMAGIC(sv);
    if (SvROK(sv)) {
	if (UNLIKELY(SvAMAGIC(sv))) {
	    sv = amagic_deref_call(sv, is_pp_rv2av ? to_av_amg : to_hv_amg);
	}
	sv = SvRV(sv);
	if (UNLIKELY(SvTYPE(sv) != type))
	    /* diag_listed_as: Not an ARRAY reference */
	    DIE(aTHX_ "Not %s reference", is_pp_rv2av ? an_array : a_hash);
	else if (UNLIKELY(PL_op->op_flags & OPf_MOD
		&& PL_op->op_private & OPpLVAL_INTRO))
	    Perl_croak(aTHX_ "%s", PL_no_localize_ref);
    }
    else if (UNLIKELY(SvTYPE(sv) != type)) {
	    GV *gv;
	
	    if (!isGV_with_GP(sv)) {
		gv = Perl_softref2xv(aTHX_ sv, is_pp_rv2av ? an_array : a_hash,
				     type, &sp);
		if (!gv)
		    RETURN;
	    }
	    else {
		gv = MUTABLE_GV(sv);
	    }
	    sv = is_pp_rv2av ? MUTABLE_SV(GvAVn(gv)) : MUTABLE_SV(GvHVn(gv));
	    if (PL_op->op_private & OPpLVAL_INTRO)
		sv = is_pp_rv2av ? MUTABLE_SV(save_ary(gv)) : MUTABLE_SV(save_hash(gv));
    }
    if (PL_op->op_flags & OPf_REF) {
		SETs(sv);
		RETURN;
    }
    else if (UNLIKELY(PL_op->op_private & OPpMAYBE_LVSUB)) {
	      const I32 flags = is_lvalue_sub();
	      if (flags && !(flags & OPpENTERSUB_INARGS)) {
		if (gimme != G_ARRAY)
		    goto croak_cant_return;
		SETs(sv);
		RETURN;
	      }
    }

    if (is_pp_rv2av) {
	AV *const av = MUTABLE_AV(sv);

	if (gimme == G_ARRAY) {
            SP--;
            PUTBACK;
            return S_pushav(aTHX_ av);
	}

	if (gimme == G_SCALAR) {
	    const SSize_t maxarg = AvFILL(av) + 1;
            if (PL_op->op_private & OPpTRUEBOOL)
                SETs(maxarg ? &PL_sv_yes : &PL_sv_zero);
            else {
                dTARGET;
                SETi(maxarg);
            }
	}
    }
    else {
        SP--; PUTBACK;
        return S_padhv_rv2hv_common(aTHX_ (HV*)sv, gimme,
                        cBOOL(PL_op->op_private & OPpRV2HV_ISKEYS),
                        1 /* has_targ*/);
    }
    RETURN;

 croak_cant_return:
    Perl_croak(aTHX_ "Can't return %s to lvalue scalar context",
	       is_pp_rv2av ? "array" : "hash");
    RETURN;
}

STATIC void
S_do_oddball(pTHX_ SV **oddkey, SV **firstkey)
{
    PERL_ARGS_ASSERT_DO_ODDBALL;

    if (*oddkey) {
        if (ckWARN(WARN_MISC)) {
	    const char *err;
	    if (oddkey == firstkey &&
		SvROK(*oddkey) &&
		(SvTYPE(SvRV(*oddkey)) == SVt_PVAV ||
		 SvTYPE(SvRV(*oddkey)) == SVt_PVHV))
	    {
		err = "Reference found where even-sized list expected";
	    }
	    else
		err = "Odd number of elements in hash assignment";
	    Perl_warner(aTHX_ packWARN(WARN_MISC), "%s", err);
	}

    }
}


/* Do a mark and sweep with the SVf_BREAK flag to detect elements which
 * are common to both the LHS and RHS of an aassign, and replace them
 * with copies. All these copies are made before the actual list assign is
 * done.
 *
 * For example in ($a,$b) = ($b,$a), assigning the value of the first RHS
 * element ($b) to the first LH element ($a), modifies $a; when the
 * second assignment is done, the second RH element now has the wrong
 * value. So we initially replace the RHS with ($b, mortalcopy($a)).
 * Note that we don't need to make a mortal copy of $b.
 *
 * The algorithm below works by, for every RHS element, mark the
 * corresponding LHS target element with SVf_BREAK. Then if the RHS
 * element is found with SVf_BREAK set, it means it would have been
 * modified, so make a copy.
 * Note that by scanning both LHS and RHS in lockstep, we avoid
 * unnecessary copies (like $b above) compared with a naive
 * "mark all LHS; copy all marked RHS; unmark all LHS".
 *
 * If the LHS element is a 'my' declaration' and has a refcount of 1, then
 * it can't be common and can be skipped.
 *
 * On DEBUGGING builds it takes an extra boolean, fake. If true, it means
 * that we thought we didn't need to call S_aassign_copy_common(), but we
 * have anyway for sanity checking. If we find we need to copy, then panic.
 */

PERL_STATIC_INLINE void
S_aassign_copy_common(pTHX_ SV **firstlelem, SV **lastlelem,
        SV **firstrelem, SV **lastrelem
#ifdef DEBUGGING
        , bool fake
#endif
)
{
    dVAR;
    SV **relem;
    SV **lelem;
    SSize_t lcount = lastlelem - firstlelem + 1;
    bool marked = FALSE; /* have we marked any LHS with SVf_BREAK ? */
    bool const do_rc1 = cBOOL(PL_op->op_private & OPpASSIGN_COMMON_RC1);
    bool copy_all = FALSE;

    assert(!PL_in_clean_all); /* SVf_BREAK not already in use */
    assert(firstlelem < lastlelem); /* at least 2 LH elements */
    assert(firstrelem < lastrelem); /* at least 2 RH elements */


    lelem = firstlelem;
    /* we never have to copy the first RH element; it can't be corrupted
     * by assigning something to the corresponding first LH element.
     * So this scan does in a loop: mark LHS[N]; test RHS[N+1]
     */
    relem = firstrelem + 1;

    for (; relem <= lastrelem; relem++) {
        SV *svr;

        /* mark next LH element */

        if (--lcount >= 0) {
            SV *svl = *lelem++;

            if (UNLIKELY(!svl)) {/* skip AV alias marker */
                assert (lelem <= lastlelem);
                svl = *lelem++;
                lcount--;
            }

            assert(svl);
            if (SvSMAGICAL(svl)) {
                copy_all = TRUE;
            }
            if (SvTYPE(svl) == SVt_PVAV || SvTYPE(svl) == SVt_PVHV) {
                if (!marked)
                    return;
                /* this LH element will consume all further args;
                 * no need to mark any further LH elements (if any).
                 * But we still need to scan any remaining RHS elements;
                 * set lcount negative to distinguish from  lcount == 0,
                 * so the loop condition continues being true
                 */
                lcount = -1;
                lelem--; /* no need to unmark this element */
            }
            else if (!(do_rc1 && SvREFCNT(svl) == 1) && !SvIMMORTAL(svl)) {
                SvFLAGS(svl) |= SVf_BREAK;
                marked = TRUE;
            }
            else if (!marked) {
                /* don't check RH element if no SVf_BREAK flags set yet */
                if (!lcount)
                    break;
                continue;
            }
        }

        /* see if corresponding RH element needs copying */

        assert(marked);
        svr = *relem;
        assert(svr);

        if (UNLIKELY(SvFLAGS(svr) & (SVf_BREAK|SVs_GMG) || copy_all)) {
            U32 brk = (SvFLAGS(svr) & SVf_BREAK);

#ifdef DEBUGGING
            if (fake) {
                /* op_dump(PL_op); */
                Perl_croak(aTHX_
                    "panic: aassign skipped needed copy of common RH elem %"
                        UVuf, (UV)(relem - firstrelem));
            }
#endif

            TAINT_NOT;	/* Each item is independent */

            /* Dear TODO test in t/op/sort.t, I love you.
               (It's relying on a panic, not a "semi-panic" from newSVsv()
               and then an assertion failure below.)  */
            if (UNLIKELY(SvIS_FREED(svr))) {
                Perl_croak(aTHX_ "panic: attempt to copy freed scalar %p",
                           (void*)svr);
            }
            /* avoid break flag while copying; otherwise COW etc
             * disabled... */
            SvFLAGS(svr) &= ~SVf_BREAK;
            /* Not newSVsv(), as it does not allow copy-on-write,
               resulting in wasteful copies.
               Also, we use SV_NOSTEAL in case the SV is used more than
               once, e.g.  (...) = (f())[0,0]
               Where the same SV appears twice on the RHS without a ref
               count bump.  (Although I suspect that the SV won't be
               stealable here anyway - DAPM).
               */
            *relem = sv_mortalcopy_flags(svr,
                                SV_GMAGIC|SV_DO_COW_SVSETSV|SV_NOSTEAL);
            /* ... but restore afterwards in case it's needed again,
             * e.g. ($a,$b,$c) = (1,$a,$a)
             */
            SvFLAGS(svr) |= brk;
        }

        if (!lcount)
            break;
    }

    if (!marked)
        return;

    /*unmark LHS */

    while (lelem > firstlelem) {
        SV * const svl = *(--lelem);
        if (svl)
            SvFLAGS(svl) &= ~SVf_BREAK;
    }
}



PP(pp_aassign)
{
    dVAR; dSP;
    SV **lastlelem = PL_stack_sp;
    SV **lastrelem = PL_stack_base + POPMARK;
    SV **firstrelem = PL_stack_base + POPMARK + 1;
    SV **firstlelem = lastrelem + 1;

    SV **relem;
    SV **lelem;
    U8 gimme;
    /* PL_delaymagic is restored by JUMPENV_POP on dieing, so we
     * only need to save locally, not on the save stack */
    U16 old_delaymagic = PL_delaymagic;
#ifdef DEBUGGING
    bool fake = 0;
#endif

    PL_delaymagic = DM_DELAY;		/* catch simultaneous items */

    /* If there's a common identifier on both sides we have to take
     * special care that assigning the identifier on the left doesn't
     * clobber a value on the right that's used later in the list.
     */

    /* at least 2 LH and RH elements, or commonality isn't an issue */
    if (firstlelem < lastlelem && firstrelem < lastrelem) {
        for (relem = firstrelem+1; relem <= lastrelem; relem++) {
            if (SvGMAGICAL(*relem))
                goto do_scan;
        }
        for (lelem = firstlelem; lelem <= lastlelem; lelem++) {
            if (*lelem && SvSMAGICAL(*lelem))
                goto do_scan;
        }
        if ( PL_op->op_private & (OPpASSIGN_COMMON_SCALAR|OPpASSIGN_COMMON_RC1) ) {
            if (PL_op->op_private & OPpASSIGN_COMMON_RC1) {
                /* skip the scan if all scalars have a ref count of 1 */
                for (lelem = firstlelem; lelem <= lastlelem; lelem++) {
                    SV *sv = *lelem;
                    if (!sv || SvREFCNT(sv) == 1)
                        continue;
                    if (SvTYPE(sv) != SVt_PVAV && SvTYPE(sv) != SVt_PVAV)
                        goto do_scan;
                    break;
                }
            }
            else {
            do_scan:
                S_aassign_copy_common(aTHX_
                                      firstlelem, lastlelem, firstrelem, lastrelem
#ifdef DEBUGGING
                    , fake
#endif
                );
            }
        }
    }
#ifdef DEBUGGING
    else {
        /* on debugging builds, do the scan even if we've concluded we
         * don't need to, then panic if we find commonality. Note that the
         * scanner assumes at least 2 elements */
        if (firstlelem < lastlelem && firstrelem < lastrelem) {
            fake = 1;
            goto do_scan;
        }
    }
#endif

    gimme = GIMME_V;
    relem = firstrelem;
    lelem = firstlelem;

    if (relem > lastrelem)
        goto no_relems;

    /* first lelem loop while there are still relems */
    while (LIKELY(lelem <= lastlelem)) {
	bool alias = FALSE;
	SV *lsv = *lelem++;

        TAINT_NOT; /* Each item stands on its own, taintwise. */

        assert(relem <= lastrelem);
	if (UNLIKELY(!lsv)) {
	    alias = TRUE;
	    lsv = *lelem++;
	    ASSUME(SvTYPE(lsv) == SVt_PVAV);
	}

	switch (SvTYPE(lsv)) {
	case SVt_PVAV: {
            SV **svp;
            SSize_t i;
            SSize_t tmps_base;
            SSize_t nelems = lastrelem - relem + 1;
            AV *ary = MUTABLE_AV(lsv);

            /* Assigning to an aggregate is tricky. First there is the
             * issue of commonality, e.g. @a = ($a[0]). Since the
             * stack isn't refcounted, clearing @a prior to storing
             * elements will free $a[0]. Similarly with
             *    sub FETCH { $status[$_[1]] } @status = @tied[0,1];
             *
             * The way to avoid these issues is to make the copy of each
             * SV (and we normally store a *copy* in the array) *before*
             * clearing the array. But this has a problem in that
             * if the code croaks during copying, the not-yet-stored copies
             * could leak. One way to avoid this is to make all the copies
             * mortal, but that's quite expensive.
             *
             * The current solution to these issues is to use a chunk
             * of the tmps stack as a temporary refcounted-stack. SVs
             * will be put on there during processing to avoid leaks,
             * but will be removed again before the end of this block,
             * so free_tmps() is never normally called. Also, the
             * sv_refcnt of the SVs doesn't have to be manipulated, since
             * the ownership of 1 reference count is transferred directly
             * from the tmps stack to the AV when the SV is stored.
             *
             * We disarm slots in the temps stack by storing PL_sv_undef
             * there: it doesn't matter if that SV's refcount is
             * repeatedly decremented during a croak. But usually this is
             * only an interim measure. By the end of this code block
             * we try where possible to not leave any PL_sv_undef's on the
             * tmps stack e.g. by shuffling newer entries down.
             *
             * There is one case where we don't copy: non-magical
             * SvTEMP(sv)'s with a ref count of 1. The only owner of these
             * is on the tmps stack, so its safe to directly steal the SV
             * rather than copying. This is common in things like function
             * returns, map etc, which all return a list of such SVs.
             *
             * Note however something like @a = (f())[0,0], where there is
             * a danger of the same SV being shared:  this avoided because
             * when the SV is stored as $a[0], its ref count gets bumped,
             * so the RC==1 test fails and the second element is copied
             * instead.
             *
             * We also use one slot in the tmps stack to hold an extra
             * ref to the array, to ensure it doesn't get prematurely
             * freed. Again, this is removed before the end of this block.
             *
             * Note that OPpASSIGN_COMMON_AGG is used to flag a possible
             * @a = ($a[0]) case, but the current implementation uses the
             * same algorithm regardless, so ignores that flag. (It *is*
             * used in the hash branch below, however).
            */

            /* Reserve slots for ary, plus the elems we're about to copy,
             * then protect ary and temporarily void the remaining slots
             * with &PL_sv_undef */
            EXTEND_MORTAL(nelems + 1);
            PL_tmps_stack[++PL_tmps_ix] = SvREFCNT_inc_simple_NN(ary);
            tmps_base = PL_tmps_ix + 1;
            for (i = 0; i < nelems; i++)
                PL_tmps_stack[tmps_base + i] = &PL_sv_undef;
            PL_tmps_ix += nelems;

            /* Make a copy of each RHS elem and save on the tmps_stack
             * (or pass through where we can optimise away the copy) */

            if (UNLIKELY(alias)) {
                U32 lval = (gimme == G_ARRAY)
                                ? (PL_op->op_flags & OPf_MOD || LVRET) : 0;
                for (svp = relem; svp <= lastrelem; svp++) {
                    SV *rsv = *svp;

                    SvGETMAGIC(rsv);
                    if (!SvROK(rsv))
                        DIE(aTHX_ "Assigned value is not a reference");
                    if (SvTYPE(SvRV(rsv)) > SVt_PVLV)
                   /* diag_listed_as: Assigned value is not %s reference */
                        DIE(aTHX_
                           "Assigned value is not a SCALAR reference");
                    if (lval)
                        *svp = rsv = sv_mortalcopy(rsv);
                    /* XXX else check for weak refs?  */
                    rsv = SvREFCNT_inc_NN(SvRV(rsv));
                    assert(tmps_base <= PL_tmps_max);
                    PL_tmps_stack[tmps_base++] = rsv;
                }
            }
            else {
                for (svp = relem; svp <= lastrelem; svp++) {
                    SV *rsv = *svp;

                    if (SvTEMP(rsv) && !SvGMAGICAL(rsv) && SvREFCNT(rsv) == 1) {
                        /* can skip the copy */
                        SvREFCNT_inc_simple_void_NN(rsv);
                        SvTEMP_off(rsv);
                    }
                    else {
                        SV *nsv;
                        /* do get before newSV, in case it dies and leaks */
                        SvGETMAGIC(rsv);
                        nsv = newSV(0);
                        /* see comment in S_aassign_copy_common about
                         * SV_NOSTEAL */
                        sv_setsv_flags(nsv, rsv,
                                (SV_DO_COW_SVSETSV|SV_NOSTEAL));
                        rsv = *svp = nsv;
                    }

                    assert(tmps_base <= PL_tmps_max);
                    PL_tmps_stack[tmps_base++] = rsv;
                }
            }

            if (SvRMAGICAL(ary) || AvFILLp(ary) >= 0) /* may be non-empty */
                av_clear(ary);

            /* store in the array, the SVs that are in the tmps stack */

            tmps_base -= nelems;

            if (SvMAGICAL(ary) || SvREADONLY(ary) || !AvREAL(ary)) {
                /* for arrays we can't cheat with, use the official API */
                av_extend(ary, nelems - 1);
                for (i = 0; i < nelems; i++) {
                    SV **svp = &(PL_tmps_stack[tmps_base + i]);
                    SV *rsv = *svp;
                    /* A tied store won't take ownership of rsv, so keep
                     * the 1 refcnt on the tmps stack; otherwise disarm
                     * the tmps stack entry */
                    if (av_store(ary, i, rsv))
                        *svp = &PL_sv_undef;
                    /* av_store() may have added set magic to rsv */;
                    SvSETMAGIC(rsv);
                }
                /* disarm ary refcount: see comments below about leak */
                PL_tmps_stack[tmps_base - 1] = &PL_sv_undef;
            }
            else {
                /* directly access/set the guts of the AV */
                SSize_t fill = nelems - 1;
                if (fill > AvMAX(ary))
                    av_extend_guts(ary, fill, &AvMAX(ary), &AvALLOC(ary),
                                    &AvARRAY(ary));
                AvFILLp(ary) = fill;
                Copy(&(PL_tmps_stack[tmps_base]), AvARRAY(ary), nelems, SV*);
                /* Quietly remove all the SVs from the tmps stack slots,
                 * since ary has now taken ownership of the refcnt.
                 * Also remove ary: which will now leak if we die before
                 * the SvREFCNT_dec_NN(ary) below */
                if (UNLIKELY(PL_tmps_ix >= tmps_base + nelems))
                    Move(&PL_tmps_stack[tmps_base + nelems],
                         &PL_tmps_stack[tmps_base - 1],
                         PL_tmps_ix - (tmps_base + nelems) + 1,
                         SV*);
                PL_tmps_ix -= (nelems + 1);
            }

	    if (UNLIKELY(PL_delaymagic & DM_ARRAY_ISA))
                /* its assumed @ISA set magic can't die and leak ary */
		SvSETMAGIC(MUTABLE_SV(ary));
            SvREFCNT_dec_NN(ary);

            relem = lastrelem + 1;
	    goto no_relems;
        }

	case SVt_PVHV: {				/* normal hash */

            SV **svp;
            bool dirty_tmps;
            SSize_t i;
            SSize_t tmps_base;
            SSize_t nelems = lastrelem - relem + 1;
            HV *hash = MUTABLE_HV(lsv);

            if (UNLIKELY(nelems & 1)) {
                do_oddball(lastrelem, relem);
                /* we have firstlelem to reuse, it's not needed any more */
                *++lastrelem = &PL_sv_undef;
                nelems++;
            }

            /* See the SVt_PVAV branch above for a long description of
             * how the following all works. The main difference for hashes
             * is that we treat keys and values separately (and have
             * separate loops for them): as for arrays, values are always
             * copied (except for the SvTEMP optimisation), since they
             * need to be stored in the hash; while keys are only
             * processed where they might get prematurely freed or
             * whatever. */

            /* tmps stack slots:
             * * reserve a slot for the hash keepalive;
             * * reserve slots for the hash values we're about to copy;
             * * preallocate for the keys we'll possibly copy or refcount bump
             *   later;
             * then protect hash and temporarily void the remaining
             * value slots with &PL_sv_undef */
            EXTEND_MORTAL(nelems + 1);

             /* convert to number of key/value pairs */
             nelems >>= 1;

            PL_tmps_stack[++PL_tmps_ix] = SvREFCNT_inc_simple_NN(hash);
            tmps_base = PL_tmps_ix + 1;
            for (i = 0; i < nelems; i++)
                PL_tmps_stack[tmps_base + i] = &PL_sv_undef;
            PL_tmps_ix += nelems;

            /* Make a copy of each RHS hash value and save on the tmps_stack
             * (or pass through where we can optimise away the copy) */

            for (svp = relem + 1; svp <= lastrelem; svp += 2) {
                SV *rsv = *svp;

                if (SvTEMP(rsv) && !SvGMAGICAL(rsv) && SvREFCNT(rsv) == 1) {
                    /* can skip the copy */
                    SvREFCNT_inc_simple_void_NN(rsv);
                    SvTEMP_off(rsv);
                }
                else {
                    SV *nsv;
                    /* do get before newSV, in case it dies and leaks */
                    SvGETMAGIC(rsv);
                    nsv = newSV(0);
                    /* see comment in S_aassign_copy_common about
                     * SV_NOSTEAL */
                    sv_setsv_flags(nsv, rsv,
                            (SV_DO_COW_SVSETSV|SV_NOSTEAL));
                    rsv = *svp = nsv;
                }

                assert(tmps_base <= PL_tmps_max);
                PL_tmps_stack[tmps_base++] = rsv;
            }
            tmps_base -= nelems;


            /* possibly protect keys */

            if (UNLIKELY(gimme == G_ARRAY)) {
                /* handle e.g.
                *     @a = ((%h = ($$r, 1)), $r = "x");
                *     $_++ for %h = (1,2,3,4);
                */
                EXTEND_MORTAL(nelems);
                for (svp = relem; svp <= lastrelem; svp += 2)
                    *svp = sv_mortalcopy_flags(*svp,
                                SV_GMAGIC|SV_DO_COW_SVSETSV|SV_NOSTEAL);
            }
            else if (PL_op->op_private & OPpASSIGN_COMMON_AGG) {
                /* for possible commonality, e.g.
                 *       %h = ($h{a},1)
                 * avoid premature freeing RHS keys by mortalising
                 * them.
                 * For a magic element, make a copy so that its magic is
                 * called *before* the hash is emptied (which may affect
                 * a tied value for example).
                 * In theory we should check for magic keys in all
                 * cases, not just under OPpASSIGN_COMMON_AGG, but in
                 * practice, !OPpASSIGN_COMMON_AGG implies only
                 * constants or padtmps on the RHS.
                 */
                EXTEND_MORTAL(nelems);
                for (svp = relem; svp <= lastrelem; svp += 2) {
                    SV *rsv = *svp;
                    if (UNLIKELY(SvGMAGICAL(rsv))) {
                        SSize_t n;
                        *svp = sv_mortalcopy_flags(*svp,
                                SV_GMAGIC|SV_DO_COW_SVSETSV|SV_NOSTEAL);
                        /* allow other branch to continue pushing
                         * onto tmps stack without checking each time */
                        n = (lastrelem - relem) >> 1;
                        EXTEND_MORTAL(n);
                    }
                    else
                        PL_tmps_stack[++PL_tmps_ix] =
                                    SvREFCNT_inc_simple_NN(rsv);
                }
            }

            if (SvRMAGICAL(hash) || HvUSEDKEYS(hash))
                hv_clear(hash);

            /* now assign the keys and values to the hash */

            dirty_tmps = FALSE;

            if (UNLIKELY(gimme == G_ARRAY)) {
                /* @a = (%h = (...)) etc */
                SV **svp;
                SV **topelem = relem;

                for (i = 0, svp = relem; svp <= lastrelem; i++, svp++) {
                    SV *key = *svp++;
                    SV *val = *svp;
                    /* remove duplicates from list we return */
                    if (!hv_exists_ent(hash, key, 0)) {
                        /* copy key back: possibly to an earlier
                         * stack location if we encountered dups earlier,
                         * The values will be updated later
                         */
                        *topelem = key;
                        topelem += 2;
                    }
                    /* A tied store won't take ownership of val, so keep
                     * the 1 refcnt on the tmps stack; otherwise disarm
                     * the tmps stack entry */
                    if (hv_store_ent(hash, key, val, 0))
                        PL_tmps_stack[tmps_base + i] = &PL_sv_undef;
                    else
                        dirty_tmps = TRUE;
                    /* hv_store_ent() may have added set magic to val */;
                    SvSETMAGIC(val);
                }
                if (topelem < svp) {
                    /* at this point we have removed the duplicate key/value
                     * pairs from the stack, but the remaining values may be
                     * wrong; i.e. with (a 1 a 2 b 3) on the stack we've removed
                     * the (a 2), but the stack now probably contains
                     * (a <freed> b 3), because { hv_save(a,1); hv_save(a,2) }
                     * obliterates the earlier key. So refresh all values. */
                    lastrelem = topelem - 1;
                    while (relem < lastrelem) {
                        HE *he;
                        he = hv_fetch_ent(hash, *relem++, 0, 0);
                        *relem++ = (he ? HeVAL(he) : &PL_sv_undef);
                    }
                }
            }
            else {
                SV **svp;
                for (i = 0, svp = relem; svp <= lastrelem; i++, svp++) {
                    SV *key = *svp++;
                    SV *val = *svp;
                    if (hv_store_ent(hash, key, val, 0))
                        PL_tmps_stack[tmps_base + i] = &PL_sv_undef;
                    else
                        dirty_tmps = TRUE;
                    /* hv_store_ent() may have added set magic to val */;
                    SvSETMAGIC(val);
                }
            }

            if (dirty_tmps) {
                /* there are still some 'live' recounts on the tmps stack
                 * - usually caused by storing into a tied hash. So let
                 * free_tmps() do the proper but slow job later.
                 * Just disarm hash refcount: see comments below about leak
                 */
                PL_tmps_stack[tmps_base - 1] = &PL_sv_undef;
            }
            else {
                /* Quietly remove all the SVs from the tmps stack slots,
                 * since hash has now taken ownership of the refcnt.
                 * Also remove hash: which will now leak if we die before
                 * the SvREFCNT_dec_NN(hash) below */
                if (UNLIKELY(PL_tmps_ix >= tmps_base + nelems))
                    Move(&PL_tmps_stack[tmps_base + nelems],
                         &PL_tmps_stack[tmps_base - 1],
                         PL_tmps_ix - (tmps_base + nelems) + 1,
                         SV*);
                PL_tmps_ix -= (nelems + 1);
            }

            SvREFCNT_dec_NN(hash);

            relem = lastrelem + 1;
	    goto no_relems;
	}

	default:
	    if (!SvIMMORTAL(lsv)) {
                SV *ref;

                if (UNLIKELY(
                  SvTEMP(lsv) && !SvSMAGICAL(lsv) && SvREFCNT(lsv) == 1 &&
                  (!isGV_with_GP(lsv) || SvFAKE(lsv)) && ckWARN(WARN_MISC)
                ))
                    Perl_warner(aTHX_
                       packWARN(WARN_MISC),
                      "Useless assignment to a temporary"
                    );

                /* avoid freeing $$lsv if it might be needed for further
                 * elements, e.g. ($ref, $foo) = (1, $$ref) */
                if (   SvROK(lsv)
                    && ( ((ref = SvRV(lsv)), SvREFCNT(ref)) == 1)
                    && lelem <= lastlelem
                ) {
                    SSize_t ix;
                    SvREFCNT_inc_simple_void_NN(ref);
                    /* an unrolled sv_2mortal */
                    ix = ++PL_tmps_ix;
                    if (UNLIKELY(ix >= PL_tmps_max))
                        /* speculatively grow enough to cover other
                         * possible refs */
                         (void)tmps_grow_p(ix + (lastlelem - lelem));
                    PL_tmps_stack[ix] = ref;
                }

                sv_setsv(lsv, *relem);
                *relem = lsv;
                SvSETMAGIC(lsv);
            }
            if (++relem > lastrelem)
                goto no_relems;
	    break;
        } /* switch */
    } /* while */


  no_relems:

    /* simplified lelem loop for when there are no relems left */
    while (LIKELY(lelem <= lastlelem)) {
	SV *lsv = *lelem++;

        TAINT_NOT; /* Each item stands on its own, taintwise. */

	if (UNLIKELY(!lsv)) {
	    lsv = *lelem++;
	    ASSUME(SvTYPE(lsv) == SVt_PVAV);
	}

	switch (SvTYPE(lsv)) {
	case SVt_PVAV:
            if (SvRMAGICAL(lsv) || AvFILLp((SV*)lsv) >= 0) {
                av_clear((AV*)lsv);
                if (UNLIKELY(PL_delaymagic & DM_ARRAY_ISA))
                    SvSETMAGIC(lsv);
            }
            break;

	case SVt_PVHV:
            if (SvRMAGICAL(lsv) || HvUSEDKEYS((HV*)lsv))
                hv_clear((HV*)lsv);
            break;

	default:
	    if (!SvIMMORTAL(lsv)) {
                sv_set_undef(lsv);
                SvSETMAGIC(lsv);
                *relem++ = lsv;
            }
	    break;
        } /* switch */
    } /* while */

    TAINT_NOT; /* result of list assign isn't tainted */

    if (UNLIKELY(PL_delaymagic & ~DM_DELAY)) {
	/* Will be used to set PL_tainting below */
	Uid_t tmp_uid  = PerlProc_getuid();
	Uid_t tmp_euid = PerlProc_geteuid();
	Gid_t tmp_gid  = PerlProc_getgid();
	Gid_t tmp_egid = PerlProc_getegid();

        /* XXX $> et al currently silently ignore failures */
	if (PL_delaymagic & DM_UID) {
#ifdef HAS_SETRESUID
	    PERL_UNUSED_RESULT(
               setresuid((PL_delaymagic & DM_RUID) ? PL_delaymagic_uid  : (Uid_t)-1,
                         (PL_delaymagic & DM_EUID) ? PL_delaymagic_euid : (Uid_t)-1,
                         (Uid_t)-1));
#elif defined(HAS_SETREUID)
            PERL_UNUSED_RESULT(
                setreuid((PL_delaymagic & DM_RUID) ? PL_delaymagic_uid  : (Uid_t)-1,
                         (PL_delaymagic & DM_EUID) ? PL_delaymagic_euid : (Uid_t)-1));
#else
#    ifdef HAS_SETRUID
	    if ((PL_delaymagic & DM_UID) == DM_RUID) {
		PERL_UNUSED_RESULT(setruid(PL_delaymagic_uid));
		PL_delaymagic &= ~DM_RUID;
	    }
#    endif /* HAS_SETRUID */
#    ifdef HAS_SETEUID
	    if ((PL_delaymagic & DM_UID) == DM_EUID) {
		PERL_UNUSED_RESULT(seteuid(PL_delaymagic_euid));
		PL_delaymagic &= ~DM_EUID;
	    }
#    endif /* HAS_SETEUID */
	    if (PL_delaymagic & DM_UID) {
		if (PL_delaymagic_uid != PL_delaymagic_euid)
		    DIE(aTHX_ "No setreuid available");
		PERL_UNUSED_RESULT(PerlProc_setuid(PL_delaymagic_uid));
	    }
#endif /* HAS_SETRESUID */

	    tmp_uid  = PerlProc_getuid();
	    tmp_euid = PerlProc_geteuid();
	}
        /* XXX $> et al currently silently ignore failures */
	if (PL_delaymagic & DM_GID) {
#ifdef HAS_SETRESGID
	    PERL_UNUSED_RESULT(
                setresgid((PL_delaymagic & DM_RGID) ? PL_delaymagic_gid  : (Gid_t)-1,
                          (PL_delaymagic & DM_EGID) ? PL_delaymagic_egid : (Gid_t)-1,
                          (Gid_t)-1));
#elif defined(HAS_SETREGID)
	    PERL_UNUSED_RESULT(
                setregid((PL_delaymagic & DM_RGID) ? PL_delaymagic_gid  : (Gid_t)-1,
                         (PL_delaymagic & DM_EGID) ? PL_delaymagic_egid : (Gid_t)-1));
#else
#    ifdef HAS_SETRGID
	    if ((PL_delaymagic & DM_GID) == DM_RGID) {
		PERL_UNUSED_RESULT(setrgid(PL_delaymagic_gid));
		PL_delaymagic &= ~DM_RGID;
	    }
#    endif /* HAS_SETRGID */
#    ifdef HAS_SETEGID
	    if ((PL_delaymagic & DM_GID) == DM_EGID) {
		PERL_UNUSED_RESULT(setegid(PL_delaymagic_egid));
		PL_delaymagic &= ~DM_EGID;
	    }
#    endif /* HAS_SETEGID */
	    if (PL_delaymagic & DM_GID) {
		if (PL_delaymagic_gid != PL_delaymagic_egid)
		    DIE(aTHX_ "No setregid available");
		PERL_UNUSED_RESULT(PerlProc_setgid(PL_delaymagic_gid));
	    }
#endif /* HAS_SETRESGID */

	    tmp_gid  = PerlProc_getgid();
	    tmp_egid = PerlProc_getegid();
	}
	TAINTING_set( TAINTING_get | (tmp_uid && (tmp_euid != tmp_uid || tmp_egid != tmp_gid)) );
#ifdef NO_TAINT_SUPPORT
        PERL_UNUSED_VAR(tmp_uid);
        PERL_UNUSED_VAR(tmp_euid);
        PERL_UNUSED_VAR(tmp_gid);
        PERL_UNUSED_VAR(tmp_egid);
#endif
    }
    PL_delaymagic = old_delaymagic;

    if (gimme == G_VOID)
	SP = firstrelem - 1;
    else if (gimme == G_SCALAR) {
	SP = firstrelem;
        EXTEND(SP,1);
        if (PL_op->op_private & OPpASSIGN_TRUEBOOL)
            SETs((firstlelem - firstrelem) ? &PL_sv_yes : &PL_sv_zero);
        else {
            dTARGET;
            SETi(firstlelem - firstrelem);
        }
    }
    else
        SP = relem - 1;

    RETURN;
}

PP(pp_qr)
{
    dSP;
    PMOP * const pm = cPMOP;
    REGEXP * rx = PM_GETRE(pm);
    regexp *prog = ReANY(rx);
    SV * const pkg = RXp_ENGINE(prog)->qr_package(aTHX_ (rx));
    SV * const rv = sv_newmortal();
    CV **cvp;
    CV *cv;

    SvUPGRADE(rv, SVt_IV);
    /* For a subroutine describing itself as "This is a hacky workaround" I'm
       loathe to use it here, but it seems to be the right fix. Or close.
       The key part appears to be that it's essential for pp_qr to return a new
       object (SV), which implies that there needs to be an effective way to
       generate a new SV from the existing SV that is pre-compiled in the
       optree.  */
    SvRV_set(rv, MUTABLE_SV(reg_temp_copy(NULL, rx)));
    SvROK_on(rv);

    cvp = &( ReANY((REGEXP *)SvRV(rv))->qr_anoncv);
    if (UNLIKELY((cv = *cvp) && CvCLONE(*cvp))) {
	*cvp = cv_clone(cv);
	SvREFCNT_dec_NN(cv);
    }

    if (pkg) {
	HV *const stash = gv_stashsv(pkg, GV_ADD);
	SvREFCNT_dec_NN(pkg);
	(void)sv_bless(rv, stash);
    }

    if (UNLIKELY(RXp_ISTAINTED(prog))) {
        SvTAINTED_on(rv);
        SvTAINTED_on(SvRV(rv));
    }
    XPUSHs(rv);
    RETURN;
}

PP(pp_match)
{
    dSP; dTARG;
    PMOP *pm = cPMOP;
    PMOP *dynpm = pm;
    const char *s;
    const char *strend;
    SSize_t curpos = 0; /* initial pos() or current $+[0] */
    I32 global;
    U8 r_flags = 0;
    const char *truebase;			/* Start of string  */
    REGEXP *rx = PM_GETRE(pm);
    regexp *prog = ReANY(rx);
    bool rxtainted;
    const U8 gimme = GIMME_V;
    STRLEN len;
    const I32 oldsave = PL_savestack_ix;
    I32 had_zerolen = 0;
    MAGIC *mg = NULL;

    if (PL_op->op_flags & OPf_STACKED)
	TARG = POPs;
    else {
        if (ARGTARG)
            GETTARGET;
        else {
            TARG = DEFSV;
        }
	EXTEND(SP,1);
    }

    PUTBACK;				/* EVAL blocks need stack_sp. */
    /* Skip get-magic if this is a qr// clone, because regcomp has
       already done it. */
    truebase = prog->mother_re
	 ? SvPV_nomg_const(TARG, len)
	 : SvPV_const(TARG, len);
    if (!truebase)
	DIE(aTHX_ "panic: pp_match");
    strend = truebase + len;
    rxtainted = (RXp_ISTAINTED(prog) ||
		 (TAINT_get && (pm->op_pmflags & PMf_RETAINT)));
    TAINT_NOT;

    /* We need to know this in case we fail out early - pos() must be reset */
    global = dynpm->op_pmflags & PMf_GLOBAL;

    /* PMdf_USED is set after a ?? matches once */
    if (
#ifdef USE_ITHREADS
        SvREADONLY(PL_regex_pad[pm->op_pmoffset])
#else
        pm->op_pmflags & PMf_USED
#endif
    ) {
        DEBUG_r(PerlIO_printf(Perl_debug_log, "?? already matched once"));
	goto nope;
    }

    /* handle the empty pattern */
    if (!RX_PRELEN(rx) && PL_curpm && !prog->mother_re) {
        if (PL_curpm == PL_reg_curpm) {
            if (PL_curpm_under) {
                if (PL_curpm_under == PL_reg_curpm) {
                    Perl_croak(aTHX_ "Infinite recursion via empty pattern");
                } else {
                    pm = PL_curpm_under;
                }
            }
        } else {
            pm = PL_curpm;
        }
        rx = PM_GETRE(pm);
        prog = ReANY(rx);
    }

    if (RXp_MINLEN(prog) >= 0 && (STRLEN)RXp_MINLEN(prog) > len) {
        DEBUG_r(PerlIO_printf(Perl_debug_log, "String shorter than min possible regex match (%"
                                              UVuf " < %" IVdf ")\n",
                                              (UV)len, (IV)RXp_MINLEN(prog)));
	goto nope;
    }

    /* get pos() if //g */
    if (global) {
        mg = mg_find_mglob(TARG);
        if (mg && mg->mg_len >= 0) {
            curpos = MgBYTEPOS(mg, TARG, truebase, len);
            /* last time pos() was set, it was zero-length match */
            if (mg->mg_flags & MGf_MINMATCH)
                had_zerolen = 1;
        }
    }

#ifdef PERL_SAWAMPERSAND
    if (       RXp_NPARENS(prog)
            || PL_sawampersand
            || (RXp_EXTFLAGS(prog) & (RXf_EVAL_SEEN|RXf_PMf_KEEPCOPY))
            || (dynpm->op_pmflags & PMf_KEEPCOPY)
    )
#endif
    {
	r_flags |= (REXEC_COPY_STR|REXEC_COPY_SKIP_PRE);
        /* in @a =~ /(.)/g, we iterate multiple times, but copy the buffer
         * only on the first iteration. Therefore we need to copy $' as well
         * as $&, to make the rest of the string available for captures in
         * subsequent iterations */
        if (! (global && gimme == G_ARRAY))
            r_flags |= REXEC_COPY_SKIP_POST;
    };
#ifdef PERL_SAWAMPERSAND
    if (dynpm->op_pmflags & PMf_KEEPCOPY)
        /* handle KEEPCOPY in pmop but not rx, eg $r=qr/a/; /$r/p */
        r_flags &= ~(REXEC_COPY_SKIP_PRE|REXEC_COPY_SKIP_POST);
#endif

    s = truebase;

  play_it_again:
    if (global)
	s = truebase + curpos;

    if (!CALLREGEXEC(rx, (char*)s, (char *)strend, (char*)truebase,
		     had_zerolen, TARG, NULL, r_flags))
	goto nope;

    PL_curpm = pm;
    if (dynpm->op_pmflags & PMf_ONCE)
#ifdef USE_ITHREADS
	SvREADONLY_on(PL_regex_pad[dynpm->op_pmoffset]);
#else
	dynpm->op_pmflags |= PMf_USED;
#endif

    if (rxtainted)
	RXp_MATCH_TAINTED_on(prog);
    TAINT_IF(RXp_MATCH_TAINTED(prog));

    /* update pos */

    if (global && (gimme != G_ARRAY || (dynpm->op_pmflags & PMf_CONTINUE))) {
        if (!mg)
            mg = sv_magicext_mglob(TARG);
        MgBYTEPOS_set(mg, TARG, truebase, RXp_OFFS(prog)[0].end);
        if (RXp_ZERO_LEN(prog))
            mg->mg_flags |= MGf_MINMATCH;
        else
            mg->mg_flags &= ~MGf_MINMATCH;
    }

    if ((!RXp_NPARENS(prog) && !global) || gimme != G_ARRAY) {
	LEAVE_SCOPE(oldsave);
	RETPUSHYES;
    }

    /* push captures on stack */

    {
	const I32 nparens = RXp_NPARENS(prog);
	I32 i = (global && !nparens) ? 1 : 0;

	SPAGAIN;			/* EVAL blocks could move the stack. */
	EXTEND(SP, nparens + i);
	EXTEND_MORTAL(nparens + i);
	for (i = !i; i <= nparens; i++) {
	    PUSHs(sv_newmortal());
	    if (LIKELY((RXp_OFFS(prog)[i].start != -1)
                     && RXp_OFFS(prog)[i].end   != -1 ))
            {
		const I32 len = RXp_OFFS(prog)[i].end - RXp_OFFS(prog)[i].start;
		const char * const s = RXp_OFFS(prog)[i].start + truebase;
	        if (UNLIKELY(  RXp_OFFS(prog)[i].end   < 0
                            || RXp_OFFS(prog)[i].start < 0
                            || len < 0
                            || len > strend - s)
                )
		    DIE(aTHX_ "panic: pp_match start/end pointers, i=%ld, "
			"start=%ld, end=%ld, s=%p, strend=%p, len=%" UVuf,
			(long) i, (long) RXp_OFFS(prog)[i].start,
			(long)RXp_OFFS(prog)[i].end, s, strend, (UV) len);
		sv_setpvn(*SP, s, len);
		if (DO_UTF8(TARG) && is_utf8_string((U8*)s, len))
		    SvUTF8_on(*SP);
	    }
	}
	if (global) {
            curpos = (UV)RXp_OFFS(prog)[0].end;
	    had_zerolen = RXp_ZERO_LEN(prog);
	    PUTBACK;			/* EVAL blocks may use stack */
	    r_flags |= REXEC_IGNOREPOS | REXEC_NOT_FIRST;
	    goto play_it_again;
	}
	LEAVE_SCOPE(oldsave);
	RETURN;
    }
    NOT_REACHED; /* NOTREACHED */

  nope:
    if (global && !(dynpm->op_pmflags & PMf_CONTINUE)) {
        if (!mg)
            mg = mg_find_mglob(TARG);
        if (mg)
            mg->mg_len = -1;
    }
    LEAVE_SCOPE(oldsave);
    if (gimme == G_ARRAY)
	RETURN;
    RETPUSHNO;
}

OP *
Perl_do_readline(pTHX)
{
    dSP; dTARGETSTACKED;
    SV *sv;
    STRLEN tmplen = 0;
    STRLEN offset;
    PerlIO *fp;
    IO * const io = GvIO(PL_last_in_gv);
    const I32 type = PL_op->op_type;
    const U8 gimme = GIMME_V;

    if (io) {
	const MAGIC *const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
	if (mg) {
	    Perl_tied_method(aTHX_ SV_CONST(READLINE), SP, MUTABLE_SV(io), mg, gimme, 0);
	    if (gimme == G_SCALAR) {
		SPAGAIN;
		SvSetSV_nosteal(TARG, TOPs);
		SETTARG;
	    }
	    return NORMAL;
	}
    }
    fp = NULL;
    if (io) {
	fp = IoIFP(io);
	if (!fp) {
	    if (IoFLAGS(io) & IOf_ARGV) {
		if (IoFLAGS(io) & IOf_START) {
		    IoLINES(io) = 0;
		    if (av_tindex(GvAVn(PL_last_in_gv)) < 0) {
			IoFLAGS(io) &= ~IOf_START;
			do_open6(PL_last_in_gv, "-", 1, NULL, NULL, 0);
			SvTAINTED_off(GvSVn(PL_last_in_gv)); /* previous tainting irrelevant */
			sv_setpvs(GvSVn(PL_last_in_gv), "-");
			SvSETMAGIC(GvSV(PL_last_in_gv));
			fp = IoIFP(io);
			goto have_fp;
		    }
		}
		fp = nextargv(PL_last_in_gv, PL_op->op_flags & OPf_SPECIAL);
		if (!fp) { /* Note: fp != IoIFP(io) */
		    (void)do_close(PL_last_in_gv, FALSE); /* now it does*/
		}
	    }
	    else if (type == OP_GLOB)
		fp = Perl_start_glob(aTHX_ POPs, io);
	}
	else if (type == OP_GLOB)
	    SP--;
	else if (IoTYPE(io) == IoTYPE_WRONLY) {
	    report_wrongway_fh(PL_last_in_gv, '>');
	}
    }
    if (!fp) {
	if ((!io || !(IoFLAGS(io) & IOf_START))
	    && ckWARN(WARN_CLOSED)
            && type != OP_GLOB)
	{
	    report_evil_fh(PL_last_in_gv);
	}
	if (gimme == G_SCALAR) {
	    /* undef TARG, and push that undefined value */
	    if (type != OP_RCATLINE) {
		sv_set_undef(TARG);
	    }
	    PUSHTARG;
	}
	RETURN;
    }
  have_fp:
    if (gimme == G_SCALAR) {
	sv = TARG;
	if (type == OP_RCATLINE && SvGMAGICAL(sv))
	    mg_get(sv);
	if (SvROK(sv)) {
	    if (type == OP_RCATLINE)
		SvPV_force_nomg_nolen(sv);
	    else
		sv_unref(sv);
	}
	else if (isGV_with_GP(sv)) {
	    SvPV_force_nomg_nolen(sv);
	}
	SvUPGRADE(sv, SVt_PV);
	tmplen = SvLEN(sv);	/* remember if already alloced */
	if (!tmplen && !SvREADONLY(sv) && !SvIsCOW(sv)) {
            /* try short-buffering it. Please update t/op/readline.t
	     * if you change the growth length.
	     */
	    Sv_Grow(sv, 80);
        }
	offset = 0;
	if (type == OP_RCATLINE && SvOK(sv)) {
	    if (!SvPOK(sv)) {
		SvPV_force_nomg_nolen(sv);
	    }
	    offset = SvCUR(sv);
	}
    }
    else {
	sv = sv_2mortal(newSV(80));
	offset = 0;
    }

    /* This should not be marked tainted if the fp is marked clean */
#define MAYBE_TAINT_LINE(io, sv) \
    if (!(IoFLAGS(io) & IOf_UNTAINT)) { \
	TAINT;				\
	SvTAINTED_on(sv);		\
    }

/* delay EOF state for a snarfed empty file */
#define SNARF_EOF(gimme,rs,io,sv) \
    (gimme != G_SCALAR || SvCUR(sv)					\
     || (IoFLAGS(io) & IOf_NOLINE) || !RsSNARF(rs))

    for (;;) {
	PUTBACK;
	if (!sv_gets(sv, fp, offset)
	    && (type == OP_GLOB
		|| SNARF_EOF(gimme, PL_rs, io, sv)
		|| PerlIO_error(fp)))
	{
	    PerlIO_clearerr(fp);
	    if (IoFLAGS(io) & IOf_ARGV) {
		fp = nextargv(PL_last_in_gv, PL_op->op_flags & OPf_SPECIAL);
		if (fp)
		    continue;
		(void)do_close(PL_last_in_gv, FALSE);
	    }
	    else if (type == OP_GLOB) {
		if (!do_close(PL_last_in_gv, FALSE)) {
		    Perl_ck_warner(aTHX_ packWARN(WARN_GLOB),
				   "glob failed (child exited with status %d%s)",
				   (int)(STATUS_CURRENT >> 8),
				   (STATUS_CURRENT & 0x80) ? ", core dumped" : "");
		}
	    }
	    if (gimme == G_SCALAR) {
		if (type != OP_RCATLINE) {
		    SV_CHECK_THINKFIRST_COW_DROP(TARG);
		    SvOK_off(TARG);
		}
		SPAGAIN;
		PUSHTARG;
	    }
	    MAYBE_TAINT_LINE(io, sv);
	    RETURN;
	}
	MAYBE_TAINT_LINE(io, sv);
	IoLINES(io)++;
	IoFLAGS(io) |= IOf_NOLINE;
	SvSETMAGIC(sv);
	SPAGAIN;
	XPUSHs(sv);
	if (type == OP_GLOB) {
	    const char *t1;
	    Stat_t statbuf;

	    if (SvCUR(sv) > 0 && SvCUR(PL_rs) > 0) {
		char * const tmps = SvEND(sv) - 1;
		if (*tmps == *SvPVX_const(PL_rs)) {
		    *tmps = '\0';
		    SvCUR_set(sv, SvCUR(sv) - 1);
		}
	    }
	    for (t1 = SvPVX_const(sv); *t1; t1++)
#ifdef __VMS
		if (strchr("*%?", *t1))
#else
		if (strchr("$&*(){}[]'\";\\|?<>~`", *t1))
#endif
			break;
	    if (*t1 && PerlLIO_lstat(SvPVX_const(sv), &statbuf) < 0) {
		(void)POPs;		/* Unmatched wildcard?  Chuck it... */
		continue;
	    }
	} else if (SvUTF8(sv)) { /* OP_READLINE, OP_RCATLINE */
	     if (ckWARN(WARN_UTF8)) {
		const U8 * const s = (const U8*)SvPVX_const(sv) + offset;
		const STRLEN len = SvCUR(sv) - offset;
		const U8 *f;

		if (!is_utf8_string_loc(s, len, &f))
		    /* Emulate :encoding(utf8) warning in the same case. */
		    Perl_warner(aTHX_ packWARN(WARN_UTF8),
				"utf8 \"\\x%02X\" does not map to Unicode",
				f < (U8*)SvEND(sv) ? *f : 0);
	     }
	}
	if (gimme == G_ARRAY) {
	    if (SvLEN(sv) - SvCUR(sv) > 20) {
		SvPV_shrink_to_cur(sv);
	    }
	    sv = sv_2mortal(newSV(80));
	    continue;
	}
	else if (gimme == G_SCALAR && !tmplen && SvLEN(sv) - SvCUR(sv) > 80) {
	    /* try to reclaim a bit of scalar space (only on 1st alloc) */
	    const STRLEN new_len
		= SvCUR(sv) < 60 ? 80 : SvCUR(sv)+40; /* allow some slop */
	    SvPV_renew(sv, new_len);
	}
	RETURN;
    }
}

PP(pp_helem)
{
    dSP;
    HE* he;
    SV **svp;
    SV * const keysv = POPs;
    HV * const hv = MUTABLE_HV(POPs);
    const U32 lval = PL_op->op_flags & OPf_MOD || LVRET;
    const U32 defer = PL_op->op_private & OPpLVAL_DEFER;
    SV *sv;
    const bool localizing = PL_op->op_private & OPpLVAL_INTRO;
    bool preeminent = TRUE;

    if (SvTYPE(hv) != SVt_PVHV)
	RETPUSHUNDEF;

    if (localizing) {
	MAGIC *mg;
	HV *stash;

	/* If we can determine whether the element exist,
	 * Try to preserve the existenceness of a tied hash
	 * element by using EXISTS and DELETE if possible.
	 * Fallback to FETCH and STORE otherwise. */
	if (SvCANEXISTDELETE(hv))
	    preeminent = hv_exists_ent(hv, keysv, 0);
    }

    he = hv_fetch_ent(hv, keysv, lval && !defer, 0);
    svp = he ? &HeVAL(he) : NULL;
    if (lval) {
	if (!svp || !*svp || *svp == &PL_sv_undef) {
	    SV* lv;
	    SV* key2;
	    if (!defer) {
		DIE(aTHX_ PL_no_helem_sv, SVfARG(keysv));
	    }
	    lv = sv_newmortal();
	    sv_upgrade(lv, SVt_PVLV);
	    LvTYPE(lv) = 'y';
	    sv_magic(lv, key2 = newSVsv(keysv), PERL_MAGIC_defelem, NULL, 0);
	    SvREFCNT_dec_NN(key2);	/* sv_magic() increments refcount */
	    LvTARG(lv) = SvREFCNT_inc_simple_NN(hv);
	    LvTARGLEN(lv) = 1;
	    PUSHs(lv);
	    RETURN;
	}
	if (localizing) {
	    if (HvNAME_get(hv) && isGV_or_RVCV(*svp))
		save_gp(MUTABLE_GV(*svp), !(PL_op->op_flags & OPf_SPECIAL));
	    else if (preeminent)
		save_helem_flags(hv, keysv, svp,
		     (PL_op->op_flags & OPf_SPECIAL) ? 0 : SAVEf_SETMAGIC);
	    else
		SAVEHDELETE(hv, keysv);
	}
	else if (PL_op->op_private & OPpDEREF) {
	    PUSHs(vivify_ref(*svp, PL_op->op_private & OPpDEREF));
	    RETURN;
	}
    }
    sv = (svp && *svp ? *svp : &PL_sv_undef);
    /* Originally this did a conditional C<sv = sv_mortalcopy(sv)>; this
     * was to make C<local $tied{foo} = $tied{foo}> possible.
     * However, it seems no longer to be needed for that purpose, and
     * introduced a new bug: stuff like C<while ($hash{taintedval} =~ /.../g>
     * would loop endlessly since the pos magic is getting set on the
     * mortal copy and lost. However, the copy has the effect of
     * triggering the get magic, and losing it altogether made things like
     * c<$tied{foo};> in void context no longer do get magic, which some
     * code relied on. Also, delayed triggering of magic on @+ and friends
     * meant the original regex may be out of scope by now. So as a
     * compromise, do the get magic here. (The MGf_GSKIP flag will stop it
     * being called too many times). */
    if (!lval && SvRMAGICAL(hv) && SvGMAGICAL(sv))
	mg_get(sv);
    PUSHs(sv);
    RETURN;
}


/* a stripped-down version of Perl_softref2xv() for use by
 * pp_multideref(), which doesn't use PL_op->op_flags */

STATIC GV *
S_softref2xv_lite(pTHX_ SV *const sv, const char *const what,
		const svtype type)
{
    if (PL_op->op_private & HINT_STRICT_REFS) {
	if (SvOK(sv))
	    Perl_die(aTHX_ PL_no_symref_sv, sv,
		     (SvPOKp(sv) && SvCUR(sv)>32 ? "..." : ""), what);
	else
	    Perl_die(aTHX_ PL_no_usym, what);
    }
    if (!SvOK(sv))
        Perl_die(aTHX_ PL_no_usym, what);
    return gv_fetchsv_nomg(sv, GV_ADD, type);
}


/* Handle one or more aggregate derefs and array/hash indexings, e.g.
 * $h->{foo}  or  $a[0]{$key}[$i]  or  f()->[1]
 *
 * op_aux points to an array of unions of UV / IV / SV* / PADOFFSET.
 * Each of these either contains a set of actions, or an argument, such as
 * an IV to use as an array index, or a lexical var to retrieve.
 * Several actions re stored per UV; we keep shifting new actions off the
 * one UV, and only reload when it becomes zero.
 */

PP(pp_multideref)
{
    SV *sv = NULL; /* init to avoid spurious 'may be used uninitialized' */
    UNOP_AUX_item *items = cUNOP_AUXx(PL_op)->op_aux;
    UV actions = items->uv;

    assert(actions);
    /* this tells find_uninit_var() where we're up to */
    PL_multideref_pc = items;

    while (1) {
        /* there are three main classes of action; the first retrieve
         * the initial AV or HV from a variable or the stack; the second
         * does the equivalent of an unrolled (/DREFAV, rv2av, aelem),
         * the third an unrolled (/DREFHV, rv2hv, helem).
         */
        switch (actions & MDEREF_ACTION_MASK) {

        case MDEREF_reload:
            actions = (++items)->uv;
            continue;

        case MDEREF_AV_padav_aelem:                 /* $lex[...] */
            sv = PAD_SVl((++items)->pad_offset);
            goto do_AV_aelem;

        case MDEREF_AV_gvav_aelem:                  /* $pkg[...] */
            sv = UNOP_AUX_item_sv(++items);
            assert(isGV_with_GP(sv));
            sv = (SV*)GvAVn((GV*)sv);
            goto do_AV_aelem;

        case MDEREF_AV_pop_rv2av_aelem:             /* expr->[...] */
            {
                dSP;
                sv = POPs;
                PUTBACK;
                goto do_AV_rv2av_aelem;
            }

        case MDEREF_AV_gvsv_vivify_rv2av_aelem:     /* $pkg->[...] */
            sv = UNOP_AUX_item_sv(++items);
            assert(isGV_with_GP(sv));
            sv = GvSVn((GV*)sv);
            goto do_AV_vivify_rv2av_aelem;

        case MDEREF_AV_padsv_vivify_rv2av_aelem:     /* $lex->[...] */
            sv = PAD_SVl((++items)->pad_offset);
            /* FALLTHROUGH */

        do_AV_vivify_rv2av_aelem:
        case MDEREF_AV_vivify_rv2av_aelem:           /* vivify, ->[...] */
            /* this is the OPpDEREF action normally found at the end of
             * ops like aelem, helem, rv2sv */
            sv = vivify_ref(sv, OPpDEREF_AV);
            /* FALLTHROUGH */

        do_AV_rv2av_aelem:
            /* this is basically a copy of pp_rv2av when it just has the
             * sKR/1 flags */
            SvGETMAGIC(sv);
            if (LIKELY(SvROK(sv))) {
                if (UNLIKELY(SvAMAGIC(sv))) {
                    sv = amagic_deref_call(sv, to_av_amg);
                }
                sv = SvRV(sv);
                if (UNLIKELY(SvTYPE(sv) != SVt_PVAV))
                    DIE(aTHX_ "Not an ARRAY reference");
            }
            else if (SvTYPE(sv) != SVt_PVAV) {
                if (!isGV_with_GP(sv))
                    sv = (SV*)S_softref2xv_lite(aTHX_ sv, "an ARRAY", SVt_PVAV);
                sv = MUTABLE_SV(GvAVn((GV*)sv));
            }
            /* FALLTHROUGH */

        do_AV_aelem:
            {
                /* retrieve the key; this may be either a lexical or package
                 * var (whose index/ptr is stored as an item) or a signed
                 * integer constant stored as an item.
                 */
                SV *elemsv;
                IV elem = 0; /* to shut up stupid compiler warnings */


                assert(SvTYPE(sv) == SVt_PVAV);

                switch (actions & MDEREF_INDEX_MASK) {
                case MDEREF_INDEX_none:
                    goto finish;
                case MDEREF_INDEX_const:
                    elem  = (++items)->iv;
                    break;
                case MDEREF_INDEX_padsv:
                    elemsv = PAD_SVl((++items)->pad_offset);
                    goto check_elem;
                case MDEREF_INDEX_gvsv:
                    elemsv = UNOP_AUX_item_sv(++items);
                    assert(isGV_with_GP(elemsv));
                    elemsv = GvSVn((GV*)elemsv);
                check_elem:
                    if (UNLIKELY(SvROK(elemsv) && !SvGAMAGIC(elemsv)
                                            && ckWARN(WARN_MISC)))
                        Perl_warner(aTHX_ packWARN(WARN_MISC),
                                "Use of reference \"%" SVf "\" as array index",
                                SVfARG(elemsv));
                    /* the only time that S_find_uninit_var() needs this
                     * is to determine which index value triggered the
                     * undef warning. So just update it here. Note that
                     * since we don't save and restore this var (e.g. for
                     * tie or overload execution), its value will be
                     * meaningless apart from just here */
                    PL_multideref_pc = items;
                    elem = SvIV(elemsv);
                    break;
                }


                /* this is basically a copy of pp_aelem with OPpDEREF skipped */

                if (!(actions & MDEREF_FLAG_last)) {
                    SV** svp = av_fetch((AV*)sv, elem, 1);
                    if (!svp || ! (sv=*svp))
                        DIE(aTHX_ PL_no_aelem, elem);
                    break;
                }

                if (PL_op->op_private &
                    (OPpMULTIDEREF_EXISTS|OPpMULTIDEREF_DELETE))
                {
                    if (PL_op->op_private & OPpMULTIDEREF_EXISTS) {
                        sv = av_exists((AV*)sv, elem) ? &PL_sv_yes : &PL_sv_no;
                    }
                    else {
                        I32 discard = (GIMME_V == G_VOID) ? G_DISCARD : 0;
                        sv = av_delete((AV*)sv, elem, discard);
                        if (discard)
                            return NORMAL;
                        if (!sv)
                            sv = &PL_sv_undef;
                    }
                }
                else {
                    const U32 lval = PL_op->op_flags & OPf_MOD || LVRET;
                    const U32 defer = PL_op->op_private & OPpLVAL_DEFER;
                    const bool localizing = PL_op->op_private & OPpLVAL_INTRO;
                    bool preeminent = TRUE;
                    AV *const av = (AV*)sv;
                    SV** svp;

                    if (UNLIKELY(localizing)) {
                        MAGIC *mg;
                        HV *stash;

                        /* If we can determine whether the element exist,
                         * Try to preserve the existenceness of a tied array
                         * element by using EXISTS and DELETE if possible.
                         * Fallback to FETCH and STORE otherwise. */
                        if (SvCANEXISTDELETE(av))
                            preeminent = av_exists(av, elem);
                    }

                    svp = av_fetch(av, elem, lval && !defer);

                    if (lval) {
                        if (!svp || !(sv = *svp)) {
                            IV len;
                            if (!defer)
                                DIE(aTHX_ PL_no_aelem, elem);
                            len = av_tindex(av);
                            /* Resolve a negative index that falls within
                             * the array.  Leave it negative it if falls
                             * outside the array.  */
                             if (elem < 0 && len + elem >= 0)
                                 elem = len + elem;
                             if (elem >= 0 && elem <= len)
                                 /* Falls within the array.  */
                                 sv = av_nonelem(av,elem);
                             else
                                 /* Falls outside the array.  If it is neg-
                                    ative, magic_setdefelem will use the
                                    index for error reporting.  */
                                sv = sv_2mortal(newSVavdefelem(av,elem,1));
                        }
                        else {
                            if (UNLIKELY(localizing)) {
                                if (preeminent) {
                                    save_aelem(av, elem, svp);
                                    sv = *svp; /* may have changed */
                                }
                                else
                                    SAVEADELETE(av, elem);
                            }
                        }
                    }
                    else {
                        sv = (svp ? *svp : &PL_sv_undef);
                        /* see note in pp_helem() */
                        if (SvRMAGICAL(av) && SvGMAGICAL(sv))
                            mg_get(sv);
                    }
                }

            }
          finish:
            {
                dSP;
                XPUSHs(sv);
                RETURN;
            }
            /* NOTREACHED */




        case MDEREF_HV_padhv_helem:                 /* $lex{...} */
            sv = PAD_SVl((++items)->pad_offset);
            goto do_HV_helem;

        case MDEREF_HV_gvhv_helem:                  /* $pkg{...} */
            sv = UNOP_AUX_item_sv(++items);
            assert(isGV_with_GP(sv));
            sv = (SV*)GvHVn((GV*)sv);
            goto do_HV_helem;

        case MDEREF_HV_pop_rv2hv_helem:             /* expr->{...} */
            {
                dSP;
                sv = POPs;
                PUTBACK;
                goto do_HV_rv2hv_helem;
            }

        case MDEREF_HV_gvsv_vivify_rv2hv_helem:     /* $pkg->{...} */
            sv = UNOP_AUX_item_sv(++items);
            assert(isGV_with_GP(sv));
            sv = GvSVn((GV*)sv);
            goto do_HV_vivify_rv2hv_helem;

        case MDEREF_HV_padsv_vivify_rv2hv_helem:    /* $lex->{...} */
            sv = PAD_SVl((++items)->pad_offset);
            /* FALLTHROUGH */

        do_HV_vivify_rv2hv_helem:
        case MDEREF_HV_vivify_rv2hv_helem:           /* vivify, ->{...} */
            /* this is the OPpDEREF action normally found at the end of
             * ops like aelem, helem, rv2sv */
            sv = vivify_ref(sv, OPpDEREF_HV);
            /* FALLTHROUGH */

        do_HV_rv2hv_helem:
            /* this is basically a copy of pp_rv2hv when it just has the
             * sKR/1 flags (and pp_rv2hv is aliased to pp_rv2av) */

            SvGETMAGIC(sv);
            if (LIKELY(SvROK(sv))) {
                if (UNLIKELY(SvAMAGIC(sv))) {
                    sv = amagic_deref_call(sv, to_hv_amg);
                }
                sv = SvRV(sv);
                if (UNLIKELY(SvTYPE(sv) != SVt_PVHV))
                    DIE(aTHX_ "Not a HASH reference");
            }
            else if (SvTYPE(sv) != SVt_PVHV) {
                if (!isGV_with_GP(sv))
                    sv = (SV*)S_softref2xv_lite(aTHX_ sv, "a HASH", SVt_PVHV);
                sv = MUTABLE_SV(GvHVn((GV*)sv));
            }
            /* FALLTHROUGH */

        do_HV_helem:
            {
                /* retrieve the key; this may be either a lexical / package
                 * var or a string constant, whose index/ptr is stored as an
                 * item
                 */
                SV *keysv = NULL; /* to shut up stupid compiler warnings */

                assert(SvTYPE(sv) == SVt_PVHV);

                switch (actions & MDEREF_INDEX_MASK) {
                case MDEREF_INDEX_none:
                    goto finish;

                case MDEREF_INDEX_const:
                    keysv = UNOP_AUX_item_sv(++items);
                    break;

                case MDEREF_INDEX_padsv:
                    keysv = PAD_SVl((++items)->pad_offset);
                    break;

                case MDEREF_INDEX_gvsv:
                    keysv = UNOP_AUX_item_sv(++items);
                    keysv = GvSVn((GV*)keysv);
                    break;
                }

                /* see comment above about setting this var */
                PL_multideref_pc = items;


                /* ensure that candidate CONSTs have been HEKified */
                assert(   ((actions & MDEREF_INDEX_MASK) != MDEREF_INDEX_const)
                       || SvTYPE(keysv) >= SVt_PVMG
                       || !SvOK(keysv)
                       || SvROK(keysv)
                       || SvIsCOW_shared_hash(keysv));

                /* this is basically a copy of pp_helem with OPpDEREF skipped */

                if (!(actions & MDEREF_FLAG_last)) {
                    HE *he = hv_fetch_ent((HV*)sv, keysv, 1, 0);
                    if (!he || !(sv=HeVAL(he)) || sv == &PL_sv_undef)
                        DIE(aTHX_ PL_no_helem_sv, SVfARG(keysv));
                    break;
                }

                if (PL_op->op_private &
                    (OPpMULTIDEREF_EXISTS|OPpMULTIDEREF_DELETE))
                {
                    if (PL_op->op_private & OPpMULTIDEREF_EXISTS) {
                        sv = hv_exists_ent((HV*)sv, keysv, 0)
                                                ? &PL_sv_yes : &PL_sv_no;
                    }
                    else {
                        I32 discard = (GIMME_V == G_VOID) ? G_DISCARD : 0;
                        sv = hv_delete_ent((HV*)sv, keysv, discard, 0);
                        if (discard)
                            return NORMAL;
                        if (!sv)
                            sv = &PL_sv_undef;
                    }
                }
                else {
                    const U32 lval = PL_op->op_flags & OPf_MOD || LVRET;
                    const U32 defer = PL_op->op_private & OPpLVAL_DEFER;
                    const bool localizing = PL_op->op_private & OPpLVAL_INTRO;
                    bool preeminent = TRUE;
                    SV **svp;
                    HV * const hv = (HV*)sv;
                    HE* he;

                    if (UNLIKELY(localizing)) {
                        MAGIC *mg;
                        HV *stash;

                        /* If we can determine whether the element exist,
                         * Try to preserve the existenceness of a tied hash
                         * element by using EXISTS and DELETE if possible.