X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=Plugin.xs;h=b7dd1d38c7fb2c0d88303d496dbdf5116eb25ace;hb=643556eaf09b5c71852f86f979c37bdd4e2046d4;hp=036185f6faa97917ceb3660a746422aa0425a901;hpb=104a143a32639ea18bf648b44b3b7545531c7d39;p=perl%2Fmodules%2Fre-engine-Plugin.git diff --git a/Plugin.xs b/Plugin.xs index 036185f..b7dd1d3 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,57 +98,75 @@ 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); } -#include "reap.h" - STATIC void rep_thread_cleanup(pTHX_ void *ud) { dMY_CXT; ptable_free(MY_CXT.tbl); } +STATIC int rep_endav_free(pTHX_ SV *sv, MAGIC *mg) { + SAVEDESTRUCTOR_X(rep_thread_cleanup, NULL); + + return 0; +} + +STATIC MGVTBL rep_endav_vtbl = { + 0, + 0, + 0, + 0, + rep_endav_free +#if MGf_COPY + , 0 +#endif +#if MGf_DUP + , 0 +#endif +#if MGf_LOCAL + , 0 +#endif +}; + #endif /* REP_THREADSAFE */ STATIC SV *rep_validate_callback(SV *code) { @@ -160,40 +183,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 +253,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 +322,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 +354,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 +372,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 +407,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 +462,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 +492,7 @@ Plugin_free(pTHX_ REGEXP * const RX) if (callback) { ENTER; SAVETMPS; - + PUSHMARK(SP); XPUSHs(rx->pprivate); PUTBACK; @@ -471,14 +531,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 +571,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 +602,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 +652,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 +668,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 +696,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(); @@ -645,20 +714,39 @@ void CLONE(...) PREINIT: ptable *t; + GV *gv; 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; MY_CXT.tbl = t; MY_CXT.owner = aTHX; } - reap(3, rep_thread_cleanup, NULL); + gv = gv_fetchpv(__PACKAGE__ "::_THREAD_CLEANUP", 0, SVt_PVCV); + if (gv) { + CV *cv = GvCV(gv); + if (!PL_endav) + PL_endav = newAV(); + SvREFCNT_inc(cv); + if (!av_store(PL_endav, av_len(PL_endav) + 1, (SV *) cv)) + SvREFCNT_dec(cv); + sv_magicext((SV *) PL_endav, NULL, PERL_MAGIC_ext, &rep_endav_vtbl, NULL, 0); + } + XSRETURN(0); + +void +_THREAD_CLEANUP(...) +PROTOTYPE: DISABLE +PPCODE: + rep_thread_cleanup(aTHX_ NULL); XSRETURN(0); #endif /* REP_THREADSAFE */ @@ -703,8 +791,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 +847,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 +856,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 +865,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 +874,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 *