Create a per-interpeter debug scratchpad container

and use that for the regexec debugging.

p4raw-id: //depot/perl@13110

diff --git a/embedvar.h b/embedvar.h
index 89c21e5..dfa0b33 100644 (file)
--- a/embedvar.h
+++ b/embedvar.h
@@ -223,6 +223,7 @@
 #define PL_dbargs              (PERL_GET_INTERP->Idbargs)
 #define PL_debstash            (PERL_GET_INTERP->Idebstash)
 #define PL_debug               (PERL_GET_INTERP->Idebug)
+#define PL_debug_pad           (PERL_GET_INTERP->Idebug_pad)
 #define PL_def_layerlist       (PERL_GET_INTERP->Idef_layerlist)
 #define PL_defgv               (PERL_GET_INTERP->Idefgv)
 #define PL_diehook             (PERL_GET_INTERP->Idiehook)
@@ -516,6 +517,7 @@
 #define PL_dbargs              (vTHX->Idbargs)
 #define PL_debstash            (vTHX->Idebstash)
 #define PL_debug               (vTHX->Idebug)
+#define PL_debug_pad           (vTHX->Idebug_pad)
 #define PL_def_layerlist       (vTHX->Idef_layerlist)
 #define PL_defgv               (vTHX->Idefgv)
 #define PL_diehook             (vTHX->Idiehook)
@@ -812,6 +814,7 @@
 #define PL_Idbargs             PL_dbargs
 #define PL_Idebstash           PL_debstash
 #define PL_Idebug              PL_debug
+#define PL_Idebug_pad          PL_debug_pad
 #define PL_Idef_layerlist      PL_def_layerlist
 #define PL_Idefgv              PL_defgv
 #define PL_Idiehook            PL_diehook

diff --git a/intrpvar.h b/intrpvar.h
index 2d47c8b..a8695f5 100644 (file)
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -502,6 +502,10 @@ PERLVARI(Idef_layerlist, PerlIO_list_t *,NULL)
 
 PERLVARI(Iencoding,    SV*, Nullsv)            /* character encoding */
 
+#ifdef DEBUGGING
+PERLVAR(Idebug_pad,    struct perl_debug_pad)
+#endif
+
 /* New variables must be added to the very end for binary compatibility.
  * XSUB.h provides wrapper functions via perlapi.h that make this
  * irrelevant, but not all code may be expected to #include XSUB.h. */

diff --git a/perl.c b/perl.c
index a8f6ceb..552d764 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -273,6 +273,12 @@ perl_construct(pTHXx)
     New(31337, PL_reentrant_buffer->tmbuff,1, struct tm);
 #endif
 
+#ifdef DEBUGGING
+    sv_setpvn(PERL_DEBUG_PAD(0), "", 0);
+    sv_setpvn(PERL_DEBUG_PAD(1), "", 0);
+    sv_setpvn(PERL_DEBUG_PAD(2), "", 0);
+#endif
+
     /* Note that strtab is a rather special HV.  Assumptions are made
        about not iterating on it, and not adding tie magic to it.
        It is properly deallocated in perl_destruct() */

diff --git a/perl.h b/perl.h
index e816534..e0250ae 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -3106,6 +3106,18 @@ enum {           /* pass one of these to get_vtbl */
 #define RsPARA(sv)    (SvPOK(sv) && ! SvCUR(sv))
 #define RsRECORD(sv)  (SvROK(sv) && (SvIV(SvRV(sv)) > 0))
 
+#ifdef DEBUGGING
+/* A struct for keeping various DEBUGGING related stuff
+ * neatly packed.  Currently only scratch variables for
+ * constructing debug output are included. */
+struct perl_debug_pad {
+  SV pad[3];
+};
+
+#define PERL_DEBUG_PAD(i)      &(PL_debug_pad.pad[i])
+#define PERL_DEBUG_PAD_ZERO(i) (sv_setpvn(PERL_DEBUG_PAD(i), "", 0), PERL_DEBUG_PAD(i))
+#endif
+
 /* Enable variables which are pointers to functions */
 typedef void (CPERLscope(*peep_t))(pTHX_ OP* o);
 typedef regexp*(CPERLscope(*regcomp_t)) (pTHX_ char* exp, char* xend, PMOP* pm);

diff --git a/perlapi.h b/perlapi.h
index f200326..dc32def 100644 (file)
--- a/perlapi.h
+++ b/perlapi.h
@@ -183,6 +183,8 @@ END_EXTERN_C
 #define PL_debstash            (*Perl_Idebstash_ptr(aTHX))
 #undef  PL_debug
 #define PL_debug               (*Perl_Idebug_ptr(aTHX))
+#undef  PL_debug_pad
+#define PL_debug_pad           (*Perl_Idebug_pad_ptr(aTHX))
 #undef  PL_def_layerlist
 #define PL_def_layerlist       (*Perl_Idef_layerlist_ptr(aTHX))
 #undef  PL_defgv

diff --git a/regexec.c b/regexec.c
index 8c3ff2e..d161c1b 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -390,7 +390,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
     char *check_at = Nullch;           /* check substr found at this pos */
 #ifdef DEBUGGING
     char *i_strpos = strpos;
-    SV *dsv = sv_2mortal(newSVpvn("", 0));
+    SV *dsv = PERL_DEBUG_PAD_ZERO(0);
 #endif
 
     DEBUG_r({
@@ -1465,7 +1465,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
     SV* oreplsv = GvSV(PL_replgv);
     bool do_utf8 = DO_UTF8(sv);
 #ifdef DEBUGGING
-    SV *dsv = sv_2mortal(newSVpvn("", 0));
+    SV *dsv = PERL_DEBUG_PAD_ZERO(0);
 #endif
 
     PL_regcc = 0;
@@ -2050,9 +2050,9 @@ S_regmatch(pTHX_ regnode *prog)
 #endif
     register bool do_utf8 = PL_reg_match_utf8;
 #ifdef DEBUGGING
-    SV *dsv0 = sv_2mortal(newSVpvn("", 0));
-    SV *dsv1 = sv_2mortal(newSVpvn("", 0));
-    SV *dsv2 = sv_2mortal(newSVpvn("", 0));
+    SV *dsv0 = PERL_DEBUG_PAD_ZERO(0);
+    SV *dsv1 = PERL_DEBUG_PAD_ZERO(1);
+    SV *dsv2 = PERL_DEBUG_PAD_ZERO(2);
 #endif
 
 #ifdef DEBUGGING