X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_hot.c;h=aa225c37da3cdeb287b63c6e884f5133e435f174;hb=be8498a1b2824339839d32c9ffcee7899af92562;hp=14bfd2ca6bb8cc8d561a3f1373d7ed54f5053498;hpb=ae6d515f69537dd5e2631b15104c2c90d022fd19;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp_hot.c b/pp_hot.c
index 14bfd2c..aa225c3 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1,7 +1,7 @@
 /*    pp_hot.c
  *
  *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- *    2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
+ *    2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -150,7 +150,7 @@ PP(pp_sassign)
 		SV *const value = SvRV(cv);
 
 		SvUPGRADE((SV *)gv, SVt_RV);
-		SvROK_on(gv);
+		SvPCS_IMPORTED_on(gv);
 		SvRV_set(gv, value);
 		SvREFCNT_inc_simple_void(value);
 		SETs(right);
@@ -782,23 +782,30 @@ PP(pp_print)
 PP(pp_rv2av)
 {
     dVAR; dSP; dTOPss;
-    AV *av;
+    const I32 gimme = GIMME_V;
+    static const char return_array_to_lvalue_scalar[] = "Can't return array to lvalue scalar context";
+    static const char return_hash_to_lvalue_scalar[] = "Can't return hash to lvalue scalar context";
+    static const char an_array[] = "an ARRAY";
+    static const char a_hash[] = "a HASH";
+    const bool is_pp_rv2av = PL_op->op_type == OP_RV2AV;
+    const U32 type = is_pp_rv2av ? SVt_PVAV : SVt_PVHV;
 
     if (SvROK(sv)) {
       wasref:
-	tryAMAGICunDEREF(to_av);
+	tryAMAGICunDEREF_var(is_pp_rv2av ? to_av_amg : to_hv_amg);
 
-	av = (AV*)SvRV(sv);
-	if (SvTYPE(av) != SVt_PVAV)
-	    DIE(aTHX_ "Not an ARRAY reference");
+	sv = SvRV(sv);
+	if (SvTYPE(sv) != type)
+	    DIE(aTHX_ "Not %s reference", is_pp_rv2av ? an_array : a_hash);
 	if (PL_op->op_flags & OPf_REF) {
-	    SETs((SV*)av);
+	    SETs(sv);
 	    RETURN;
 	}
 	else if (LVRET) {
-	    if (GIMME == G_SCALAR)
-		Perl_croak(aTHX_ "Can't return array to lvalue scalar context");
-	    SETs((SV*)av);
+	    if (gimme != G_ARRAY)
+		Perl_croak(aTHX_ is_pp_rv2av ? return_array_to_lvalue_scalar
+			   : return_hash_to_lvalue_scalar);
+	    SETs(sv);
 	    RETURN;
 	}
 	else if (PL_op->op_flags & OPf_MOD
@@ -806,17 +813,17 @@ PP(pp_rv2av)
 	    Perl_croak(aTHX_ PL_no_localize_ref);
     }
     else {
-	if (SvTYPE(sv) == SVt_PVAV) {
-	    av = (AV*)sv;
+	if (SvTYPE(sv) == type) {
 	    if (PL_op->op_flags & OPf_REF) {
-		SETs((SV*)av);
+		SETs(sv);
 		RETURN;
 	    }
 	    else if (LVRET) {
-		if (GIMME == G_SCALAR)
-		    Perl_croak(aTHX_ "Can't return array to lvalue"
-			       " scalar context");
-		SETs((SV*)av);
+		if (gimme != G_ARRAY)
+		    Perl_croak(aTHX_
+			       is_pp_rv2av ? return_array_to_lvalue_scalar
+			       : return_hash_to_lvalue_scalar);
+		SETs(sv);
 		RETURN;
 	    }
 	}
@@ -829,56 +836,38 @@ PP(pp_rv2av)
 		    if (SvROK(sv))
 			goto wasref;
 		}
-		if (!SvOK(sv)) {
-		    if (PL_op->op_flags & OPf_REF ||
-		      PL_op->op_private & HINT_STRICT_REFS)
-			DIE(aTHX_ PL_no_usym, "an ARRAY");
-		    if (ckWARN(WARN_UNINITIALIZED))
-			report_uninit(sv);
-		    if (GIMME == G_ARRAY) {
-			(void)POPs;
-			RETURN;
-		    }
-		    RETSETUNDEF;
-		}
-		if ((PL_op->op_flags & OPf_SPECIAL) &&
-		    !(PL_op->op_flags & OPf_MOD))
-		{
-		    gv = (GV*)gv_fetchsv(sv, 0, SVt_PVAV);
-		    if (!gv
-			&& (!is_gv_magical_sv(sv,0)
-			    || !(gv = (GV*)gv_fetchsv(sv, GV_ADD, SVt_PVAV))))
-		    {
-			RETSETUNDEF;
-		    }
-		}
-		else {
-		    if (PL_op->op_private & HINT_STRICT_REFS)
-			DIE(aTHX_ PL_no_symref_sv, sv, "an ARRAY");
-		    gv = (GV*)gv_fetchsv(sv, GV_ADD, SVt_PVAV);
-		}
+		gv = Perl_softref2xv(aTHX_ sv, is_pp_rv2av ? an_array : a_hash,
+				     type, &sp);
+		if (!gv)
+		    RETURN;
 	    }
 	    else {
 		gv = (GV*)sv;
 	    }
-	    av = GvAVn(gv);
+	    sv = is_pp_rv2av ? (SV*)GvAVn(gv) : (SV*)GvHVn(gv);
 	    if (PL_op->op_private & OPpLVAL_INTRO)
-		av = save_ary(gv);
+		sv = is_pp_rv2av ? (SV*)save_ary(gv) : (SV*)save_hash(gv);
 	    if (PL_op->op_flags & OPf_REF) {
-		SETs((SV*)av);
+		SETs(sv);
 		RETURN;
 	    }
 	    else if (LVRET) {
-		if (GIMME == G_SCALAR)
-		    Perl_croak(aTHX_ "Can't return array to lvalue"
-			       " scalar context");
-		SETs((SV*)av);
+		if (gimme != G_ARRAY)
+		    Perl_croak(aTHX_
+			       is_pp_rv2av ? return_array_to_lvalue_scalar
+			       : return_hash_to_lvalue_scalar);
+		SETs(sv);
 		RETURN;
 	    }
 	}
     }
 
-    if (GIMME == G_ARRAY) {
+    if (is_pp_rv2av) {
+	AV *const av = (AV*)sv;
+	/* The guts of pp_rv2av, with no intenting change to preserve history
+	   (until such time as we get tools that can do blame annotation across
+	   whitespace changes.  */
+    if (gimme == G_ARRAY) {
 	const I32 maxarg = AvFILL(av) + 1;
 	(void)POPs;			/* XXXX May be optimized away? */
 	EXTEND(SP, maxarg);
@@ -897,122 +886,23 @@ PP(pp_rv2av)
 	}
 	SP += maxarg;
     }
