Re: [ PATCH perl@8956 ] new debug option -DR shows ref counts

Message-Id: <200103081206.MAA06281@tiree.fdgroup.co.uk>

p4raw-id: //depot/perl@9084

11 files changed, 134 insertions, 62 deletions

diff --git a/ext/re/re.xs b/ext/re/re.xs
index 25c2a90d60..5ee333b335 100644
--- a/ext/re/re.xs
+++ b/ext/re/re.xs
@@ -20,8 +20,6 @@ extern SV*	my_re_intuit_string (pTHX_ regexp *prog);
 
 static int oldfl;
 
-#define R_DB 512
-
 static void
 deinstall(pTHX)
 {
@@ -32,7 +30,7 @@ deinstall(pTHX)
     PL_regfree = Perl_pregfree;
 
     if (!oldfl)
-	PL_debug &= ~R_DB;
+	PL_debug &= ~DEBUG_r_FLAG;
 }
 
 static void
@@ -44,8 +42,8 @@ install(pTHX)
     PL_regint_start = &my_re_intuit_start;
     PL_regint_string = &my_re_intuit_string;
     PL_regfree = &my_regfree;
-    oldfl = PL_debug & R_DB;
-    PL_debug |= R_DB;
+    oldfl = PL_debug & DEBUG_r_FLAG;
+    PL_debug |= ~DEBUG_r_FLAG;
 }
 
 MODULE = re	PACKAGE = re
diff --git a/malloc.c b/malloc.c
index 4f7289fa67..fe0b66dd70 100644
--- a/malloc.c
+++ b/malloc.c
@@ -351,7 +351,7 @@
 #  undef DEBUG_m
 #  define DEBUG_m(a)  \
     STMT_START {							\
-	if (PERL_GET_INTERP) { dTHX; if (PL_debug & 128) { a; } }	\
+	if (PERL_GET_INTERP) { dTHX; if (DEBUG_m_TEST) { a; } }	\
     } STMT_END
 #endif
 
diff --git a/mg.c b/mg.c
index aa0728396e..eb79dc469a 100644
--- a/mg.c
+++ b/mg.c
@@ -479,9 +479,9 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 	break;
 
     case '\004':		/* ^D */
-	sv_setiv(sv, (IV)(PL_debug & 32767));
+	sv_setiv(sv, (IV)(PL_debug & DEBUG_MASK));
 #if defined(YYDEBUG) && defined(DEBUGGING)
-	PL_yydebug = (PL_debug & 1);
+	PL_yydebug = DEBUG_p_TEST;
 #endif
 	break;
     case '\005':  /* ^E */
@@ -1711,7 +1711,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 	break;
 
     case '\004':	/* ^D */
-	PL_debug = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) | 0x80000000;
+	PL_debug = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) | DEBUG_TOP_FLAG;
 	DEBUG_x(dump_all());
 	break;
     case '\005':  /* ^E */
diff --git a/perl.c b/perl.c
index 0920a41d33..0c4d9072cd 100644
--- a/perl.c
+++ b/perl.c
@@ -2136,7 +2136,7 @@ Perl_moreswitches(pTHX_ char *s)
 	    PL_debug = atoi(s+1);
 	    for (s++; isDIGIT(*s); s++) ;
 	}
-	PL_debug |= 0x80000000;
+	PL_debug |= DEBUG_TOP_FLAG;
 #else
 	if (ckWARN_d(WARN_DEBUGGING))
 	    Perl_warner(aTHX_ WARN_DEBUGGING,
diff --git a/perl.h b/perl.h
index 4ee33cc4fa..66c6e4de96 100644
--- a/perl.h
+++ b/perl.h
@@ -2131,64 +2131,137 @@ Gid_t getegid (void);
 				 : PerlIO_stderr())
 #endif
 
