X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_hot.c;h=476fd805d09902166fa516878a280f9e7efe2391;hb=4dc4bba60f13ed8dad154870e750085525979ec1;hp=4f35993061a464e9a3508552a0e65a2e02588aea;hpb=a9ef256d686ebab6464dfd2ad06eb0aff1240f34;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp_hot.c b/pp_hot.c
index 4f35993..476fd80 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);
@@ -1523,7 +1523,7 @@ yup:					/* Confirmed by INTUIT */
 	    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);
@@ -1838,7 +1838,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);
@@ -2120,7 +2120,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;
@@ -2682,40 +2683,6 @@ PP(pp_leavesublv)
     return cx->blk_sub.retop;
 }
 
-
-STATIC void
-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  */
-    }
-}
-
 PP(pp_entersub)
 {
     dVAR; dSP; dPOPss;
@@ -2810,7 +2777,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)
@@ -2823,7 +2790,7 @@ try_autoload:
         if (CvASSERTION(cv) && PL_DBassertion)
 	    sv_setiv(PL_DBassertion, 1);
 	
-	 get_db_sub(&sv, cv);
+	 Perl_get_db_sub(aTHX_ &sv, cv);
 	 if (CvISXSUB(cv))
 	     PL_curcopdb = PL_curcop;
 	 cv = GvCV(PL_DBsub);
@@ -2898,7 +2865,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));
     }
@@ -2954,7 +2921,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));
     }
 }
 
@@ -2972,7 +2939,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)