-    else if (GIMME_V == G_SCALAR) {
+    else if (gimme == G_SCALAR) {
 	dTARGET;
 	const I32 maxarg = AvFILL(av) + 1;
 	SETi(maxarg);
     }
-    RETURN;
-}
-
-PP(pp_rv2hv)
-{
-    dVAR; dSP; dTOPss;
-    HV *hv;
-    const I32 gimme = GIMME_V;
-    static const char return_hash_to_lvalue_scalar[] = "Can't return hash to lvalue scalar context";
-
-    if (SvROK(sv)) {
-      wasref:
-	tryAMAGICunDEREF(to_hv);
-
-	hv = (HV*)SvRV(sv);
-	if (SvTYPE(hv) != SVt_PVHV)
-	    DIE(aTHX_ "Not a HASH reference");
-	if (PL_op->op_flags & OPf_REF) {
-	    SETs((SV*)hv);
-	    RETURN;
-	}
-	else if (LVRET) {
-	    if (gimme != G_ARRAY)
-		Perl_croak(aTHX_ return_hash_to_lvalue_scalar );
-	    SETs((SV*)hv);
-	    RETURN;
-	}
-	else if (PL_op->op_flags & OPf_MOD
-		&& PL_op->op_private & OPpLVAL_INTRO)
-	    Perl_croak(aTHX_ PL_no_localize_ref);
-    }
-    else {
-	if (SvTYPE(sv) == SVt_PVHV) {
-	    hv = (HV*)sv;
-	    if (PL_op->op_flags & OPf_REF) {
-		SETs((SV*)hv);
-		RETURN;
-	    }
-	    else if (LVRET) {
-		if (gimme != G_ARRAY)
-		    Perl_croak(aTHX_ return_hash_to_lvalue_scalar );
-		SETs((SV*)hv);
-		RETURN;
-	    }
-	}
-	else {
-	    GV *gv;
-	
-	    if (SvTYPE(sv) != SVt_PVGV) {
-		if (SvGMAGICAL(sv)) {
-		    mg_get(sv);
-		    if (SvROK(sv))
-			goto wasref;
-		}
-		if (!SvOK(sv)) {
-		    if (PL_op->op_flags & OPf_REF ||
-		      PL_op->op_private & HINT_STRICT_REFS)
-			DIE(aTHX_ PL_no_usym, "a HASH");
-		    if (ckWARN(WARN_UNINITIALIZED))
-			report_uninit(sv);
-		    if (gimme == G_ARRAY) {
-			SP--;
-			RETURN;
-		    }
-		    RETSETUNDEF;
-		}
-		if ((PL_op->op_flags & OPf_SPECIAL) &&
-		    !(PL_op->op_flags & OPf_MOD))
-		{
-		    gv = (GV*)gv_fetchsv(sv, 0, SVt_PVHV);
-		    if (!gv
-			&& (!is_gv_magical_sv(sv,0)
-			    || !(gv = (GV*)gv_fetchsv(sv, GV_ADD, SVt_PVHV))))
-		    {
-			RETSETUNDEF;
-		    }
-		}
-		else {
-		    if (PL_op->op_private & HINT_STRICT_REFS)
-			DIE(aTHX_ PL_no_symref_sv, sv, "a HASH");
-		    gv = (GV*)gv_fetchsv(sv, GV_ADD, SVt_PVHV);
-		}
-	    }
-	    else {
-		gv = (GV*)sv;
-	    }
-	    hv = GvHVn(gv);
-	    if (PL_op->op_private & OPpLVAL_INTRO)
-		hv = save_hash(gv);
-	    if (PL_op->op_flags & OPf_REF) {
-		SETs((SV*)hv);
-		RETURN;
-	    }
-	    else if (LVRET) {
-		if (gimme != G_ARRAY)
-		    Perl_croak(aTHX_ return_hash_to_lvalue_scalar );
-		SETs((SV*)hv);
-		RETURN;
-	    }
-	}
-    }
-
+    } else {
+	/* The guts of pp_rv2hv  */
     if (gimme == G_ARRAY) { /* array wanted */
-	*PL_stack_sp = (SV*)hv;
+	*PL_stack_sp = sv;
 	return do_kv();
     }
     else if (gimme == G_SCALAR) {
 	dTARGET;
-    TARG = Perl_hv_scalar(aTHX_ hv);
+    TARG = Perl_hv_scalar(aTHX_ (HV*)sv);
 	SETTARG;
     }
+    }
     RETURN;
 }
 
