This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
op.c: update comment about compiler warnings
[perl5.git] / pp_ctl.c
diff --git a/pp_ctl.c b/pp_ctl.c
index 72266fa..011da56 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -40,7 +40,6 @@
 
 PP(pp_wantarray)
 {
 
 PP(pp_wantarray)
 {
-    dVAR;
     dSP;
     I32 cxix;
     const PERL_CONTEXT *cx;
     dSP;
     I32 cxix;
     const PERL_CONTEXT *cx;
@@ -68,14 +67,12 @@ PP(pp_wantarray)
 
 PP(pp_regcreset)
 {
 
 PP(pp_regcreset)
 {
-    dVAR;
     TAINT_NOT;
     return NORMAL;
 }
 
 PP(pp_regcomp)
 {
     TAINT_NOT;
     return NORMAL;
 }
 
 PP(pp_regcomp)
 {
-    dVAR;
     dSP;
     PMOP *pm = (PMOP*)cLOGOP->op_other;
     SV **args;
     dSP;
     PMOP *pm = (PMOP*)cLOGOP->op_other;
     SV **args;
@@ -145,7 +142,7 @@ PP(pp_regcomp)
            const bool was_tainted = TAINT_get;
            if (pm->op_flags & OPf_STACKED)
                lhs = args[-1];
            const bool was_tainted = TAINT_get;
            if (pm->op_flags & OPf_STACKED)
                lhs = args[-1];
-           else if (pm->op_private & OPpTARGET_MY)
+           else if (pm->op_targ)
                lhs = PAD_SV(pm->op_targ);
            else lhs = DEFSV;
            SvGETMAGIC(lhs);
                lhs = PAD_SV(pm->op_targ);
            else lhs = DEFSV;
            SvGETMAGIC(lhs);
@@ -168,7 +165,8 @@ PP(pp_regcomp)
     }
 
 
     }
 
 
-    if (TAINTING_get && TAINT_get) {
+    assert(TAINTING_get || !TAINT_get);
+    if (TAINT_get) {
        SvTAINTED_on((SV*)new_re);
         RX_TAINT_on(new_re);
     }
        SvTAINTED_on((SV*)new_re);
         RX_TAINT_on(new_re);
     }
@@ -191,7 +189,6 @@ PP(pp_regcomp)
 
 PP(pp_substcont)
 {
 
 PP(pp_substcont)
 {
-    dVAR;
     dSP;
     PERL_CONTEXT *cx = &cxstack[cxstack_ix];
     PMOP * const pm = (PMOP*) cLOGOP->op_other;
     dSP;
     PERL_CONTEXT *cx = &cxstack[cxstack_ix];
     PMOP * const pm = (PMOP*) cLOGOP->op_other;
@@ -214,7 +211,7 @@ PP(pp_substcont)
     rxres_restore(&cx->sb_rxres, rx);
 
     if (cx->sb_iters++) {
     rxres_restore(&cx->sb_rxres, rx);
 
     if (cx->sb_iters++) {
-       const I32 saviters = cx->sb_iters;
+       const SSize_t saviters = cx->sb_iters;
        if (cx->sb_iters > cx->sb_maxiters)
            DIE(aTHX_ "Substitution loop");
 
        if (cx->sb_iters > cx->sb_maxiters)
            DIE(aTHX_ "Substitution loop");
 
@@ -292,7 +289,7 @@ PP(pp_substcont)
            POPSUBST(cx);
            PERL_ASYNC_CHECK();
            RETURNOP(pm->op_next);
            POPSUBST(cx);
            PERL_ASYNC_CHECK();
            RETURNOP(pm->op_next);
-           assert(0); /* NOTREACHED */
+           NOT_REACHED; /* NOTREACHED */
        }
        cx->sb_iters = saviters;
     }
        }
        cx->sb_iters = saviters;
     }
@@ -316,11 +313,17 @@ PP(pp_substcont)
        SV * const sv
            = (pm->op_pmflags & PMf_NONDESTRUCT) ? cx->sb_dstr : cx->sb_targ;
        MAGIC *mg;
        SV * const sv
            = (pm->op_pmflags & PMf_NONDESTRUCT) ? cx->sb_dstr : cx->sb_targ;
        MAGIC *mg;
+
+        /* the string being matched against may no longer be a string,
+         * e.g. $_=0; s/.../$_++/ge */
+
+        if (!SvPOK(sv))
+            SvPV_force_nomg_nolen(sv);
+
        if (!(mg = mg_find_mglob(sv))) {
            mg = sv_magicext_mglob(sv);
        }
        if (!(mg = mg_find_mglob(sv))) {
            mg = sv_magicext_mglob(sv);
        }
-       assert(SvPOK(dstr));
-       MgBYTEPOS_set(mg, sv, SvPVX(dstr), m - orig);
+       MgBYTEPOS_set(mg, sv, SvPVX(sv), m - orig);
     }
     if (old != rx)
        (void)ReREFCNT_inc(rx);
     }
     if (old != rx)
        (void)ReREFCNT_inc(rx);
@@ -457,7 +460,7 @@ S_rxres_free(pTHX_ void **rsp)
 
 PP(pp_formline)
 {
 
 PP(pp_formline)
 {
-    dVAR; dSP; dMARK; dORIGMARK;
+    dSP; dMARK; dORIGMARK;
     SV * const tmpForm = *++MARK;
     SV *formsv;                    /* contains text of original format */
     U32 *fpc;      /* format ops program counter */
     SV * const tmpForm = *++MARK;
     SV *formsv;                    /* contains text of original format */
     U32 *fpc;      /* format ops program counter */
@@ -590,6 +593,7 @@ PP(pp_formline)
                         break;
                 }
                 itembytes = s - item;
                         break;
                 }
                 itembytes = s - item;
+                chophere = s;
                break;
            }
 
                break;
            }
 
@@ -678,7 +682,7 @@ PP(pp_formline)
            goto append;
 
        case FF_CHOP: /* (for ^*) chop the current item */
            goto append;
 
        case FF_CHOP: /* (for ^*) chop the current item */
