diff options
| -rw-r--r-- | ext/re/re.xs | 8 | ||||
| -rw-r--r-- | malloc.c | 2 | ||||
| -rw-r--r-- | mg.c | 6 | ||||
| -rw-r--r-- | perl.c | 2 | ||||
| -rw-r--r-- | perl.h | 163 | ||||
| -rw-r--r-- | perly.c | 2 | ||||
| -rw-r--r-- | perly.y | 2 | ||||
| -rw-r--r-- | pp_ctl.c | 3 | ||||
| -rw-r--r-- | regexec.c | 2 | ||||
| -rw-r--r-- | sv.c | 4 | ||||
| -rw-r--r-- | vms/perly_c.vms | 2 |
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 @@ -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 @@ -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 */ @@ -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, @@ -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 */ @@ -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; } @@ -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; } @@ -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; @@ -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... */ @@ -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; } |