@@ -1282,7 +1172,8 @@ PP(pp_qr)
     if (pm->op_pmdynflags & PMdf_TAINTED)
         SvTAINTED_on(rv);
     sv_magic(sv,(SV*)ReREFCNT_inc(PM_GETRE(pm)), PERL_MAGIC_qr,0,0);
-    RETURNX(PUSHs(rv));
+    XPUSHs(rv);
+    RETURN;
 }
 
 PP(pp_match)
@@ -1304,6 +1195,7 @@ PP(pp_match)
     const I32 oldsave = PL_savestack_ix;
     I32 update_minmatch = 1;
     I32 had_zerolen = 0;
+    U32 gpos = 0;
 
     if (PL_op->op_flags & OPf_STACKED)
 	TARG = POPs;
@@ -1350,48 +1242,55 @@ PP(pp_match)
 	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->reganch & ROPT_GPOS_SEEN))
+		if (!(rx->extflags & RXf_GPOS_SEEN))
 		    rx->endp[0] = rx->startp[0] = mg->mg_len;
-		else if (rx->reganch & ROPT_ANCH_GPOS) {
+		else if (rx->extflags & RXf_ANCH_GPOS) {
 		    r_flags |= REXEC_IGNOREPOS;
 		    rx->endp[0] = rx->startp[0] = mg->mg_len;
-		}
-		minmatch = (mg->mg_flags & MGf_MINMATCH);
+		} else if (rx->extflags & RXf_GPOS_FLOAT) 
+		    gpos = mg->mg_len;
+		else 
+		    rx->endp[0] = rx->startp[0] = mg->mg_len;
+		minmatch = (mg->mg_flags & MGf_MINMATCH) ? rx->gofs + 1 : 0;
 		update_minmatch = 0;
 	    }
 	}
     }
