X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FLexical-Types.git;a=blobdiff_plain;f=Types.xs;h=f5e7664ea546d2dfaa178817ce09d2a3389bc398;hp=6ead2eb61321356b7f6336749e2def7bd224945b;hb=eded748c69e52f9fb51a224de9e1ad9b96d5d2ca;hpb=4c22d853712b16da554eac5525819366b1dec494 diff --git a/Types.xs b/Types.xs index 6ead2eb..f5e7664 100644 --- a/Types.xs +++ b/Types.xs @@ -259,8 +259,6 @@ STATIC void lt_ptable_clone(pTHX_ ptable_ent *ent, void *ud_) { ptable_hints_store(ud->tbl, ent->key, h2); } -#include "reap.h" - STATIC void lt_thread_cleanup(pTHX_ void *ud) { dMY_CXT; @@ -268,6 +266,29 @@ STATIC void lt_thread_cleanup(pTHX_ void *ud) { ptable_seen_free(MY_CXT.seen); } +STATIC int lt_endav_free(pTHX_ SV *sv, MAGIC *mg) { + SAVEDESTRUCTOR_X(lt_thread_cleanup, NULL); + + return 0; +} + +STATIC MGVTBL lt_endav_vtbl = { + 0, + 0, + 0, + 0, + lt_endav_free +#if MGf_COPY + , 0 +#endif +#if MGf_DUP + , 0 +#endif +#if MGf_LOCAL + , 0 +#endif +}; + #endif /* LT_THREADSAFE */ /* ... Hint tags ........................................................... */ @@ -1006,6 +1027,7 @@ PREINIT: ptable *t; ptable *s; SV *cloned_default_meth; + GV *gv; PPCODE: { { @@ -1027,7 +1049,23 @@ PPCODE: MY_CXT.seen = s; MY_CXT.default_meth = cloned_default_meth; } - reap(3, lt_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, <_endav_vtbl, NULL, 0); + } + XSRETURN(0); + +void +_THREAD_CLEANUP(...) +PROTOTYPE: DISABLE +PPCODE: + lt_thread_cleanup(aTHX_ NULL); XSRETURN(0); #endif