+
+#define DEBUG_p_FLAG		0x00000001 /*      1 */
+#define DEBUG_s_FLAG		0x00000002 /*      2 */
+#define DEBUG_l_FLAG		0x00000004 /*      4 */
+#define DEBUG_t_FLAG		0x00000008 /*      8 */
+#define DEBUG_o_FLAG		0x00000010 /*     16 */
+#define DEBUG_c_FLAG		0x00000020 /*     32 */
+#define DEBUG_P_FLAG		0x00000040 /*     64 */
+#define DEBUG_m_FLAG		0x00000080 /*    128 */
+#define DEBUG_f_FLAG		0x00000100 /*    256 */
+#define DEBUG_r_FLAG		0x00000200 /*    512 */
+#define DEBUG_x_FLAG		0x00000400 /*   1024 */
+#define DEBUG_u_FLAG		0x00000800 /*   2048 */
+#define DEBUG_L_FLAG		0x00001000 /*   4096 */
+#define DEBUG_H_FLAG		0x00002000 /*   8192 */
+#define DEBUG_X_FLAG		0x00004000 /*  16384 */
+#define DEBUG_D_FLAG		0x00008000 /*  32768 */
+#define DEBUG_S_FLAG		0x00010000 /*  65536 */
+#define DEBUG_T_FLAG		0x00020000 /* 131072 */
+#define DEBUG_MASK		0x0003FFFF /* mask of all the standard flags */
+
+#define DEBUG_DB_RECURSE_FLAG	0x40000000
+#define DEBUG_TOP_FLAG		0x80000000 /* XXX what's this for ??? */
+
+
 #ifdef DEBUGGING
-#undef  YYDEBUG
-#define YYDEBUG 1
-#define DEB(a)     			a
-#define DEBUG(a)   if (PL_debug)		a
-#define DEBUG_p(a) if (PL_debug & 1)	a
-#define DEBUG_s(a) if (PL_debug & 2)	a
-#define DEBUG_l(a) if (PL_debug & 4)	a
-#define DEBUG_t(a) if (PL_debug & 8)	a
-#define DEBUG_o(a) if (PL_debug & 16)	a
-#define DEBUG_c(a) if (PL_debug & 32)	a
-#define DEBUG_P(a) if (PL_debug & 64)	a
+
+#  undef  YYDEBUG
+#  define YYDEBUG 1
+
+#  define DEBUG_p_TEST (PL_debug & DEBUG_p_FLAG)
+#  define DEBUG_s_TEST (PL_debug & DEBUG_s_FLAG)
+#  define DEBUG_l_TEST (PL_debug & DEBUG_l_FLAG)
+#  define DEBUG_t_TEST (PL_debug & DEBUG_t_FLAG)
+#  define DEBUG_o_TEST (PL_debug & DEBUG_o_FLAG)
+#  define DEBUG_c_TEST (PL_debug & DEBUG_c_FLAG)
+#  define DEBUG_P_TEST (PL_debug & DEBUG_P_FLAG)
+#  define DEBUG_m_TEST (PL_debug & DEBUG_m_FLAG)
+#  define DEBUG_f_TEST (PL_debug & DEBUG_f_FLAG)
+#  define DEBUG_r_TEST (PL_debug & DEBUG_r_FLAG)
+#  define DEBUG_x_TEST (PL_debug & DEBUG_x_FLAG)
+#  define DEBUG_u_TEST (PL_debug & DEBUG_u_FLAG)
+#  define DEBUG_L_TEST (PL_debug & DEBUG_L_FLAG)
+#  define DEBUG_H_TEST (PL_debug & DEBUG_H_FLAG)
+#  define DEBUG_X_TEST (PL_debug & DEBUG_X_FLAG)
+#  define DEBUG_D_TEST (PL_debug & DEBUG_D_FLAG)
+#  define DEBUG_S_TEST (PL_debug & DEBUG_S_FLAG)
+#  define DEBUG_T_TEST (PL_debug & DEBUG_T_FLAG)
+
+#  define DEB(a)     a
+#  define DEBUG(a)   if (PL_debug)   a
+#  define DEBUG_p(a) if (DEBUG_p_TEST) a
+#  define DEBUG_s(a) if (DEBUG_s_TEST) a
+#  define DEBUG_l(a) if (DEBUG_l_TEST) a
+#  define DEBUG_t(a) if (DEBUG_t_TEST) a
+#  define DEBUG_o(a) if (DEBUG_o_TEST) a
+#  define DEBUG_c(a) if (DEBUG_c_TEST) a
+#  define DEBUG_P(a) if (DEBUG_P_TEST) a
+
 #  if defined(PERL_OBJECT)