-    if ((!global && rx->nparens)
-	    || SvTEMP(TARG) || PL_sawampersand || (pm->op_pmflags & PMf_EVAL))
+    /* remove comment to get faster /g but possibly unsafe $1 vars after a
+       match. Test for the unsafe vars will fail as well*/
+    if (( /* !global &&  */ rx->nparens) 
+	    || SvTEMP(TARG) || PL_sawampersand ||
+	    (pm->op_pmflags & (PMf_EVAL|PMf_KEEPCOPY)))
 	r_flags |= REXEC_COPY_STR;
     if (SvSCREAM(TARG))
 	r_flags |= REXEC_SCREAM;
 
 play_it_again:
     if (global && rx->startp[0] != -1) {
-	t = s = rx->endp[0] + truebase;
-	if ((s + rx->minlen) > strend)
+	t = s = rx->endp[0] + truebase - rx->gofs;
+	if ((s + rx->minlen) > strend || s < truebase)
 	    goto nope;
 	if (update_minmatch++)
 	    minmatch = had_zerolen;
     }
-    if (rx->reganch & RE_USE_INTUIT &&
-	DO_UTF8(TARG) == ((rx->reganch & ROPT_UTF8) != 0)) {
+    if (rx->extflags & RXf_USE_INTUIT &&
+	DO_UTF8(TARG) == ((rx->extflags & RXf_UTF8) != 0)) {
 	/* FIXME - can PL_bostr be made const char *?  */
 	PL_bostr = (char *)truebase;
 	s = CALLREG_INTUIT_START(rx, TARG, (char *)s, (char *)strend, r_flags, NULL);
 
 	if (!s)
 	    goto nope;
-	if ( (rx->reganch & ROPT_CHECK_ALL)
+	if ( (rx->extflags & RXf_CHECK_ALL)
 	     && !PL_sawampersand
-	     && ((rx->reganch & ROPT_NOSCAN)
-		 || !((rx->reganch & RE_INTUIT_TAIL)
+	     && !(pm->op_pmflags & PMf_KEEPCOPY)
+	     && ((rx->extflags & RXf_NOSCAN)
+		 || !((rx->extflags & RXf_INTUIT_TAIL)
 		      && (r_flags & REXEC_SCREAM)))
 	     && !SvROK(TARG))	/* Cannot trust since INTUIT cannot guess ^ */
 	    goto yup;
     }
-    if (CALLREGEXEC(rx, (char*)s, (char *)strend, (char*)truebase, minmatch, TARG, NULL, r_flags))
+    if (CALLREGEXEC(rx, (char*)s, (char *)strend, (char*)truebase, minmatch, TARG, INT2PTR(void*, gpos), r_flags))
     {
 	PL_curpm = pm;
 	if (dynpm->op_pmflags & PMf_ONCE)
@@ -1441,14 +1340,14 @@ play_it_again:
 		}
 		if (rx->startp[0] != -1) {
 		    mg->mg_len = rx->endp[0];
-		    if (rx->startp[0] == rx->endp[0])
+		    if (rx->startp[0] + rx->gofs == (UV)rx->endp[0])
 			mg->mg_flags |= MGf_MINMATCH;
 		    else
 			mg->mg_flags &= ~MGf_MINMATCH;
 		}
 	    }
 	    had_zerolen = (rx->startp[0] != -1
-			   && rx->startp[0] == rx->endp[0]);
+			   && rx->startp[0] + rx->gofs == (UV)rx->endp[0]);
 	    PUTBACK;			/* EVAL blocks may use stack */
 	    r_flags |= REXEC_IGNOREPOS | REXEC_NOT_FIRST;
 	    goto play_it_again;
@@ -1475,7 +1374,7 @@ play_it_again:
 	    }
 	    if (rx->startp[0] != -1) {
 		mg->mg_len = rx->endp[0];
-		if (rx->startp[0] == rx->endp[0])
+		if (rx->startp[0] + rx->gofs == (UV)rx->endp[0])
 		    mg->mg_flags |= MGf_MINMATCH;
 		else
 		    mg->mg_flags &= ~MGf_MINMATCH;
@@ -1510,14 +1409,14 @@ yup:					/* Confirmed by INTUIT */
 	rx->sublen = strend - truebase;
 	goto gotcha;
     }
-    if (PL_sawampersand) {
+    if (PL_sawampersand || pm->op_pmflags & PMf_KEEPCOPY) {
 	I32 off;
 #ifdef PERL_OLD_COPY_ON_WRITE
 	if (SvIsCOW(TARG) || (SvFLAGS(TARG) & CAN_COW_MASK) == CAN_COW_FLAGS) {
 	    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), truebase, t,
+			      (int) SvTYPE(TARG), (void*)truebase, (void*)t,
 			      (int)(t-truebase));
 	    }
 	    rx->saved_copy = sv_setsv_cow(rx->saved_copy, TARG);
@@ -1541,6 +1440,8 @@ yup:					/* Confirmed by INTUIT */
 	rx->startp[0] = s - truebase;
 	rx->endp[0] = s - truebase + rx->minlenret;
     }
