From: Vincent Pit Date: Wed, 1 Oct 2014 19:14:49 +0000 (+0200) Subject: Don't cleanup thread local storage before END blocks are executed X-Git-Tag: rt92118~3 X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=e8bed8ee905c10ae1dd9ebaf5882798f342ba90a;p=perl%2Fmodules%2Fre-engine-Plugin.git Don't cleanup thread local storage before END blocks are executed reap.h is no longer necessary. --- diff --git a/MANIFEST b/MANIFEST index d40e2ab..23d61a0 100644 --- a/MANIFEST +++ b/MANIFEST @@ -9,7 +9,6 @@ Plugin.pod Plugin.xs README ptable.h -reap.h t/00-compile.t t/10-usage/basic.pm t/10-usage/basic.t diff --git a/Plugin.xs b/Plugin.xs index ec8c0fe..b7dd1d3 100644 --- a/Plugin.xs +++ b/Plugin.xs @@ -138,14 +138,35 @@ STATIC void rep_ptable_clone(pTHX_ ptable_ent *ent, void *ud_) { 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) { @@ -693,6 +714,7 @@ void CLONE(...) PREINIT: ptable *t; + GV *gv; PPCODE: { rep_ptable_clone_ud ud; @@ -708,7 +730,23 @@ PPCODE: 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 */ diff --git a/reap.h b/reap.h deleted file mode 100644 index bc1e44d..0000000 --- a/reap.h +++ /dev/null @@ -1,81 +0,0 @@ -/* This file is part of the re::engine::Plugin Perl module. - * See http://search.cpan.org/dist/re-engine-Plugin/ */ - -/* This header provides a specialized version of Scope::Upper::reap that can be - * called directly from XS. - * See http://search.cpan.org/dist/Scope-Upper/ for details. */ - -#ifndef REAP_H -#define REAP_H 1 - -#define REAP_DESTRUCTOR_SIZE 3 - -typedef struct { - I32 depth; - I32 *origin; - void (*cb)(pTHX_ void *); - void *ud; - char *dummy; -} reap_ud; - -STATIC void reap_pop(pTHX_ void *); - -STATIC void reap_pop(pTHX_ void *ud_) { - reap_ud *ud = ud_; - I32 depth, *origin, mark, base; - - depth = ud->depth; - origin = ud->origin; - mark = origin[depth]; - base = origin[depth - 1]; - - if (base < mark) { - PL_savestack_ix = mark; - leave_scope(base); - } - PL_savestack_ix = base; - - if ((ud->depth = --depth) > 0) { - SAVEDESTRUCTOR_X(reap_pop, ud); - } else { - void (*cb)(pTHX_ void *) = ud->cb; - void *cb_ud = ud->ud; - - PerlMemShared_free(ud->origin); - PerlMemShared_free(ud); - - SAVEDESTRUCTOR_X(cb, cb_ud); - } -} - -STATIC void reap(pTHX_ I32 depth, void (*cb)(pTHX_ void *), void *cb_ud) { -#define reap(D, CB, UD) reap(aTHX_ (D), (CB), (UD)) - reap_ud *ud; - I32 i; - - if (depth > PL_scopestack_ix) - depth = PL_scopestack_ix; - - ud = PerlMemShared_malloc(sizeof *ud); - ud->depth = depth; - ud->origin = PerlMemShared_malloc((depth + 1) * sizeof *ud->origin); - ud->cb = cb; - ud->ud = cb_ud; - ud->dummy = NULL; - - for (i = depth; i >= 1; --i) { - I32 j = PL_scopestack_ix - i; - ud->origin[depth - i] = PL_scopestack[j]; - PL_scopestack[j] += REAP_DESTRUCTOR_SIZE; - } - ud->origin[depth] = PL_savestack_ix; - - while (PL_savestack_ix + REAP_DESTRUCTOR_SIZE - <= PL_scopestack[PL_scopestack_ix - 1]) { - save_pptr(&ud->dummy); - } - - SAVEDESTRUCTOR_X(reap_pop, ud); -} - -#endif /* REAP_H */