X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/1f3ffe4c6058f20e1f7d746ababdd669651e8d2b..77e42cd2aa3aeb1b12b284fc71ecb17547b4a5c7:/pp_hot.c?ds=sidebyside

diff --git a/pp_hot.c b/pp_hot.c
index e19776b..1155328 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -326,11 +326,11 @@ STATIC void
 S_pushav(pTHX_ AV* const av)
 {
     dSP;
-    const I32 maxarg = AvFILL(av) + 1;
+    const SSize_t maxarg = AvFILL(av) + 1;
     EXTEND(SP, maxarg);
     if (SvRMAGICAL(av)) {
-        U32 i;
-        for (i=0; i < (U32)maxarg; i++) {
+        PADOFFSET i;
+        for (i=0; i < (PADOFFSET)maxarg; i++) {
             SV ** const svp = av_fetch(av, i, FALSE);
             /* See note in pp_helem, and bug id #27839 */
             SP[i+1] = svp
@@ -339,7 +339,11 @@ S_pushav(pTHX_ AV* const av)
         }
     }
     else {
-        Copy(AvARRAY(av), SP+1, maxarg, SV*);
+        PADOFFSET i;
+        for (i=0; i < (PADOFFSET)maxarg; i++) {
+            SV * const sv = AvARRAY(av)[i];
+            SP[i+1] = sv ? sv : &PL_sv_undef;
+        }
     }
     SP += maxarg;
     PUTBACK;
@@ -783,7 +787,7 @@ PP(pp_print)
 	    Move(MARK, MARK + 1, (SP - MARK) + 1, SV*);
 	    ++SP;
 	}
-	return Perl_tied_method(aTHX_ "PRINT", mark - 1, MUTABLE_SV(io),
+	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
@@ -920,7 +924,7 @@ PP(pp_rv2av)
 	}
 	else if (gimme == G_SCALAR) {
 	    dTARGET;
-	    const I32 maxarg = AvFILL(av) + 1;
+	    const SSize_t maxarg = AvFILL(av) + 1;
 	    SETi(maxarg);
 	}
     } else {
@@ -990,7 +994,7 @@ PP(pp_aassign)
 
     I32 gimme;
     HV *hash;
-    I32 i;
+    SSize_t i;
     int magic;
     U32 lval = 0;
 
@@ -1055,8 +1059,8 @@ PP(pp_aassign)
 	    i = 0;
 	    while (relem <= lastrelem) {	/* gobble up all the rest */
 		SV **didstore;
-		assert(*relem);
-		SvGETMAGIC(*relem); /* before newSV, in case it dies */
+		if (*relem)
+		    SvGETMAGIC(*relem); /* before newSV, in case it dies */
 		sv = newSV(0);
 		sv_setsv_nomg(sv, *relem);
 		*(relem++) = sv;
@@ -1320,21 +1324,19 @@ PP(pp_match)
     dVAR; dSP; dTARG;
     PMOP *pm = cPMOP;
     PMOP *dynpm = pm;
-    const char *t;
     const char *s;
     const char *strend;
+    SSize_t curpos = 0; /* initial pos() or current $+[0] */
     I32 global;
-    U8 r_flags = REXEC_CHECKED;
+    U8 r_flags = 0;
     const char *truebase;			/* Start of string  */
     REGEXP *rx = PM_GETRE(pm);
     bool rxtainted;
     const I32 gimme = GIMME;
     STRLEN len;
-    I32 minmatch = 0;
     const I32 oldsave = PL_savestack_ix;
-    I32 update_minmatch = 1;
     I32 had_zerolen = 0;
-    U32 gpos = 0;
+    MAGIC *mg = NULL;
 
     if (PL_op->op_flags & OPf_STACKED)
 	TARG = POPs;
@@ -1348,12 +1350,12 @@ PP(pp_match)
     PUTBACK;				/* EVAL blocks need stack_sp. */
     /* Skip get-magic if this is a qr// clone, because regcomp has
        already done it. */
-    s = ReANY(rx)->mother_re
+    truebase = ReANY(rx)->mother_re
 	 ? SvPV_nomg_const(TARG, len)
 	 : SvPV_const(TARG, len);
-    if (!s)
+    if (!truebase)
 	DIE(aTHX_ "panic: pp_match");
-    strend = s + len;
+    strend = truebase + len;
     rxtainted = (RX_ISTAINTED(rx) ||
 		 (TAINT_get && (pm->op_pmflags & PMf_RETAINT)));
     TAINT_NOT;
@@ -1381,37 +1383,29 @@ PP(pp_match)
 	rx = PM_GETRE(pm);
     }
 
-    if (RX_MINLEN(rx) > (I32)len) {
-        DEBUG_r(PerlIO_printf(Perl_debug_log, "String shorter than min possible regex match\n"));
+    if (RX_MINLEN(rx) >= 0 && (STRLEN)RX_MINLEN(rx) > len) {
+        DEBUG_r(PerlIO_printf(Perl_debug_log, "String shorter than min possible regex match (%"
+                                              UVuf" < %"IVdf")\n",
+                                              (UV)len, (IV)RX_MINLEN(rx)));
 	goto nope;
     }
 
-    truebase = t = s;
-
-    /* XXXX What part of this is needed with true \G-support? */
+    /* get pos() if //g */
     if (global) {
-	RX_OFFS(rx)[0].start = -1;
-	if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) {
-	    MAGIC* const mg = mg_find(TARG, PERL_MAGIC_regex_global);
-	    if (mg && mg->mg_len >= 0) {
-		if (!(RX_EXTFLAGS(rx) & RXf_GPOS_SEEN))
-		    RX_OFFS(rx)[0].end = RX_OFFS(rx)[0].start = mg->mg_len;
-		else if (RX_EXTFLAGS(rx) & RXf_ANCH_GPOS) {
-		    r_flags |= REXEC_IGNOREPOS;
-		    RX_OFFS(rx)[0].end = RX_OFFS(rx)[0].start = mg->mg_len;
-		} else if (RX_EXTFLAGS(rx) & RXf_GPOS_FLOAT) 
-		    gpos = mg->mg_len;
-		else 
-		    RX_OFFS(rx)[0].end = RX_OFFS(rx)[0].start = mg->mg_len;
-		minmatch = (mg->mg_flags & MGf_MINMATCH) ? RX_GOFS(rx) + 1 : 0;
-		update_minmatch = 0;
-	    }
-	}
+        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 (       RX_NPARENS(rx)
             || PL_sawampersand
             || (RX_EXTFLAGS(rx) & (RXf_EVAL_SEEN|RXf_PMf_KEEPCOPY))
+            || (dynpm->op_pmflags & PMf_KEEPCOPY)
     )
 #endif
     {
@@ -1423,50 +1417,54 @@ PP(pp_match)
         if (! (global && gimme == G_ARRAY))
             r_flags |= REXEC_COPY_SKIP_POST;
     };
-
-  play_it_again:
-    if (global && RX_OFFS(rx)[0].start != -1) {
-	t = s = RX_OFFS(rx)[0].end + truebase - RX_GOFS(rx);
-	if ((s + RX_MINLEN(rx)) > strend || s < truebase) {
-	    DEBUG_r(PerlIO_printf(Perl_debug_log, "Regex match can't succeed, so not even tried\n"));
-	    goto nope;
-	}
-	if (update_minmatch++)
-	    minmatch = had_zerolen;
-    }
-    if (RX_EXTFLAGS(rx) & RXf_USE_INTUIT &&
-	DO_UTF8(TARG) == (RX_UTF8(rx) != 0)) {
-	s = CALLREG_INTUIT_START(rx, TARG, truebase,
-                        (char *)s, (char *)strend, r_flags, NULL);
-
-	if (!s)
-	    goto nope;
 #ifdef PERL_SAWAMPERSAND
-	if ( (RX_EXTFLAGS(rx) & RXf_CHECK_ALL)
-	     && !PL_sawampersand
-	     && !(RX_EXTFLAGS(rx) & RXf_PMf_KEEPCOPY)
-	     && !SvROK(TARG))	/* Cannot trust since INTUIT cannot guess ^ */
-	    goto yup;
+    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,
-		     minmatch, TARG, NUM2PTR(void*, gpos), r_flags))
-	goto ret_no;
+		     had_zerolen, TARG, NULL, r_flags))
+	goto nope;
 
     PL_curpm = pm;
