From: Nicholas Clark <nick@ccl4.org>
Date: Fri, 1 Dec 2006 22:51:22 +0000 (+0000)
Subject: Make get_db_sub non-static, and call it from pp_goto, which allows the
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=005a8a35ce5b6191102f848d17a5c617740a685c;p=p5sagit%2Fp5-mst-13.2.git

Make get_db_sub non-static, and call it from pp_goto, which allows the
removal of duplicate code. (The conversion of GvSV(PL_DBsub) to
GvSVn(PL_DBsub) implicit in this change should fix a failure with
Devel::SmallProf.)

p4raw-id: //depot/perl@29434
---

diff --git a/embed.fnc b/embed.fnc
index eeff4c2..adcdb84 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -266,6 +266,7 @@ p	|OP*	|gen_constant_list|NULLOK OP* o
 #if !defined(HAS_GETENV_LEN)
 p	|char*	|getenv_len	|NN const char* key|NN unsigned long *len
 #endif
+pox	|void	|get_db_sub	|NULLOK SV **svp|NN CV *cv
 Ap	|void	|gp_free	|NULLOK GV* gv
 Ap	|GP*	|gp_ref		|NULLOK GP* gp
 Ap	|GV*	|gv_AVadd	|NN GV* gv
@@ -1277,7 +1278,6 @@ s	|OP*	|do_smartmatch	|NULLOK HV* seen_this|NULLOK HV* seen_other
 
 #if defined(PERL_IN_PP_HOT_C) || defined(PERL_DECL_PROT)
 s	|void	|do_oddball	|NN HV *hash|NN SV **relem|NN SV **firstrelem
-s	|void	|get_db_sub	|NN SV **svp|NN CV *cv
 sR	|SV*	|method_common	|NN SV* meth|NULLOK U32* hashp
 #endif
 
diff --git a/embed.h b/embed.h
index 618166f..8cc8bba 100644
--- a/embed.h
+++ b/embed.h
@@ -1274,7 +1274,6 @@
 #if defined(PERL_IN_PP_HOT_C) || defined(PERL_DECL_PROT)
 #ifdef PERL_CORE
 #define do_oddball		S_do_oddball
-#define get_db_sub		S_get_db_sub
 #define method_common		S_method_common
 #endif
 #endif
@@ -2458,6 +2457,8 @@
 #define getenv_len(a,b)		Perl_getenv_len(aTHX_ a,b)
 #endif
 #endif
+#ifdef PERL_CORE
+#endif
 #define gp_free(a)		Perl_gp_free(aTHX_ a)
 #define gp_ref(a)		Perl_gp_ref(aTHX_ a)
 #define gv_AVadd(a)		Perl_gv_AVadd(aTHX_ a)
@@ -3477,7 +3478,6 @@
 #if defined(PERL_IN_PP_HOT_C) || defined(PERL_DECL_PROT)
 #ifdef PERL_CORE
 #define do_oddball(a,b,c)	S_do_oddball(aTHX_ a,b,c)
-#define get_db_sub(a,b)		S_get_db_sub(aTHX_ a,b)
 #define method_common(a,b)	S_method_common(aTHX_ a,b)
 #endif
 #endif
diff --git a/pp_ctl.c b/pp_ctl.c
index 5cbf0a8..11554c9 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2475,21 +2475,7 @@ PP(pp_goto)
 		    }
 		}
 		if (PERLDB_SUB) {	/* Checking curstash breaks DProf. */
-		    /*
-		     * We do not care about using sv to call CV;
-		     * it's for informational purposes only.
-		     */
-		    SV * const sv = GvSV(PL_DBsub);
-		    save_item(sv);
-		    if (PERLDB_SUB_NN) {
-			const int type = SvTYPE(sv);
-			if (type < SVt_PVIV && type != SVt_IV)
-			    sv_upgrade(sv, SVt_PVIV);
-			(void)SvIOK_on(sv);
-			SvIV_set(sv, PTR2IV(cv)); /* Do it the quickest way */
-		    } else {
-			gv_efullname3(sv, CvGV(cv), NULL);
-		    }
+		    Perl_get_db_sub(aTHX_ NULL, cv);
 		    if (PERLDB_GOTO) {
 			CV * const gotocv = get_cv("DB::goto", FALSE);
 			if (gotocv) {
diff --git a/pp_hot.c b/pp_hot.c
index 4f35993..8c48576 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -2683,20 +2683,23 @@ PP(pp_leavesublv)
 }
 
 
-STATIC void
-S_get_db_sub(pTHX_ SV **svp, CV *cv)
+void
+Perl_get_db_sub(pTHX_ SV **svp, CV *cv)
 {
     dVAR;
     SV * const dbsv = GvSVn(PL_DBsub);
+    /* We do not care about using sv to call CV;
+     * it's for informational purposes only.
+     */
 
     save_item(dbsv);
     if (!PERLDB_SUB_NN) {
 	GV * const gv = CvGV(cv);
 
-	if ( (CvFLAGS(cv) & (CVf_ANON | CVf_CLONED))
+	if ( svp && ((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) ))) {
+		 !( (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);
@@ -2823,7 +2826,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);
diff --git a/proto.h b/proto.h
index 821f42c..06bef08 100644
--- a/proto.h
+++ b/proto.h
@@ -588,6 +588,9 @@ PERL_CALLCONV char*	Perl_getenv_len(pTHX_ const char* key, unsigned long *len)
 			__attribute__nonnull__(pTHX_2);
 
 #endif
+PERL_CALLCONV void	Perl_get_db_sub(pTHX_ SV **svp, CV *cv)
+			__attribute__nonnull__(pTHX_2);
+
 PERL_CALLCONV void	Perl_gp_free(pTHX_ GV* gv);
 PERL_CALLCONV GP*	Perl_gp_ref(pTHX_ GP* gp);
 PERL_CALLCONV GV*	Perl_gv_AVadd(pTHX_ GV* gv)
@@ -3465,10 +3468,6 @@ STATIC void	S_do_oddball(pTHX_ HV *hash, SV **relem, SV **firstrelem)
 			__attribute__nonnull__(pTHX_2)
 			__attribute__nonnull__(pTHX_3);
 
-STATIC void	S_get_db_sub(pTHX_ SV **svp, CV *cv)
-			__attribute__nonnull__(pTHX_1)
-			__attribute__nonnull__(pTHX_2);
-
 STATIC SV*	S_method_common(pTHX_ SV* meth, U32* hashp)
 			__attribute__warn_unused_result__
 			__attribute__nonnull__(pTHX_1);