From: Nicholas Clark <nick@ccl4.org>
Date: Fri, 11 Jan 2008 12:14:04 +0000 (+0000)
Subject: REGEXPs are now stored directly in PL_regex_padav, rather than
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=14a49a2428492a7a120f0254ff8085e99252f641;p=p5sagit%2Fp5-mst-13.2.git

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
--- 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
--- 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
--- 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
--- 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);