X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;ds=sidebyside;f=Types.xs;h=d37cdc7eabb0e5a311b0e9e6701e81e0dee0fdb6;hb=cb00fbfded7c20f01c75b520c5e5d2b582e2d4be;hp=6ead2eb61321356b7f6336749e2def7bd224945b;hpb=ac8fadd02eaa275485af784bc3a70fd2c666906c;p=perl%2Fmodules%2FLexical-Types.git diff --git a/Types.xs b/Types.xs index 6ead2eb..d37cdc7 100644 --- a/Types.xs +++ b/Types.xs @@ -259,15 +259,40 @@ 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; ptable_hints_free(MY_CXT.tbl); + MY_CXT.tbl = NULL; ptable_seen_free(MY_CXT.seen); + MY_CXT.seen = NULL; + SvREFCNT_dec(MY_CXT.default_meth); + MY_CXT.default_meth = NULL; } +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 ........................................................... */ @@ -323,7 +348,13 @@ get_enclosing_cv: STATIC SV *lt_tag(pTHX_ SV *value) { #define lt_tag(V) lt_tag(aTHX_ (V)) lt_hint_t *h; - SV *code = NULL; + SV *code = NULL; +#if LT_THREADSAFE + dMY_CXT; + + if (!MY_CXT.tbl) + return newSViv(0); +#endif /* LT_THREADSAFE */ if (SvROK(value)) { value = SvRV(value); @@ -344,13 +375,10 @@ STATIC SV *lt_tag(pTHX_ SV *value) { #endif /* !LT_HINT_STRUCT */ #if LT_THREADSAFE - { - dMY_CXT; - /* We only need for the key to be an unique tag for looking up the value later - * Allocated memory provides convenient unique identifiers, so that's why we - * use the hint as the key itself. */ - ptable_hints_store(MY_CXT.tbl, h, h); - } + /* We only need for the key to be an unique tag for looking up the value later + * Allocated memory provides convenient unique identifiers, so that's why we + * use the hint as the key itself. */ + ptable_hints_store(MY_CXT.tbl, h, h); #endif /* LT_THREADSAFE */ return newSViv(PTR2IV(h)); @@ -361,7 +389,10 @@ STATIC SV *lt_detag(pTHX_ const SV *hint) { lt_hint_t *h; #if LT_THREADSAFE dMY_CXT; -#endif + + if (!MY_CXT.tbl) + return NULL; +#endif /* LT_THREADSAFE */ if (!(hint && SvIOK(hint))) return NULL; @@ -685,7 +716,7 @@ STATIC OP *lt_ck_padany(pTHX_ OP *o) { if (stash && (code = lt_hint())) { dMY_CXT; SV *orig_pkg = newSVpvn(HvNAME_get(stash), HvNAMELEN_get(stash)); - SV *orig_meth = MY_CXT.default_meth; + SV *orig_meth = MY_CXT.default_meth; /* Guarded by lt_hint() */ SV *type_pkg = NULL; SV *type_meth = NULL; int items; @@ -889,9 +920,11 @@ STATIC void lt_peep(pTHX_ OP *o) { lt_old_peep(aTHX_ o); - ptable_seen_clear(seen); - lt_peep_rec(o); - ptable_seen_clear(seen); + if (seen) { + ptable_seen_clear(seen); + lt_peep_rec(o); + ptable_seen_clear(seen); + } } /* --- Interpreter setup/teardown ------------------------------------------ */ @@ -912,9 +945,12 @@ STATIC void lt_teardown(pTHX_ void *root) { dMY_CXT; #if LT_THREADSAFE ptable_hints_free(MY_CXT.tbl); + MY_CXT.tbl = NULL; #endif ptable_seen_free(MY_CXT.seen); + MY_CXT.seen = NULL; SvREFCNT_dec(MY_CXT.default_meth); + MY_CXT.default_meth = NULL; } lt_ck_restore(OP_PADANY, <_old_ck_padany); @@ -1006,6 +1042,7 @@ PREINIT: ptable *t; ptable *s; SV *cloned_default_meth; + GV *gv; PPCODE: { { @@ -1027,7 +1064,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