+    /* including rx->nparens in the below code seems highly suspicious.
+       -dmq */
     rx->nparens = rx->lastparen = rx->lastcloseparen = 0;	/* used by @-, @+, and $^N */
     LEAVE_SCOPE(oldsave);
     RETPUSHYES;
@@ -1644,6 +1545,8 @@ Perl_do_readline(pTHX)
   have_fp:
     if (gimme == G_SCALAR) {
 	sv = TARG;
+	if (type == OP_RCATLINE && SvGMAGICAL(sv))
+	    mg_get(sv);
 	if (SvROK(sv)) {
 	    if (type == OP_RCATLINE)
 		SvPV_force_nolen(sv);
@@ -1830,7 +1733,7 @@ PP(pp_helem)
 	    SV* lv;
 	    SV* key2;
 	    if (!defer) {
-		DIE(aTHX_ PL_no_helem_sv, keysv);
+		DIE(aTHX_ PL_no_helem_sv, SVfARG(keysv));
 	    }
 	    lv = sv_newmortal();
 	    sv_upgrade(lv, SVt_PVLV);
@@ -2041,8 +1944,7 @@ PP(pp_iter)
 	if (lv)
 	    SvREFCNT_dec(LvTARG(lv));
 	else {
-	    lv = cx->blk_loop.iterlval = newSV(0);
-	    sv_upgrade(lv, SVt_PVLV);
+	    lv = cx->blk_loop.iterlval = newSV_type(SVt_PVLV);
 	    LvTYPE(lv) = 'y';
 	    sv_magic(lv, NULL, PERL_MAGIC_defelem, NULL, 0);
 	}
@@ -2112,7 +2014,8 @@ PP(pp_subst)
 	!is_cow &&
 #endif
 	(SvREADONLY(TARG)
-	|| ( (SvTYPE(TARG) == SVt_PVGV || SvTYPE(TARG) > SVt_PVLV)
+	 || ( ((SvTYPE(TARG) == SVt_PVGV && isGV_with_GP(TARG))
+	       || SvTYPE(TARG) > SVt_PVLV)
 	     && !(SvTYPE(TARG) == SVt_PVGV && SvFAKE(TARG)))))
 	DIE(aTHX_ PL_no_modify);
     PUTBACK;
@@ -2143,23 +2046,24 @@ PP(pp_subst)
 	rx = PM_GETRE(pm);
     }
     r_flags = (rx->nparens || SvTEMP(TARG) || PL_sawampersand
-	    || (pm->op_pmflags & PMf_EVAL))
+	    || (pm->op_pmflags & (PMf_EVAL|PMf_KEEPCOPY)) )
 	       ? REXEC_COPY_STR : 0;
     if (SvSCREAM(TARG))
 	r_flags |= REXEC_SCREAM;
 
     orig = m = s;