-#    define DEBUG_m(a) if (PL_debug & 128)	a
+#    define DEBUG_m(a) if (DEBUG_m_TEST) a
 #  else
      /* Temporarily turn off memory debugging in case the a
       * does memory allocation, either directly or indirectly. */
 #    define DEBUG_m(a)  \
     STMT_START {							\
-        if (PERL_GET_INTERP) { dTHX; if (PL_debug & 128) {PL_debug&=~128; a; PL_debug|=128;} } \
+        if (PERL_GET_INTERP) { dTHX; if (DEBUG_m_TEST) {PL_debug&=~DEBUG_m_FLAG; a; PL_debug|=DEBUG_m_FLAG;} } \
     } STMT_END
 #  endif
-#define DEBUG_f(a) if (PL_debug & 256)	a
-#define DEBUG_r(a) if (PL_debug & 512)	a
-#define DEBUG_x(a) if (PL_debug & 1024)	a
-#define DEBUG_u(a) if (PL_debug & 2048)	a
-#define DEBUG_L(a) if (PL_debug & 4096)	a
-#define DEBUG_H(a) if (PL_debug & 8192)	a
-#define DEBUG_X(a) if (PL_debug & 16384)	a
-#define DEBUG_D(a) if (PL_debug & 32768)	a
+
+#  define DEBUG_f(a) if (DEBUG_f_TEST) a
+#  define DEBUG_r(a) if (DEBUG_r_TEST) a
+#  define DEBUG_x(a) if (DEBUG_x_TEST) a
+#  define DEBUG_u(a) if (DEBUG_u_TEST) a
+#  define DEBUG_L(a) if (DEBUG_L_TEST) a
+#  define DEBUG_H(a) if (DEBUG_H_TEST) a
+#  define DEBUG_X(a) if (DEBUG_X_TEST) a
+#  define DEBUG_D(a) if (DEBUG_D_TEST) a
+
 #  ifdef USE_THREADS
-#    define DEBUG_S(a) if (PL_debug & (1<<16))	a
+#    define DEBUG_S(a) if (DEBUG_S_TEST) a
 #  else
 #    define DEBUG_S(a)
 #  endif
-#define DEBUG_T(a) if (PL_debug & (1<<17))	a
-#else
-#define DEB(a)
-#define DEBUG(a)
-#define DEBUG_p(a)
-#define DEBUG_s(a)
-#define DEBUG_l(a)
-#define DEBUG_t(a)
-#define DEBUG_o(a)
-#define DEBUG_c(a)
-#define DEBUG_P(a)
-#define DEBUG_m(a)
-#define DEBUG_f(a)
-#define DEBUG_r(a)
-#define DEBUG_x(a)
-#define DEBUG_u(a)
-#define DEBUG_S(a)
-#define DEBUG_H(a)
-#define DEBUG_X(a)
-#define DEBUG_D(a)
-#define DEBUG_S(a)
-#define DEBUG_T(a)
-#endif
+
+#  define DEBUG_T(a) if (DEBUG_T_TEST) a
+
+#else /* DEBUGGING */
+
+#  define DEBUG_p_TEST (0)
+#  define DEBUG_s_TEST (0)
+#  define DEBUG_l_TEST (0)
+#  define DEBUG_t_TEST (0)
+#  define DEBUG_o_TEST (0)
+#  define DEBUG_c_TEST (0)
+#  define DEBUG_P_TEST (0)
+#  define DEBUG_m_TEST (0)
+#  define DEBUG_f_TEST (0)
+#  define DEBUG_r_TEST (0)
+#  define DEBUG_x_TEST (0)
+#  define DEBUG_u_TEST (0)
+#  define DEBUG_L_TEST (0)
+#  define DEBUG_H_TEST (0)
+#  define DEBUG_X_TEST (0)
+#  define DEBUG_D_TEST (0)
+#  define DEBUG_S_TEST (0)
+#  define DEBUG_T_TEST (0)
+
+#  define DEB(a)
+#  define DEBUG(a)
+#  define DEBUG_p(a)
+#  define DEBUG_s(a)
+#  define DEBUG_l(a)
+#  define DEBUG_t(a)
+#  define DEBUG_o(a)
+#  define DEBUG_c(a)
+#  define DEBUG_P(a)
+#  define DEBUG_m(a)
+#  define DEBUG_f(a)
+#  define DEBUG_r(a)
+#  define DEBUG_x(a)
+#  define DEBUG_u(a)
+#  define DEBUG_L(a)
+#  define DEBUG_H(a)
+#  define DEBUG_X(a)
+#  define DEBUG_D(a)
+#  define DEBUG_S(a)
+#  define DEBUG_T(a)
+#endif /* DEBUGGING */
+
+
 #define YYMAXDEPTH 300
 
 #ifndef assert  /* <assert.h> might have been included somehow */
