X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=Plugin.xs;h=1e6a73ba46ea61ac9b5a4946b2a7251b5b8b0db3;hb=4327f8c53cab465ee6892481b01717664fb6c973;hp=c1272d91dcc8c66df872436175f24c6f4fc0236c;hpb=832243641a82325adb47027bc44a003cc66f2237;p=perl%2Fmodules%2Fre-engine-Plugin.git diff --git a/Plugin.xs b/Plugin.xs index c1272d9..1e6a73b 100644 --- a/Plugin.xs +++ b/Plugin.xs @@ -11,15 +11,21 @@ #define __PACKAGE__ "re::engine::Plugin" #define __PACKAGE_LEN__ (sizeof(__PACKAGE__)-1) -#ifndef ENTER_with_name -# define ENTER_with_name(N) ENTER -#endif +#define REP_HAS_PERL(R, V, S) (PERL_REVISION > (R) || (PERL_REVISION == (R) && (PERL_VERSION > (V) || (PERL_VERSION == (V) && (PERL_SUBVERSION >= (S)))))) -#ifndef LEAVE_with_name -# define LEAVE_with_name(N) LEAVE +#undef ENTERn +#if defined(ENTER_with_name) && !REP_HAS_PERL(5, 11, 4) +# define ENTERn(N) ENTER_with_name(N) +#else +# define ENTERn(N) ENTER #endif -#define REP_HAS_PERL(R, V, S) (PERL_REVISION > (R) || (PERL_REVISION == (R) && (PERL_VERSION > (V) || (PERL_VERSION == (V) && (PERL_SUBVERSION >= (S)))))) +#undef LEAVEn +#if defined(LEAVE_with_name) && !REP_HAS_PERL(5, 11, 4) +# define LEAVEn(N) LEAVE_with_name(N) +#else +# define LEAVEn(N) LEAVE +#endif #ifndef REP_WORKAROUND_REQUIRE_PROPAGATION # define REP_WORKAROUND_REQUIRE_PROPAGATION !REP_HAS_PERL(5, 10, 1) @@ -144,21 +150,12 @@ STATIC void rep_ptable_clone(pTHX_ ptable_ent *ent, void *ud_) { ptable_store(ud->tbl, ent->key, h2); } -STATIC void rep_thread_cleanup(pTHX_ void *); +#include "reap.h" STATIC void rep_thread_cleanup(pTHX_ void *ud) { - int *level = ud; - - if (*level) { - *level = 0; - LEAVE; - SAVEDESTRUCTOR_X(rep_thread_cleanup, level); - ENTER; - } else { - dMY_CXT; - PerlMemShared_free(level); - ptable_free(MY_CXT.tbl); - } + dMY_CXT; + + ptable_free(MY_CXT.tbl); } #endif /* REP_THREADSAFE */ @@ -243,12 +240,17 @@ STATIC const rep_hint_t *rep_hint(pTHX) { #define rep_hint() rep_hint(aTHX) SV *hint; +#ifdef cop_hints_fetch_pvn + hint = cop_hints_fetch_pvn(PL_curcop, + __PACKAGE__, __PACKAGE_LEN__, rep_hash, 0); +#else /* We already require 5.9.5 for the regexp engine API. */ hint = Perl_refcounted_he_fetch(aTHX_ PL_curcop->cop_hints_hash, NULL, __PACKAGE__, __PACKAGE_LEN__, 0, rep_hash); +#endif return rep_detag(hint); } @@ -651,8 +653,7 @@ void CLONE(...) PREINIT: ptable *t; - int *level; -CODE: +PPCODE: { my_cxt_t ud; dMY_CXT; @@ -665,15 +666,10 @@ CODE: MY_CXT.tbl = t; MY_CXT.owner = aTHX; } - { - level = PerlMemShared_malloc(sizeof *level); - *level = 1; - LEAVE_with_name("sub"); - SAVEDESTRUCTOR_X(rep_thread_cleanup, level); - ENTER_with_name("sub"); - } + reap(3, rep_thread_cleanup, NULL); + XSRETURN(0); -#endif +#endif /* REP_THREADSAFE */ void pattern(re::engine::Plugin self, ...)