Change 11274 by jhi@alpha on 2001/07/11 13:13:27
Subject: [PATCH] Threadsafe PMOPs! We might still win this war.
From: "Artur Bergman" <[EMAIL PROTECTED]>
Date: Wed, 11 Jul 2001 14:23:37 +0200
Message-ID: <000b01c10a04$4fa16a10$21000a0a@vogw2kdev>
Threadsafe PMOPs for ithreads, waiting for AMS's Perl_re_dup().
Affected files ...
... //depot/perl/embedvar.h#114 edit
... //depot/perl/intrpvar.h#79 edit
... //depot/perl/op.c#412 edit
... //depot/perl/op.h#81 edit
... //depot/perl/perl.c#343 edit
... //depot/perl/perlapi.h#37 edit
... //depot/perl/pod/perlapi.pod#87 edit
... //depot/perl/sv.c#435 edit
Differences ...
==== //depot/perl/embedvar.h#114 (text+w) ====
Index: perl/embedvar.h
--- perl/embedvar.h.~1~ Wed Jul 11 07:30:05 2001
+++ perl/embedvar.h Wed Jul 11 07:30:05 2001
@@ -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
==== //depot/perl/intrpvar.h#79 (text) ====
Index: perl/intrpvar.h
--- perl/intrpvar.h.~1~ Wed Jul 11 07:30:05 2001
+++ perl/intrpvar.h Wed Jul 11 07:30:05 2001
@@ -475,6 +475,11 @@
#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. */
==== //depot/perl/op.c#412 (text) ====
Index: perl/op.c
--- perl/op.c.~1~ Wed Jul 11 07:30:05 2001
+++ perl/op.c Wed Jul 11 07:30:05 2001
@@ -2952,7 +2952,16 @@
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;
==== //depot/perl/op.h#81 (text) ====
Index: perl/op.h
--- perl/op.h.~1~ Wed Jul 11 07:30:05 2001
+++ perl/op.h Wed Jul 11 07:30:05 2001
@@ -235,7 +235,11 @@
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 @@
#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 */
==== //depot/perl/perl.c#343 (text) ====
Index: perl/perl.c
--- perl/perl.c.~1~ Wed Jul 11 07:30:05 2001
+++ perl/perl.c Wed Jul 11 07:30:05 2001
@@ -312,7 +312,9 @@
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;
}
==== //depot/perl/perlapi.h#37 (text+w) ====
Index: perl/perlapi.h
--- perl/perlapi.h.~1~ Wed Jul 11 07:30:05 2001
+++ perl/perlapi.h Wed Jul 11 07:30:05 2001
@@ -458,6 +458,10 @@
#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
==== //depot/perl/pod/perlapi.pod#87 (text+w) ====
Index: perl/pod/perlapi.pod
--- perl/pod/perlapi.pod.~1~ Wed Jul 11 07:30:05 2001
+++ perl/pod/perlapi.pod Wed Jul 11 07:30:05 2001
@@ -1344,6 +1344,17 @@
=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 @@
=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 @@
=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 @@
=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 @@
=for hackers
Found in file sv.h
-=item SvTYPE
+=item svtype
-Returns the type of the SV. See C<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
+
+Returns the type of the SV. See C<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.
+ svtype SvTYPE(SV* sv)
=for hackers
Found in file sv.h
==== //depot/perl/sv.c#435 (text) ====
Index: perl/sv.c
--- perl/sv.c.~1~ Wed Jul 11 07:30:05 2001
+++ perl/sv.c Wed Jul 11 07:30:05 2001
@@ -9693,6 +9693,19 @@
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);
End of Patch.
