From: Sam Tregar <sam@tregar.com>
Date: Tue, 14 May 2002 21:27:05 +0000 (-0400)
Subject: Fix Devel::DProf debugging aid
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=94277a97d1af7b30ea50c37ce6ad0b82c608bd96;p=p5sagit%2Fp5-mst-13.2.git

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
--- 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 */