X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2Findirect.git;a=blobdiff_plain;f=indirect.xs;h=5cd420cb31f7897649bde1324dec1ea1d98706c6;hp=511d9cd81df75d069f87cbe101929a9af17117e0;hb=2cba38dec0a1ccaeb6ff4119ee2af3ae634e739c;hpb=217e4a123f681f91cd2cfb1e6eb001a9cb757d66 diff --git a/indirect.xs b/indirect.xs index 511d9cd..5cd420c 100644 --- a/indirect.xs +++ b/indirect.xs @@ -323,16 +323,40 @@ STATIC void indirect_ptable_clone(pTHX_ ptable_ent *ent, void *ud_) { ptable_hints_store(ud->tbl, ent->key, h2); } -#include "reap.h" - STATIC void indirect_thread_cleanup(pTHX_ void *ud) { dMY_CXT; SvREFCNT_dec(MY_CXT.global_code); + MY_CXT.global_code = NULL; ptable_free(MY_CXT.map); + MY_CXT.map = NULL; ptable_hints_free(MY_CXT.tbl); + MY_CXT.tbl = NULL; +} + +STATIC int indirect_endav_free(pTHX_ SV *sv, MAGIC *mg) { + SAVEDESTRUCTOR_X(indirect_thread_cleanup, NULL); + + return 0; } +STATIC MGVTBL indirect_endav_vtbl = { + 0, + 0, + 0, + 0, + indirect_endav_free +#if MGf_COPY + , 0 +#endif +#if MGf_DUP + , 0 +#endif +#if MGf_LOCAL + , 0 +#endif +}; + #endif /* I_THREADSAFE */ #if I_WORKAROUND_REQUIRE_PROPAGATION @@ -909,8 +933,10 @@ STATIC void indirect_teardown(pTHX_ void *root) { { dMY_CXT; ptable_free(MY_CXT.map); + MY_CXT.map = NULL; #if I_THREADSAFE ptable_hints_free(MY_CXT.tbl); + MY_CXT.tbl = NULL; #endif } @@ -995,6 +1021,7 @@ PROTOTYPE: DISABLE PREINIT: ptable *t; SV *global_code_dup; + GV *gv; PPCODE: { my_cxt_t ud; @@ -1011,7 +1038,23 @@ PPCODE: MY_CXT.owner = aTHX; MY_CXT.global_code = global_code_dup; } - reap(3, indirect_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, &indirect_endav_vtbl, NULL, 0); + } + XSRETURN(0); + +void +_THREAD_CLEANUP(...) +PROTOTYPE: DISABLE +PPCODE: + indirect_thread_cleanup(aTHX_ NULL); XSRETURN(0); #endif