From 14a49a2428492a7a120f0254ff8085e99252f641 Mon Sep 17 00:00:00 2001 From: Nicholas Clark Date: Fri, 11 Jan 2008 12:14:04 +0000 Subject: REGEXPs are now stored directly in PL_regex_padav, rather than indirectly via RVs. This saves memory, and removes 1 level of pointer indirection. p4raw-id: //depot/perl@32950 --- op.c | 13 +++++-------- op.h | 30 +++++++++++------------------- pp_ctl.c | 5 +++++ regexec.c | 2 +- 4 files changed, 22 insertions(+), 28 deletions(-) diff --git a/op.c b/op.c index 9410bf0d37..3903f53bb1 100644 --- a/op.c +++ b/op.c @@ -624,10 +624,8 @@ clear_pmop: #ifdef USE_ITHREADS if(PL_regex_pad) { /* We could be in destruction */ ReREFCNT_dec(PM_GETRE(cPMOPo)); - av_push((AV*) PL_regex_pad[0], - (SV*) SvREFCNT_inc_simple_NN(PL_regex_pad[(cPMOPo)->op_pmoffset])); - SvREADONLY_off(PL_regex_pad[(cPMOPo)->op_pmoffset]); - PM_SETRE_OFFSET(cPMOPo, (cPMOPo)->op_pmoffset); + av_push((AV*) PL_regex_pad[0], newSViv((cPMOPo)->op_pmoffset)); + PL_regex_pad[(cPMOPo)->op_pmoffset] = &PL_sv_undef; } #else ReREFCNT_dec(PM_GETRE(cPMOPo)); @@ -3370,12 +3368,11 @@ Perl_newPMOP(pTHX_ I32 type, I32 flags) SV * const repointer = av_pop((AV*)PL_regex_pad[0]); const IV offset = SvIV(repointer); pmop->op_pmoffset = offset; - SvOK_off(repointer); - assert(repointer == PL_regex_pad[offset]); - /* One reference remains, in PL_regex_pad[offset] */ + /* This slot should be free, so assert this: */ + assert(PL_regex_pad[offset] == &PL_sv_undef); SvREFCNT_dec(repointer); } else { - SV * const repointer = newSViv(0); + SV * const repointer = &PL_sv_undef; av_push(PL_regex_padav, repointer); pmop->op_pmoffset = av_len(PL_regex_padav); PL_regex_pad = AvARRAY(PL_regex_padav); diff --git a/op.h b/op.h index 2bb042bfa0..dc36c01806 100644 --- a/op.h +++ b/op.h @@ -329,29 +329,21 @@ struct pmop { }; #ifdef USE_ITHREADS -#define PM_GETRE(o) (SvROK(PL_regex_pad[(o)->op_pmoffset]) ? \ - (REGEXP*)SvRV(PL_regex_pad[(o)->op_pmoffset]) : NULL) +#define PM_GETRE(o) (SvTYPE(PL_regex_pad[(o)->op_pmoffset]) == SVt_REGEXP \ + ? (REGEXP*)(PL_regex_pad[(o)->op_pmoffset]) : NULL) /* The assignment is just to enforce type safety (or at least get a warning). */ +/* With first class regexps not via a reference one needs to assign + &PL_sv_undef under ithreads. (This would probably work unthreaded, but NULL + is cheaper. I guess we could allow NULL, but the check above would get + more complex, and we'd have an AV with (SV*)NULL in it, which feels bad */ +/* BEWARE - something that calls this macro passes (r) which has a side + effect. */ #define PM_SETRE(o,r) STMT_START { \ - const REGEXP *const slosh = (r); \ - SV *const whap = PL_regex_pad[(o)->op_pmoffset]; \ - SvIOK_off(whap); \ - SvROK_on(whap); \ - SvRV_set(whap, (SV*)slosh); \ + const REGEXP *const whap = (r); \ + assert(whap); \ + PL_regex_pad[(o)->op_pmoffset] = (SV*)whap; \ } STMT_END -/* Actually you can assign any IV, not just an offset. And really should it be - UV? */ -/* Need to turn the SvOK off as the regexp code is quite carefully manually - reference counting the thing pointed to, so don't want sv_setiv also - deciding to clear a reference count because it sees an SV. */ -#define PM_SETRE_OFFSET(o,iv) \ - STMT_START { \ - SV* const sv = PL_regex_pad[(o)->op_pmoffset]; \ - SvROK_off(sv); \ - sv_setiv(sv, (iv)); \ - } STMT_END - # ifndef PERL_CORE /* No longer used anywhere in the core. Migrate to Devel::PPPort? */ #define PM_GETRE_SAFE(o) (PL_regex_pad ? PM_GETRE(o) : (REGEXP*)0) diff --git a/pp_ctl.c b/pp_ctl.c index 564e437cb5..d5027204d4 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -128,6 +128,7 @@ PP(pp_regcomp) STRLEN len; const char *t = SvOK(tmpstr) ? SvPV_const(tmpstr, len) : ""; re = PM_GETRE(pm); + assert (re != (REGEXP*) &PL_sv_undef); /* Check against the last compiled regexp. */ if (!re || !RX_PRECOMP(re) || RX_PRELEN(re) != len || @@ -137,7 +138,11 @@ PP(pp_regcomp) U32 pm_flags = pm->op_pmflags & PMf_COMPILETIME; if (re) { ReREFCNT_dec(re); +#ifdef USE_ITHREADS + PM_SETRE(pm, (REGEXP*) &PL_sv_undef); +#else PM_SETRE(pm, NULL); /* crucial if regcomp aborts */ +#endif } else if (PL_curcop->cop_hints_hash) { SV *ptr = Perl_refcounted_he_fetch(aTHX_ PL_curcop->cop_hints_hash, 0, "regcomp", 7, 0, 0); diff --git a/regexec.c b/regexec.c index 3a7d461d28..e64846fdd0 100644 --- a/regexec.c +++ b/regexec.c @@ -2255,7 +2255,7 @@ S_regtry(pTHX_ regmatch_info *reginfo, char **startpos) Newxz(PL_reg_curpm, 1, PMOP); #ifdef USE_ITHREADS { - SV* const repointer = newSViv(0); + SV* const repointer = &PL_sv_undef; /* this regexp is also owned by the new PL_reg_curpm, which will try to free it. */ av_push(PL_regex_padav, repointer); -- cgit v1.2.1