Skip to content

Commit

Permalink
Create a per-interpeter debug scratchpad container
Browse files Browse the repository at this point in the history
and use that for the regexec debugging.

p4raw-id: //depot/perl@13110
  • Loading branch information
jhi committed Nov 20, 2001
1 parent 86989e5 commit ce33321
Show file tree
Hide file tree
Showing 6 changed files with 32 additions and 5 deletions.
3 changes: 3 additions & 0 deletions embedvar.h
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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
Expand Down
4 changes: 4 additions & 0 deletions intrpvar.h
Original file line number Diff line number Diff line change
Expand Up @@ -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. */
Expand Down
6 changes: 6 additions & 0 deletions perl.c
Original file line number Diff line number Diff line change
Expand Up @@ -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() */
Expand Down
12 changes: 12 additions & 0 deletions perl.h
Original file line number Diff line number Diff line change
Expand Up @@ -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);
Expand Down
2 changes: 2 additions & 0 deletions perlapi.h
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
10 changes: 5 additions & 5 deletions regexec.c
Original file line number Diff line number Diff line change
Expand Up @@ -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({
Expand Down Expand Up @@ -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;
Expand Down Expand Up @@ -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
Expand Down

0 comments on commit ce33321

Please sign in to comment.