-    if (dynpm->op_pmflags & PMf_ONCE) {
+    if (dynpm->op_pmflags & PMf_ONCE)
 #ifdef USE_ITHREADS
 	SvREADONLY_on(PL_regex_pad[dynpm->op_pmoffset]);
 #else
 	dynpm->op_pmflags |= PMf_USED;
 #endif
-    }
 
-  gotcha:
     if (rxtainted)
 	RX_MATCH_TAINTED_on(rx);
     TAINT_IF(RX_MATCH_TAINTED(rx));
-    if (gimme == G_ARRAY) {
+
+    /* update pos */
+
+    if (global && (gimme != G_ARRAY || (dynpm->op_pmflags & PMf_CONTINUE))) {
+        if (!mg)
+            mg = sv_magicext_mglob(TARG);
+        MgBYTEPOS_set(mg, TARG, truebase, RX_OFFS(rx)[0].end);
+        if (RX_ZERO_LEN(rx))
+            mg->mg_flags |= MGf_MINMATCH;
+        else
+            mg->mg_flags &= ~MGf_MINMATCH;
+    }
+
+    if ((!RX_NPARENS(rx) && !global) || gimme != G_ARRAY) {
+	LEAVE_SCOPE(oldsave);
+	RETPUSHYES;
+    }
+
+    /* push captures on stack */
+
+    {
 	const I32 nparens = RX_NPARENS(rx);
 	I32 i = (global && !nparens) ? 1 : 0;
 
@@ -1477,7 +1475,7 @@ PP(pp_match)
 	    PUSHs(sv_newmortal());
 	    if ((RX_OFFS(rx)[i].start != -1) && RX_OFFS(rx)[i].end != -1 ) {
 		const I32 len = RX_OFFS(rx)[i].end - RX_OFFS(rx)[i].start;
-		s = RX_OFFS(rx)[i].start + truebase;
+		const char * const s = RX_OFFS(rx)[i].start + truebase;
 	        if (RX_OFFS(rx)[i].end < 0 || RX_OFFS(rx)[i].start < 0 ||
 		    len < 0 || len > strend - s)
 		    DIE(aTHX_ "panic: pp_match start/end pointers, i=%ld, "
@@ -1490,152 +1488,23 @@ PP(pp_match)
 	    }
 	}
 	if (global) {
-	    if (dynpm->op_pmflags & PMf_CONTINUE) {
-		MAGIC* mg = NULL;
-		if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG))
-		    mg = mg_find(TARG, PERL_MAGIC_regex_global);
-		if (!mg) {
-#ifdef PERL_OLD_COPY_ON_WRITE
-		    if (SvIsCOW(TARG))
-			sv_force_normal_flags(TARG, 0);
-#endif
-		    mg = sv_magicext(TARG, NULL, PERL_MAGIC_regex_global,
-				     &PL_vtbl_mglob, NULL, 0);
-		}
-		if (RX_OFFS(rx)[0].start != -1) {
-		    mg->mg_len = RX_OFFS(rx)[0].end;
-		    if (RX_OFFS(rx)[0].start + RX_GOFS(rx) == (UV)RX_OFFS(rx)[0].end)
-			mg->mg_flags |= MGf_MINMATCH;
-		    else
-			mg->mg_flags &= ~MGf_MINMATCH;
-		}
-	    }
-	    had_zerolen = (RX_OFFS(rx)[0].start != -1
-			   && (RX_OFFS(rx)[0].start + RX_GOFS(rx)
-			       == (UV)RX_OFFS(rx)[0].end));
+            curpos = (UV)RX_OFFS(rx)[0].end;
+	    had_zerolen = RX_ZERO_LEN(rx);
 	    PUTBACK;			/* EVAL blocks may use stack */
 	    r_flags |= REXEC_IGNOREPOS | REXEC_NOT_FIRST;
 	    goto play_it_again;
 	}
