X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2Fre-engine-Plugin.git;a=blobdiff_plain;f=Plugin.xs;h=ec8c0fe3094a19a2cd8d5dd0e5f83555c031ccf3;hp=036185f6faa97917ceb3660a746422aa0425a901;hb=8841074697e50dc9be0faf100e25e540968a2d9a;hpb=104a143a32639ea18bf648b44b3b7545531c7d39 diff --git a/Plugin.xs b/Plugin.xs index 036185f..ec8c0fe 100644 --- a/Plugin.xs +++ b/Plugin.xs @@ -19,6 +19,11 @@ /* ... Thread safety and multiplicity ...................................... */ +/* Safe unless stated otherwise in Makefile.PL */ +#ifndef REP_FORKSAFE +# define REP_FORKSAFE 1 +#endif + #ifndef REP_MULTIPLICITY # if defined(MULTIPLICITY) || defined(PERL_IMPLICIT_CONTEXT) # define REP_MULTIPLICITY 1 @@ -61,7 +66,7 @@ typedef struct { SV *comp; SV *exec; #if REP_WORKAROUND_REQUIRE_PROPAGATION - IV cxreq; + IV require_tag; #endif } rep_hint_t; @@ -93,44 +98,41 @@ typedef struct { START_MY_CXT -STATIC SV *rep_clone(pTHX_ SV *sv, tTHX owner) { -#define rep_clone(S, O) rep_clone(aTHX_ (S), (O)) - CLONE_PARAMS param; - AV *stashes = NULL; - SV *dupsv; - - if (SvTYPE(sv) == SVt_PVHV && HvNAME_get(sv)) - stashes = newAV(); - - param.stashes = stashes; - param.flags = 0; - param.proto_perl = owner; - - dupsv = sv_dup(sv, ¶m); - - if (stashes) { - av_undef(stashes); - SvREFCNT_dec(stashes); - } - - return SvREFCNT_inc(dupsv); -} +typedef struct { + ptable *tbl; +#if REP_HAS_PERL(5, 13, 2) + CLONE_PARAMS *params; +#else + CLONE_PARAMS params; +#endif +} rep_ptable_clone_ud; + +#if REP_HAS_PERL(5, 13, 2) +# define rep_ptable_clone_ud_init(U, T, O) \ + (U).tbl = (T); \ + (U).params = Perl_clone_params_new((O), aTHX) +# define rep_ptable_clone_ud_deinit(U) Perl_clone_params_del((U).params) +# define rep_dup_inc(S, U) SvREFCNT_inc(sv_dup((S), (U)->params)) +#else +# define rep_ptable_clone_ud_init(U, T, O) \ + (U).tbl = (T); \ + (U).params.stashes = newAV(); \ + (U).params.flags = 0; \ + (U).params.proto_perl = (O) +# define rep_ptable_clone_ud_deinit(U) SvREFCNT_dec((U).params.stashes) +# define rep_dup_inc(S, U) SvREFCNT_inc(sv_dup((S), &((U)->params))) +#endif STATIC void rep_ptable_clone(pTHX_ ptable_ent *ent, void *ud_) { - my_cxt_t *ud = ud_; + rep_ptable_clone_ud *ud = ud_; rep_hint_t *h1 = ent->val; rep_hint_t *h2; - if (ud->owner == aTHX) - return; - - h2 = PerlMemShared_malloc(sizeof *h2); - h2->comp = rep_clone(h1->comp, ud->owner); - SvREFCNT_inc(h2->comp); - h2->exec = rep_clone(h1->exec, ud->owner); - SvREFCNT_inc(h2->exec); + h2 = PerlMemShared_malloc(sizeof *h2); + h2->comp = rep_dup_inc(h1->comp, ud); + h2->exec = rep_dup_inc(h1->exec, ud); #if REP_WORKAROUND_REQUIRE_PROPAGATION - h2->cxreq = h1->cxreq; + h2->require_tag = PTR2IV(rep_dup_inc(INT2PTR(SV *, h1->require_tag), ud)); #endif ptable_store(ud->tbl, ent->key, h2); @@ -160,40 +162,68 @@ STATIC SV *rep_validate_callback(SV *code) { #if REP_WORKAROUND_REQUIRE_PROPAGATION STATIC IV rep_require_tag(pTHX) { #define rep_require_tag() rep_require_tag(aTHX) - const PERL_SI *si; - - for (si = PL_curstackinfo; si; si = si->si_prev) { - I32 cxix; - - for (cxix = si->si_cxix; cxix >= 0; --cxix) { - const PERL_CONTEXT *cx = si->si_cxstack + cxix; - - if (CxTYPE(cx) == CXt_EVAL && cx->blk_eval.old_op_type == OP_REQUIRE) - return PTR2IV(cx); + const CV *cv, *outside; + + cv = PL_compcv; + + if (!cv) { + /* If for some reason the pragma is operational at run-time, try to discover + * the current cv in use. */ + const PERL_SI *si; + + for (si = PL_curstackinfo; si; si = si->si_prev) { + I32 cxix; + + for (cxix = si->si_cxix; cxix >= 0; --cxix) { + const PERL_CONTEXT *cx = si->si_cxstack + cxix; + + switch (CxTYPE(cx)) { + case CXt_SUB: + case CXt_FORMAT: + /* The propagation workaround is only needed up to 5.10.0 and at that + * time format and sub contexts were still identical. And even later the + * cv members offsets should have been kept the same. */ + cv = cx->blk_sub.cv; + goto get_enclosing_cv; + case CXt_EVAL: + cv = cx->blk_eval.cv; + goto get_enclosing_cv; + default: + break; + } + } } + + cv = PL_main_cv; } - return PTR2IV(NULL); +get_enclosing_cv: + for (outside = CvOUTSIDE(cv); outside; outside = CvOUTSIDE(cv)) + cv = outside; + + return PTR2IV(cv); } #endif /* REP_WORKAROUND_REQUIRE_PROPAGATION */ STATIC SV *rep_tag(pTHX_ SV *comp, SV *exec) { #define rep_tag(C, E) rep_tag(aTHX_ (C), (E)) rep_hint_t *h; - dMY_CXT; - h = PerlMemShared_malloc(sizeof *h); - h->comp = rep_validate_callback(comp); - h->exec = rep_validate_callback(exec); + h = PerlMemShared_malloc(sizeof *h); + h->comp = rep_validate_callback(comp); + h->exec = rep_validate_callback(exec); #if REP_WORKAROUND_REQUIRE_PROPAGATION - h->cxreq = rep_require_tag(); + h->require_tag = rep_require_tag(); #endif /* REP_WORKAROUND_REQUIRE_PROPAGATION */ #if REP_THREADSAFE - /* We only need for the key to be an unique tag for looking up the value later. - * Allocated memory provides convenient unique identifiers, so that's why we - * use the hint as the key itself. */ - ptable_store(MY_CXT.tbl, h, h); + { + dMY_CXT; + /* We only need for the key to be an unique tag for looking up the value later + * Allocated memory provides convenient unique identifiers, so that's why we + * use the hint as the key itself. */ + ptable_store(MY_CXT.tbl, h, h); + } #endif /* REP_THREADSAFE */ return newSViv(PTR2IV(h)); @@ -202,18 +232,20 @@ STATIC SV *rep_tag(pTHX_ SV *comp, SV *exec) { STATIC const rep_hint_t *rep_detag(pTHX_ const SV *hint) { #define rep_detag(H) rep_detag(aTHX_ (H)) rep_hint_t *h; - dMY_CXT; if (!(hint && SvIOK(hint))) return NULL; h = INT2PTR(rep_hint_t *, SvIVX(hint)); #if REP_THREADSAFE - h = ptable_fetch(MY_CXT.tbl, h); + { + dMY_CXT; + h = ptable_fetch(MY_CXT.tbl, h); + } #endif /* REP_THREADSAFE */ #if REP_WORKAROUND_REQUIRE_PROPAGATION - if (rep_require_tag() != h->cxreq) + if (rep_require_tag() != h->require_tag) return NULL; #endif /* REP_WORKAROUND_REQUIRE_PROPAGATION */ @@ -269,7 +301,7 @@ Plugin_comp(pTHX_ SV * const pattern, U32 flags) /* Our blessed object */ obj = newSV(0); - SvREFCNT_inc(obj); + SvREFCNT_inc_simple_void_NN(obj); Newxz(re, 1, struct replug); sv_setref_pv(obj, "re::engine::Plugin", (void*)re); @@ -301,7 +333,7 @@ Plugin_comp(pTHX_ SV * const pattern, U32 flags) /* Store the pattern for ->pattern */ re->pattern = (SV*)pattern; - SvREFCNT_inc(re->pattern); + SvREFCNT_inc_simple_void(re->pattern); /* If there's an exec callback, store it into the private object so * that it will be the one to be called, even if the engine changes @@ -319,9 +351,9 @@ Plugin_comp(pTHX_ SV * const pattern, U32 flags) * already set up all the stuff we're going to to need for * subsequent exec and other calls */ if (h->comp) { - ENTER; + ENTER; SAVETMPS; - + PUSHMARK(SP); XPUSHs(obj); PUTBACK; @@ -354,19 +386,20 @@ Plugin_exec(pTHX_ REGEXP * const RX, char *stringarg, char *strend, SV *ret; /* Store the current str for ->str */ - self->str = (SV*)sv; - SvREFCNT_inc(self->str); + SvREFCNT_dec(self->str); + self->str = sv; + SvREFCNT_inc_simple_void(self->str); ENTER; SAVETMPS; - + PUSHMARK(SP); XPUSHs(rx->pprivate); XPUSHs(sv); PUTBACK; call_sv(self->cb_exec, G_SCALAR); - + SPAGAIN; ret = POPs; @@ -408,8 +441,14 @@ Plugin_checkstr(pTHX_ REGEXP * const RX) void Plugin_free(pTHX_ REGEXP * const RX) { - struct regexp *rx = rxREGEXP(RX); - GET_SELF_FROM_PPRIVATE(rx->pprivate); + struct regexp *rx; + re__engine__Plugin self; + + if (PL_dirty) + return; + + rx = rxREGEXP(RX); + SELF_FROM_PPRIVATE(self, rx->pprivate); SvREFCNT_dec(self->pattern); SvREFCNT_dec(self->str); @@ -432,7 +471,7 @@ Plugin_free(pTHX_ REGEXP * const RX) if (callback) { ENTER; SAVETMPS; - + PUSHMARK(SP); XPUSHs(rx->pprivate); PUTBACK; @@ -471,14 +510,14 @@ Plugin_numbered_buff_FETCH(pTHX_ REGEXP * const RX, const I32 paren, if (callback) { ENTER; SAVETMPS; - + PUSHMARK(SP); XPUSHs(rx->pprivate); XPUSHs(sv_2mortal(newSViv(paren))); PUTBACK; items = call_sv(callback, G_SCALAR); - + if (items == 1) { SV *ret; @@ -511,7 +550,7 @@ Plugin_numbered_buff_STORE(pTHX_ REGEXP * const RX, const I32 paren, if (callback) { ENTER; SAVETMPS; - + PUSHMARK(SP); XPUSHs(rx->pprivate); XPUSHs(sv_2mortal(newSViv(paren))); @@ -542,7 +581,7 @@ Plugin_numbered_buff_LENGTH(pTHX_ REGEXP * const RX, const SV * const sv, ENTER; SAVETMPS; - + PUSHMARK(SP); XPUSHs(rx->pprivate); XPUSHs(sv_2mortal(newSViv(paren))); @@ -592,12 +631,13 @@ Plugin_package(pTHX_ REGEXP * const RX) STATIC U32 rep_initialized = 0; STATIC void rep_teardown(pTHX_ void *root) { - dMY_CXT; - if (!rep_initialized || aTHX != root) return; - ptable_free(MY_CXT.tbl); + { + dMY_CXT; + ptable_free(MY_CXT.tbl); + } rep_initialized = 0; } @@ -607,9 +647,11 @@ STATIC void rep_setup(pTHX) { if (rep_initialized) return; - MY_CXT_INIT; - MY_CXT.tbl = ptable_new(); - MY_CXT.owner = aTHX; + { + MY_CXT_INIT; + MY_CXT.tbl = ptable_new(); + MY_CXT.owner = aTHX; + } call_atexit(rep_teardown, aTHX); @@ -633,7 +675,13 @@ PROTOTYPES: DISABLE BOOT: { if (!rep_booted++) { + HV *stash; + PERL_HASH(rep_hash, __PACKAGE__, __PACKAGE_LEN__); + + stash = gv_stashpvn(__PACKAGE__, __PACKAGE_LEN__, 1); + newCONSTSUB(stash, "REP_THREADSAFE", newSVuv(REP_THREADSAFE)); + newCONSTSUB(stash, "REP_FORKSAFE", newSVuv(REP_FORKSAFE)); } rep_setup(); @@ -647,11 +695,13 @@ PREINIT: ptable *t; PPCODE: { - my_cxt_t ud; + rep_ptable_clone_ud ud; dMY_CXT; - ud.tbl = t = ptable_new(); - ud.owner = MY_CXT.owner; + + t = ptable_new(); + rep_ptable_clone_ud_init(ud, t, MY_CXT.owner); ptable_walk(MY_CXT.tbl, rep_ptable_clone, &ud); + rep_ptable_clone_ud_deinit(ud); } { MY_CXT_CLONE; @@ -703,8 +753,9 @@ void stash(re::engine::Plugin self, ...) PPCODE: if (items > 1) { + SvREFCNT_dec(self->stash); self->stash = ST(1); - SvREFCNT_inc(self->stash); + SvREFCNT_inc_simple_void(self->stash); XSRETURN_EMPTY; } else { XPUSHs(self->stash); @@ -758,7 +809,7 @@ PPCODE: if (items > 1) { SvREFCNT_dec(self->cb_exec); self->cb_exec = ST(1); - SvREFCNT_inc(self->cb_exec); + SvREFCNT_inc_simple_void(self->cb_exec); } void @@ -767,7 +818,7 @@ PPCODE: if (items > 1) { SvREFCNT_dec(self->cb_num_capture_buff_FETCH); self->cb_num_capture_buff_FETCH = ST(1); - SvREFCNT_inc(self->cb_num_capture_buff_FETCH); + SvREFCNT_inc_simple_void(self->cb_num_capture_buff_FETCH); } void @@ -776,7 +827,7 @@ PPCODE: if (items > 1) { SvREFCNT_dec(self->cb_num_capture_buff_STORE); self->cb_num_capture_buff_STORE = ST(1); - SvREFCNT_inc(self->cb_num_capture_buff_STORE); + SvREFCNT_inc_simple_void(self->cb_num_capture_buff_STORE); } void @@ -785,7 +836,7 @@ PPCODE: if (items > 1) { SvREFCNT_dec(self->cb_num_capture_buff_LENGTH); self->cb_num_capture_buff_LENGTH = ST(1); - SvREFCNT_inc(self->cb_num_capture_buff_LENGTH); + SvREFCNT_inc_simple_void(self->cb_num_capture_buff_LENGTH); } SV *