-    if (rx->reganch & RE_USE_INTUIT) {
+    if (rx->extflags & RXf_USE_INTUIT) {
 	PL_bostr = orig;
 	s = CALLREG_INTUIT_START(rx, TARG, s, strend, r_flags, NULL);
 
 	if (!s)
 	    goto nope;
 	/* How to do it in subst? */
-/*	if ( (rx->reganch & ROPT_CHECK_ALL)
+/*	if ( (rx->extflags & RXf_CHECK_ALL)
 	     && !PL_sawampersand
-	     && ((rx->reganch & ROPT_NOSCAN)
-		 || !((rx->reganch & RE_INTUIT_TAIL)
+	     && !(pm->op_pmflags & PMf_KEEPCOPY)
+	     && ((rx->extflags & RXf_NOSCAN)
+		 || !((rx->extflags & RXf_INTUIT_TAIL)
 		      && (r_flags & REXEC_SCREAM))))
 	    goto yup;
 */
@@ -2197,7 +2101,7 @@ PP(pp_subst)
 	&& !is_cow
 #endif
 	&& (I32)clen <= rx->minlenret && (once || !(r_flags & REXEC_COPY_STR))
-	&& !(rx->reganch & ROPT_LOOKBEHIND_SEEN)
+	&& !(rx->extflags & RXf_LOOKBEHIND_SEEN)
 	&& (!doutf8 || SvUTF8(TARG))) {
 	if (!CALLREGEXEC(rx, s, strend, orig, 0, TARG, NULL,
 			 r_flags | REXEC_CHECKED))
@@ -2674,45 +2578,6 @@ PP(pp_leavesublv)
     return cx->blk_sub.retop;
 }
 
-
-STATIC CV *
-S_get_db_sub(pTHX_ SV **svp, CV *cv)
-{
-    dVAR;
-    SV * const dbsv = GvSVn(PL_DBsub);
-
-    save_item(dbsv);
-    if (!PERLDB_SUB_NN) {
-	GV * const gv = CvGV(cv);
-
-	if ( (CvFLAGS(cv) & (CVf_ANON | CVf_CLONED))
-	     || strEQ(GvNAME(gv), "END")
-	     || ((GvCV(gv) != cv) && /* Could be imported, and old sub redefined. */
-		 !( (SvTYPE(*svp) == SVt_PVGV) && (GvCV((GV*)*svp) == cv) ))) {
-	    /* Use GV from the stack as a fallback. */
-	    /* GV is potentially non-unique, or contain different CV. */
-	    SV * const tmp = newRV((SV*)cv);
-	    sv_setsv(dbsv, tmp);
-	    SvREFCNT_dec(tmp);
-	}
-	else {
-	    gv_efullname3(dbsv, gv, NULL);
-	}
-    }
-    else {
-	const int type = SvTYPE(dbsv);
-	if (type < SVt_PVIV && type != SVt_IV)
-	    sv_upgrade(dbsv, SVt_PVIV);
-	(void)SvIOK_on(dbsv);
-	SvIV_set(dbsv, PTR2IV(cv));	/* Do it the quickest way  */
-    }
-
-    if (CvISXSUB(cv))
-	PL_curcopdb = PL_curcop;
-    cv = GvCV(PL_DBsub);
-    return cv;
-}
-
 PP(pp_entersub)
 {
     dVAR; dSP; dPOPss;
@@ -2740,6 +2605,7 @@ PP(pp_entersub)
     default:
 	if (!SvROK(sv)) {
 	    const char *sym;
+	    STRLEN len;
 	    if (sv == &PL_sv_yes) {		/* unfound import, ignore */
 		if (hasargs)
 		    SP = PL_stack_base + POPMARK;
@@ -2749,16 +2615,22 @@ PP(pp_entersub)
 		mg_get(sv);
 		if (SvROK(sv))
 		    goto got_rv;
-		sym = SvPOKp(sv) ? SvPVX_const(sv) : NULL;
+		if (SvPOKp(sv)) {
+		    sym = SvPVX_const(sv);
+		    len = SvCUR(sv);
+		} else {
+		    sym = NULL;
+		    len = 0;
+		}
 	    }
 	    else {
-		sym = SvPV_nolen_const(sv);
+		sym = SvPV_const(sv, len);
             }
 	    if (!sym)
 		DIE(aTHX_ PL_no_usym, "a subroutine");
 	    if (PL_op->op_private & HINT_STRICT_REFS)
 		DIE(aTHX_ PL_no_symref, sym, "a subroutine");
-	    cv = get_cv(sym, TRUE);
+	    cv = get_cvn_flags(sym, len, GV_ADD|SvUTF8(sv));
 	    break;
 	}
   got_rv:
@@ -2807,7 +2679,7 @@ try_autoload:
 	    else {
 		sub_name = sv_newmortal();
 		gv_efullname3(sub_name, gv, NULL);
-		DIE(aTHX_ "Undefined subroutine &%"SVf" called", (void*)sub_name);
+		DIE(aTHX_ "Undefined subroutine &%"SVf" called", SVfARG(sub_name));
 	    }
 	}
 	if (!cv)
@@ -2820,7 +2692,11 @@ try_autoload:
         if (CvASSERTION(cv) && PL_DBassertion)
 	    sv_setiv(PL_DBassertion, 1);
 	
-	cv = get_db_sub(&sv, cv);
+	 Perl_get_db_sub(aTHX_ &sv, cv);
+	 if (CvISXSUB(cv))
+	     PL_curcopdb = PL_curcop;
+	 cv = GvCV(PL_DBsub);
+
 	if (!cv || (!CvXSUB(cv) && !CvSTART(cv)))
 	    DIE(aTHX_ "No DB::sub routine defined");
     }
