From: Vincent Pit Date: Wed, 26 Oct 2011 14:52:27 +0000 (+0200) Subject: Clone wizard objects through dup magic X-Git-Tag: v0.47~12 X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=cd9fcbe160cced7b5012a48f581f1c0674fc21fa;p=perl%2Fmodules%2FVariable-Magic.git Clone wizard objects through dup magic ptable.h is no longer needed. --- diff --git a/MANIFEST b/MANIFEST index f533af0..d984750 100644 --- a/MANIFEST +++ b/MANIFEST @@ -6,7 +6,6 @@ Magic.xs Makefile.PL README lib/Variable/Magic.pm -ptable.h samples/copy.pl samples/magic.pl samples/synopsis.pl diff --git a/Magic.xs b/Magic.xs index 3fb9739..a2dd6db 100644 --- a/Magic.xs +++ b/Magic.xs @@ -55,9 +55,6 @@ # define VMG_MULTIPLICITY 0 # endif #endif -#if VMG_MULTIPLICITY && !defined(tTHX) -# define tTHX PerlInterpreter* -#endif #if VMG_MULTIPLICITY && defined(USE_ITHREADS) && defined(dMY_CXT) && defined(MY_CXT) && defined(START_MY_CXT) && defined(MY_CXT_INIT) && (defined(MY_CXT_CLONE) || defined(dMY_CXT_SV)) # define VMG_THREADSAFE 1 @@ -90,33 +87,6 @@ # define VMG_UNLOCK(M) #endif -#if VMG_THREADSAFE - -STATIC SV *vmg_clone(pTHX_ SV *sv, tTHX owner) { -#define vmg_clone(P, O) vmg_clone(aTHX_ (P), (O)) - SV *dupsv; - -#if VMG_HAS_PERL(5, 13, 2) - CLONE_PARAMS *param = Perl_clone_params_new(owner, aTHX); - - dupsv = sv_dup(sv, param); - - Perl_clone_params_del(param); -#else - CLONE_PARAMS param; - - param.stashes = NULL; /* don't need it unless sv is a PVHV */ - param.flags = 0; - param.proto_perl = owner; - - dupsv = sv_dup(sv, ¶m); -#endif - - return SvREFCNT_inc(dupsv); -} - -#endif /* VMG_THREADSAFE */ - /* --- Compatibility ------------------------------------------------------- */ #ifndef Newx @@ -518,10 +488,6 @@ typedef struct { #if VMG_UVAR SV *cb_fetch, *cb_store, *cb_exists, *cb_delete; #endif /* VMG_UVAR */ - -#if VMG_MULTIPLICITY - tTHX owner; -#endif /* VMG_MULTIPLICITY */ } MGWIZ; STATIC void vmg_op_info_init(pTHX_ unsigned int opinfo); @@ -548,15 +514,6 @@ STATIC void vmg_mgwiz_free(pTHX_ MGWIZ *w) { if (!w) return; - /* We reach this point in dirty state when ptable_free() is called from the - * atexit cleanup callback, and that the global table still holds a live - * wizard. This happens before all the SV bodies are freed, so all the wizard - * callbacks are still alive (as they are referenced by the undead wizard). - * Hence it is safe to decrement their refcount. Later on, the wizard free - * callback itself will trigger when the wizard body is reaped, but it will - * be skipped as it guards against dirty state - which is good since nothing - * has to be done anymore at that point. */ - SvREFCNT_dec(w->cb_data); SvREFCNT_dec(w->cb_get); SvREFCNT_dec(w->cb_set); @@ -586,11 +543,11 @@ STATIC void vmg_mgwiz_free(pTHX_ MGWIZ *w) { #if VMG_THREADSAFE #define VMG_CLONE_CB(N) \ - z->cb_ ## N = (w->cb_ ## N) ? vmg_clone(w->cb_ ## N, w->owner) \ + z->cb_ ## N = (w->cb_ ## N) ? SvREFCNT_inc(sv_dup(w->cb_ ## N, params)) \ : NULL; -STATIC MGWIZ *vmg_mgwiz_clone(pTHX_ const MGWIZ *w) { -#define vmg_mgwiz_clone(W) vmg_mgwiz_clone(aTHX_ (W)) +STATIC const MGWIZ *vmg_mgwiz_dup(pTHX_ const MGWIZ *w, CLONE_PARAMS *params) { +#define vmg_mgwiz_dup(W, P) vmg_mgwiz_dup(aTHX_ (W), (P)) MGWIZ *z; if (!w) @@ -620,8 +577,6 @@ STATIC MGWIZ *vmg_mgwiz_clone(pTHX_ const MGWIZ *w) { VMG_CLONE_CB(delete); #endif /* VMG_UVAR */ - z->owner = aTHX; - return z; } @@ -629,55 +584,20 @@ STATIC MGWIZ *vmg_mgwiz_clone(pTHX_ const MGWIZ *w) { /* --- Context-safe global data -------------------------------------------- */ -#if VMG_THREADSAFE - -#define PTABLE_NAME ptable -#define PTABLE_VAL_FREE(V) vmg_mgwiz_free(VOID2(MGWIZ *, (V))) - -#define pPTBL pTHX -#define pPTBL_ pTHX_ -#define aPTBL aTHX -#define aPTBL_ aTHX_ - -#include "ptable.h" - -#define ptable_store(T, K, V) ptable_store(aTHX_ (T), (K), (V)) -#define ptable_clear(T) ptable_clear(aTHX_ (T)) -#define ptable_free(T) ptable_free(aTHX_ (T)) - -#endif /* VMG_THREADSAFE */ - #define MY_CXT_KEY __PACKAGE__ "::_guts" XS_VERSION typedef struct { -#if VMG_THREADSAFE - ptable *wizards; - tTHX owner; -#endif - HV *b__op_stashes[OPc_MAX]; + HV *b__op_stashes[OPc_MAX]; } my_cxt_t; START_MY_CXT -#if VMG_THREADSAFE - -STATIC void vmg_ptable_clone(pTHX_ ptable_ent *ent, void *ud_) { - my_cxt_t *ud = VOID2(my_cxt_t *, ud_); - MGWIZ *w; - - if (ud->owner == aTHX) - return; - - w = vmg_mgwiz_clone(VOID2(MGWIZ *, ent->val)); - if (w) - ptable_store(ud->wizards, ent->key, w); -} - -#endif /* VMG_THREADSAFE */ - /* --- Wizard objects ------------------------------------------------------ */ STATIC int vmg_wizard_free(pTHX_ SV *sv, MAGIC *mg); +#if VMG_THREADSAFE +STATIC int vmg_wizard_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *params); +#endif STATIC MGVTBL vmg_wizard_vtbl = { NULL, /* get */ @@ -686,7 +606,11 @@ STATIC MGVTBL vmg_wizard_vtbl = { NULL, /* clear */ vmg_wizard_free, /* free */ NULL, /* copy */ +#if VMG_THREADSAFE + vmg_wizard_dup, /* dup */ +#else NULL, /* dup */ +#endif #if MGf_LOCAL NULL, /* local */ #endif /* MGf_LOCAL */ @@ -696,11 +620,21 @@ STATIC MGVTBL vmg_wizard_vtbl = { STATIC SV *vmg_wizard_new(pTHX_ const MGWIZ *w) { #define vmg_wizard_new(W) vmg_wizard_new(aTHX_ (W)) - SV *wiz = newSVuv(PTR2IV(w)); + SV *wiz; + +#if VMG_THREADSAFE + wiz = newSV(0); +#else + wiz = newSViv(PTR2IV(w)); +#endif if (w) { - MAGIC *mg = sv_magicext(wiz, NULL, PERL_MAGIC_ext, &vmg_wizard_vtbl, NULL, 0); + MAGIC *mg = sv_magicext(wiz, NULL, PERL_MAGIC_ext, &vmg_wizard_vtbl, + (const char *) w, 0); mg->mg_private = SIG_WZO; +#if VMG_THREADSAFE + mg->mg_flags |= MGf_DUP; +#endif } SvREADONLY_on(wiz); @@ -711,7 +645,11 @@ STATIC const SV *vmg_wizard_validate(pTHX_ const SV *wiz) { #define vmg_wizard_validate(W) vmg_wizard_validate(aTHX_ (W)) if (SvROK(wiz)) { wiz = SvRV_const(wiz); +#if VMG_THREADSAFE + if (SvTYPE(wiz) >= SVt_PVMG && SvMAGIC(wiz)) +#else if (SvIOK(wiz)) +#endif return wiz; } @@ -720,52 +658,51 @@ STATIC const SV *vmg_wizard_validate(pTHX_ const SV *wiz) { return NULL; } -#define vmg_wizard_id(W) SvIVX((const SV *) (W)) -#define vmg_wizard_main_mgwiz(W) INT2PTR(const MGWIZ *, vmg_wizard_id(W)) +#if VMG_THREADSAFE + +STATIC const MGWIZ *vmg_wizard_mgwiz(const SV *wiz) { + MAGIC *mg; + + for (mg = SvMAGIC(wiz); mg; mg = mg->mg_moremagic) { + if (mg->mg_type == PERL_MAGIC_ext && mg->mg_virtual == &vmg_wizard_vtbl) + return (const MGWIZ *) mg->mg_ptr; + } + + return NULL; +} + +#define vmg_wizard_mgwiz(W) vmg_wizard_mgwiz((const SV *) (W)) + +#define vmg_wizard_id(W) PTR2IV(vmg_vtable_vtbl(vmg_wizard_mgwiz(W)->vtable)) + +#else + +#define vmg_wizard_id(W) SvIVX((const SV *) (W)) + +#define vmg_wizard_mgwiz(W) INT2PTR(const MGWIZ *, vmg_wizard_id(W)) + +#endif /* ... Wizard destructor ................................................... */ STATIC int vmg_wizard_free(pTHX_ SV *sv, MAGIC *mg) { - MGWIZ *w; - if (PL_dirty) /* During global destruction, the context is already freed */ return 0; - w = (MGWIZ *) vmg_wizard_main_mgwiz(sv); - -#if VMG_THREADSAFE - { - dMY_CXT; - ptable_store(MY_CXT.wizards, w, NULL); - } -#else /* VMG_THREADSAFE */ - vmg_mgwiz_free(w); -#endif /* !VMG_THREADSAFE */ + vmg_mgwiz_free((MGWIZ *) mg->mg_ptr); return 0; } #if VMG_THREADSAFE -STATIC const MGWIZ *vmg_wizard_mgwiz(pTHX_ const SV *wiz) { -#define vmg_wizard_mgwiz(W) vmg_wizard_mgwiz(aTHX_ ((const SV *) (W))) - const MGWIZ *w; - - w = vmg_wizard_main_mgwiz(wiz); - if (w->owner == aTHX) - return w; +STATIC int vmg_wizard_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *params) { + mg->mg_ptr = (char *) vmg_mgwiz_dup((const MGWIZ *) mg->mg_ptr, params); - { - dMY_CXT; - return VOID2(const MGWIZ *, ptable_fetch(MY_CXT.wizards, w)); - } + return 0; } -#else /* VMG_THREADSAFE */ - -#define vmg_wizard_mgwiz(W) vmg_wizard_main_mgwiz(W) - -#endif /* !VMG_THREADSAFE */ +#endif /* VMG_THREADSAFE */ /* --- User-level functions implementation --------------------------------- */ @@ -1411,17 +1348,6 @@ STATIC I32 vmg_svt_val(pTHX_ IV action, SV *sv) { w->cb_ ## N = NULL; \ } -#if VMG_THREADSAFE - -STATIC void vmg_cleanup(pTHX_ void *ud) { - dMY_CXT; - - ptable_free(MY_CXT.wizards); - MY_CXT.wizards = NULL; -} - -#endif /* VMG_THREADSAFE */ - /* --- XS ------------------------------------------------------------------ */ MODULE = Variable::Magic PACKAGE = Variable::Magic @@ -1433,15 +1359,10 @@ BOOT: HV *stash; MY_CXT_INIT; -#if VMG_THREADSAFE - MY_CXT.wizards = ptable_new(); - MY_CXT.owner = aTHX; -#endif MY_CXT.b__op_stashes[0] = NULL; #if VMG_THREADSAFE MUTEX_INIT(&vmg_vtable_refcount_mutex); MUTEX_INIT(&vmg_op_name_init_mutex); - call_atexit(vmg_cleanup, NULL); #endif stash = gv_stashpv(__PACKAGE__, 1); @@ -1473,18 +1394,11 @@ void CLONE(...) PROTOTYPE: DISABLE PREINIT: - ptable *t; - U32 had_b__op_stash = 0; - int c; + U32 had_b__op_stash = 0; + int c; PPCODE: { - my_cxt_t ud; dMY_CXT; - - ud.wizards = t = ptable_new(); - ud.owner = MY_CXT.owner; - ptable_walk(MY_CXT.wizards, vmg_ptable_clone, &ud); - for (c = OPc_NULL; c < OPc_MAX; ++c) { if (MY_CXT.b__op_stashes[c]) had_b__op_stash |= (((U32) 1) << c); @@ -1492,8 +1406,6 @@ PPCODE: } { MY_CXT_CLONE; - MY_CXT.wizards = t; - MY_CXT.owner = aTHX; for (c = OPc_NULL; c < OPc_MAX; ++c) { MY_CXT.b__op_stashes[c] = (had_b__op_stash & (((U32) 1) << c)) ? gv_stashpv(vmg_opclassnames[c], 1) : NULL; @@ -1511,8 +1423,6 @@ PREINIT: MGVTBL *t; SV *cb, *op_info, *copy_key; CODE: - dMY_CXT; - if (items != 9 #if MGf_LOCAL + 1 @@ -1551,12 +1461,6 @@ CODE: if (w->cb_fetch || w->cb_store || w->cb_exists || w->cb_delete) w->uvar = SvTRUE(copy_key) ? 2 : 1; #endif /* VMG_UVAR */ -#if VMG_MULTIPLICITY - w->owner = aTHX; -#endif /* VMG_MULTIPLICITY */ -#if VMG_THREADSAFE - ptable_store(MY_CXT.wizards, w, w); -#endif /* VMG_THREADSAFE */ RETVAL = newRV_noinc(vmg_wizard_new(w)); OUTPUT: diff --git a/ptable.h b/ptable.h deleted file mode 100644 index 5e9e8ed..0000000 --- a/ptable.h +++ /dev/null @@ -1,251 +0,0 @@ -/* This file is part of the Variable::Magic Perl module. - * See http://search.cpan.org/dist/Variable-Magic/ */ - -/* This is a pointer table implementation essentially copied from the ptr_table - * implementation in perl's sv.c, except that it has been modified to use memory - * shared across threads. - * Copyright goes to the original authors, bug reports to me. */ - -/* This header is designed to be included several times with different - * definitions for PTABLE_NAME and PTABLE_VAL_FREE(). */ - -#undef VOID2 -#ifdef __cplusplus -# define VOID2(T, P) static_cast(P) -#else -# define VOID2(T, P) (P) -#endif - -#undef pPTBLMS -#undef pPTBLMS_ -#undef aPTBLMS -#undef aPTBLMS_ - -/* Context for PerlMemShared_* functions */ - -#ifdef PERL_IMPLICIT_SYS -# define pPTBLMS pTHX -# define pPTBLMS_ pTHX_ -# define aPTBLMS aTHX -# define aPTBLMS_ aTHX_ -#else -# define pPTBLMS void -# define pPTBLMS_ -# define aPTBLMS -# define aPTBLMS_ -#endif - -#ifndef pPTBL -# define pPTBL pPTBLMS -#endif -#ifndef pPTBL_ -# define pPTBL_ pPTBLMS_ -#endif -#ifndef aPTBL -# define aPTBL aPTBLMS -#endif -#ifndef aPTBL_ -# define aPTBL_ aPTBLMS_ -#endif - -#ifndef PTABLE_NAME -# define PTABLE_NAME ptable -#endif - -#ifndef PTABLE_VAL_FREE -# define PTABLE_VAL_FREE(V) -#endif - -#ifndef PTABLE_JOIN -# define PTABLE_PASTE(A, B) A ## B -# define PTABLE_JOIN(A, B) PTABLE_PASTE(A, B) -#endif - -#ifndef PTABLE_PREFIX -# define PTABLE_PREFIX(X) PTABLE_JOIN(PTABLE_NAME, X) -#endif - -#ifndef ptable_ent -typedef struct ptable_ent { - struct ptable_ent *next; - const void * key; - void * val; -} ptable_ent; -#define ptable_ent ptable_ent -#endif /* !ptable_ent */ - -#ifndef ptable -typedef struct ptable { - ptable_ent **ary; - size_t max; - size_t items; -} ptable; -#define ptable ptable -#endif /* !ptable */ - -#ifndef ptable_new -STATIC ptable *ptable_new(pPTBLMS) { -#define ptable_new() ptable_new(aPTBLMS) - ptable *t = VOID2(ptable *, PerlMemShared_malloc(sizeof *t)); - t->max = 15; - t->items = 0; - t->ary = VOID2(ptable_ent **, - PerlMemShared_calloc(t->max + 1, sizeof *t->ary)); - return t; -} -#endif /* !ptable_new */ - -#ifndef PTABLE_HASH -# define PTABLE_HASH(ptr) \ - ((PTR2UV(ptr) >> 3) ^ (PTR2UV(ptr) >> (3 + 7)) ^ (PTR2UV(ptr) >> (3 + 17))) -#endif - -#ifndef ptable_find -STATIC ptable_ent *ptable_find(const ptable * const t, const void * const key) { -#define ptable_find ptable_find - ptable_ent *ent; - const UV hash = PTABLE_HASH(key); - - ent = t->ary[hash & t->max]; - for (; ent; ent = ent->next) { - if (ent->key == key) - return ent; - } - - return NULL; -} -#endif /* !ptable_find */ - -#ifndef ptable_fetch -STATIC void *ptable_fetch(const ptable * const t, const void * const key) { -#define ptable_fetch ptable_fetch - const ptable_ent *const ent = ptable_find(t, key); - - return ent ? ent->val : NULL; -} -#endif /* !ptable_fetch */ - -#ifndef ptable_split -STATIC void ptable_split(pPTBLMS_ ptable * const t) { -#define ptable_split(T) ptable_split(aPTBLMS_ (T)) - ptable_ent **ary = t->ary; - const size_t oldsize = t->max + 1; - size_t newsize = oldsize * 2; - size_t i; - - ary = VOID2(ptable_ent **, PerlMemShared_realloc(ary, newsize * sizeof(*ary))); - Zero(&ary[oldsize], newsize - oldsize, sizeof(*ary)); - t->max = --newsize; - t->ary = ary; - - for (i = 0; i < oldsize; i++, ary++) { - ptable_ent **curentp, **entp, *ent; - if (!*ary) - continue; - curentp = ary + oldsize; - for (entp = ary, ent = *ary; ent; ent = *entp) { - if ((newsize & PTABLE_HASH(ent->key)) != i) { - *entp = ent->next; - ent->next = *curentp; - *curentp = ent; - continue; - } else - entp = &ent->next; - } - } -} -#endif /* !ptable_split */ - -STATIC void PTABLE_PREFIX(_store)(pPTBL_ ptable * const t, const void * const key, void * const val) { - ptable_ent *ent = ptable_find(t, key); - - if (ent) { - void *oldval = ent->val; - PTABLE_VAL_FREE(oldval); - ent->val = val; - } else if (val) { - const size_t i = PTABLE_HASH(key) & t->max; - ent = VOID2(ptable_ent *, PerlMemShared_malloc(sizeof *ent)); - ent->key = key; - ent->val = val; - ent->next = t->ary[i]; - t->ary[i] = ent; - t->items++; - if (ent->next && t->items > t->max) - ptable_split(t); - } -} - -STATIC void PTABLE_PREFIX(_delete)(pPTBL_ ptable * const t, const void * const key) { - ptable_ent *prev, *ent; - const size_t i = PTABLE_HASH(key) & t->max; - - prev = NULL; - ent = t->ary[i]; - for (; ent; prev = ent, ent = ent->next) { - if (ent->key == key) - break; - } - - if (ent) { - if (prev) - prev->next = ent->next; - else - t->ary[i] = ent->next; - PTABLE_VAL_FREE(ent->val); - PerlMemShared_free(ent); - } -} - -#ifndef ptable_walk -STATIC void ptable_walk(pTHX_ ptable * const t, void (*cb)(pTHX_ ptable_ent *ent, void *userdata), void *userdata) { -#define ptable_walk(T, CB, UD) ptable_walk(aTHX_ (T), (CB), (UD)) - if (t && t->items) { - register ptable_ent ** const array = t->ary; - size_t i = t->max; - do { - ptable_ent *entry; - for (entry = array[i]; entry; entry = entry->next) - if (entry->val) - cb(aTHX_ entry, userdata); - } while (i--); - } -} -#endif /* !ptable_walk */ - -STATIC void PTABLE_PREFIX(_clear)(pPTBL_ ptable * const t) { - if (t && t->items) { - register ptable_ent ** const array = t->ary; - size_t i = t->max; - - do { - ptable_ent *entry = array[i]; - while (entry) { - ptable_ent * const oentry = entry; - void *val = oentry->val; - entry = entry->next; - PTABLE_VAL_FREE(val); - PerlMemShared_free(oentry); - } - array[i] = NULL; - } while (i--); - - t->items = 0; - } -} - -STATIC void PTABLE_PREFIX(_free)(pPTBL_ ptable * const t) { - if (!t) - return; - PTABLE_PREFIX(_clear)(aPTBL_ t); - PerlMemShared_free(t->ary); - PerlMemShared_free(t); -} - -#undef pPTBL -#undef pPTBL_ -#undef aPTBL -#undef aPTBL_ - -#undef PTABLE_NAME -#undef PTABLE_VAL_FREE