From ce333219556f6d529f7e259feeb5cc99020a19a7 Mon Sep 17 00:00:00 2001
From: Jarkko Hietaniemi <jhi@iki.fi>
Date: Tue, 20 Nov 2001 00:39:02 +0000
Subject: [PATCH] Create a per-interpeter debug scratchpad container and use
 that for the regexec debugging.

p4raw-id: //depot/perl@13110
---
 embedvar.h |  3 +++
 intrpvar.h |  4 ++++
 perl.c     |  6 ++++++
 perl.h     | 12 ++++++++++++
 perlapi.h  |  2 ++
 regexec.c  | 10 +++++-----
 6 files changed, 32 insertions(+), 5 deletions(-)

diff --git a/embedvar.h b/embedvar.h
index 89c21e5..dfa0b33 100644
--- 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
--- 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
--- 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
--- 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
--- 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
--- 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
-- 
2.7.4