diff --git a/perly.c b/perly.c
index 2b5108fac1..d00102ddf8 100644
--- a/perly.c
+++ b/perly.c
@@ -1566,7 +1566,7 @@ case 1:
 #line 125 "perly.y"
 {
 #if defined(YYDEBUG) && defined(DEBUGGING)
-		    yydebug = (PL_debug & 1);
+		    yydebug = (DEBUG_p_TEST);
 #endif
 		    PL_expect = XSTATE;
 		}
diff --git a/perly.y b/perly.y
index f9c5c5f606..bf98ac8079 100644
--- a/perly.y
+++ b/perly.y
@@ -125,7 +125,7 @@ static void yydestruct(pTHXo_ void *ptr);
 prog	:	/* NULL */
 		{
 #if defined(YYDEBUG) && defined(DEBUGGING)
-		    yydebug = (PL_debug & 1);
+		    yydebug = (DEBUG_p_TEST);
 #endif
 		    PL_expect = XSTATE;
 		}
diff --git a/pp_ctl.c b/pp_ctl.c
index 8466d45a8e..0dbab534a1 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1743,7 +1743,8 @@ PP(pp_dbstate)
 	if (!cv)
 	    DIE(aTHX_ "No DB::DB routine defined");
 
-	if (CvDEPTH(cv) >= 1 && !(PL_debug & (1<<30))) /* don't do recursive DB::DB call */
+	if (CvDEPTH(cv) >= 1 && !(PL_debug & DEBUG_DB_RECURSE_FLAG))
+	    /* don't do recursive DB::DB call */
 	    return NORMAL;
 
 	ENTER;
diff --git a/regexec.c b/regexec.c
index 5d9e8ac8fa..30f99070f4 100644
--- a/regexec.c
+++ b/regexec.c
@@ -1401,7 +1401,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
 
     cache_re(prog);
 #ifdef DEBUGGING
-    PL_regnarrate = PL_debug & 512;
+    PL_regnarrate = DEBUG_r_TEST;
 #endif
 
     /* Be paranoid... */
diff --git a/sv.c b/sv.c
index 20b4f2a393..0fff2066e1 100644
--- a/sv.c
+++ b/sv.c
@@ -63,7 +63,7 @@ static void do_clean_all(pTHXo_ SV *sv);
 #define del_SV(p) \
     STMT_START {					\
 	LOCK_SV_MUTEX;					\
-	if (PL_debug & 32768)				\
+	if (DEBUG_D_TEST)				\
 	    del_sv(p);					\
 	else						\
 	    plant_SV(p);				\
@@ -73,7 +73,7 @@ static void do_clean_all(pTHXo_ SV *sv);
 STATIC void
 S_del_sv(pTHX_ SV *p)
 {
-    if (PL_debug & 32768) {
+    if (DEBUG_D_TEST) {
 	SV* sva;
 	SV* sv;
 	SV* svend;
diff --git a/vms/perly_c.vms b/vms/perly_c.vms
index 640780af83..7fb0b47a09 100644
--- a/vms/perly_c.vms
+++ b/vms/perly_c.vms
@@ -1568,7 +1568,7 @@ case 1:
 #line 125 "perly.y"
 {
 #if defined(YYDEBUG) && defined(DEBUGGING)
-		    yydebug = (PL_debug & 1);
+		    yydebug = (DEBUG_p_TEST);
 #endif
 		    PL_expect = XSTATE;
 		}