-           {
+           if (sv != &PL_sv_no) {
                const char *s = chophere;
                if (chopspace) {
                    while (isSPACE(*s))
                const char *s = chophere;
                if (chopspace) {
                    while (isSPACE(*s))
@@ -705,11 +709,11 @@ PP(pp_formline)
                const char *const send = s + len;
 
                item_is_utf8 = DO_UTF8(sv);
                const char *const send = s + len;
 
                item_is_utf8 = DO_UTF8(sv);
+               chophere = s + len;
                if (!len)
                    break;
                trans = 0;
                gotsome = TRUE;
                if (!len)
                    break;
                trans = 0;
                gotsome = TRUE;
-               chophere = s + len;
                source = (U8 *) s;
                to_copy = len;
                while (s < send) {
                source = (U8 *) s;
                to_copy = len;
                while (s < send) {
@@ -797,26 +801,14 @@ PP(pp_formline)
 
        case FF_0DECIMAL: /* like FF_DECIMAL but for 0### */
            arg = *fpc++;
 
        case FF_0DECIMAL: /* like FF_DECIMAL but for 0### */
            arg = *fpc++;
-#if defined(USE_LONG_DOUBLE)
-           fmt = (const char *)
-               ((arg & FORM_NUM_POINT) ?
-                "%#0*.*" PERL_PRIfldbl : "%0*.*" PERL_PRIfldbl);
-#else
            fmt = (const char *)
            fmt = (const char *)
-               ((arg & FORM_NUM_POINT) ?
-                "%#0*.*f"              : "%0*.*f");
-#endif
+               ((arg & FORM_NUM_POINT) ? "%#0*.*" NVff : "%0*.*" NVff);
            goto ff_dec;
 
        case FF_DECIMAL: /* do @##, ^##, where <arg>=(precision|flags) */
            arg = *fpc++;
            goto ff_dec;
 
        case FF_DECIMAL: /* do @##, ^##, where <arg>=(precision|flags) */
            arg = *fpc++;
-#if defined(USE_LONG_DOUBLE)
            fmt = (const char *)
            fmt = (const char *)
-               ((arg & FORM_NUM_POINT) ? "%#*.*" PERL_PRIfldbl : "%*.*" PERL_PRIfldbl);
-#else
-            fmt = (const char *)
-               ((arg & FORM_NUM_POINT) ? "%#*.*f"              : "%*.*f");
-#endif
+               ((arg & FORM_NUM_POINT) ? "%#*.*" NVff : "%*.*" NVff);
        ff_dec:
            /* If the field is marked with ^ and the value is undefined,
               blank it out. */
        ff_dec:
            /* If the field is marked with ^ and the value is undefined,
               blank it out. */
@@ -837,12 +829,30 @@ PP(pp_formline)
            }
            /* Formats aren't yet marked for locales, so assume "yes". */
            {
            }
            /* Formats aren't yet marked for locales, so assume "yes". */
            {
-                DECLARE_STORE_LC_NUMERIC_SET_TO_NEEDED();
+                Size_t max = SvLEN(PL_formtarget) - (t - SvPVX(PL_formtarget));
+                int len;
+                DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
+                STORE_LC_NUMERIC_SET_TO_NEEDED();
                 arg &= ~(FORM_NUM_POINT|FORM_NUM_BLANK);
                 arg &= ~(FORM_NUM_POINT|FORM_NUM_BLANK);
+#ifdef USE_QUADMATH
+                {
+                    const char* qfmt = quadmath_format_single(fmt);
+                    int len;
+                    if (!qfmt)
+                        Perl_croak_nocontext("panic: quadmath invalid format \"%s\"", fmt);
+                    len = quadmath_snprintf(t, max, qfmt, (int) fieldsize, (int) arg, value);
+                    if (len == -1)
+                        Perl_croak_nocontext("panic: quadmath_snprintf failed, format \"%s\"", qfmt);
+                    if (qfmt != fmt)
+                        Safefree(fmt);
+                }
+#else
                 /* we generate fmt ourselves so it is safe */
                 GCC_DIAG_IGNORE(-Wformat-nonliteral);
                 /* we generate fmt ourselves so it is safe */
                 GCC_DIAG_IGNORE(-Wformat-nonliteral);
-                PERL_UNUSED_RESULT(my_snprintf(t, SvLEN(PL_formtarget) - (t - SvPVX(PL_formtarget)), fmt, (int) fieldsize, (int) arg, value));
+                len = my_snprintf(t, max, fmt, (int) fieldsize, (int) arg, value);
                 GCC_DIAG_RESTORE;
                 GCC_DIAG_RESTORE;
+#endif
+                PERL_MY_SNPRINTF_POST_GUARD(len, max);
                 RESTORE_LC_NUMERIC();
            }
            t += fieldsize;
                 RESTORE_LC_NUMERIC();
            }
            t += fieldsize;
@@ -916,39 +926,32 @@ PP(pp_formline)
 
 PP(pp_grepstart)
 {
 
 PP(pp_grepstart)
 {
-    dVAR; dSP;
+    dSP;
     SV *src;
 
     SV *src;
 
-    if (PL_stack_base + *PL_markstack_ptr == SP) {
+    if (PL_stack_base + TOPMARK == SP) {
        (void)POPMARK;
        if (GIMME_V == G_SCALAR)
            mXPUSHi(0);
        RETURNOP(PL_op->op_next->op_next);
     }
        (void)POPMARK;
        if (GIMME_V == G_SCALAR)
            mXPUSHi(0);
        RETURNOP(PL_op->op_next->op_next);
     }
-    PL_stack_sp = PL_stack_base + *PL_markstack_ptr + 1;
+    PL_stack_sp = PL_stack_base + TOPMARK + 1;
     Perl_pp_pushmark(aTHX);                            /* push dst */
     Perl_pp_pushmark(aTHX);                            /* push src */
     ENTER_with_name("grep");                                   /* enter outer scope */
 
     SAVETMPS;
     Perl_pp_pushmark(aTHX);                            /* push dst */
     Perl_pp_pushmark(aTHX);                            /* push src */
     ENTER_with_name("grep");                                   /* enter outer scope */
 
     SAVETMPS;
-    if (PL_op->op_private & OPpGREP_LEX)
-       SAVESPTR(PAD_SVl(PL_op->op_targ));
-    else
-       SAVE_DEFSV;
+    SAVE_DEFSV;
     ENTER_with_name("grep_item");                                      /* enter inner scope */
     SAVEVPTR(PL_curpm);
 
     ENTER_with_name("grep_item");                                      /* enter inner scope */
     SAVEVPTR(PL_curpm);
 
-    src = PL_stack_base[*PL_markstack_ptr];
+    src = PL_stack_base[TOPMARK];
     if (SvPADTMP(src)) {
     if (SvPADTMP(src)) {
-        assert(!IS_PADGV(src));
-       src = PL_stack_base[*PL_markstack_ptr] = sv_mortalcopy(src);
+       src = PL_stack_base[TOPMARK] = sv_mortalcopy(src);
        PL_tmps_floor++;
     }
     SvTEMP_off(src);
        PL_tmps_floor++;
     }
     SvTEMP_off(src);
-    if (PL_op->op_private & OPpGREP_LEX)
-       PAD_SVl(PL_op->op_targ) = src;
-    else
-       DEFSV_set(src);
+    DEFSV_set(src);
 
     PUTBACK;
     if (PL_op->op_type == OP_MAPSTART)
 
     PUTBACK;
     if (PL_op->op_type == OP_MAPSTART)
@@ -958,9 +961,9 @@ PP(pp_grepstart)
 
 PP(pp_mapwhile)
 {
 
 PP(pp_mapwhile)
 {
-    dVAR; dSP;
+    dSP;
     const I32 gimme = GIMME_V;
     const I32 gimme = GIMME_V;
-    I32 items = (SP - PL_stack_base) - *PL_markstack_ptr; /* how many new items */
+    I32 items = (SP - PL_stack_base) - TOPMARK; /* how many new items */
     I32 count;
     I32 shift;
     SV** src;
     I32 count;
     I32 shift;
     SV** src;
@@ -1061,7 +1064,7 @@ PP(pp_mapwhile)
     LEAVE_with_name("grep_item");                                      /* exit inner scope */
 
     /* All done yet? */
     LEAVE_with_name("grep_item");                                      /* exit inner scope */
 
     /* All done yet? */
-    if (PL_markstack_ptr[-1] > *PL_markstack_ptr) {
+    if (PL_markstack_ptr[-1] > TOPMARK) {
 
        (void)POPMARK;                          /* pop top */
        LEAVE_with_name("grep");                                        /* exit outer scope */
 
        (void)POPMARK;                          /* pop top */
        LEAVE_with_name("grep");                                        /* exit outer scope */
@@ -1070,15 +1073,8 @@ PP(pp_mapwhile)
        (void)POPMARK;                          /* pop dst */
        SP = PL_stack_base + POPMARK;           /* pop original mark */
        if (gimme == G_SCALAR) {
        (void)POPMARK;                          /* pop dst */
        SP = PL_stack_base + POPMARK;           /* pop original mark */
        if (gimme == G_SCALAR) {
-           if (PL_op->op_private & OPpGREP_LEX) {
-               SV* sv = sv_newmortal();
-               sv_setiv(sv, items);
-               PUSHs(sv);
-           }
-           else {
                dTARGET;
                XPUSHi(items);
                dTARGET;
                XPUSHi(items);
-           }
        }
        else if (gimme == G_ARRAY)
            SP += items;
        }
        else if (gimme == G_ARRAY)
            SP += items;
@@ -1093,14 +1089,10 @@ PP(pp_mapwhile)
        /* set $_ to the new source item */
        src = PL_stack_base[PL_markstack_ptr[-1]];
        if (SvPADTMP(src)) {
        /* set $_ to the new source item */
        src = PL_stack_base[PL_markstack_ptr[-1]];
        if (SvPADTMP(src)) {
-            assert(!IS_PADGV(src));
             src = sv_mortalcopy(src);
         }
        SvTEMP_off(src);
             src = sv_mortalcopy(src);
         }
        SvTEMP_off(src);
-       if (PL_op->op_private & OPpGREP_LEX)
-           PAD_SVl(PL_op->op_targ) = src;
-       else
-           DEFSV_set(src);
+       DEFSV_set(src);
 
        RETURNOP(cLOGOP->op_other);
     }
 
        RETURNOP(cLOGOP->op_other);
     }
@@ -1110,8 +1102,7 @@ PP(pp_mapwhile)
 
 PP(pp_range)
 {
 
 PP(pp_range)
 {
-    dVAR;
-    if (GIMME == G_ARRAY)
+    if (GIMME_V == G_ARRAY)
        return NORMAL;
     if (SvTRUEx(PAD_SV(PL_op->op_targ)))
        return cLOGOP->op_other;
        return NORMAL;
     if (SvTRUEx(PAD_SV(PL_op->op_targ)))
        return cLOGOP->op_other;
@@ -1121,10 +1112,9 @@ PP(pp_range)
 
 PP(pp_flip)
 {
 
 PP(pp_flip)
 {
-    dVAR;
     dSP;
 
     dSP;
 
-    if (GIMME == G_ARRAY) {
+    if (GIMME_V == G_ARRAY) {
        RETURNOP(((LOGOP*)cUNOP->op_first)->op_other);
     }
     else {
        RETURNOP(((LOGOP*)cUNOP->op_first)->op_other);
     }
     else {
@@ -1176,9 +1166,9 @@ PP(pp_flip)
 
 PP(pp_flop)
 {
 
 PP(pp_flop)
 {
-    dVAR; dSP;
+    dSP;
 
 
-    if (GIMME == G_ARRAY) {
+    if (GIMME_V == G_ARRAY) {
        dPOPPOPssrl;
 
        SvGETMAGIC(left);
        dPOPPOPssrl;
 
        SvGETMAGIC(left);
@@ -1201,7 +1191,11 @@ PP(pp_flop)
                     /* The wraparound of signed integers is undefined
                      * behavior, but here we aim for count >=1, and
                      * negative count is just wrong. */
                     /* The wraparound of signed integers is undefined
                      * behavior, but here we aim for count >=1, and
                      * negative count is just wrong. */
-                    if (n < 1)
+                    if (n < 1
+#if IVSIZE > Size_t_size
+                        || n > SSize_t_MAX
+#endif
+                        )
                         overflow = TRUE;
                 }
                 if (overflow)
                         overflow = TRUE;
                 }
                 if (overflow)
@@ -1212,8 +1206,10 @@ PP(pp_flop)
            else
                n = 0;
            while (n--) {
            else
                n = 0;
            while (n--) {
-               SV * const sv = sv_2mortal(newSViv(i++));
+               SV * const sv = sv_2mortal(newSViv(i));
                PUSHs(sv);
                PUSHs(sv);
+                if (n) /* avoid incrementing above IV_MAX */
+                    i++;
            }
        }
        else {
            }
        }
        else {
@@ -1280,7 +1276,6 @@ static const char * const context_name[] = {
 STATIC I32
 S_dopoptolabel(pTHX_ const char *label, STRLEN len, U32 flags)
 {
 STATIC I32
 S_dopoptolabel(pTHX_ const char *label, STRLEN len, U32 flags)
 {
-    dVAR;
     I32 i;
 
     PERL_ARGS_ASSERT_DOPOPTOLABEL;
     I32 i;
 
     PERL_ARGS_ASSERT_DOPOPTOLABEL;
@@ -1335,7 +1330,6 @@ S_dopoptolabel(pTHX_ const char *label, STRLEN len, U32 flags)
 I32
 Perl_dowantarray(pTHX)
 {
 I32
 Perl_dowantarray(pTHX)
 {
-    dVAR;
     const I32 gimme = block_gimme();
     return (gimme == G_VOID) ? G_SCALAR : gimme;
 }
     const I32 gimme = block_gimme();
     return (gimme == G_VOID) ? G_SCALAR : gimme;
 }
@@ -1343,28 +1337,21 @@ Perl_dowantarray(pTHX)
 I32
 Perl_block_gimme(pTHX)
 {
 I32
 Perl_block_gimme(pTHX)
 {
-    dVAR;
     const I32 cxix = dopoptosub(cxstack_ix);
     const I32 cxix = dopoptosub(cxstack_ix);
+    U8 gimme;
     if (cxix < 0)
        return G_VOID;
 
     if (cxix < 0)
        return G_VOID;
 
-    switch (cxstack[cxix].blk_gimme) {
-    case G_VOID:
-       return G_VOID;
-    case G_SCALAR:
-       return G_SCALAR;
-    case G_ARRAY:
-       return G_ARRAY;
-    default:
-       Perl_croak(aTHX_ "panic: bad gimme: %d\n", cxstack[cxix].blk_gimme);
-    }
-    NOT_REACHED; /* NOTREACHED */
+    gimme = (cxstack[cxix].blk_gimme & G_WANT);
+    if (!gimme)
+       Perl_croak(aTHX_ "panic: bad gimme: %d\n", gimme);
+    return gimme;
 }
 
 }
 
+
 I32
 Perl_is_lvalue_sub(pTHX)
 {
 I32
 Perl_is_lvalue_sub(pTHX)
 {
-    dVAR;
     const I32 cxix = dopoptosub(cxstack_ix);
     assert(cxix >= 0);  /* We should only be called from inside subs */
 
     const I32 cxix = dopoptosub(cxstack_ix);
     assert(cxix >= 0);  /* We should only be called from inside subs */
 
@@ -1378,7 +1365,6 @@ Perl_is_lvalue_sub(pTHX)
 I32
 Perl_was_lvalue_sub(pTHX)
 {
 I32
 Perl_was_lvalue_sub(pTHX)
 {
-    dVAR;
     const I32 cxix = dopoptosub(cxstack_ix-1);
     assert(cxix >= 0);  /* We should only be called from inside subs */
 
     const I32 cxix = dopoptosub(cxstack_ix-1);
     assert(cxix >= 0);  /* We should only be called from inside subs */
 
@@ -1391,7 +1377,6 @@ Perl_was_lvalue_sub(pTHX)
 STATIC I32
 S_dopoptosub_at(pTHX_ const PERL_CONTEXT *cxstk, I32 startingblock)
 {
 STATIC I32
 S_dopoptosub_at(pTHX_ const PERL_CONTEXT *cxstk, I32 startingblock)
 {
-    dVAR;
     I32 i;
 
     PERL_ARGS_ASSERT_DOPOPTOSUB_AT;
     I32 i;
 
     PERL_ARGS_ASSERT_DOPOPTOSUB_AT;
@@ -1424,7 +1409,6 @@ S_dopoptosub_at(pTHX_ const PERL_CONTEXT *cxstk, I32 startingblock)
 STATIC I32
 S_dopoptoeval(pTHX_ I32 startingblock)
 {
 STATIC I32
 S_dopoptoeval(pTHX_ I32 startingblock)
 {
-    dVAR;
     I32 i;
     for (i = startingblock; i >= 0; i--) {
        const PERL_CONTEXT *cx = &cxstack[i];
     I32 i;
     for (i = startingblock; i >= 0; i--) {
        const PERL_CONTEXT *cx = &cxstack[i];
@@ -1442,7 +1426,6 @@ S_dopoptoeval(pTHX_ I32 startingblock)
 STATIC I32
 S_dopoptoloop(pTHX_ I32 startingblock)
 {
 STATIC I32
 S_dopoptoloop(pTHX_ I32 startingblock)
 {
-    dVAR;
     I32 i;
     for (i = startingblock; i >= 0; i--) {
        const PERL_CONTEXT * const cx = &cxstack[i];
     I32 i;
     for (i = startingblock; i >= 0; i--) {
        const PERL_CONTEXT * const cx = &cxstack[i];
@@ -1472,7 +1455,6 @@ S_dopoptoloop(pTHX_ I32 startingblock)
 STATIC I32
 S_dopoptogiven(pTHX_ I32 startingblock)
 {
 STATIC I32
 S_dopoptogiven(pTHX_ I32 startingblock)
 {
-    dVAR;
     I32 i;
     for (i = startingblock; i >= 0; i--) {
        const PERL_CONTEXT *cx = &cxstack[i];
     I32 i;
     for (i = startingblock; i >= 0; i--) {
        const PERL_CONTEXT *cx = &cxstack[i];
@@ -1500,7 +1482,6 @@ S_dopoptogiven(pTHX_ I32 startingblock)
 STATIC I32
 S_dopoptowhen(pTHX_ I32 startingblock)
 {
 STATIC I32
 S_dopoptowhen(pTHX_ I32 startingblock)
 {
-    dVAR;
     I32 i;
     for (i = startingblock; i >= 0; i--) {
        const PERL_CONTEXT *cx = &cxstack[i];
     I32 i;
     for (i = startingblock; i >= 0; i--) {
        const PERL_CONTEXT *cx = &cxstack[i];
@@ -1518,7 +1499,6 @@ S_dopoptowhen(pTHX_ I32 startingblock)
 void
 Perl_dounwind(pTHX_ I32 cxix)
 {
 void
 Perl_dounwind(pTHX_ I32 cxix)
 {
-    dVAR;
     I32 optype;
 
     if (!PL_curstackinfo) /* can happen if die during thread cloning */
     I32 optype;
 
     if (!PL_curstackinfo) /* can happen if die during thread cloning */
@@ -1560,8 +1540,6 @@ Perl_dounwind(pTHX_ I32 cxix)
 void
 Perl_qerror(pTHX_ SV *err)
 {
 void
 Perl_qerror(pTHX_ SV *err)
 {
-    dVAR;
-
     PERL_ARGS_ASSERT_QERROR;
 
     if (PL_in_eval) {
     PERL_ARGS_ASSERT_QERROR;
 
     if (PL_in_eval) {
@@ -1583,7 +1561,6 @@ Perl_qerror(pTHX_ SV *err)
 void
 Perl_die_unwind(pTHX_ SV *msv)
 {
 void
 Perl_die_unwind(pTHX_ SV *msv)
 {
-    dVAR;
     SV *exceptsv = sv_mortalcopy(msv);
     U8 in_eval = PL_in_eval;
     PERL_ARGS_ASSERT_DIE_UNWIND;
     SV *exceptsv = sv_mortalcopy(msv);
     U8 in_eval = PL_in_eval;
     PERL_ARGS_ASSERT_DIE_UNWIND;
@@ -1643,7 +1620,9 @@ Perl_die_unwind(pTHX_ SV *msv)
            SV *namesv;
            PERL_CONTEXT *cx;
            SV **newsp;
            SV *namesv;
            PERL_CONTEXT *cx;
            SV **newsp;
+#ifdef DEBUGGING
            COP *oldcop;
            COP *oldcop;
+#endif
            JMPENV *restartjmpenv;
            OP *restartop;
 
            JMPENV *restartjmpenv;
            OP *restartop;
 
@@ -1660,7 +1639,9 @@ Perl_die_unwind(pTHX_ SV *msv)
            }
            POPEVAL(cx);
            namesv = cx->blk_eval.old_namesv;
            }
            POPEVAL(cx);
            namesv = cx->blk_eval.old_namesv;
+#ifdef DEBUGGING
            oldcop = cx->blk_oldcop;
            oldcop = cx->blk_oldcop;
+#endif
            restartjmpenv = cx->blk_eval.cur_top_env;
            restartop = cx->blk_eval.retop;
 
            restartjmpenv = cx->blk_eval.cur_top_env;
            restartop = cx->blk_eval.retop;
 
@@ -1670,13 +1651,8 @@ Perl_die_unwind(pTHX_ SV *msv)
 
            LEAVE;
 
 
            LEAVE;
 
-           /* LEAVE could clobber PL_curcop (see save_re_context())
-            * XXX it might be better to find a way to avoid messing with
-            * PL_curcop in save_re_context() instead, but this is a more
-            * minimal fix --GSAR */
-           PL_curcop = oldcop;
-
            if (optype == OP_REQUIRE) {
            if (optype == OP_REQUIRE) {
+                assert (PL_curcop == oldcop);
                 (void)hv_store(GvHVn(PL_incgv),
                                SvPVX_const(namesv),
                                SvUTF8(namesv) ? -(I32)SvCUR(namesv) : (I32)SvCUR(namesv),
                 (void)hv_store(GvHVn(PL_incgv),
                                SvPVX_const(namesv),
                                SvUTF8(namesv) ? -(I32)SvCUR(namesv) : (I32)SvCUR(namesv),
@@ -1694,18 +1670,18 @@ Perl_die_unwind(pTHX_ SV *msv)
            PL_restartjmpenv = restartjmpenv;
            PL_restartop = restartop;
            JMPENV_JUMP(3);
            PL_restartjmpenv = restartjmpenv;
            PL_restartop = restartop;
            JMPENV_JUMP(3);
-           assert(0); /* NOTREACHED */
+           NOT_REACHED; /* NOTREACHED */
        }
     }
 
     write_to_stderr(exceptsv);
     my_failure_exit();
        }
     }
 
     write_to_stderr(exceptsv);
     my_failure_exit();
-    assert(0); /* NOTREACHED */
+    NOT_REACHED; /* NOTREACHED */
 }
 
 PP(pp_xor)
 {
 }
 
 PP(pp_xor)
 {
-    dVAR; dSP; dPOPTOPssrl;
+    dSP; dPOPTOPssrl;
     if (SvTRUE(left) != SvTRUE(right))
        RETSETYES;
     else
     if (SvTRUE(left) != SvTRUE(right))
        RETSETYES;
     else
@@ -1777,11 +1753,10 @@ Perl_caller_cx(pTHX_ I32 count, const PERL_CONTEXT **dbcxp)
 
 PP(pp_caller)
 {
 
 PP(pp_caller)
 {
-    dVAR;
     dSP;
     const PERL_CONTEXT *cx;
     const PERL_CONTEXT *dbcx;
     dSP;
     const PERL_CONTEXT *cx;
     const PERL_CONTEXT *dbcx;
-    I32 gimme;
+    I32 gimme = GIMME_V;
     const HEK *stash_hek;
     I32 count = 0;
     bool has_arg = MAXARG && TOPs;
     const HEK *stash_hek;
     I32 count = 0;
     bool has_arg = MAXARG && TOPs;
@@ -1795,7 +1770,7 @@ PP(pp_caller)
 
     cx = caller_cx(count + !!(PL_op->op_private & OPpOFFBYONE), &dbcx);
     if (!cx) {
 
     cx = caller_cx(count + !!(PL_op->op_private & OPpOFFBYONE), &dbcx);
     if (!cx) {
-       if (GIMME != G_ARRAY) {
+       if (gimme != G_ARRAY) {
            EXTEND(SP, 1);
            RETPUSHUNDEF;
        }
            EXTEND(SP, 1);
            RETPUSHUNDEF;
        }
@@ -1807,7 +1782,7 @@ PP(pp_caller)
     stash_hek = SvTYPE(CopSTASH(cx->blk_oldcop)) == SVt_PVHV
       ? HvNAME_HEK((HV*)CopSTASH(cx->blk_oldcop))
       : NULL;
     stash_hek = SvTYPE(CopSTASH(cx->blk_oldcop)) == SVt_PVHV
       ? HvNAME_HEK((HV*)CopSTASH(cx->blk_oldcop))
       : NULL;
-    if (GIMME != G_ARRAY) {
+    if (gimme != G_ARRAY) {
         EXTEND(SP, 1);
        if (!stash_hek)
            PUSHs(&PL_sv_undef);
         EXTEND(SP, 1);
        if (!stash_hek)
            PUSHs(&PL_sv_undef);
@@ -1829,20 +1804,17 @@ PP(pp_caller)
        PUSHTARG;
     }
     mPUSHs(newSVpv(OutCopFILE(cx->blk_oldcop), 0));
        PUSHTARG;
     }
     mPUSHs(newSVpv(OutCopFILE(cx->blk_oldcop), 0));
-    lcop = closest_cop(cx->blk_oldcop, cx->blk_oldcop->op_sibling,
+    lcop = closest_cop(cx->blk_oldcop, OpSIBLING(cx->blk_oldcop),
                       cx->blk_sub.retop, TRUE);
     if (!lcop)
        lcop = cx->blk_oldcop;
                       cx->blk_sub.retop, TRUE);
     if (!lcop)
        lcop = cx->blk_oldcop;
-    mPUSHi((I32)CopLINE(lcop));
+    mPUSHu(CopLINE(lcop));
     if (!has_arg)
        RETURN;
     if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) {
     if (!has_arg)
        RETURN;
     if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) {
-       GV * const cvgv = CvGV(dbcx->blk_sub.cv);
        /* So is ccstack[dbcxix]. */
        /* So is ccstack[dbcxix]. */
-       if (cvgv && isGV(cvgv)) {
-           SV * const sv = newSV(0);
-           gv_efullname3(sv, cvgv, NULL);
-           mPUSHs(sv);
+       if (CvHASGV(dbcx->blk_sub.cv)) {
+           PUSHs(cv_name(dbcx->blk_sub.cv, 0, 0));
            PUSHs(boolSV(CxHASARGS(cx)));
        }
        else {
            PUSHs(boolSV(CxHASARGS(cx)));
        }
        else {
@@ -1937,7 +1909,6 @@ PP(pp_caller)
 
 PP(pp_reset)
 {
 
 PP(pp_reset)
 {
-    dVAR;
     dSP;
     const char * tmps;
     STRLEN len = 0;
     dSP;
     const char * tmps;
     STRLEN len = 0;
@@ -1954,7 +1925,6 @@ PP(pp_reset)
 
 PP(pp_dbstate)
 {
 
 PP(pp_dbstate)
 {
-    dVAR;
     PL_curcop = (COP*)PL_op;
     TAINT_NOT;         /* Each statement is presumed innocent */
     PL_stack_sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp;
     PL_curcop = (COP*)PL_op;
     TAINT_NOT;         /* Each statement is presumed innocent */
     PL_stack_sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp;
@@ -1963,7 +1933,7 @@ PP(pp_dbstate)
     PERL_ASYNC_CHECK();
 
     if (PL_op->op_flags & OPf_SPECIAL /* breakpoint */
     PERL_ASYNC_CHECK();
 
     if (PL_op->op_flags & OPf_SPECIAL /* breakpoint */
-           || SvIV(PL_DBsingle) || SvIV(PL_DBsignal) || SvIV(PL_DBtrace))
+           || PL_DBsingle_iv || PL_DBsignal_iv || PL_DBtrace_iv)
     {
        dSP;
        PERL_CONTEXT *cx;
     {
        dSP;
        PERL_CONTEXT *cx;
@@ -2016,17 +1986,24 @@ PP(pp_dbstate)
        return NORMAL;
 }
 
        return NORMAL;
 }
 
+/* S_leave_common: Common code that many functions in this file use on
+                  scope exit.  */
+
 /* SVs on the stack that have any of the flags passed in are left as is.
    Other SVs are protected via the mortals stack if lvalue is true, and
 /* SVs on the stack that have any of the flags passed in are left as is.
    Other SVs are protected via the mortals stack if lvalue is true, and
-   copied otherwise. */
+   copied otherwise.
+
+   Also, taintedness is cleared.
+*/
 
 STATIC SV **
 
 STATIC SV **
-S_adjust_stack_on_leave(pTHX_ SV **newsp, SV **sp, SV **mark, I32 gimme,
+S_leave_common(pTHX_ SV **newsp, SV **sp, SV **mark, I32 gimme,
                              U32 flags, bool lvalue)
 {
     bool padtmp = 0;
                              U32 flags, bool lvalue)
 {
     bool padtmp = 0;
-    PERL_ARGS_ASSERT_ADJUST_STACK_ON_LEAVE;
+    PERL_ARGS_ASSERT_LEAVE_COMMON;
 
 
+    TAINT_NOT;
     if (flags & SVs_PADTMP) {
        flags &= ~SVs_PADTMP;
        padtmp = 1;
     if (flags & SVs_PADTMP) {
        flags &= ~SVs_PADTMP;
        padtmp = 1;
@@ -2067,7 +2044,7 @@ S_adjust_stack_on_leave(pTHX_ SV **newsp, SV **sp, SV **mark, I32 gimme,
 
 PP(pp_enter)
 {
 
 PP(pp_enter)
 {
-    dVAR; dSP;
+    dSP;
     PERL_CONTEXT *cx;
     I32 gimme = GIMME_V;
 
     PERL_CONTEXT *cx;
     I32 gimme = GIMME_V;
 
@@ -2081,7 +2058,7 @@ PP(pp_enter)
 
 PP(pp_leave)
 {
 
 PP(pp_leave)
 {
-    dVAR; dSP;
+    dSP;
     PERL_CONTEXT *cx;
     SV **newsp;
     PMOP *newpm;
     PERL_CONTEXT *cx;
     SV **newsp;
     PMOP *newpm;
@@ -2096,8 +2073,7 @@ PP(pp_leave)
 
     gimme = OP_GIMME(PL_op, (cxstack_ix >= 0) ? gimme : G_SCALAR);
 
 
     gimme = OP_GIMME(PL_op, (cxstack_ix >= 0) ? gimme : G_SCALAR);
 
-    TAINT_NOT;
-    SP = adjust_stack_on_leave(newsp, SP, newsp, gimme, SVs_PADTMP|SVs_TEMP,
+    SP = leave_common(newsp, SP, newsp, gimme, SVs_PADTMP|SVs_TEMP,
                               PL_op->op_private & OPpLVALUE);
     PL_curpm = newpm;  /* Don't pop $1 et al till now */
 
                               PL_op->op_private & OPpLVALUE);
     PL_curpm = newpm;  /* Don't pop $1 et al till now */
 
@@ -2106,9 +2082,31 @@ PP(pp_leave)
     RETURN;
 }
 
     RETURN;
 }
 
+static bool
+S_outside_integer(pTHX_ SV *sv)
+{
+  if (SvOK(sv)) {
+    const NV nv = SvNV_nomg(sv);
+    if (Perl_isinfnan(nv))
+      return TRUE;
+#ifdef NV_PRESERVES_UV
+    if (nv < (NV)IV_MIN || nv > (NV)IV_MAX)
+      return TRUE;
+#else
+    if (nv <= (NV)IV_MIN)
+      return TRUE;
+    if ((nv > 0) &&
+        ((nv > (NV)UV_MAX ||
+          SvUV_nomg(sv) > (UV)IV_MAX)))
+      return TRUE;
+#endif
+  }
+  return FALSE;
+}
+
 PP(pp_enteriter)
 {
 PP(pp_enteriter)
 {
-    dVAR; dSP; dMARK;
+    dSP; dMARK;
     PERL_CONTEXT *cx;
     const I32 gimme = GIMME_V;
     void *itervar; /* location of the iteration variable */
     PERL_CONTEXT *cx;
     const I32 gimme = GIMME_V;
     void *itervar; /* location of the iteration variable */
@@ -2130,13 +2128,21 @@ PP(pp_enteriter)
        itervar = &PAD_SVl(PL_op->op_targ);
 #endif
     }
        itervar = &PAD_SVl(PL_op->op_targ);
 #endif
     }
-    else {                                     /* symbol table variable */
+    else if (LIKELY(isGV(TOPs))) {             /* symbol table variable */
        GV * const gv = MUTABLE_GV(POPs);
        SV** svp = &GvSV(gv);
        save_pushptrptr(gv, SvREFCNT_inc(*svp), SAVEt_GVSV);
        *svp = newSV(0);
        itervar = (void *)gv;
     }
        GV * const gv = MUTABLE_GV(POPs);
        SV** svp = &GvSV(gv);
        save_pushptrptr(gv, SvREFCNT_inc(*svp), SAVEt_GVSV);
        *svp = newSV(0);
        itervar = (void *)gv;
     }
+    else {
+       SV * const sv = POPs;
+       assert(SvTYPE(sv) == SVt_PVMG);
+       assert(SvMAGIC(sv));
+       assert(SvMAGIC(sv)->mg_type == PERL_MAGIC_lvref);
+       itervar = (void *)sv;
+       cxtype |= CXp_FOR_LVREF;
+    }
 
     if (PL_op->op_private & OPpITER_DEF)
        cxtype |= CXp_FOR_DEF;
 
     if (PL_op->op_private & OPpITER_DEF)
        cxtype |= CXp_FOR_DEF;
@@ -2150,6 +2156,8 @@ PP(pp_enteriter)
        if (SvTYPE(maybe_ary) != SVt_PVAV) {
            dPOPss;
            SV * const right = maybe_ary;
        if (SvTYPE(maybe_ary) != SVt_PVAV) {
            dPOPss;
            SV * const right = maybe_ary;
+           if (UNLIKELY(cxtype & CXp_FOR_LVREF))
+               DIE(aTHX_ "Assigned value is not a reference");
            SvGETMAGIC(sv);
            SvGETMAGIC(right);
            if (RANGE_IS_NUMERIC(sv,right)) {
            SvGETMAGIC(sv);
            SvGETMAGIC(right);
            if (RANGE_IS_NUMERIC(sv,right)) {
@@ -2158,26 +2166,8 @@ PP(pp_enteriter)
                /* Make sure that no-one re-orders cop.h and breaks our
                   assumptions */
                assert(CxTYPE(cx) == CXt_LOOP_LAZYIV);
                /* Make sure that no-one re-orders cop.h and breaks our
                   assumptions */
                assert(CxTYPE(cx) == CXt_LOOP_LAZYIV);
-#ifdef NV_PRESERVES_UV
-               if ((SvOK(sv) && ((SvNV_nomg(sv) < (NV)IV_MIN) ||
-                                 (SvNV_nomg(sv) > (NV)IV_MAX)))
-                       ||
-                   (SvOK(right) && ((SvNV_nomg(right) > (NV)IV_MAX) ||
-                                    (SvNV_nomg(right) < (NV)IV_MIN))))
-#else
-               if ((SvOK(sv) && ((SvNV_nomg(sv) <= (NV)IV_MIN)
-                                 ||
-                                 ((SvNV_nomg(sv) > 0) &&
-                                       ((SvUV_nomg(sv) > (UV)IV_MAX) ||
-                                        (SvNV_nomg(sv) > (NV)UV_MAX)))))
-                       ||
-                   (SvOK(right) && ((SvNV_nomg(right) <= (NV)IV_MIN)
-                                    ||
-                                    ((SvNV_nomg(right) > 0) &&
-                                       ((SvUV_nomg(right) > (UV)IV_MAX) ||
-                                        (SvNV_nomg(right) > (NV)UV_MAX))
-                                    ))))
-#endif
+               if (S_outside_integer(aTHX_ sv) ||
+                    S_outside_integer(aTHX_ right))
                    DIE(aTHX_ "Range iterator outside integer range");
                cx->blk_loop.state_u.lazyiv.cur = SvIV_nomg(sv);
                cx->blk_loop.state_u.lazyiv.end = SvIV_nomg(right);
                    DIE(aTHX_ "Range iterator outside integer range");
                cx->blk_loop.state_u.lazyiv.cur = SvIV_nomg(sv);
                cx->blk_loop.state_u.lazyiv.end = SvIV_nomg(right);
@@ -2231,7 +2221,7 @@ PP(pp_enteriter)
 
 PP(pp_enterloop)
 {
 
 PP(pp_enterloop)
 {
-    dVAR; dSP;
+    dSP;
     PERL_CONTEXT *cx;
     const I32 gimme = GIMME_V;
 
     PERL_CONTEXT *cx;
     const I32 gimme = GIMME_V;
 
@@ -2247,7 +2237,7 @@ PP(pp_enterloop)
 
 PP(pp_leaveloop)
 {
 
 PP(pp_leaveloop)
 {
-    dVAR; dSP;
+    dSP;
     PERL_CONTEXT *cx;
     I32 gimme;
     SV **newsp;
     PERL_CONTEXT *cx;
     I32 gimme;
     SV **newsp;
@@ -2259,8 +2249,7 @@ PP(pp_leaveloop)
     mark = newsp;
     newsp = PL_stack_base + cx->blk_loop.resetsp;
 
     mark = newsp;
     newsp = PL_stack_base + cx->blk_loop.resetsp;
 
-    TAINT_NOT;
-    SP = adjust_stack_on_leave(newsp, SP, MARK, gimme, 0,
+    SP = leave_common(newsp, SP, MARK, gimme, 0,
                               PL_op->op_private & OPpLVALUE);
     PUTBACK;
 
                               PL_op->op_private & OPpLVALUE);
     PUTBACK;
 
@@ -2273,21 +2262,47 @@ PP(pp_leaveloop)
     return NORMAL;
 }
 
     return NORMAL;
 }
 
-STATIC void
-S_return_lvalues(pTHX_ SV **mark, SV **sp, SV **newsp, I32 gimme,
-                       PERL_CONTEXT *cx, PMOP *newpm)
+
+/* This duplicates most of pp_leavesub, but with additional code to handle
+ * return args in lvalue context. It was forked from pp_leavesub to
+ * avoid slowing down that function any further.
+ *
+ * Any changes made to this function may need to be copied to pp_leavesub
+ * and vice-versa.
+ */
+
+PP(pp_leavesublv)
 {
 {
-    const bool ref = !!(CxLVAL(cx) & OPpENTERSUB_INARGS);
+    dSP;
+    SV **newsp;
+    SV **mark;
+    PMOP *newpm;
+    I32 gimme;
+    PERL_CONTEXT *cx;
+    SV *sv;
+    bool ref;
+    const char *what = NULL;
+
+    if (CxMULTICALL(&cxstack[cxstack_ix])) {
+        /* entry zero of a stack is always PL_sv_undef, which
+         * simplifies converting a '()' return into undef in scalar context */
+        assert(PL_stack_sp > PL_stack_base || *PL_stack_base == &PL_sv_undef);
+       return 0;
+    }
+
+    POPBLOCK(cx,newpm);
+    cxstack_ix++; /* preserve cx entry on stack for use by POPSUB */
+    TAINT_NOT;
+
+    mark = newsp + 1;
+
+    ref = !!(CxLVAL(cx) & OPpENTERSUB_INARGS);
     if (gimme == G_SCALAR) {
        if (CxLVAL(cx) && !ref) {     /* Leave it as it is if we can. */
            SV *sv;
     if (gimme == G_SCALAR) {
        if (CxLVAL(cx) && !ref) {     /* Leave it as it is if we can. */
            SV *sv;
-           const char *what = NULL;
-           if (MARK < SP) {
-               assert(MARK+1 == SP);
-               if ((SvPADTMP(TOPs) ||
-                    (SvFLAGS(TOPs) & (SVf_READONLY | SVf_FAKE))
-                      == SVf_READONLY
-                   ) &&
+           if (MARK <= SP) {
+               assert(MARK == SP);
+               if ((SvPADTMP(TOPs) || SvREADONLY(TOPs)) &&
                    !SvSMAGICAL(TOPs)) {
                    what =
                        SvREADONLY(TOPs) ? (TOPs == &PL_sv_undef) ? "undef"
                    !SvSMAGICAL(TOPs)) {
                    what =
                        SvREADONLY(TOPs) ? (TOPs == &PL_sv_undef) ? "undef"
@@ -2299,33 +2314,34 @@ S_return_lvalues(pTHX_ SV **mark, SV **sp, SV **newsp, I32 gimme,
                /* sub:lvalue{} will take us here. */
                what = "undef";
            }
                /* sub:lvalue{} will take us here. */
                what = "undef";
            }
+          croak:
            LEAVE;
            LEAVE;
-           cxstack_ix--;
            POPSUB(cx,sv);
            POPSUB(cx,sv);
+           cxstack_ix--;
            PL_curpm = newpm;
            LEAVESUB(sv);
            Perl_croak(aTHX_
                      "Can't return %s from lvalue subroutine", what
            );
        }
            PL_curpm = newpm;
            LEAVESUB(sv);
            Perl_croak(aTHX_
                      "Can't return %s from lvalue subroutine", what
            );
        }
-       if (MARK < SP) {
+       if (MARK <= SP) {
              copy_sv:
                if (cx->blk_sub.cv && CvDEPTH(cx->blk_sub.cv) > 1) {
                    if (!SvPADTMP(*SP)) {
              copy_sv:
                if (cx->blk_sub.cv && CvDEPTH(cx->blk_sub.cv) > 1) {
                    if (!SvPADTMP(*SP)) {
-                       *++newsp = SvREFCNT_inc(*SP);
+                       *MARK = SvREFCNT_inc(*SP);
                        FREETMPS;
                        FREETMPS;
-                       sv_2mortal(*newsp);
+                       sv_2mortal(*MARK);
                    }
                    else {
                        /* FREETMPS could clobber it */
                        SV *sv = SvREFCNT_inc(*SP);
                        FREETMPS;
                    }
                    else {
                        /* FREETMPS could clobber it */
                        SV *sv = SvREFCNT_inc(*SP);
                        FREETMPS;
-                       *++newsp = sv_mortalcopy(sv);
+                       *MARK = sv_mortalcopy(sv);
                        SvREFCNT_dec(sv);
                    }
                }
                else
                        SvREFCNT_dec(sv);
                    }
                }
                else
-                   *++newsp =
+                   *MARK =
                      SvPADTMP(*SP)
                       ? sv_mortalcopy(*SP)
                       : !SvTEMP(*SP)
                      SvPADTMP(*SP)
                       ? sv_mortalcopy(*SP)
                       : !SvTEMP(*SP)
@@ -2333,9 +2349,11 @@ S_return_lvalues(pTHX_ SV **mark, SV **sp, SV **newsp, I32 gimme,
                          : *SP;
        }
        else {
                          : *SP;
        }
        else {
-           EXTEND(newsp,1);
-           *++newsp = &PL_sv_undef;
+           MEXTEND(MARK, 0);
+           *MARK = &PL_sv_undef;
        }
        }
+        SP = MARK;
+
        if (CxLVAL(cx) & OPpDEREF) {
            SvGETMAGIC(TOPs);
            if (!SvOK(TOPs)) {
        if (CxLVAL(cx) & OPpDEREF) {
            SvGETMAGIC(TOPs);
            if (!SvOK(TOPs)) {
@@ -2346,216 +2364,114 @@ S_return_lvalues(pTHX_ SV **mark, SV **sp, SV **newsp, I32 gimme,
     else if (gimme == G_ARRAY) {
        assert (!(CxLVAL(cx) & OPpDEREF));
        if (ref || !CxLVAL(cx))
     else if (gimme == G_ARRAY) {
        assert (!(CxLVAL(cx) & OPpDEREF));
        if (ref || !CxLVAL(cx))
-           while (++MARK <= SP)
-               *++newsp =
+           for (; MARK <= SP; MARK++)
+               *MARK =
                       SvFLAGS(*MARK) & SVs_PADTMP
                           ? sv_mortalcopy(*MARK)
                     : SvTEMP(*MARK)
                           ? *MARK
                           : sv_2mortal(SvREFCNT_inc_simple_NN(*MARK));
                       SvFLAGS(*MARK) & SVs_PADTMP
                           ? sv_mortalcopy(*MARK)
                     : SvTEMP(*MARK)
                           ? *MARK
                           : sv_2mortal(SvREFCNT_inc_simple_NN(*MARK));
-       else while (++MARK <= SP) {
+       else for (; MARK <= SP; MARK++) {
            if (*MARK != &PL_sv_undef
            if (*MARK != &PL_sv_undef
-                   && (SvPADTMP(*MARK)
-                      || (SvFLAGS(*MARK) & (SVf_READONLY|SVf_FAKE))
-                            == SVf_READONLY
-                      )
+                   && (SvPADTMP(*MARK) || SvREADONLY(*MARK))
            ) {
            ) {
-                   SV *sv;
                    /* Might be flattened array after $#array =  */
                    /* Might be flattened array after $#array =  */
-                   PUTBACK;
-                   LEAVE;
-                   cxstack_ix--;
-                   POPSUB(cx,sv);
-                   PL_curpm = newpm;
-                   LEAVESUB(sv);
-              /* diag_listed_as: Can't return %s from lvalue subroutine */
-                   Perl_croak(aTHX_
-                       "Can't return a %s from lvalue subroutine",
-                       SvREADONLY(TOPs) ? "readonly value" : "temporary");
+                    what = SvREADONLY(*MARK)
+                            ? "a readonly value" : "a temporary";
+                    goto croak;
            }
            }
-           else
-               *++newsp =
-                   SvTEMP(*MARK)
-                      ? *MARK
-                      : sv_2mortal(SvREFCNT_inc_simple_NN(*MARK));
+           else if (!SvTEMP(*MARK))
+               *MARK = sv_2mortal(SvREFCNT_inc_simple_NN(*MARK));
        }
     }
        }
     }
-    PL_stack_sp = newsp;
+    PUTBACK;
+
+    LEAVE;
+    POPSUB(cx,sv);     /* Stack values are safe: release CV and @_ ... */
+    cxstack_ix--;
+    PL_curpm = newpm;  /* ... and pop $1 et al */
+    LEAVESUB(sv);
+
+    return cx->blk_sub.retop;
 }
 
 }
 
+
 PP(pp_return)
 {
 PP(pp_return)
 {
-    dVAR; dSP; dMARK;
+    dSP; dMARK;
     PERL_CONTEXT *cx;
     PERL_CONTEXT *cx;
-    bool popsub2 = FALSE;
-    bool clear_errsv = FALSE;
-    bool lval = FALSE;
-    I32 gimme;
-    SV **newsp;
-    PMOP *newpm;
-    I32 optype = 0;
-    SV *namesv;
-    SV *sv;
-    OP *retop = NULL;
-
+    SV **oldsp;
     const I32 cxix = dopoptosub(cxstack_ix);
 
     const I32 cxix = dopoptosub(cxstack_ix);
 
-    if (cxix < 0) {
-       if (CxMULTICALL(cxstack)) { /* In this case we must be in a
-                                    * sort block, which is a CXt_NULL
-                                    * not a CXt_SUB */
-           dounwind(0);
-           PL_stack_base[1] = *PL_stack_sp;
-           PL_stack_sp = PL_stack_base + 1;
-           return 0;
-       }
-       else
-           DIE(aTHX_ "Can't return outside a subroutine");
-    }
-    if (cxix < cxstack_ix)
+    assert(cxstack_ix >= 0);
+    if (cxix < cxstack_ix) {
+        if (cxix < 0) {
+            if (CxMULTICALL(cxstack)) { /* In this case we must be in a
+                                         * sort block, which is a CXt_NULL
+                                         * not a CXt_SUB */
+                dounwind(0);
+                /* if we were in list context, we would have to splice out
+                 * any junk before the return args, like we do in the general
+                 * pp_return case, e.g.
+                 *   sub f { for (junk1, junk2) { return arg1, arg2 }}
+                 */
+                assert(cxstack[0].blk_gimme == G_SCALAR);
+                return 0;
+            }
+            else
+                DIE(aTHX_ "Can't return outside a subroutine");
+        }
        dounwind(cxix);
        dounwind(cxix);
+    }
 
 
-    if (CxMULTICALL(&cxstack[cxix])) {
-       gimme = cxstack[cxix].blk_gimme;
-       if (gimme == G_VOID)
-           PL_stack_sp = PL_stack_base;
-       else if (gimme == G_SCALAR) {
-           PL_stack_base[1] = *PL_stack_sp;
-           PL_stack_sp = PL_stack_base + 1;
-       }
-       return 0;
+    cx = &cxstack[cxix];
+
+    oldsp = PL_stack_base + cx->blk_oldsp;
+    if (oldsp != MARK) {
+        /* Handle extra junk on the stack. For example,
+         *    for (1,2) { return 3,4 }
+         * leaves 1,2,3,4 on the stack. In list context we
+         * have to splice out the 1,2; In scalar context for
+         *    for (1,2) { return }
+         * we need to set sp = oldsp so that pp_leavesub knows
+         * to push &PL_sv_undef onto the stack.
+         * Note that in pp_return we only do the extra processing
+         * required to handle junk; everything else we leave to
+         * pp_leavesub.
+         */
+        SSize_t nargs = SP - MARK;
+        if (nargs) {
+            if (cx->blk_gimme == G_ARRAY) {
+                /* shift return args to base of call stack frame */
+                Move(MARK + 1, oldsp + 1, nargs, SV*);
+                PL_stack_sp  = oldsp + nargs;
+            }
+        }
+        else
+            PL_stack_sp  = oldsp;
     }
 
     }
 
-    POPBLOCK(cx,newpm);
+    /* fall through to a normal exit */
     switch (CxTYPE(cx)) {
     switch (CxTYPE(cx)) {
-    case CXt_SUB:
-       popsub2 = TRUE;
-       lval = !!CvLVALUE(cx->blk_sub.cv);
-       retop = cx->blk_sub.retop;
-       cxstack_ix++; /* preserve cx entry on stack for use by POPSUB */
-       break;
     case CXt_EVAL:
     case CXt_EVAL:
-       if (!(PL_in_eval & EVAL_KEEPERR))
-           clear_errsv = TRUE;
-       POPEVAL(cx);
-       namesv = cx->blk_eval.old_namesv;
-       retop = cx->blk_eval.retop;
-       if (CxTRYBLOCK(cx))
-           break;
-       if (optype == OP_REQUIRE &&
-           (MARK == SP || (gimme == G_SCALAR && !SvTRUE(*SP))) )
-       {
-           /* Unassume the success we assumed earlier. */
-           (void)hv_delete(GvHVn(PL_incgv),
-                           SvPVX_const(namesv),
-                            SvUTF8(namesv) ? -(I32)SvCUR(namesv) : (I32)SvCUR(namesv),
-                           G_DISCARD);
-           DIE(aTHX_ "%"SVf" did not return a true value", SVfARG(namesv));
-       }
-       break;
+        return CxTRYBLOCK(cx)
+            ? Perl_pp_leavetry(aTHX)
+            : Perl_pp_leaveeval(aTHX);
+    case CXt_SUB:
+        return CvLVALUE(cx->blk_sub.cv)
+            ? Perl_pp_leavesublv(aTHX)
+            : Perl_pp_leavesub(aTHX);
     case CXt_FORMAT:
     case CXt_FORMAT:
-       retop = cx->blk_sub.retop;
-       POPFORMAT(cx);
-       break;
+        return Perl_pp_leavewrite(aTHX);
     default:
        DIE(aTHX_ "panic: return, type=%u", (unsigned) CxTYPE(cx));
     }
     default:
        DIE(aTHX_ "panic: return, type=%u", (unsigned) CxTYPE(cx));
     }
-
-    TAINT_NOT;
-    if (lval) S_return_lvalues(aTHX_ MARK, SP, newsp, gimme, cx, newpm);
-    else {
-      if (gimme == G_SCALAR) {
-       if (MARK < SP) {
-           if (popsub2) {
-               if (cx->blk_sub.cv && CvDEPTH(cx->blk_sub.cv) > 1) {
-                   if (SvTEMP(TOPs) && SvREFCNT(TOPs) == 1
-                        && !SvMAGICAL(TOPs)) {
-                       *++newsp = SvREFCNT_inc(*SP);
-                       FREETMPS;
-                       sv_2mortal(*newsp);
-                   }
-                   else {
-                       sv = SvREFCNT_inc(*SP); /* FREETMPS could clobber it */
-                       FREETMPS;
-                       *++newsp = sv_mortalcopy(sv);
-                       SvREFCNT_dec(sv);
-                   }
-               }
-               else if (SvTEMP(*SP) && SvREFCNT(*SP) == 1
-                         && !SvMAGICAL(*SP)) {
-                   *++newsp = *SP;
-               }
-               else
-                   *++newsp = sv_mortalcopy(*SP);
-           }
-           else
-               *++newsp = sv_mortalcopy(*SP);
-       }
-       else
-           *++newsp = &PL_sv_undef;
-      }
-      else if (gimme == G_ARRAY) {
-       while (++MARK <= SP) {
-           *++newsp = popsub2 && SvTEMP(*MARK) && SvREFCNT(*MARK) == 1
-                              && !SvGMAGICAL(*MARK)
-                       ? *MARK : sv_mortalcopy(*MARK);
-           TAINT_NOT;          /* Each item is independent */
-       }
-      }
-      PL_stack_sp = newsp;
-    }
-
-    LEAVE;
-    /* Stack values are safe: */
-    if (popsub2) {
-       cxstack_ix--;
-       POPSUB(cx,sv);  /* release CV and @_ ... */
-    }
-    else
-       sv = NULL;
-    PL_curpm = newpm;  /* ... and pop $1 et al */
-
-    LEAVESUB(sv);
-    if (clear_errsv) {
-       CLEAR_ERRSV();
-    }
-    return retop;
 }
 
 }
 
-/* This duplicates parts of pp_leavesub, so that it can share code with
- * pp_return */
-PP(pp_leavesublv)
-{
-    dVAR; dSP;
-    SV **newsp;
-    PMOP *newpm;
-    I32 gimme;
-    PERL_CONTEXT *cx;
-    SV *sv;
-
-    if (CxMULTICALL(&cxstack[cxstack_ix]))
-       return 0;
-
-    POPBLOCK(cx,newpm);
-    cxstack_ix++; /* temporarily protect top context */
-
-    TAINT_NOT;
-
-    S_return_lvalues(aTHX_ newsp, SP, newsp, gimme, cx, newpm);
-
-    LEAVE;
-    POPSUB(cx,sv);     /* Stack values are safe: release CV and @_ ... */
-    cxstack_ix--;
-    PL_curpm = newpm;  /* ... and pop $1 et al */
-
-    LEAVESUB(sv);
-    return cx->blk_sub.retop;
-}
 
 static I32
 S_unwind_loop(pTHX_ const char * const opname)
 {
 
 static I32
 S_unwind_loop(pTHX_ const char * const opname)
 {
-    dVAR;
     I32 cxix;
     if (PL_op->op_flags & OPf_SPECIAL) {
        cxix = dopoptoloop(cxstack_ix);
     I32 cxix;
     if (PL_op->op_flags & OPf_SPECIAL) {
        cxix = dopoptoloop(cxstack_ix);
@@ -2594,44 +2510,24 @@ S_unwind_loop(pTHX_ const char * const opname)
 
 PP(pp_last)
 {
 
 PP(pp_last)
 {
-    dVAR;
     PERL_CONTEXT *cx;
     PERL_CONTEXT *cx;
-    I32 pop2 = 0;
     I32 gimme;
     I32 gimme;
-    I32 optype;
     OP *nextop = NULL;
     SV **newsp;
     PMOP *newpm;
     OP *nextop = NULL;
     SV **newsp;
     PMOP *newpm;
-    SV *sv = NULL;
 
     S_unwind_loop(aTHX_ "last");
 
     POPBLOCK(cx,newpm);
     cxstack_ix++; /* temporarily protect top context */
 
     S_unwind_loop(aTHX_ "last");
 
     POPBLOCK(cx,newpm);
     cxstack_ix++; /* temporarily protect top context */
-    switch (CxTYPE(cx)) {
-    case CXt_LOOP_LAZYIV:
-    case CXt_LOOP_LAZYSV:
-    case CXt_LOOP_FOR:
-    case CXt_LOOP_PLAIN:
-       pop2 = CxTYPE(cx);
-       newsp = PL_stack_base + cx->blk_loop.resetsp;
-       nextop = cx->blk_loop.my_op->op_lastop->op_next;
-       break;
-    case CXt_SUB:
-       pop2 = CXt_SUB;
-       nextop = cx->blk_sub.retop;
-       break;
-    case CXt_EVAL:
-       POPEVAL(cx);
-       nextop = cx->blk_eval.retop;
-       break;
-    case CXt_FORMAT:
-       POPFORMAT(cx);
-       nextop = cx->blk_sub.retop;
-       break;
-    default:
-       DIE(aTHX_ "panic: last, type=%u", (unsigned) CxTYPE(cx));
-    }
+    assert(
+           CxTYPE(cx) == CXt_LOOP_LAZYIV
+        || CxTYPE(cx) == CXt_LOOP_LAZYSV
+        || CxTYPE(cx) == CXt_LOOP_FOR
+        || CxTYPE(cx) == CXt_LOOP_PLAIN
+    );
+    newsp = PL_stack_base + cx->blk_loop.resetsp;
+    nextop = cx->blk_loop.my_op->op_lastop->op_next;
 
     TAINT_NOT;
     PL_stack_sp = newsp;
 
     TAINT_NOT;
     PL_stack_sp = newsp;
@@ -2639,29 +2535,16 @@ PP(pp_last)
     LEAVE;
     cxstack_ix--;
     /* Stack values are safe: */
     LEAVE;
     cxstack_ix--;
     /* Stack values are safe: */
-    switch (pop2) {
-    case CXt_LOOP_LAZYIV:
-    case CXt_LOOP_PLAIN:
-    case CXt_LOOP_LAZYSV:
-    case CXt_LOOP_FOR:
-       POPLOOP(cx);    /* release loop vars ... */
-       LEAVE;
-       break;
-    case CXt_SUB:
-       POPSUB(cx,sv);  /* release CV and @_ ... */
-       break;
-    }
+    POPLOOP(cx);       /* release loop vars ... */
+    LEAVE;
     PL_curpm = newpm;  /* ... and pop $1 et al */
 
     PL_curpm = newpm;  /* ... and pop $1 et al */
 
-    LEAVESUB(sv);
-    PERL_UNUSED_VAR(optype);
     PERL_UNUSED_VAR(gimme);
     return nextop;
 }
 
 PP(pp_next)
 {
     PERL_UNUSED_VAR(gimme);
     return nextop;
 }
 
 PP(pp_next)
 {
-    dVAR;
     PERL_CONTEXT *cx;
     const I32 inner = PL_scopestack_ix;
 
     PERL_CONTEXT *cx;
     const I32 inner = PL_scopestack_ix;
 
@@ -2679,7 +2562,6 @@ PP(pp_next)
 
 PP(pp_redo)
 {
 
 PP(pp_redo)
 {
-    dVAR;
     const I32 cxix = S_unwind_loop(aTHX_ "redo");
     PERL_CONTEXT *cx;
     I32 oldsave;
     const I32 cxix = S_unwind_loop(aTHX_ "redo");
     PERL_CONTEXT *cx;
     I32 oldsave;
@@ -2704,7 +2586,6 @@ PP(pp_redo)
 STATIC OP *
 S_dofindlabel(pTHX_ OP *o, const char *label, STRLEN len, U32 flags, OP **opstack, OP **oplimit)
 {
 STATIC OP *
 S_dofindlabel(pTHX_ OP *o, const char *label, STRLEN len, U32 flags, OP **opstack, OP **oplimit)
 {
-    dVAR;
     OP **ops = opstack;
     static const char* const too_deep = "Target of goto is too deeply nested";
 
     OP **ops = opstack;
     static const char* const too_deep = "Target of goto is too deeply nested";
 
@@ -2726,7 +2607,7 @@ S_dofindlabel(pTHX_ OP *o, const char *label, STRLEN len, U32 flags, OP **opstac
     if (o->op_flags & OPf_KIDS) {
        OP *kid;
        /* First try all the kids at this level, since that's likeliest. */
     if (o->op_flags & OPf_KIDS) {
        OP *kid;
        /* First try all the kids at this level, since that's likeliest. */
-       for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling) {
+       for (kid = cUNOPo->op_first; kid; kid = OpSIBLING(kid)) {
            if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) {
                 STRLEN kid_label_len;
                 U32 kid_label_flags;
            if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) {
                 STRLEN kid_label_len;
                 U32 kid_label_flags;
@@ -2746,7 +2627,7 @@ S_dofindlabel(pTHX_ OP *o, const char *label, STRLEN len, U32 flags, OP **opstac
                    return kid;
            }
        }
                    return kid;
            }
        }
-       for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling) {
+       for (kid = cUNOPo->op_first; kid; kid = OpSIBLING(kid)) {
            if (kid == PL_lastgotoprobe)
                continue;
            if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) {
            if (kid == PL_lastgotoprobe)
                continue;
            if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) {
@@ -2766,7 +2647,10 @@ S_dofindlabel(pTHX_ OP *o, const char *label, STRLEN len, U32 flags, OP **opstac
     return 0;
 }
 
     return 0;
 }
 
-PP(pp_goto) /* also pp_dump */
+
+/* also used for: pp_dump() */
+
+PP(pp_goto)
 {
     dVAR; dSP;
     OP *retop = NULL;
 {
     dVAR; dSP;
     OP *retop = NULL;
@@ -2882,7 +2766,6 @@ PP(pp_goto) /* also pp_dump */
            SAVETMPS;
            SAVEFREESV(cv); /* later, undo the 'avoid premature free' hack */
            if (CvISXSUB(cv)) {
            SAVETMPS;
            SAVEFREESV(cv); /* later, undo the 'avoid premature free' hack */
            if (CvISXSUB(cv)) {
-               OP* const retop = cx->blk_sub.retop;
                SV **newsp;
                I32 gimme;
                const SSize_t items = arg ? AvFILL(arg) + 1 : 0;
                SV **newsp;
                I32 gimme;
                const SSize_t items = arg ? AvFILL(arg) + 1 : 0;
@@ -2922,6 +2805,7 @@ PP(pp_goto) /* also pp_dump */
                    SvREFCNT_dec(arg);
                }
 
                    SvREFCNT_dec(arg);
                }
 
+               retop = cx->blk_sub.retop;
                /* XS subs don't have a CxSUB, so pop it */
                POPBLOCK(cx, PL_curpm);
                /* Push a mark for the start of arglist */
                /* XS subs don't have a CxSUB, so pop it */
                POPBLOCK(cx, PL_curpm);
                /* Push a mark for the start of arglist */
@@ -2929,8 +2813,7 @@ PP(pp_goto) /* also pp_dump */
                PUTBACK;
                (void)(*CvXSUB(cv))(aTHX_ cv);
                LEAVE;
                PUTBACK;
                (void)(*CvXSUB(cv))(aTHX_ cv);
                LEAVE;
-               PERL_ASYNC_CHECK();
-               return retop;
+               goto _return;
            }
            else {
                PADLIST * const padlist = CvPADLIST(cv);
            }
            else {
                PADLIST * const padlist = CvPADLIST(cv);
@@ -2983,8 +2866,8 @@ PP(pp_goto) /* also pp_dump */
                        }
                    }
                }
                        }
                    }
                }
-               PERL_ASYNC_CHECK();
-               RETURNOP(CvSTART(cv));
+               retop = CvSTART(cv);
+               goto putback_return;
            }
        }
        else {
            }
        }
        else {
@@ -3032,13 +2915,13 @@ PP(pp_goto) /* also pp_dump */
            case CXt_LOOP_PLAIN:
            case CXt_GIVEN:
            case CXt_WHEN:
            case CXt_LOOP_PLAIN:
            case CXt_GIVEN:
            case CXt_WHEN:
-               gotoprobe = cx->blk_oldcop->op_sibling;
+               gotoprobe = OpSIBLING(cx->blk_oldcop);
                break;
            case CXt_SUBST:
                continue;
            case CXt_BLOCK:
                if (ix) {
                break;
            case CXt_SUBST:
                continue;
            case CXt_BLOCK:
                if (ix) {
-                   gotoprobe = cx->blk_oldcop->op_sibling;
+                   gotoprobe = OpSIBLING(cx->blk_oldcop);
                    in_block = TRUE;
                } else
                    gotoprobe = PL_main_root;
                    in_block = TRUE;
                } else
                    gotoprobe = PL_main_root;
@@ -3060,14 +2943,17 @@ PP(pp_goto) /* also pp_dump */
                break;
            }
            if (gotoprobe) {
                break;
            }
            if (gotoprobe) {
+                OP *sibl1, *sibl2;
+
                retop = dofindlabel(gotoprobe, label, label_len, label_flags,
                                    enterops, enterops + GOTO_DEPTH);
                if (retop)
                    break;
                retop = dofindlabel(gotoprobe, label, label_len, label_flags,
                                    enterops, enterops + GOTO_DEPTH);
                if (retop)
                    break;
-               if (gotoprobe->op_sibling &&
-                       gotoprobe->op_sibling->op_type == OP_UNSTACK &&
-                       gotoprobe->op_sibling->op_sibling) {
-                   retop = dofindlabel(gotoprobe->op_sibling->op_sibling,
+               if ( (sibl1 = OpSIBLING(gotoprobe)) &&
+                    sibl1->op_type == OP_UNSTACK &&
+                    (sibl2 = OpSIBLING(sibl1)))
+                {
+                   retop = dofindlabel(sibl2,
                                        label, label_len, label_flags, enterops,
                                        enterops + GOTO_DEPTH);
                    if (retop)
                                        label, label_len, label_flags, enterops,
                                        enterops + GOTO_DEPTH);
                    if (retop)
@@ -3140,13 +3026,15 @@ PP(pp_goto) /* also pp_dump */
        PL_do_undump = FALSE;
     }
 
        PL_do_undump = FALSE;
     }
 
+    putback_return:
+    PL_stack_sp = sp;
+    _return:
     PERL_ASYNC_CHECK();
     PERL_ASYNC_CHECK();
-    RETURNOP(retop);
+    return retop;
 }
 
 PP(pp_exit)
 {
 }
 
 PP(pp_exit)
 {
-    dVAR;
     dSP;
     I32 anum;
 
     dSP;
     I32 anum;
 
@@ -3207,7 +3095,7 @@ Check for the cases 0 or 3 of cur_env.je_ret, only used inside an eval context.
 
 3 is used for a die caught by an inner eval - continue inner loop
 
 
 3 is used for a die caught by an inner eval - continue inner loop
 
-See cop.h: je_mustcatch, when set at any runlevel to TRUE, means eval ops must
+See F<cop.h>: je_mustcatch, when set at any runlevel to TRUE, means eval ops must
 establish a local jmpenv to handle exception traps.
 
 =cut
 establish a local jmpenv to handle exception traps.
 
 =cut
@@ -3215,7 +3103,6 @@ establish a local jmpenv to handle exception traps.
 STATIC OP *
 S_docatch(pTHX_ OP *o)
 {
 STATIC OP *
 S_docatch(pTHX_ OP *o)
 {
-    dVAR;
     int ret;
     OP * const oldop = PL_op;
     dJMPENV;
     int ret;
     OP * const oldop = PL_op;
     dJMPENV;
@@ -3247,7 +3134,7 @@ S_docatch(pTHX_ OP *o)
        JMPENV_POP;
        PL_op = oldop;
        JMPENV_JUMP(ret);
        JMPENV_POP;
        PL_op = oldop;
        JMPENV_JUMP(ret);
-       assert(0); /* NOTREACHED */
+       NOT_REACHED; /* NOTREACHED */
     }
     JMPENV_POP;
     PL_op = oldop;
     }
     JMPENV_POP;
     PL_op = oldop;
@@ -3259,8 +3146,8 @@ S_docatch(pTHX_ OP *o)
 =for apidoc find_runcv
 
 Locate the CV corresponding to the currently executing sub or eval.
 =for apidoc find_runcv
 
 Locate the CV corresponding to the currently executing sub or eval.
-If db_seqp is non_null, skip CVs that are in the DB package and populate
-*db_seqp with the cop sequence number at the point that the DB:: code was
+If C<db_seqp> is non_null, skip CVs that are in the DB package and populate
+C<*db_seqp> with the cop sequence number at the point that the DB:: code was
 entered.  (This allows debuggers to eval in the scope of the breakpoint
 rather than in the scope of the debugger itself.)
 
 entered.  (This allows debuggers to eval in the scope of the breakpoint
 rather than in the scope of the debugger itself.)
 
@@ -3277,7 +3164,6 @@ Perl_find_runcv(pTHX_ U32 *db_seqp)
 CV *
 Perl_find_runcv_where(pTHX_ U8 cond, IV arg, U32 *db_seqp)
 {
 CV *
 Perl_find_runcv_where(pTHX_ U8 cond, IV arg, U32 *db_seqp)
 {
-    dVAR;
     PERL_SI     *si;
     int                 level = 0;
 
     PERL_SI     *si;
     int                 level = 0;
 
@@ -3308,7 +3194,7 @@ Perl_find_runcv_where(pTHX_ U8 cond, IV arg, U32 *db_seqp)
                switch (cond) {
                case FIND_RUNCV_padid_eq:
                    if (!CvPADLIST(cv)
                switch (cond) {
                case FIND_RUNCV_padid_eq:
                    if (!CvPADLIST(cv)
-                    || PadlistNAMES(CvPADLIST(cv)) != INT2PTR(PADNAMELIST *, arg))
+                    || CvPADLIST(cv)->xpadl_id != (U32)arg)
                        continue;
                    return cv;
                case FIND_RUNCV_level_eq:
                        continue;
                    return cv;
                case FIND_RUNCV_level_eq:
@@ -3346,7 +3232,7 @@ S_try_yyparse(pTHX_ int gramtype)
     default:
        JMPENV_POP;
        JMPENV_JUMP(ret);
     default:
        JMPENV_POP;
        JMPENV_JUMP(ret);
-       assert(0); /* NOTREACHED */
+       NOT_REACHED; /* NOTREACHED */
     }
     JMPENV_POP;
     return ret;
     }
     JMPENV_POP;
     return ret;
@@ -3370,7 +3256,7 @@ S_try_yyparse(pTHX_ int gramtype)
 STATIC bool
 S_doeval(pTHX_ int gimme, CV* outside, U32 seq, HV *hh)
 {
 STATIC bool
 S_doeval(pTHX_ int gimme, CV* outside, U32 seq, HV *hh)
 {
-    dVAR; dSP;
+    dSP;
     OP * const saveop = PL_op;
     bool clear_hints = saveop->op_type != OP_ENTEREVAL;
     COP * const oldcurcop = PL_curcop;
     OP * const saveop = PL_op;
     bool clear_hints = saveop->op_type != OP_ENTEREVAL;
     COP * const oldcurcop = PL_curcop;
@@ -3397,7 +3283,7 @@ S_doeval(pTHX_ int gimme, CV* outside, U32 seq, HV *hh)
 
     /* set up a scratch pad */
 
 
     /* set up a scratch pad */
 
-    CvPADLIST(evalcv) = pad_new(padnew_SAVE);
+    CvPADLIST_set(evalcv, pad_new(padnew_SAVE));
     PL_op = NULL; /* avoid PL_op and PL_curpad referring to different CVs */
 
 
     PL_op = NULL; /* avoid PL_op and PL_curpad referring to different CVs */
 
 
@@ -3587,6 +3473,7 @@ S_check_type_and_open(pTHX_ SV *name)
 {
     Stat_t st;
     STRLEN len;
 {
     Stat_t st;
     STRLEN len;
+    PerlIO * retio;
     const char *p = SvPV_const(name, len);
     int st_rc;
 
     const char *p = SvPV_const(name, len);
     int st_rc;
 
@@ -3595,12 +3482,20 @@ S_check_type_and_open(pTHX_ SV *name)
     /* checking here captures a reasonable error message when
      * PERL_DISABLE_PMC is true, but when PMC checks are enabled, the
      * user gets a confusing message about looking for the .pmc file
     /* checking here captures a reasonable error message when
      * PERL_DISABLE_PMC is true, but when PMC checks are enabled, the
      * user gets a confusing message about looking for the .pmc file
-     * rather than for the .pm file.
+     * rather than for the .pm file so do the check in S_doopen_pm when
+     * PMC is on instead of here. S_doopen_pm calls this func.
      * This check prevents a \0 in @INC causing problems.
      */
      * This check prevents a \0 in @INC causing problems.
      */
+#ifdef PERL_DISABLE_PMC
     if (!IS_SAFE_PATHNAME(p, len, "require"))
         return NULL;
     if (!IS_SAFE_PATHNAME(p, len, "require"))
         return NULL;
+#endif
 
 
+    /* on Win32 stat is expensive (it does an open() and close() twice and
+       a couple other IO calls), the open will fail with a dir on its own with
+       errno EACCES, so only do a stat to separate a dir from a real EACCES
+       caused by user perms */
+#ifndef WIN32
     /* we use the value of errno later to see how stat() or open() failed.
      * We don't want it set if the stat succeeded but we still failed,
      * such as if the name exists, but is a directory */
     /* we use the value of errno later to see how stat() or open() failed.
      * We don't want it set if the stat succeeded but we still failed,
      * such as if the name exists, but is a directory */
@@ -3611,12 +3506,25 @@ S_check_type_and_open(pTHX_ SV *name)
     if (st_rc < 0 || S_ISDIR(st.st_mode) || S_ISBLK(st.st_mode)) {
        return NULL;
     }
     if (st_rc < 0 || S_ISDIR(st.st_mode) || S_ISBLK(st.st_mode)) {
        return NULL;
     }
+#endif
 
 
-#if !defined(PERLIO_IS_STDIO)
-    return PerlIO_openn(aTHX_ ":", PERL_SCRIPT_MODE, -1, 0, 0, NULL, 1, &name);
-#else
-    return PerlIO_open(p, PERL_SCRIPT_MODE);
+    retio = PerlIO_openn(aTHX_ ":", PERL_SCRIPT_MODE, -1, 0, 0, NULL, 1, &name);
+#ifdef WIN32
+    /* EACCES stops the INC search early in pp_require to implement
+       feature RT #113422 */
+    if(!retio && errno == EACCES) { /* exists but probably a directory */
+       int eno;
+       st_rc = PerlLIO_stat(p, &st);
+       if (st_rc >= 0) {
+           if(S_ISDIR(st.st_mode) || S_ISBLK(st.st_mode))
+               eno = 0;
+           else
+               eno = EACCES;
+           errno = eno;
+       }
+    }
 #endif
 #endif
+    return retio;
 }
 
 #ifndef PERL_DISABLE_PMC
 }
 
 #ifndef PERL_DISABLE_PMC
@@ -3637,13 +3545,14 @@ S_doopen_pm(pTHX_ SV *name)
 
     if (namelen > 3 && memEQs(p + namelen - 3, 3, ".pm")) {
        SV *const pmcsv = sv_newmortal();
 
     if (namelen > 3 && memEQs(p + namelen - 3, 3, ".pm")) {
        SV *const pmcsv = sv_newmortal();
-       Stat_t pmcstat;
+       PerlIO * pmcio;
 
        SvSetSV_nosteal(pmcsv,name);
        sv_catpvs(pmcsv, "c");
 
 
        SvSetSV_nosteal(pmcsv,name);
        sv_catpvs(pmcsv, "c");
 
-       if (PerlLIO_stat(SvPV_nolen_const(pmcsv), &pmcstat) >= 0)
-           return check_type_and_open(pmcsv);
+       pmcio = check_type_and_open(pmcsv);
+       if (pmcio)
+           return pmcio;
     }
     return check_type_and_open(name);
 }
     }
     return check_type_and_open(name);
 }
@@ -3652,7 +3561,7 @@ S_doopen_pm(pTHX_ SV *name)
 #endif /* !PERL_DISABLE_PMC */
 
 /* require doesn't search for absolute names, or when the name is
 #endif /* !PERL_DISABLE_PMC */
 
 /* require doesn't search for absolute names, or when the name is
-   explicity relative the current directory */
+   explicitly relative the current directory */
 PERL_STATIC_INLINE bool
 S_path_is_searchable(const char *name)
 {
 PERL_STATIC_INLINE bool
 S_path_is_searchable(const char *name)
 {
@@ -3677,9 +3586,12 @@ S_path_is_searchable(const char *name)
        return TRUE;
 }
 
        return TRUE;
 }
 
+
+/* also used for: pp_dofile() */
+
 PP(pp_require)
 {
 PP(pp_require)
 {
-    dVAR; dSP;
+    dSP;
     PERL_CONTEXT *cx;
     SV *sv;
     const char *name;
     PERL_CONTEXT *cx;
     SV *sv;
     const char *name;
@@ -3699,12 +3611,12 @@ PP(pp_require)
     SV *filter_state = NULL;
     SV *filter_sub = NULL;
     SV *hook_sv = NULL;
     SV *filter_state = NULL;
     SV *filter_sub = NULL;
     SV *hook_sv = NULL;
-    SV *encoding;
     OP *op;
     int saved_errno;
     bool path_searchable;
 
     sv = POPs;
     OP *op;
     int saved_errno;
     bool path_searchable;
 
     sv = POPs;
+    SvGETMAGIC(sv);
     if ( (SvNIOKp(sv) || SvVOK(sv)) && PL_op->op_type != OP_DOFILE) {
        sv = sv_2mortal(new_version(sv));
        if (!Perl_sv_derived_from_pvn(aTHX_ PL_patchlevel, STR_WITH_LEN("version"), 0))
     if ( (SvNIOKp(sv) || SvVOK(sv)) && PL_op->op_type != OP_DOFILE) {
        sv = sv_2mortal(new_version(sv));
        if (!Perl_sv_derived_from_pvn(aTHX_ PL_patchlevel, STR_WITH_LEN("version"), 0))
@@ -3762,9 +3674,12 @@ PP(pp_require)
 
        RETPUSHYES;
     }
 
        RETPUSHYES;
     }
-    name = SvPV_const(sv, len);
+    if (!SvOK(sv))
+        DIE(aTHX_ "Missing or undefined argument to require");
+    name = SvPV_nomg_const(sv, len);
     if (!(name && len > 0 && *name))
     if (!(name && len > 0 && *name))
-       DIE(aTHX_ "Null filename used");
+        DIE(aTHX_ "Missing or undefined argument to require");
+
     if (!IS_SAFE_PATHNAME(name, len, "require")) {
         DIE(aTHX_ "Can't locate %s:   %s",
             pv_escape(newSVpvs_flags("",SVs_TEMP),SvPVX(sv),SvCUR(sv),
     if (!IS_SAFE_PATHNAME(name, len, "require")) {
         DIE(aTHX_ "Can't locate %s:   %s",
             pv_escape(newSVpvs_flags("",SVs_TEMP),SvPVX(sv),SvCUR(sv),
@@ -4053,7 +3968,8 @@ PP(pp_require)
        if (PL_op->op_type == OP_REQUIRE) {
            if(saved_errno == EMFILE || saved_errno == EACCES) {
                /* diag_listed_as: Can't locate %s */
        if (PL_op->op_type == OP_REQUIRE) {
            if(saved_errno == EMFILE || saved_errno == EACCES) {
                /* diag_listed_as: Can't locate %s */
-               DIE(aTHX_ "Can't locate %s:   %s", name, Strerror(saved_errno));
+               DIE(aTHX_ "Can't locate %s:   %s: %s",
+                   name, tryname, Strerror(saved_errno));
            } else {
                if (namesv) {                   /* did we lookup @INC? */
                    AV * const ar = GvAVn(PL_incgv);
            } else {
                if (namesv) {                   /* did we lookup @INC? */
                    AV * const ar = GvAVn(PL_incgv);
@@ -4142,18 +4058,11 @@ PP(pp_require)
 
     PUTBACK;
 
 
     PUTBACK;
 
-    /* Store and reset encoding. */
-    encoding = PL_encoding;
-    PL_encoding = NULL;
-
     if (doeval(gimme, NULL, PL_curcop->cop_seq, NULL))
        op = DOCATCH(PL_eval_start);
     else
        op = PL_op->op_next;
 
     if (doeval(gimme, NULL, PL_curcop->cop_seq, NULL))
        op = DOCATCH(PL_eval_start);
     else
        op = PL_op->op_next;
 
-    /* Restore encoding. */
-    PL_encoding = encoding;
-
     LOADED_FILE_PROBE(unixname);
 
     return op;
     LOADED_FILE_PROBE(unixname);
 
     return op;
@@ -4165,7 +4074,6 @@ PP(pp_require)
 
 PP(pp_hintseval)
 {
 
 PP(pp_hintseval)
 {
-    dVAR;
     dSP;
     mXPUSHs(MUTABLE_SV(hv_copy_hints_hv(MUTABLE_HV(cSVOP_sv))));
     RETURN;
     dSP;
     mXPUSHs(MUTABLE_SV(hv_copy_hints_hv(MUTABLE_HV(cSVOP_sv))));
     RETURN;
@@ -4174,7 +4082,7 @@ PP(pp_hintseval)
 
 PP(pp_entereval)
 {
 
 PP(pp_entereval)
 {
-    dVAR; dSP;
+    dSP;
     PERL_CONTEXT *cx;
     SV *sv;
     const I32 gimme = GIMME_V;
     PERL_CONTEXT *cx;
     SV *sv;
     const I32 gimme = GIMME_V;
@@ -4261,7 +4169,7 @@ PP(pp_entereval)
 
     /* prepare to compile string */
 
 
     /* prepare to compile string */
 
-    if ((PERLDB_LINE || PERLDB_SAVESRC) && PL_curstash != PL_debstash)
+    if (PERLDB_LINE_OR_SAVESRC && PL_curstash != PL_debstash)
        save_lines(CopFILEAV(&PL_compiling), PL_parser->linestr);
     else {
        /* XXX For C<eval "...">s within BEGIN {} blocks, this ends up
        save_lines(CopFILEAV(&PL_compiling), PL_parser->linestr);
     else {
        /* XXX For C<eval "...">s within BEGIN {} blocks, this ends up
@@ -4278,7 +4186,7 @@ PP(pp_entereval)
 
     if (doeval(gimme, runcv, seq, saved_hh)) {
        if (was != PL_breakable_sub_gen /* Some subs defined here. */
 
     if (doeval(gimme, runcv, seq, saved_hh)) {
        if (was != PL_breakable_sub_gen /* Some subs defined here. */
-           ? (PERLDB_LINE || PERLDB_SAVESRC)
+           ?  PERLDB_LINE_OR_SAVESRC
            :  PERLDB_SAVESRC_NOSUBS) {
            /* Retain the filegv we created.  */
        } else if (!saved_delete) {
            :  PERLDB_SAVESRC_NOSUBS) {
            /* Retain the filegv we created.  */
        } else if (!saved_delete) {
@@ -4290,7 +4198,7 @@ PP(pp_entereval)
        /* We have already left the scope set up earlier thanks to the LEAVE
           in doeval().  */
        if (was != PL_breakable_sub_gen /* Some subs defined here. */
        /* We have already left the scope set up earlier thanks to the LEAVE
           in doeval().  */
        if (was != PL_breakable_sub_gen /* Some subs defined here. */
-           ? (PERLDB_LINE || PERLDB_SAVESRC)
+           ?  PERLDB_LINE_OR_SAVESRC
            :  PERLDB_SAVESRC_INVALID) {
            /* Retain the filegv we created.  */
        } else if (!saved_delete) {
            :  PERLDB_SAVESRC_INVALID) {
            /* Retain the filegv we created.  */
        } else if (!saved_delete) {
@@ -4302,16 +4210,17 @@ PP(pp_entereval)
 
 PP(pp_leaveeval)
 {
 
 PP(pp_leaveeval)
 {
-    dVAR; dSP;
+    dSP;
     SV **newsp;
     PMOP *newpm;
     I32 gimme;
     PERL_CONTEXT *cx;
     OP *retop;
     SV **newsp;
     PMOP *newpm;
     I32 gimme;
     PERL_CONTEXT *cx;
     OP *retop;
-    const U8 save_flags = PL_op -> op_flags;
     I32 optype;
     SV *namesv;
     CV *evalcv;
     I32 optype;
     SV *namesv;
     CV *evalcv;
+    /* grab this value before POPEVAL restores old PL_in_eval */
+    bool keep = cBOOL(PL_in_eval & EVAL_KEEPERR);
 
     PERL_ASYNC_CHECK();
     POPBLOCK(cx,newpm);
 
     PERL_ASYNC_CHECK();
     POPBLOCK(cx,newpm);
@@ -4320,8 +4229,7 @@ PP(pp_leaveeval)
     retop = cx->blk_eval.retop;
     evalcv = cx->blk_eval.cv;
 
     retop = cx->blk_eval.retop;
     evalcv = cx->blk_eval.cv;
 
-    TAINT_NOT;
-    SP = adjust_stack_on_leave((gimme == G_VOID) ? SP : newsp, SP, newsp,
+    SP = leave_common((gimme == G_VOID) ? SP : newsp, SP, newsp,
                                gimme, SVs_TEMP, FALSE);
     PL_curpm = newpm;  /* Don't pop $1 et al till now */
 
                                gimme, SVs_TEMP, FALSE);
     PL_curpm = newpm;  /* Don't pop $1 et al till now */
 
@@ -4344,9 +4252,8 @@ PP(pp_leaveeval)
     }
     else {
        LEAVE_with_name("eval");
     }
     else {
        LEAVE_with_name("eval");
-       if (!(save_flags & OPf_SPECIAL)) {
+        if (!keep)
            CLEAR_ERRSV();
            CLEAR_ERRSV();
-       }
     }
 
     RETURNOP(retop);
     }
 
     RETURNOP(retop);
@@ -4399,7 +4306,6 @@ Perl_create_eval_scope(pTHX_ U32 flags)
     
 PP(pp_entertry)
 {
     
 PP(pp_entertry)
 {
-    dVAR;
     PERL_CONTEXT * const cx = create_eval_scope(0);
     cx->blk_eval.retop = cLOGOP->op_other->op_next;
     return DOCATCH(PL_op->op_next);
     PERL_CONTEXT * const cx = create_eval_scope(0);
     cx->blk_eval.retop = cLOGOP->op_other->op_next;
     return DOCATCH(PL_op->op_next);
@@ -4407,46 +4313,41 @@ PP(pp_entertry)
 
 PP(pp_leavetry)
 {
 
 PP(pp_leavetry)
 {
-    dVAR; dSP;
+    dSP;
     SV **newsp;
     PMOP *newpm;
     I32 gimme;
     PERL_CONTEXT *cx;
     I32 optype;
     SV **newsp;
     PMOP *newpm;
     I32 gimme;
     PERL_CONTEXT *cx;
     I32 optype;
+    OP *retop;
 
     PERL_ASYNC_CHECK();
     POPBLOCK(cx,newpm);
 
     PERL_ASYNC_CHECK();
     POPBLOCK(cx,newpm);
+    retop = cx->blk_eval.retop;
     POPEVAL(cx);
     PERL_UNUSED_VAR(optype);
 
     POPEVAL(cx);
     PERL_UNUSED_VAR(optype);
 
-    TAINT_NOT;
-    SP = adjust_stack_on_leave(newsp, SP, newsp, gimme,
+    SP = leave_common(newsp, SP, newsp, gimme,
                               SVs_PADTMP|SVs_TEMP, FALSE);
     PL_curpm = newpm;  /* Don't pop $1 et al till now */
 
     LEAVE_with_name("eval_scope");
     CLEAR_ERRSV();
                               SVs_PADTMP|SVs_TEMP, FALSE);
     PL_curpm = newpm;  /* Don't pop $1 et al till now */
 
     LEAVE_with_name("eval_scope");
     CLEAR_ERRSV();
-    RETURN;
+    RETURNOP(retop);
 }
 
 PP(pp_entergiven)
 {
 }
 
 PP(pp_entergiven)
 {
-    dVAR; dSP;
+    dSP;
     PERL_CONTEXT *cx;
     const I32 gimme = GIMME_V;
     
     ENTER_with_name("given");
     SAVETMPS;
 
     PERL_CONTEXT *cx;
     const I32 gimme = GIMME_V;
     
     ENTER_with_name("given");
     SAVETMPS;
 
-    if (PL_op->op_targ) {
-       SAVEPADSVANDMORTALIZE(PL_op->op_targ);
-       SvREFCNT_dec(PAD_SVl(PL_op->op_targ));
-       PAD_SVl(PL_op->op_targ) = SvREFCNT_inc_NN(POPs);
-    }
-    else {
-       SAVE_DEFSV;
-       DEFSV_set(POPs);
-    }
+    assert(!PL_op->op_targ); /* used to be set for lexical $_ */
+    SAVE_DEFSV;
+    DEFSV_set(POPs);
 
     PUSHBLOCK(cx, CXt_GIVEN, SP);
     PUSHGIVEN(cx);
 
     PUSHBLOCK(cx, CXt_GIVEN, SP);
     PUSHGIVEN(cx);
@@ -4456,7 +4357,7 @@ PP(pp_entergiven)
 
 PP(pp_leavegiven)
 {
 
 PP(pp_leavegiven)
 {
-    dVAR; dSP;
+    dSP;
     PERL_CONTEXT *cx;
     I32 gimme;
     SV **newsp;
     PERL_CONTEXT *cx;
     I32 gimme;
     SV **newsp;
@@ -4466,8 +4367,7 @@ PP(pp_leavegiven)
     POPBLOCK(cx,newpm);
     assert(CxTYPE(cx) == CXt_GIVEN);
 
     POPBLOCK(cx,newpm);
     assert(CxTYPE(cx) == CXt_GIVEN);
 
-    TAINT_NOT;
-    SP = adjust_stack_on_leave(newsp, SP, newsp, gimme,
+    SP = leave_common(newsp, SP, newsp, gimme,
                               SVs_PADTMP|SVs_TEMP, FALSE);
     PL_curpm = newpm;  /* Don't pop $1 et al till now */
 
                               SVs_PADTMP|SVs_TEMP, FALSE);
     PL_curpm = newpm;  /* Don't pop $1 et al till now */
 
@@ -4479,7 +4379,6 @@ PP(pp_leavegiven)
 STATIC PMOP *
 S_make_matcher(pTHX_ REGEXP *re)
 {
 STATIC PMOP *
 S_make_matcher(pTHX_ REGEXP *re)
 {
-    dVAR;
     PMOP *matcher = (PMOP *) newPMOP(OP_MATCH, OPf_WANT_SCALAR | OPf_STACKED);
 
     PERL_ARGS_ASSERT_MAKE_MATCHER;
     PMOP *matcher = (PMOP *) newPMOP(OP_MATCH, OPf_WANT_SCALAR | OPf_STACKED);
 
     PERL_ARGS_ASSERT_MAKE_MATCHER;
@@ -4495,8 +4394,8 @@ S_make_matcher(pTHX_ REGEXP *re)
 STATIC bool
 S_matcher_matches_sv(pTHX_ PMOP *matcher, SV *sv)
 {
 STATIC bool
 S_matcher_matches_sv(pTHX_ PMOP *matcher, SV *sv)
 {
-    dVAR;
     dSP;
     dSP;
+    bool result;
 
     PERL_ARGS_ASSERT_MATCHER_MATCHES_SV;
     
 
     PERL_ARGS_ASSERT_MATCHER_MATCHES_SV;
     
@@ -4505,14 +4404,15 @@ S_matcher_matches_sv(pTHX_ PMOP *matcher, SV *sv)
     PUTBACK;
     (void) Perl_pp_match(aTHX);
     SPAGAIN;
     PUTBACK;
     (void) Perl_pp_match(aTHX);
     SPAGAIN;
-    return (SvTRUEx(POPs));
+    result = SvTRUEx(POPs);
+    PUTBACK;
+
+    return result;
 }
 
 STATIC void
 S_destroy_matcher(pTHX_ PMOP *matcher)
 {
 }
 
 STATIC void
 S_destroy_matcher(pTHX_ PMOP *matcher)
 {
-    dVAR;
-
     PERL_ARGS_ASSERT_DESTROY_MATCHER;
     PERL_UNUSED_ARG(matcher);
 
     PERL_ARGS_ASSERT_DESTROY_MATCHER;
     PERL_UNUSED_ARG(matcher);
 
@@ -4533,7 +4433,6 @@ PP(pp_smartmatch)
 STATIC OP *
 S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other, const bool copied)
 {
 STATIC OP *
 S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other, const bool copied)
 {
-    dVAR;
     dSP;
     
     bool object_on_left = FALSE;
     dSP;
     
     bool object_on_left = FALSE;
@@ -4570,7 +4469,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other, const bool copied)
     }
 
     SP -= 2;   /* Pop the values */
     }
 
     SP -= 2;   /* Pop the values */
-
+    PUTBACK;
 
     /* ~~ undef */
     if (!SvOK(e)) {
 
     /* ~~ undef */
     if (!SvOK(e)) {
@@ -4581,11 +4480,11 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other, const bool copied)
            RETPUSHYES;
     }
 
            RETPUSHYES;
     }
 
-    if (sv_isobject(e) && (SvTYPE(SvRV(e)) != SVt_REGEXP)) {
+    if (SvROK(e) && SvOBJECT(SvRV(e)) && (SvTYPE(SvRV(e)) != SVt_REGEXP)) {
        DEBUG_M(Perl_deb(aTHX_ "    applying rule Any-Object\n"));
        Perl_croak(aTHX_ "Smart matching a non-overloaded object breaks encapsulation");
     }
        DEBUG_M(Perl_deb(aTHX_ "    applying rule Any-Object\n"));
        Perl_croak(aTHX_ "Smart matching a non-overloaded object breaks encapsulation");
     }
-    if (sv_isobject(d) && (SvTYPE(SvRV(d)) != SVt_REGEXP))
+    if (SvROK(d) && SvOBJECT(SvRV(d)) && (SvTYPE(SvRV(d)) != SVt_REGEXP))
        object_on_left = TRUE;
 
     /* ~~ sub */
        object_on_left = TRUE;
 
     /* ~~ sub */
@@ -4767,11 +4666,14 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other, const bool copied)
                (void) hv_iterinit(hv);
                while ( (he = hv_iternext(hv)) ) {
                    DEBUG_M(Perl_deb(aTHX_ "        testing key against pattern...\n"));
                (void) hv_iterinit(hv);
                while ( (he = hv_iternext(hv)) ) {
                    DEBUG_M(Perl_deb(aTHX_ "        testing key against pattern...\n"));
+                    PUTBACK;
                    if (matcher_matches_sv(matcher, hv_iterkeysv(he))) {
                    if (matcher_matches_sv(matcher, hv_iterkeysv(he))) {
+                        SPAGAIN;
                        (void) hv_iterinit(hv);
                        destroy_matcher(matcher);
                        RETPUSHYES;
                    }
                        (void) hv_iterinit(hv);
                        destroy_matcher(matcher);
                        RETPUSHYES;
                    }
+                    SPAGAIN;
                }
                destroy_matcher(matcher);
                RETPUSHNO;
                }
                destroy_matcher(matcher);
                RETPUSHNO;
@@ -4876,10 +4778,13 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other, const bool copied)
                for(i = 0; i <= this_len; ++i) {
                    SV * const * const svp = av_fetch(MUTABLE_AV(SvRV(e)), i, FALSE);
                    DEBUG_M(Perl_deb(aTHX_ "        testing element against pattern...\n"));
                for(i = 0; i <= this_len; ++i) {
                    SV * const * const svp = av_fetch(MUTABLE_AV(SvRV(e)), i, FALSE);
                    DEBUG_M(Perl_deb(aTHX_ "        testing element against pattern...\n"));
+                    PUTBACK;
                    if (svp && matcher_matches_sv(matcher, *svp)) {
                    if (svp && matcher_matches_sv(matcher, *svp)) {
+                        SPAGAIN;
                        destroy_matcher(matcher);
                        RETPUSHYES;
                    }
                        destroy_matcher(matcher);
                        RETPUSHYES;
                    }
+                    SPAGAIN;
                }
                destroy_matcher(matcher);
                RETPUSHNO;
                }
                destroy_matcher(matcher);
                RETPUSHNO;
@@ -4940,12 +4845,13 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other, const bool copied)
        }
        else {
            PMOP * const matcher = make_matcher((REGEXP*) SvRV(e));
        }
        else {
            PMOP * const matcher = make_matcher((REGEXP*) SvRV(e));
+            bool result;
 
            DEBUG_M(Perl_deb(aTHX_ "    applying rule Any-Regex\n"));
            PUTBACK;
 
            DEBUG_M(Perl_deb(aTHX_ "    applying rule Any-Regex\n"));
            PUTBACK;
-           PUSHs(matcher_matches_sv(matcher, d)
-                   ? &PL_sv_yes
-                   : &PL_sv_no);
+           result = matcher_matches_sv(matcher, d);
+            SPAGAIN;
+           PUSHs(result ? &PL_sv_yes : &PL_sv_no);
            destroy_matcher(matcher);
            RETURN;
        }
            destroy_matcher(matcher);
            RETURN;
        }
@@ -5005,7 +4911,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other, const bool copied)
 
 PP(pp_enterwhen)
 {
 
 PP(pp_enterwhen)
 {
-    dVAR; dSP;
+    dSP;
     PERL_CONTEXT *cx;
     const I32 gimme = GIMME_V;
 
     PERL_CONTEXT *cx;
     const I32 gimme = GIMME_V;
 
@@ -5029,7 +4935,7 @@ PP(pp_enterwhen)
 
 PP(pp_leavewhen)
 {
 
 PP(pp_leavewhen)
 {
-    dVAR; dSP;
+    dSP;
     I32 cxix;
     PERL_CONTEXT *cx;
     I32 gimme;
     I32 cxix;
     PERL_CONTEXT *cx;
     I32 gimme;
@@ -5045,8 +4951,7 @@ PP(pp_leavewhen)
     POPBLOCK(cx,newpm);
     assert(CxTYPE(cx) == CXt_WHEN);
 
     POPBLOCK(cx,newpm);
     assert(CxTYPE(cx) == CXt_WHEN);
 
-    TAINT_NOT;
-    SP = adjust_stack_on_leave(newsp, SP, newsp, gimme,
+    SP = leave_common(newsp, SP, newsp, gimme,
                               SVs_PADTMP|SVs_TEMP, FALSE);
     PL_curpm = newpm;   /* pop $1 et al */
 
                               SVs_PADTMP|SVs_TEMP, FALSE);
     PL_curpm = newpm;   /* pop $1 et al */
 
@@ -5077,7 +4982,7 @@ PP(pp_leavewhen)
 
 PP(pp_continue)
 {
 
 PP(pp_continue)
 {
-    dVAR; dSP;
+    dSP;
     I32 cxix;
     PERL_CONTEXT *cx;
     I32 gimme;
     I32 cxix;
     PERL_CONTEXT *cx;
     I32 gimme;
@@ -5105,7 +5010,6 @@ PP(pp_continue)
 
 PP(pp_break)
 {
 
 PP(pp_break)
 {
-    dVAR;   
     I32 cxix;
     PERL_CONTEXT *cx;
 
     I32 cxix;
     PERL_CONTEXT *cx;
 
@@ -5408,7 +5312,6 @@ S_num_overflow(NV value, I32 fldsize, I32 frcsize)
 static I32
 S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
 {
 static I32
 S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
 {
-    dVAR;
     SV * const datasv = FILTER_DATA(idx);
     const int filter_has_file = IoLINES(datasv);
     SV * const filter_state = MUTABLE_SV(IoTOP_GV(datasv));
     SV * const datasv = FILTER_DATA(idx);
     const int filter_has_file = IoLINES(datasv);
     SV * const filter_state = MUTABLE_SV(IoTOP_GV(datasv));
@@ -5428,7 +5331,7 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
     umaxlen = maxlen;
 
     /* I was having segfault trouble under Linux 2.2.5 after a
     umaxlen = maxlen;
 
     /* I was having segfault trouble under Linux 2.2.5 after a
-       parse error occured.  (Had to hack around it with a test
+       parse error occurred.  (Had to hack around it with a test
        for PL_parser->error_count == 0.)  Solaris doesn't segfault --
        not sure where the trouble is yet.  XXX */
 
        for PL_parser->error_count == 0.)  Solaris doesn't segfault --
        not sure where the trouble is yet.  XXX */
 
@@ -5605,11 +5508,5 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
 }
 
 /*
 }
 
 /*
- * Local variables:
- * c-indentation-style: bsd
- * c-basic-offset: 4
- * indent-tabs-mode: nil
- * End:
- *
  * ex: set ts=8 sts=4 sw=4 et:
  */
  * ex: set ts=8 sts=4 sw=4 et:
  */
Unnamed repository; edit this file 'description' to name the repository.