From: Nicholas Clark <nick@ccl4.org>
Date: Tue, 8 Jan 2008 17:10:29 +0000 (+0000)
Subject: In PL_regexp_padav, store regexps via real references, rather than
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=10599a699e18a26ba9c9154ce2c01e7cf53249ce;p=p5sagit%2Fp5-mst-13.2.git

In PL_regexp_padav, store regexps via real references, rather than
hiding them within IVs. We can do this now that they are real SV
pointers.

p4raw-id: //depot/perl@32900
---

diff --git a/op.h b/op.h
index adf5d1f..2bb042b 100644
--- a/op.h
+++ b/op.h
@@ -329,18 +329,26 @@ struct pmop {
 };
 
 #ifdef USE_ITHREADS
-#define PM_GETRE(o)     (INT2PTR(REGEXP*,SvIVX(PL_regex_pad[(o)->op_pmoffset])))
+#define PM_GETRE(o)     (SvROK(PL_regex_pad[(o)->op_pmoffset]) ? 	\
+			 (REGEXP*)SvRV(PL_regex_pad[(o)->op_pmoffset]) : NULL)
 /* The assignment is just to enforce type safety (or at least get a warning).
  */
 #define PM_SETRE(o,r)	STMT_START {					\
                             const REGEXP *const slosh = (r);		\
-                            PM_SETRE_OFFSET((o), PTR2IV(slosh));	\
+			    SV *const whap = PL_regex_pad[(o)->op_pmoffset]; \
+			    SvIOK_off(whap);				\
+			    SvROK_on(whap);				\
+			    SvRV_set(whap, (SV*)slosh);			\
                         } 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
 
diff --git a/perl.c b/perl.c
index 72735c2..e57356b 100644
--- a/perl.c
+++ b/perl.c
@@ -884,13 +884,11 @@ perl_destruct(pTHXx)
                  * flag is set in regexec.c:S_regtry
                  */
                 SvFLAGS(resv) &= ~SVf_BREAK;
+		/* So stop it pointing to what is now a dead reference.  */
+		SvROK_off(resv);
             }
 	    else if(SvREPADTMP(resv)) {
 	      SvREPADTMP_off(resv);
-	    }
-            else if(SvIOKp(resv)) {
-		REGEXP *re = INT2PTR(REGEXP *,SvIVX(resv));
-                ReREFCNT_dec(re);
             }
         }
     }
diff --git a/pp_hot.c b/pp_hot.c
index 7a71b6f..d391272 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1197,9 +1197,18 @@ PP(pp_qr)
     dVAR; dSP;
     register PMOP * const pm = cPMOP;
     REGEXP * rx = PM_GETRE(pm);
-    SV * const pkg = CALLREG_PACKAGE(rx);
+    SV * const pkg = rx ? CALLREG_PACKAGE(rx) : NULL;
     SV * const rv = sv_newmortal();
 
+    if (!rx) {
+	/* FIXME ORANGE.
+	   This can go if/when regexps are stored directly in PL_regex_pad
+	   rather than via references. do_clean_objs finds and frees them
+	   when they are stored as references.  */
+	XPUSHs(rv);
+	RETURN;
+    }
+
     SvUPGRADE(rv, SVt_IV);
     /* This RV is about to own a reference to the regexp. (In addition to the
        reference already owned by the PMOP.  */
diff --git a/sv.c b/sv.c
index f8e18a9..c2b1e1e 100644
--- a/sv.c
+++ b/sv.c
@@ -11268,15 +11268,9 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 			newSViv(PTR2IV(CALLREGDUPE(
 				INT2PTR(REGEXP *, SvIVX(regex)), param))))
 	    */
-	    /* And while we're at it, can we FIXME on the whole hiding 
-	       pointer inside an IV hack? */
-	    SV * const sv =
-		SvREPADTMP(regex)
-		    ? sv_dup_inc((SV*) regex, param)
-		    : newSViv(PTR2IV(sv_dup_inc(INT2PTR(SV *, SvIVX(regex)), param)))
-		;
+	    SV * const sv = sv_dup_inc((SV*) regex, param);
 	    if (SvFLAGS(regex) & SVf_BREAK)
-		SvFLAGS(sv) |= SVf_BREAK; /* unrefcnted PL_curpm */
+		assert(SvFLAGS(sv) & SVf_BREAK); /* unrefcnted PL_curpm */
 	    av_push(PL_regex_padav, sv);
 	}
     }