-	else if (!nparens)
-	    XPUSHs(&PL_sv_yes);
 	LEAVE_SCOPE(oldsave);
 	RETURN;
     }
-    else {
-	if (global) {
-	    MAGIC* mg;
-	    if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG))
-		mg = mg_find(TARG, PERL_MAGIC_regex_global);
-	    else
-		mg = NULL;
-	    if (!mg) {
-#ifdef PERL_OLD_COPY_ON_WRITE
-		if (SvIsCOW(TARG))
-		    sv_force_normal_flags(TARG, 0);
-#endif
-		mg = sv_magicext(TARG, NULL, PERL_MAGIC_regex_global,
-				 &PL_vtbl_mglob, NULL, 0);
-	    }
-	    if (RX_OFFS(rx)[0].start != -1) {
-		mg->mg_len = RX_OFFS(rx)[0].end;
-		if (RX_OFFS(rx)[0].start + RX_GOFS(rx) == (UV)RX_OFFS(rx)[0].end)
-		    mg->mg_flags |= MGf_MINMATCH;
-		else
-		    mg->mg_flags &= ~MGf_MINMATCH;
-	    }
-	}
-	LEAVE_SCOPE(oldsave);
-	RETPUSHYES;
-    }
-
-#ifdef PERL_SAWAMPERSAND
-yup:					/* Confirmed by INTUIT */
-#endif
-    if (rxtainted)
-	RX_MATCH_TAINTED_on(rx);
-    TAINT_IF(RX_MATCH_TAINTED(rx));
-    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 (RX_MATCH_COPIED(rx))
-	Safefree(RX_SUBBEG(rx));
-    RX_MATCH_COPIED_off(rx);
-    RX_SUBBEG(rx) = NULL;
-    if (global) {
-	/* FIXME - should rx->subbeg be const char *?  */
-	RX_SUBBEG(rx) = (char *) truebase;
-	RX_SUBOFFSET(rx) = 0;
-	RX_SUBCOFFSET(rx) = 0;
-	RX_OFFS(rx)[0].start = s - truebase;
-	if (RX_MATCH_UTF8(rx)) {
-	    char * const t = (char*)utf8_hop((U8*)s, RX_MINLENRET(rx));
-	    RX_OFFS(rx)[0].end = t - truebase;
-	}
-	else {
-	    RX_OFFS(rx)[0].end = s - truebase + RX_MINLENRET(rx);
-	}
-	RX_SUBLEN(rx) = strend - truebase;
-	goto gotcha;
-    }
-#ifdef PERL_SAWAMPERSAND
-    if (PL_sawampersand || RX_EXTFLAGS(rx) & RXf_PMf_KEEPCOPY)
-#endif
-    {
-	I32 off;
-#ifdef PERL_ANY_COW
-	if (SvCANCOW(TARG)) {
-	    if (DEBUG_C_TEST) {
-		PerlIO_printf(Perl_debug_log,
-			      "Copy on write: pp_match $& capture, type %d, truebase=%p, t=%p, difference %d\n",
-			      (int) SvTYPE(TARG), (void*)truebase, (void*)t,
-			      (int)(t-truebase));
-	    }
-	    RX_SAVED_COPY(rx) = sv_setsv_cow(RX_SAVED_COPY(rx), TARG);
-	    RX_SUBBEG(rx)
-		= (char *) SvPVX_const(RX_SAVED_COPY(rx)) + (t - truebase);
-	    assert (SvPOKp(RX_SAVED_COPY(rx)));
-	} else
-#endif
-	{
-
-	    RX_SUBBEG(rx) = savepvn(t, strend - t);
-#ifdef PERL_ANY_COW
-	    RX_SAVED_COPY(rx) = NULL;
-#endif
-	}
-	RX_SUBLEN(rx) = strend - t;
-	RX_SUBOFFSET(rx) = 0;
-	RX_SUBCOFFSET(rx) = 0;
-	RX_MATCH_COPIED_on(rx);
-	off = RX_OFFS(rx)[0].start = s - t;
-	RX_OFFS(rx)[0].end = off + RX_MINLENRET(rx);
-    }
-#ifdef PERL_SAWAMPERSAND
-    else {			/* startp/endp are used by @- @+. */
-	RX_OFFS(rx)[0].start = s - truebase;
-	RX_OFFS(rx)[0].end = s - truebase + RX_MINLENRET(rx);
-    }
-#endif
-    /* match via INTUIT shouldn't have any captures. Let @-, @+, $^N know */
-    assert(!RX_NPARENS(rx));
-    RX_LASTPAREN(rx) = RX_LASTCLOSEPAREN(rx) = 0;
-    LEAVE_SCOPE(oldsave);
-    RETPUSHYES;
+    /* NOTREACHED */
 
 nope:
