Threadsafe PMOPs! We might still win this war.

Message-ID: <000b01c10a04$4fa16a10$21000a0a@vogw2kdev>

Threadsafe PMOPs for ithreads, waiting for AMS's Perl_re_dup().

p4raw-id: //depot/perl@11274

8 files changed, 86 insertions, 36 deletions

diff --git a/embedvar.h b/embedvar.h
index 82c965f09f..80b2e3e9db 100644
--- a/embedvar.h
+++ b/embedvar.h
@@ -360,6 +360,8 @@
 #define PL_psig_pend		(PERL_GET_INTERP->Ipsig_pend)
 #define PL_psig_ptr		(PERL_GET_INTERP->Ipsig_ptr)
 #define PL_ptr_table		(PERL_GET_INTERP->Iptr_table)
+#define PL_regex_pad		(PERL_GET_INTERP->Iregex_pad)
+#define PL_regex_padav		(PERL_GET_INTERP->Iregex_padav)
 #define PL_replgv		(PERL_GET_INTERP->Ireplgv)
 #define PL_rsfp			(PERL_GET_INTERP->Irsfp)
 #define PL_rsfp_filters		(PERL_GET_INTERP->Irsfp_filters)
@@ -642,6 +644,8 @@
 #define PL_psig_pend		(vTHX->Ipsig_pend)
 #define PL_psig_ptr		(vTHX->Ipsig_ptr)
 #define PL_ptr_table		(vTHX->Iptr_table)
+#define PL_regex_pad		(vTHX->Iregex_pad)
+#define PL_regex_padav		(vTHX->Iregex_padav)
 #define PL_replgv		(vTHX->Ireplgv)
 #define PL_rsfp			(vTHX->Irsfp)
 #define PL_rsfp_filters		(vTHX->Irsfp_filters)
@@ -1061,6 +1065,8 @@
 #define PL_psig_pend		(aTHXo->interp.Ipsig_pend)
 #define PL_psig_ptr		(aTHXo->interp.Ipsig_ptr)
 #define PL_ptr_table		(aTHXo->interp.Iptr_table)
+#define PL_regex_pad		(aTHXo->interp.Iregex_pad)
+#define PL_regex_padav		(aTHXo->interp.Iregex_padav)
 #define PL_replgv		(aTHXo->interp.Ireplgv)
 #define PL_rsfp			(aTHXo->interp.Irsfp)
 #define PL_rsfp_filters		(aTHXo->interp.Irsfp_filters)
@@ -1344,6 +1350,8 @@
 #define PL_Ipsig_pend		PL_psig_pend
 #define PL_Ipsig_ptr		PL_psig_ptr
 #define PL_Iptr_table		PL_ptr_table
+#define PL_Iregex_pad		PL_regex_pad
+#define PL_Iregex_padav		PL_regex_padav
 #define PL_Ireplgv		PL_replgv
 #define PL_Irsfp		PL_rsfp
 #define PL_Irsfp_filters	PL_rsfp_filters
diff --git a/intrpvar.h b/intrpvar.h
index 2e21f92e5f..6447b272c4 100644
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -475,6 +475,11 @@ PERLVAR(Inumeric_radix_sv,	SV *)	/* The radix separator if not '.' */
 
 #endif
 
+#if defined(USE_ITHREADS)
+PERLVAR(Iregex_pad,     SV**)    /* All regex objects */
+PERLVAR(Iregex_padav,   AV*)    /* All regex objects */
+#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. */
diff --git a/op.c b/op.c
index eba79ef16f..c7c53e436f 100644
--- a/op.c
+++ b/op.c
@@ -2952,7 +2952,16 @@ Perl_newPMOP(pTHX_ I32 type, I32 flags)
 	pmop->op_pmpermflags |= PMf_LOCALE;
     pmop->op_pmflags = pmop->op_pmpermflags;
 
