From: Vincent Pit Date: Thu, 6 Jan 2011 01:07:18 +0000 (+0100) Subject: Fix the thread destructor trick for 5.13.1 X-Git-Tag: v0.09~18 X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=4327f8c53cab465ee6892481b01717664fb6c973;p=perl%2Fmodules%2Fre-engine-Plugin.git Fix the thread destructor trick for 5.13.1 --- diff --git a/MANIFEST b/MANIFEST index 0acafdf..2ed61a0 100644 --- a/MANIFEST +++ b/MANIFEST @@ -9,6 +9,7 @@ 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 cffc463..1e6a73b 100644 --- a/Plugin.xs +++ b/Plugin.xs @@ -150,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 */ @@ -662,8 +653,7 @@ void CLONE(...) PREINIT: ptable *t; - int *level; -CODE: +PPCODE: { my_cxt_t ud; dMY_CXT; @@ -676,15 +666,10 @@ CODE: MY_CXT.tbl = t; MY_CXT.owner = aTHX; } - { - level = PerlMemShared_malloc(sizeof *level); - *level = 1; - LEAVEn("sub"); - SAVEDESTRUCTOR_X(rep_thread_cleanup, level); - ENTERn("sub"); - } + reap(3, rep_thread_cleanup, NULL); + XSRETURN(0); -#endif +#endif /* REP_THREADSAFE */ void pattern(re::engine::Plugin self, ...) diff --git a/reap.h b/reap.h new file mode 100644 index 0000000..bc1e44d --- /dev/null +++ b/reap.h @@ -0,0 +1,81 @@ +/* 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 */