X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/1f3ffe4c6058f20e1f7d746ababdd669651e8d2b..cb2dcfb25ec8a3cf487a54f645efffed55b50153:/pp_hot.c

diff --git a/pp_hot.c b/pp_hot.c
index e19776b..5010606 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -783,7 +783,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
@@ -1320,21 +1320,19 @@ PP(pp_match)
     dVAR; dSP; dTARG;
     PMOP *pm = cPMOP;
     PMOP *dynpm = pm;
-    const char *t;
     const char *s;
     const char *strend;
+    I32 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 +1346,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;
@@ -1386,32 +1384,22 @@ PP(pp_match)
 	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 = mg->mg_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 +1411,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);
+        mg->mg_len = 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 +1469,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 +1482,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 +1521,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);
@@ -2042,8 +1905,12 @@ 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
             sv = &PL_sv_undef;
@@ -2148,13 +2015,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 */
@@ -2204,7 +2068,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 +2090,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 +2109,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 +2117,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? */
@@ -2321,18 +2172,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 +2200,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 */
@@ -2384,9 +2235,9 @@ PP(pp_subst)
 	    } while (CALLREGEXEC(rx, s, strend, orig, s == m,
 				 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 +2247,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 +2261,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 +2270,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 +2285,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 +2292,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 +2323,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 +2431,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;
@@ -2718,7 +2580,6 @@ PP(pp_entersub)
     }
 
     ENTER;
-    SAVETMPS;
 
   retry:
     if (CvCLONE(cv) && ! CvCLONED(cv))
@@ -2818,12 +2679,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");
@@ -2839,6 +2706,7 @@ try_autoload:
     else {
 	I32 markix = TOPMARK;
 
+	SAVETMPS;
 	PUTBACK;
 
 	if (((PL_op->op_private
@@ -2895,8 +2763,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));
     }
@@ -3068,6 +2943,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 +3006,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))))
     {