-ret_no:
     if (global && !(dynpm->op_pmflags & PMf_CONTINUE)) {
-	if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) {
-	    MAGIC* const mg = mg_find(TARG, PERL_MAGIC_regex_global);
-	    if (mg)
-		mg->mg_len = -1;
-	}
+        if (!mg)
+            mg = mg_find_mglob(TARG);
+        if (mg)
+            mg->mg_len = -1;
     }
     LEAVE_SCOPE(oldsave);
     if (gimme == G_ARRAY)
@@ -1658,7 +1527,7 @@ Perl_do_readline(pTHX)
     if (io) {
 	const MAGIC *const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
 	if (mg) {
-	    Perl_tied_method(aTHX_ "READLINE", SP, MUTABLE_SV(io), mg, gimme, 0);
+	    Perl_tied_method(aTHX_ SV_CONST(READLINE), SP, MUTABLE_SV(io), mg, gimme, 0);
 	    if (gimme == G_SCALAR) {
 		SPAGAIN;
 		SvSetSV_nosteal(TARG, TOPs);
@@ -1700,14 +1569,10 @@ Perl_do_readline(pTHX)
     }
     if (!fp) {
 	if ((!io || !(IoFLAGS(io) & IOf_START))
-	    && ckWARN2(WARN_GLOB, WARN_CLOSED))
+	    && ckWARN(WARN_CLOSED)
+            && type != OP_GLOB)
 	{
-	    if (type == OP_GLOB)
-		Perl_ck_warner_d(aTHX_ packWARN(WARN_GLOB),
-			    "glob failed (can't start child: %s)",
-			    Strerror(errno));
-	    else
-		report_evil_fh(PL_last_in_gv);
+	    report_evil_fh(PL_last_in_gv);
 	}
 	if (gimme == G_SCALAR) {
 	    /* undef TARG, and push that undefined value */
@@ -2042,22 +1907,19 @@ PP(pp_iter)
                 *itersvp = NULL;
                 Perl_croak(aTHX_ "Use of freed value in iteration");
             }
-            SvTEMP_off(sv);
-            SvREFCNT_inc_simple_void_NN(sv);
+            if (SvPADTMP(sv) && !IS_PADGV(sv))
+                sv = newSVsv(sv);
+            else {
+                SvTEMP_off(sv);
+                SvREFCNT_inc_simple_void_NN(sv);
+            }
+        }
+        else if (!av_is_stack) {
+            sv = newSVavdefelem(av, ix, 0);
         }
         else
             sv = &PL_sv_undef;
 
-        if (!av_is_stack && sv == &PL_sv_undef) {
-            SV *lv = newSV_type(SVt_PVLV);
-            LvTYPE(lv) = 'y';
-            sv_magic(lv, NULL, PERL_MAGIC_defelem, NULL, 0);
-            LvTARG(lv) = SvREFCNT_inc_simple(av);
-            LvTARGOFF(lv) = ix;
-            LvTARGLEN(lv) = (STRLEN)UV_MAX;
-            sv = lv;
-        }
-
         oldsv = *itersvp;
         *itersvp = sv;
         SvREFCNT_dec(oldsv);
@@ -2148,13 +2010,10 @@ PP(pp_subst)
     PMOP *rpm = pm;
     char *s;
     char *strend;
-    char *m;
     const char *c;
-    char *d;
     STRLEN clen;
     I32 iters = 0;
     I32 maxiters;
-    I32 i;
     bool once;
     U8 rxtainted = 0; /* holds various SUBST_TAINT_* flag bits.
 			See "how taint works" above */
@@ -2194,9 +2053,6 @@ PP(pp_subst)
 	sv_force_normal_flags(TARG,0);
 #endif
     if (!(rpm->op_pmflags & PMf_NONDESTRUCT)
-#ifdef PERL_ANY_COW
-	&& !is_cow
-#endif
 	&& (SvREADONLY(TARG)
 	    || ( ((SvTYPE(TARG) == SVt_PVGV && isGV_with_GP(TARG))
 		  || SvTYPE(TARG) > SVt_PVLV)
@@ -2204,7 +2060,10 @@ PP(pp_subst)
 	Perl_croak_no_modify();
     PUTBACK;
 
-    s = SvPV_nomg(TARG, len);
+    orig = SvPV_nomg(TARG, len);
+    /* note we don't (yet) force the var into being a string; if we fail
+     * to match, we leave as-is; on successful match howeverm, we *will*
+     * coerce into a string, then repeat the match */
     if (!SvPOKp(TARG) || SvTYPE(TARG) == SVt_PVGV || SvVOK(TARG))
 	force_on_match = 1;
 
@@ -2223,11 +2082,11 @@ PP(pp_subst)
     }
 
   force_it:
-    if (!pm || !s)
-	DIE(aTHX_ "panic: pp_subst, pm=%p, s=%p", pm, s);
+    if (!pm || !orig)
+	DIE(aTHX_ "panic: pp_subst, pm=%p, orig=%p", pm, orig);
 
-    strend = s + len;
-    slen = DO_UTF8(TARG) ? utf8_length((U8*)s, (U8*)strend) : len;
+    strend = orig + len;
+    slen = DO_UTF8(TARG) ? utf8_length((U8*)orig, (U8*)strend) : len;
     maxiters = 2 * slen + 10;	/* We can match twice at each
 				   position, once with zero-length,
 				   second time with non-zero. */
@@ -2242,6 +2101,7 @@ PP(pp_subst)
     r_flags = (    RX_NPARENS(rx)
                 || PL_sawampersand
                 || (RX_EXTFLAGS(rx) & (RXf_EVAL_SEEN|RXf_PMf_KEEPCOPY))
+                || (rpm->op_pmflags & PMf_KEEPCOPY)
               )
           ? REXEC_COPY_STR
           : 0;
@@ -2249,30 +2109,13 @@ PP(pp_subst)
     r_flags = REXEC_COPY_STR;
 #endif
 
-    orig = m = s;
-    if (RX_EXTFLAGS(rx) & RXf_USE_INTUIT) {
-	s = CALLREG_INTUIT_START(rx, TARG, orig, s, strend, r_flags, NULL);
-
-	if (!s)
-	    goto ret_no;
-	/* How to do it in subst? */
-/*	if ( (RX_EXTFLAGS(rx) & RXf_CHECK_ALL)
-	     && !PL_sawampersand
-	     && !(RX_EXTFLAGS(rx) & RXf_KEEPCOPY))
-	    goto yup;
-*/
-    }
-
-    if (!CALLREGEXEC(rx, s, strend, orig, 0, TARG, NULL,
-			 r_flags | REXEC_CHECKED))
+    if (!CALLREGEXEC(rx, orig, strend, orig, 0, TARG, NULL, r_flags))
     {
-      ret_no:
 	SPAGAIN;
 	PUSHs(rpm->op_pmflags & PMf_NONDESTRUCT ? TARG : &PL_sv_no);
 	LEAVE_SCOPE(oldsave);
 	RETURN;
     }
-
     PL_curpm = pm;
 
     /* known replacement string? */
@@ -2307,7 +2150,10 @@ PP(pp_subst)
 	&& !is_cow
 #endif
         && (I32)clen <= RX_MINLENRET(rx)
-        && (once || !(r_flags & REXEC_COPY_STR))
+        && (  once
+           || !(r_flags & REXEC_COPY_STR)
+           || (!SvGMAGICAL(dstr) && !(RX_EXTFLAGS(rx) & RXf_EVAL_SEEN))
+           )
         && !(RX_EXTFLAGS(rx) & RXf_NO_INPLACE_SUBST)
 	&& (!doutf8 || SvUTF8(TARG))
 	&& !(rpm->op_pmflags & PMf_NONDESTRUCT))
@@ -2321,18 +2167,22 @@ PP(pp_subst)
 	}
 #endif
 	if (force_on_match) {
+            /* redo the first match, this time with the orig var
+             * forced into being a string */
 	    force_on_match = 0;
-	    s = SvPV_force_nomg(TARG, len);
+	    orig = SvPV_force_nomg(TARG, len);
 	    goto force_it;
 	}
-	d = s;
+
 	if (once) {
+            char *d, *m;
 	    if (RX_MATCH_TAINTED(rx)) /* run time pattern taint, eg locale */
 		rxtainted |= SUBST_TAINT_PAT;
 	    m = orig + RX_OFFS(rx)[0].start;
 	    d = orig + RX_OFFS(rx)[0].end;
 	    s = orig;
 	    if (m - s > strend - d) {  /* faster to shorten from end */
+                I32 i;
 		if (clen) {
 		    Copy(c, m, clen, char);
 		    m += clen;
@@ -2345,27 +2195,23 @@ PP(pp_subst)
 		*m = '\0';
 		SvCUR_set(TARG, m - s);
 	    }
-	    else if ((i = m - s)) {	/* faster from front */
+	    else {	/* faster from front */
+                I32 i = m - s;
 		d -= clen;
-		m = d;
-		Move(s, d - i, i, char);
+                if (i > 0)
+                    Move(s, d - i, i, char);
 		sv_chop(TARG, d-i);
 		if (clen)
-		    Copy(c, m, clen, char);
-	    }
-	    else if (clen) {
-		d -= clen;
-		sv_chop(TARG, d);
-		Copy(c, d, clen, char);
-	    }
-	    else {
-		sv_chop(TARG, d);
+		    Copy(c, d, clen, char);
 	    }
 	    SPAGAIN;
 	    PUSHs(&PL_sv_yes);
 	}
 	else {
+            char *d, *m;
+            d = s = RX_OFFS(rx)[0].start + orig;
 	    do {
+                I32 i;
 		if (iters++ > maxiters)
 		    DIE(aTHX_ "Substitution loop");
 		if (RX_MATCH_TAINTED(rx)) /* run time pattern taint, eg locale */
@@ -2381,12 +2227,12 @@ PP(pp_subst)
 		    d += clen;
 		}
 		s = RX_OFFS(rx)[0].end + orig;
-	    } while (CALLREGEXEC(rx, s, strend, orig, s == m,
+	    } while (CALLREGEXEC(rx, s, strend, orig,
+				 s == m, /* don't match same null twice */
 				 TARG, NULL,
-				 /* don't match same null twice */
-				 REXEC_NOT_FIRST|REXEC_IGNOREPOS));
+                     REXEC_NOT_FIRST|REXEC_IGNOREPOS|REXEC_FAIL_ON_UNDERFLOW));
 	    if (s != d) {
-		i = strend - s;
+                I32 i = strend - s;
 		SvCUR_set(TARG, d - SvPVX_const(TARG) + i);
 		Move(s, d, i+1, char);		/* include the NUL */
 	    }
@@ -2396,8 +2242,11 @@ PP(pp_subst)
     }
     else {
 	bool first;
+        char *m;
 	SV *repl;
 	if (force_on_match) {
+            /* redo the first match, this time with the orig var
+             * forced into being a string */
 	    force_on_match = 0;
 	    if (rpm->op_pmflags & PMf_NONDESTRUCT) {
 		/* I feel that it should be possible to avoid this mortal copy
@@ -2407,7 +2256,7 @@ PP(pp_subst)
 		   cases where it would be viable to drop into the copy code. */
 		TARG = sv_2mortal(newSVsv(TARG));
 	    }
-	    s = SvPV_force_nomg(TARG, len);
+	    orig = SvPV_force_nomg(TARG, len);
 	    goto force_it;
 	}
 #ifdef PERL_ANY_COW
@@ -2416,10 +2265,13 @@ PP(pp_subst)
 	if (RX_MATCH_TAINTED(rx)) /* run time pattern taint, eg locale */
 	    rxtainted |= SUBST_TAINT_PAT;
 	repl = dstr;
-	dstr = newSVpvn_flags(m, s-m, SVs_TEMP | (DO_UTF8(TARG) ? SVf_UTF8 : 0));
+        s = RX_OFFS(rx)[0].start + orig;
+	dstr = newSVpvn_flags(orig, s-orig,
+                    SVs_TEMP | (DO_UTF8(TARG) ? SVf_UTF8 : 0));
 	if (!c) {
 	    PERL_CONTEXT *cx;
 	    SPAGAIN;
+            m = orig;
 	    /* note that a whole bunch of local vars are saved here for
 	     * use by pp_substcont: here's a list of them in case you're
 	     * searching for places in this sub that uses a particular var:
@@ -2428,7 +2280,6 @@ PP(pp_subst)
 	    PUSHSUBST(cx);
 	    RETURNOP(cPMOP->op_pmreplrootu.op_pmreplroot);
 	}
-	r_flags |= REXEC_IGNOREPOS | REXEC_NOT_FIRST;
 	first = TRUE;
 	do {
 	    if (iters++ > maxiters)
@@ -2436,12 +2287,13 @@ PP(pp_subst)
 	    if (RX_MATCH_TAINTED(rx))
 		rxtainted |= SUBST_TAINT_PAT;
 	    if (RX_MATCH_COPIED(rx) && RX_SUBBEG(rx) != orig) {
-		m = s;
-		s = orig;
+		char *old_s    = s;
+		char *old_orig = orig;
                 assert(RX_SUBOFFSET(rx) == 0);
+
 		orig = RX_SUBBEG(rx);
-		s = orig + (m - s);
-		strend = s + (strend - m);
+		s = orig + (old_s - old_orig);
+		strend = s + (strend - old_s);
 	    }
 	    m = RX_OFFS(rx)[0].start + orig;
 	    sv_catpvn_nomg_maybeutf8(dstr, s, m - s, DO_UTF8(TARG));
@@ -2466,7 +2318,8 @@ PP(pp_subst)
 	    if (once)
 		break;
 	} while (CALLREGEXEC(rx, s, strend, orig, s == m,
-			     TARG, NULL, r_flags));
+			     TARG, NULL,
+                    REXEC_NOT_FIRST|REXEC_IGNOREPOS|REXEC_FAIL_ON_UNDERFLOW));
 	sv_catpvn_nomg_maybeutf8(dstr, s, strend - s, DO_UTF8(TARG));
 
 	if (rpm->op_pmflags & PMf_NONDESTRUCT) {
@@ -2573,6 +2426,10 @@ PP(pp_grepwhile)
 	SAVEVPTR(PL_curpm);
 
 	src = PL_stack_base[*PL_markstack_ptr];
+	if (SvPADTMP(src) && !IS_PADGV(src)) {
+	    src = PL_stack_base[*PL_markstack_ptr] = sv_mortalcopy(src);
+	    PL_tmps_floor++;
+	}
 	SvTEMP_off(src);
 	if (PL_op->op_private & OPpGREP_LEX)
 	    PAD_SVl(PL_op->op_targ) = src;
@@ -2642,8 +2499,8 @@ PP(pp_leavesub)
     PUTBACK;
 
     LEAVE;
-    cxstack_ix--;
     POPSUB(cx,sv);	/* Stack values are safe: release CV and @_ ... */
+    cxstack_ix--;
     PL_curpm = newpm;	/* ... and pop $1 et al */
 
     LEAVESUB(sv);
@@ -2718,7 +2575,6 @@ PP(pp_entersub)
     }
 
     ENTER;
-    SAVETMPS;
 
   retry:
     if (CvCLONE(cv) && ! CvCLONED(cv))
@@ -2780,7 +2636,7 @@ try_autoload:
     if (!(CvISXSUB(cv))) {
 	/* This path taken at least 75% of the time   */
 	dMARK;
-	I32 items = SP - MARK;
+	SSize_t items = SP - MARK;
 	PADLIST * const padlist = CvPADLIST(cv);
 	PUSHBLOCK(cx, CXt_SUB, MARK);
 	PUSHSUB(cx);
@@ -2818,12 +2674,18 @@ try_autoload:
 	    Copy(MARK,AvARRAY(av),items,SV*);
 	    AvFILLp(av) = items - 1;
 	
+	    MARK = AvARRAY(av);
 	    while (items--) {
 		if (*MARK)
+		{
+		    if (SvPADTMP(*MARK) && !IS_PADGV(*MARK))
+			*MARK = sv_mortalcopy(*MARK);
 		    SvTEMP_off(*MARK);
+		}
 		MARK++;
 	    }
 	}
+	SAVETMPS;
 	if ((cx->blk_u16 & OPpENTERSUB_LVAL_MASK) == OPpLVAL_INTRO &&
 	    !CvLVALUE(cv))
 	    DIE(aTHX_ "Can't modify non-lvalue subroutine call");
@@ -2837,8 +2699,9 @@ try_autoload:
 	RETURNOP(CvSTART(cv));
     }
     else {
-	I32 markix = TOPMARK;
+	SSize_t markix = TOPMARK;
 
+	SAVETMPS;
 	PUTBACK;
 
 	if (((PL_op->op_private
@@ -2847,21 +2710,44 @@ try_autoload:
 	    !CvLVALUE(cv))
 	    DIE(aTHX_ "Can't modify non-lvalue subroutine call");
 
-	if (!hasargs) {
+	if (!hasargs && GvAV(PL_defgv)) {
 	    /* Need to copy @_ to stack. Alternative may be to
 	     * switch stack to @_, and copy return values
 	     * back. This would allow popping @_ in XSUB, e.g.. XXXX */
 	    AV * const av = GvAV(PL_defgv);
-	    const I32 items = AvFILLp(av) + 1;   /* @_ is not tieable */
+	    const SSize_t items = AvFILL(av) + 1;
 
 	    if (items) {
+		SSize_t i = 0;
+		const bool m = cBOOL(SvRMAGICAL(av));
 		/* Mark is at the end of the stack. */
 		EXTEND(SP, items);
-		Copy(AvARRAY(av), SP + 1, items, SV*);
+		for (; i < items; ++i)
+		{
+		    SV *sv;
+		    if (m) {
+			SV ** const svp = av_fetch(av, i, 0);
+			sv = svp ? *svp : NULL;
+		    }
+		    else sv = AvARRAY(av)[i];
+		    if (sv) SP[i+1] = sv;
+		    else {
+			SP[i+1] = newSVavdefelem(av, i, 1);
+		    }
+		}
 		SP += items;
 		PUTBACK ;		
 	    }
 	}
+	else {
+	    SV **mark = PL_stack_base + markix;
+	    SSize_t items = SP - mark;
+	    while (items--) {
+		mark++;
+		if (*mark && SvPADTMP(*mark) && !IS_PADGV(*mark))
+		    *mark = sv_mortalcopy(*mark);
+	    }
+	}
 	/* We assume first XSUB in &DB::sub is the called one. */
 	if (PL_curcopdb) {
 	    SAVEVPTR(PL_curcop);
@@ -2895,8 +2781,15 @@ Perl_sub_crush_depth(pTHX_ CV *cv)
     if (CvANON(cv))
 	Perl_warner(aTHX_ packWARN(WARN_RECURSION), "Deep recursion on anonymous subroutine");
     else {
-	SV* const tmpstr = sv_newmortal();
-	gv_efullname3(tmpstr, CvGV(cv), NULL);
+        HEK *const hek = CvNAME_HEK(cv);
+        SV *tmpstr;
+        if (hek) {
+            tmpstr = sv_2mortal(newSVhek(hek));
+        }
+        else {
+            tmpstr = sv_newmortal();
+            gv_efullname3(tmpstr, CvGV(cv), NULL);
+        }
 	Perl_warner(aTHX_ packWARN(WARN_RECURSION), "Deep recursion on subroutine \"%"SVf"\"",
 		    SVfARG(tmpstr));
     }
@@ -2910,7 +2803,7 @@ PP(pp_aelem)
     IV elem = SvIV(elemsv);
     AV *const av = MUTABLE_AV(POPs);
     const U32 lval = PL_op->op_flags & OPf_MOD || LVRET;
-    const U32 defer = (PL_op->op_private & OPpLVAL_DEFER) && (elem > av_len(av));
+    const U32 defer = PL_op->op_private & OPpLVAL_DEFER;
     const bool localizing = PL_op->op_private & OPpLVAL_INTRO;
     bool preeminent = TRUE;
     SV *sv;
@@ -2949,18 +2842,17 @@ PP(pp_aelem)
 	      MEM_WRAP_CHECK_1(elem,SV*,oom_array_extend);
 	 }
 #endif
-	if (!svp || *svp == &PL_sv_undef) {
-	    SV* lv;
+	if (!svp || !*svp) {
+	    IV len;
 	    if (!defer)
 		DIE(aTHX_ PL_no_aelem, elem);
-	    lv = sv_newmortal();
-	    sv_upgrade(lv, SVt_PVLV);
-	    LvTYPE(lv) = 'y';
-	    sv_magic(lv, NULL, PERL_MAGIC_defelem, NULL, 0);
-	    LvTARG(lv) = SvREFCNT_inc_simple(av);
-	    LvTARGOFF(lv) = elem;
-	    LvTARGLEN(lv) = 1;
-	    PUSHs(lv);
+	    len = av_len(av);
+	    mPUSHs(newSVavdefelem(av,
+	    /* Resolve a negative index now, unless it points before the
+	       beginning of the array, in which case record it for error
+	       reporting in magic_setdefelem. */
+		elem < 0 && len + elem >= 0 ? len + elem : elem,
+		1));
 	    RETURN;
 	}
 	if (localizing) {
@@ -3068,6 +2960,19 @@ S_method_common(pTHX_ SV* meth, U32* hashp)
     if (SvROK(sv))
 	ob = MUTABLE_SV(SvRV(sv));
     else if (!SvOK(sv)) goto undefined;
+    else if (isGV_with_GP(sv)) {
+	if (!GvIO(sv))
+	    Perl_croak(aTHX_ "Can't call method \"%"SVf"\" "
+			     "without a package or object reference",
+			      SVfARG(meth));
+	ob = sv;
+	if (SvTYPE(ob) == SVt_PVLV && LvTYPE(ob) == 'y') {
+	    assert(!LvTARGLEN(ob));
+	    ob = LvTARG(ob);
+	    assert(ob);
+	}
+	*(PL_stack_base + TOPMARK + 1) = sv_2mortal(newRV(ob));
+    }
     else {
 	/* this isn't a reference */
 	GV* iogv;
@@ -3118,8 +3023,7 @@ S_method_common(pTHX_ SV* meth, U32* hashp)
 
     /* if we got here, ob should be an object or a glob */
     if (!ob || !(SvOBJECT(ob)
-		 || (SvTYPE(ob) == SVt_PVGV 
-		     && isGV_with_GP(ob)
+		 || (isGV_with_GP(ob)
 		     && (ob = MUTABLE_SV(GvIO((const GV *)ob)))
 		     && SvOBJECT(ob))))
     {