@@ -2891,7 +2767,7 @@ try_autoload:
 	    sub_crush_depth(cv);
 #if 0
 	DEBUG_S(PerlIO_printf(Perl_debug_log,
-			      "%p entersub returning %p\n", thr, CvSTART(cv)));
+			      "%p entersub returning %p\n", (void*)thr, (void*)CvSTART(cv)));
 #endif
 	RETURNOP(CvSTART(cv));
     }
@@ -2947,7 +2823,7 @@ Perl_sub_crush_depth(pTHX_ CV *cv)
 	SV* const tmpstr = sv_newmortal();
 	gv_efullname3(tmpstr, CvGV(cv), NULL);
 	Perl_warner(aTHX_ packWARN(WARN_RECURSION), "Deep recursion on subroutine \"%"SVf"\"",
-		    (void*)tmpstr);
+		    SVfARG(tmpstr));
     }
 }
 
@@ -2965,7 +2841,7 @@ PP(pp_aelem)
     if (SvROK(elemsv) && !SvGAMAGIC(elemsv) && ckWARN(WARN_MISC))
 	Perl_warner(aTHX_ packWARN(WARN_MISC),
 		    "Use of reference \"%"SVf"\" as array index",
-		    (void*)elemsv);
+		    SVfARG(elemsv));
     if (elem > 0)
 	elem -= CopARYBASE_get(PL_curcop);
     if (SvTYPE(av) != SVt_PVAV)
@@ -3117,7 +2993,7 @@ S_method_common(pTHX_ SV* meth, U32* hashp)
 				    : "on an undefined value");
 	    }
 	    /* assume it's a package name */
-	    stash = gv_stashpvn(packname, packlen, FALSE);
+	    stash = gv_stashpvn(packname, packlen, 0);
 	    if (!stash)
 		packsv = sv;
             else {
@@ -3209,7 +3085,7 @@ S_method_common(pTHX_ SV* meth, U32* hashp)
 	}
 	
 	/* we're relying on gv_fetchmethod not autovivifying the stash */
-	if (gv_stashpvn(packname, packlen, FALSE)) {
+	if (gv_stashpvn(packname, packlen, 0)) {
 	    Perl_croak(aTHX_
 		       "Can't locate object method \"%s\" via package \"%.*s\"",
 		       leaf, (int)packlen, packname);