From 1fcf4c126eb604a2803256137e52891a03090e84 Mon Sep 17 00:00:00 2001 From: Artur Bergman Date: Wed, 11 Jul 2001 16:23:37 +0200 Subject: [PATCH] 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 --- embedvar.h | 8 +++++++ intrpvar.h | 5 +++++ op.c | 11 +++++++++- op.h | 11 +++++++++- perl.c | 4 +++- perlapi.h | 4 ++++ pod/perlapi.pod | 66 ++++++++++++++++++++++++++++----------------------------- sv.c | 13 ++++++++++++ 8 files changed, 86 insertions(+), 36 deletions(-) diff --git a/embedvar.h b/embedvar.h index 82c965f..80b2e3e 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 2e21f92..6447b27 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 eba79ef..c7c53e4 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 05e4580..352d358 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 cef5c47..90d7134 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 7a8dcec..36e297c 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 bee65f6..4872a9f 100644 --- a/pod/perlapi.pod +++ b/pod/perlapi.pod @@ -1344,6 +1344,17 @@ SV is B 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 +macro. + + SV* newSV(STRLEN len) + +=for hackers +Found in file sv.c + =item NEWSV Creates a new SV. A non-zero C parameter indicates the number of @@ -1357,17 +1368,6 @@ C 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 -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 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. - 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. +Coerces the given SV to an integer and returns it. Guarantees to evaluate +sv only once. Use the more efficent C otherwise. - IV SvIVX(SV* sv) + IV SvIVx(SV* sv) =for hackers Found in file sv.h @@ -2443,21 +2443,21 @@ Like C, but converts sv to uft8 first if necessary. =for hackers Found in file sv.h -=item SvPVx +=item SvPVX -A version of C 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 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. +=item svtype - svtype SvTYPE(SV* sv) +An enum of flags for Perl types. These are found in the file B +in the C enum. Test these flags with the C 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 -in the C enum. Test these flags with the C macro. +Returns the type of the SV. See C. + + svtype SvTYPE(SV* sv) =for hackers Found in file sv.h diff --git a/sv.c b/sv.c index a7e1bda..da6bc2b 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); -- 2.7.4