Threadsafe PMOPs! We might still win this war.
Artur Bergman [Wed, 11 Jul 2001 14:23:37 +0000 (16:23 +0200)]
Message-ID: <000b01c10a04$4fa16a10$21000a0a@vogw2kdev>

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

p4raw-id: //depot/perl@11274

embedvar.h
intrpvar.h
op.c
op.h
perl.c
perlapi.h
pod/perlapi.pod
sv.c

index 82c965f..80b2e3e 100644 (file)
 #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)
 #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)
 #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)
 #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
index 2e21f92..6447b27 100644 (file)
@@ -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 eba79ef..c7c53e4 100644 (file)
--- 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 05e4580..352d358 100644 (file)
--- 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 cef5c47..90d7134 100644 (file)
--- 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;
 }
 
index 7a8dcec..36e297c 100644 (file)
--- 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
index bee65f6..4872a9f 100644 (file)
@@ -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 a7e1bda..da6bc2b 100644 (file)
--- 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);