Fix Devel::DProf debugging aid

Message-ID: <Pine.LNX.4.44.0205142123270.24343-100000@localhost.localdomain>

p4raw-id: //depot/perl@16604

diff --git a/ext/Devel/DProf/DProf.xs b/ext/Devel/DProf/DProf.xs
index 2219bd2..3525a27 100644 (file)
--- a/ext/Devel/DProf/DProf.xs
+++ b/ext/Devel/DProf/DProf.xs
@@ -3,15 +3,32 @@
 #include "perl.h"
 #include "XSUB.h"
 
+/* define DBG_SUB to cause a warning on each subroutine entry. */
 /*#define DBG_SUB 1      */
-/*#define DBG_TIMER 1    */
+
+/* define DBG_TIMER to cause a warning when the timer is turned on and off. */
+/*#define DBG_TIMER 1  */
 
 #ifdef DBG_SUB
-#  define DBG_SUB_NOTIFY(A,B) warn(A, B)
+#  define DBG_SUB_NOTIFY(A) dprof_dbg_sub_notify(A)
+void
+dprof_dbg_sub_notify(SV *Sub) {
+    CV   *cv = INT2PTR(CV*,SvIVX(Sub));
+    GV   *gv = cv ? CvGV(cv) : NULL;
+    if (cv && gv) {
+       warn("XS DBsub(%s::%s)\n",
+            ((GvSTASH(gv) && HvNAME(GvSTASH(gv))) ?
+             HvNAME(GvSTASH(gv)) : "(null)"),
+            GvNAME(gv));
+    } else {
+       warn("XS DBsub(unknown) at %x", Sub);
+    }
+}
 #else
-#  define DBG_SUB_NOTIFY(A,B)  /* nothing */
+#  define DBG_SUB_NOTIFY(A)  /* nothing */
 #endif
 
+
 #ifdef DBG_TIMER
 #  define DBG_TIMER_NOTIFY(A) warn(A)
 #else
@@ -528,7 +545,7 @@ XS(XS_DB_sub)
     {
        HV *oldstash = PL_curstash;
 
-        DBG_SUB_NOTIFY("XS DBsub(%s)\n", SvPV_nolen(Sub));
+        DBG_SUB_NOTIFY(Sub);
 
        SAVEDESTRUCTOR_X(check_depth, INT2PTR(void*,g_depth));
        g_depth++;
@@ -568,7 +585,7 @@ XS(XS_DB_goto)
                 HV *oldstash = PL_curstash;
                SV *Sub = GvSV(PL_DBsub);       /* name of current sub */
                 /* SP -= items;  added by xsubpp */
-                DBG_SUB_NOTIFY("XS DBsub(%s)\n", SvPV_nolen(Sub));
+                DBG_SUB_NOTIFY(Sub);
 
                 sv_setiv(PL_DBsingle, 0);      /* disable DB single-stepping */