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

diff --git a/op.c b/op.c
index 9410bf0..3903f53 100644 (file)
--- 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 2bb042b..dc36c01 100644 (file)
--- 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 564e437..d502720 100644 (file)
--- 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 3a7d461..e64846f 100644 (file)
--- 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);