-    /* link into pm list */
+ #ifdef USE_ITHREADS
+        {
+                SV* repointer = newSViv(0);
+                av_push(PL_regex_padav,repointer);
+                pmop->op_pmoffset = av_len(PL_regex_padav);
+                PL_regex_pad = AvARRAY(PL_regex_padav);
+        }
+ #endif
+        
+        /* link into pm list */
     if (type != OP_TRANS && PL_curstash) {
 	pmop->op_pmnext = HvPMROOT(PL_curstash);
 	HvPMROOT(PL_curstash) = pmop;
diff --git a/op.h b/op.h
index 05e45800af..352d358f5d 100644
--- a/op.h
+++ b/op.h
@@ -235,7 +235,11 @@ struct pmop {
     OP *	op_pmreplroot;
     OP *	op_pmreplstart;
     PMOP *	op_pmnext;		/* list of all scanpats */
-    REGEXP *	op_pmregexp;		/* compiled expression */
+#ifdef USE_ITHREADS
+    I32         op_pmoffset;
+#else
+    REGEXP *    op_pmregexp;            /* compiled expression */
+#endif
     U16		op_pmflags;
     U16		op_pmpermflags;
     U8		op_pmdynflags;
@@ -246,8 +250,13 @@ struct pmop {
 #endif
 };
 
+#ifdef USE_ITHREADS
+#define PM_GETRE(o)     ((REGEXP*)SvIV(PL_regex_pad[(o)->op_pmoffset]))
+#define PM_SETRE(o,r)   (sv_setiv(PL_regex_pad[(o)->op_pmoffset], (IV)r))
+#else
 #define PM_GETRE(o)     ((o)->op_pmregexp)
 #define PM_SETRE(o,r)   ((o)->op_pmregexp = (r))
+#endif
 
 #define PMdf_USED	0x01		/* pm has been used once already */
 #define PMdf_TAINTED	0x02		/* pm compiled from tainted pattern */
diff --git a/perl.c b/perl.c
index cef5c4783a..90d7134e3a 100644
--- a/perl.c
+++ b/perl.c
@@ -312,7 +312,9 @@ perl_construct(pTHXx)
     PL_fdpid = newAV();			/* for remembering popen pids by fd */
     PL_modglobal = newHV();		/* pointers to per-interpreter module globals */
     PL_errors = newSVpvn("",0);
-
+#ifdef USE_ITHREADS
+        PL_regex_padav = newAV();
+#endif
     ENTER;
 }
 
diff --git a/perlapi.h b/perlapi.h
index 7a8dcec618..36e297c16f 100644
--- a/perlapi.h
+++ b/perlapi.h
@@ -458,6 +458,10 @@ START_EXTERN_C
 #define PL_psig_ptr		(*Perl_Ipsig_ptr_ptr(aTHXo))
 #undef  PL_ptr_table
 #define PL_ptr_table		(*Perl_Iptr_table_ptr(aTHXo))
+#undef  PL_regex_pad
+#define PL_regex_pad		(*Perl_Iregex_pad_ptr(aTHXo))
+#undef  PL_regex_padav
+#define PL_regex_padav		(*Perl_Iregex_padav_ptr(aTHXo))
 #undef  PL_replgv
 #define PL_replgv		(*Perl_Ireplgv_ptr(aTHXo))
 #undef  PL_rsfp
diff --git a/pod/perlapi.pod b/pod/perlapi.pod
index bee65f60fa..4872a9fbc3 100644
--- a/pod/perlapi.pod
+++ b/pod/perlapi.pod
@@ -1344,6 +1344,17 @@ SV is B<not> incremented.
 =for hackers
 Found in file sv.c
 
+=item newSV
+
+Create a new null SV, or if len > 0, create a new empty SVt_PV type SV
+with an initial PV allocation of len+1. Normally accessed via the C<NEWSV>
+macro.
+
+	SV*	newSV(STRLEN len)
+
+=for hackers
+Found in file sv.c
+
 =item NEWSV
 
 Creates a new SV.  A non-zero C<len> parameter indicates the number of
@@ -1357,17 +1368,6 @@ C<id> is an integer id between 0 and 1299 (used to identify leaks).
 =for hackers
 Found in file handy.h
 
-=item newSV
-
-Create a new null SV, or if len > 0, create a new empty SVt_PV type SV
-with an initial PV allocation of len+1. Normally accessed via the C<NEWSV>
-macro.
-
-	SV*	newSV(STRLEN len)
-
-=for hackers
-Found in file sv.c
-
 =item newSViv
 
 Creates a new SV and copies an integer into it.  The reference count for the
@@ -2119,22 +2119,22 @@ version which guarantees to evaluate sv only once.
 =for hackers
 Found in file sv.h
 
-=item SvIVx
+=item SvIVX
 
-Coerces the given SV to an integer and returns it. Guarantees to evaluate
-sv only once. Use the more efficent C<SvIV> otherwise.
+Returns the raw value in the SV's IV slot, without checks or conversions.
+Only use when you are sure SvIOK is true. See also C<SvIV()>.
 
-	IV	SvIVx(SV* sv)
+	IV	SvIVX(SV* sv)
 
 =for hackers
 Found in file sv.h
 
-=item SvIVX
+=item SvIVx
 
-Returns the raw value in the SV's IV slot, without checks or conversions.
-Only use when you are sure SvIOK is true. See also C<SvIV()>.
+Coerces the given SV to an integer and returns it. Guarantees to evaluate
+sv only once. Use the more efficent C<SvIV> otherwise.
 
-	IV	SvIVX(SV* sv)
+	IV	SvIVx(SV* sv)
 
 =for hackers
 Found in file sv.h
@@ -2443,21 +2443,21 @@ Like C<SvPV_nolen>, but converts sv to uft8 first if necessary.
 =for hackers
 Found in file sv.h
 
-=item SvPVx
+=item SvPVX
 
-A version of C<SvPV> which guarantees to evaluate sv only once.
+Returns a pointer to the physical string in the SV.  The SV must contain a
+string.
 
-	char*	SvPVx(SV* sv, STRLEN len)
+	char*	SvPVX(SV* sv)
 
 =for hackers
 Found in file sv.h
 
-=item SvPVX
+=item SvPVx
 
-Returns a pointer to the physical string in the SV.  The SV must contain a
-string.
+A version of C<SvPV> which guarantees to evaluate sv only once.
 
-	char*	SvPVX(SV* sv)
+	char*	SvPVx(SV* sv, STRLEN len)
 
 =for hackers
 Found in file sv.h
@@ -2664,19 +2664,19 @@ false, defined or undefined.  Does not handle 'get' magic.
 =for hackers
 Found in file sv.h
 
-=item SvTYPE
-
-Returns the type of the SV.  See C<svtype>.
+=item svtype
 
-	svtype	SvTYPE(SV* sv)
+An enum of flags for Perl types.  These are found in the file B<sv.h> 
+in the C<svtype> enum.  Test these flags with the C<SvTYPE> macro.
 
 =for hackers
 Found in file sv.h
 
-=item svtype
+=item SvTYPE
 
-An enum of flags for Perl types.  These are found in the file B<sv.h> 
-in the C<svtype> enum.  Test these flags with the C<SvTYPE> macro.
+Returns the type of the SV.  See C<svtype>.
+
+	svtype	SvTYPE(SV* sv)
 
 =for hackers
 Found in file sv.h
diff --git a/sv.c b/sv.c
index a7e1bda293..da6bc2b925 100644
--- a/sv.c
+++ b/sv.c
@@ -9693,6 +9693,19 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_statusvalue_vms	= proto_perl->Istatusvalue_vms;
 #endif
 
+        /* Clone the regex array */
+        PL_regex_padav = newAV();
+        {
+                I32 len = av_len((AV*)proto_perl->Iregex_padav);
+                SV** regexen = AvARRAY((AV*)proto_perl->Iregex_padav);
+                for(i = 0; i <= len; i++) {                             
+                        av_push(PL_regex_padav,
+                            newSViv((IV)re_dup((REGEXP*) SvIV(regexen[i])) ));
+                }
+        }
+        PL_regex_pad = AvARRAY(PL_regex_padav);
+        
+
     /* shortcuts to various I/O objects */
     PL_stdingv		= gv_dup(proto_perl->Istdingv, param);
     PL_stderrgv		= gv_dup(proto_perl->Istderrgv, param);