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

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

p4raw-id: //depot/perl@9084

diff --git a/ext/re/re.xs b/ext/re/re.xs
index 25c2a90d60f1fe264b55e204a4fe55940aee164f..5ee333b335c1f6cbfae8e9a04521b57bbf9cc06d 100644 (file)
--- 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 4f7289fa67d14a1dd07ea204b5ef8c866c965e7d..fe0b66dd70a6ace7f01144aa70280e0491813c9c 100644 (file)
--- 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 aa0728396ea6f315327cf9d8208bdfcb7d258c5e..eb79dc469a5762254d0a7f1118a8cee60cdcf3e4 100644 (file)
--- 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 0920a41d3372d7918b87694422279e78c541c9e5..0c4d9072cde8b50d3044fa2fe4c0911d2435b734 100644 (file)
--- 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 4ee33cc4fa63a0432cb6451634b1779b718f9f74..66c6e4de967f296349284581a2b20bc7364f1990 100644 (file)
--- 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 2b5108fac1666131456cb5eabac4d1935ba65a4f..d00102ddf8190ca1d6c41bc92ac85cbf2c2f55b3 100644 (file)
--- 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 f9c5c5f60696e75fda419c735d6e9e4e79fb1346..bf98ac8079986b13ec96d9af88720165fa6f67f5 100644 (file)
--- 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 8466d45a8eaba94064b3d8d552d04c1f78648415..0dbab534a10ab88b9c0f3d8f9cd61bbedba51bb6 100644 (file)
--- 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 5d9e8ac8faff174781752dacbdcac6e2b083bbec..30f99070f44fe6c8f741e8c832c360a8769acb04 100644 (file)
--- 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 20b4f2a393c2f4627ea48a7a307c7a516dd995b2..0fff2066e17ec38c5fb3072d6e10c4de510dd64e 100644 (file)
--- 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 640780af83cbddbe5cce543a0576b18b04427f29..7fb0b47a09ceef41c66457986efedfcd24cb5b59 100644 (file)
--- 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;
                }