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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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);