X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=Magic.xs;h=4ac45e73ec12e7de3d11e359d26b38742c2fc2a9;hb=65768c73d8cbf0c086f7032b384de17479aef9fe;hp=084868613602f3697551fe48b19fff83154b51be;hpb=14dd148fdcebf80aa4b583e590eb71b391f111c3;p=perl%2Fmodules%2FVariable-Magic.git diff --git a/Magic.xs b/Magic.xs index 0848686..4ac45e7 100644 --- a/Magic.xs +++ b/Magic.xs @@ -82,6 +82,14 @@ # define MY_CXT_CLONE NOOP #endif +#if VMG_THREADSAFE +# define VMG_LOCK(M) MUTEX_LOCK(M) +# define VMG_UNLOCK(M) MUTEX_UNLOCK(M) +#else +# define VMG_LOCK(M) +# define VMG_UNLOCK(M) +#endif + #if VMG_THREADSAFE STATIC SV *vmg_clone(pTHX_ SV *sv, tTHX owner) { @@ -124,7 +132,7 @@ STATIC SV *vmg_clone(pTHX_ SV *sv, tTHX owner) { #endif #ifndef SvREFCNT_inc_simple_void -# define SvREFCNT_inc_simple_void(sv) SvREFCNT_inc(sv) +# define SvREFCNT_inc_simple_void(sv) ((void) SvREFCNT_inc(sv)) #endif #ifndef mPUSHu @@ -139,14 +147,6 @@ STATIC SV *vmg_clone(pTHX_ SV *sv, tTHX owner) { # define PERL_MAGIC_tied 'P' #endif -#ifndef MGf_COPY -# define MGf_COPY 0 -#endif - -#ifndef MGf_DUP -# define MGf_DUP 0 -#endif - #ifndef MGf_LOCAL # define MGf_LOCAL 0 #endif @@ -213,30 +213,36 @@ STATIC SV *vmg_clone(pTHX_ SV *sv, tTHX owner) { /* ... Bug-free mg_magical ................................................. */ -/* See the discussion at http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2008-01/msg00036.html. This version is specialized to our needs. */ +/* See the discussion at http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2008-01/msg00036.html */ -#if VMG_UVAR +#if VMG_HAS_PERL(5, 11, 3) + +#define vmg_mg_magical(S) mg_magical(S) + +#else + +STATIC void vmg_mg_magical(SV *sv) { + const MAGIC *mg; -STATIC void vmg_sv_magicuvar(pTHX_ SV *sv, const char *uf, I32 len) { -#define vmg_sv_magicuvar(S, U, L) vmg_sv_magicuvar(aTHX_ (S), (U), (L)) - const MAGIC* mg; - sv_magic(sv, NULL, PERL_MAGIC_uvar, uf, len); - /* uvar magic has set and get magic, hence this has set SVs_GMG and SVs_SMG. */ + SvMAGICAL_off(sv); if ((mg = SvMAGIC(sv))) { - SvRMAGICAL_off(sv); do { const MGVTBL* const vtbl = mg->mg_virtual; if (vtbl) { - if (vtbl->svt_clear) { + if (vtbl->svt_get && !(mg->mg_flags & MGf_GSKIP)) + SvGMAGICAL_on(sv); + if (vtbl->svt_set) + SvSMAGICAL_on(sv); + if (vtbl->svt_clear) SvRMAGICAL_on(sv); - break; - } } } while ((mg = mg->mg_moremagic)); + if (!(SvFLAGS(sv) & (SVs_GMG|SVs_SMG))) + SvRMAGICAL_on(sv); } } -#endif /* VMG_UVAR */ +#endif /* ... Safe version of call_sv() ........................................... */ @@ -353,9 +359,11 @@ STATIC opclass vmg_opclass(const OP *o) { return ((o->op_private & OPpASSIGN_BACKWARDS) ? OPc_UNOP : OPc_BINOP); if (o->op_type == OP_AELEMFAST) { +#if PERL_VERSION <= 14 if (o->op_flags & OPf_SPECIAL) return OPc_BASEOP; else +#endif #ifdef USE_ITHREADS return OPc_PADOP; #else @@ -433,12 +441,8 @@ typedef struct { SV *cb_data; SV *cb_get, *cb_set, *cb_len, *cb_clear, *cb_free; -#if MGf_COPY SV *cb_copy; -#endif /* MGf_COPY */ -#if MGf_DUP SV *cb_dup; -#endif /* MGf_DUP */ #if MGf_LOCAL SV *cb_local; #endif /* MGf_LOCAL */ @@ -451,6 +455,26 @@ typedef struct { #endif /* VMG_MULTIPLICITY */ } MGWIZ; +STATIC void vmg_op_info_init(pTHX_ unsigned int opinfo); + +STATIC MGWIZ *vmg_mgwiz_alloc(pTHX_ UV opinfo) { +#define vmg_mgwiz_alloc(O) vmg_mgwiz_alloc(aTHX_ (O)) + MGWIZ *w; + MGVTBL *t; + + Newx(w, 1, MGWIZ); + + w->uvar = 0; + w->opinfo = (U8) ((opinfo < 255) ? opinfo : 255); + if (w->opinfo) + vmg_op_info_init(aTHX_ w->opinfo); + + Newx(t, 1, MGVTBL); + w->vtbl = t; + + return w; +} + STATIC void vmg_mgwiz_free(pTHX_ MGWIZ *w) { #define vmg_mgwiz_free(W) vmg_mgwiz_free(aTHX_ (W)) if (!w) @@ -471,12 +495,10 @@ STATIC void vmg_mgwiz_free(pTHX_ MGWIZ *w) { SvREFCNT_dec(w->cb_len); SvREFCNT_dec(w->cb_clear); SvREFCNT_dec(w->cb_free); -#if MGf_COPY SvREFCNT_dec(w->cb_copy); -#endif /* MGf_COPY */ -#if 0 /* MGf_DUP */ +#if 0 SvREFCNT_dec(w->cb_dup); -#endif /* MGf_DUP */ +#endif #if MGf_LOCAL SvREFCNT_dec(w->cb_local); #endif /* MGf_LOCAL */ @@ -522,12 +544,8 @@ STATIC MGWIZ *vmg_mgwiz_clone(pTHX_ const MGWIZ *w) { VMG_CLONE_CB(len); VMG_CLONE_CB(clear); VMG_CLONE_CB(free); -#if MGf_COPY VMG_CLONE_CB(copy); -#endif /* MGf_COPY */ -#if MGf_DUP VMG_CLONE_CB(dup); -#endif /* MGf_DUP */ #if MGf_LOCAL VMG_CLONE_CB(local); #endif /* MGf_LOCAL */ @@ -603,12 +621,8 @@ STATIC MGVTBL vmg_wizard_vtbl = { NULL, /* len */ NULL, /* clear */ vmg_wizard_free, /* free */ -#if MGf_COPY NULL, /* copy */ -#endif /* MGf_COPY */ -#if MGf_DUP NULL, /* dup */ -#endif /* MGf_DUP */ #if MGf_LOCAL NULL, /* local */ #endif /* MGf_LOCAL */ @@ -751,7 +765,7 @@ STATIC SV *vmg_data_get(pTHX_ SV *sv, const SV *wiz) { #define vmg_data_get(S, W) vmg_data_get(aTHX_ (S), (W)) const MAGIC *mg = vmg_find(sv, wiz); return mg ? mg->mg_obj : NULL; -} +} /* ... Magic cast/dispell .................................................. */ @@ -784,17 +798,17 @@ STATIC UV vmg_cast(pTHX_ SV *sv, const SV *wiz, SV **args, I32 items) { oldgmg = SvGMAGICAL(sv); data = (w->cb_data) ? vmg_data_new(w->cb_data, sv, args, items) : NULL; - mg = sv_magicext(sv, data, PERL_MAGIC_ext, w->vtbl, (const char *) wiz, HEf_SVKEY); + /* sv_magicext() calls mg_magical and increments data's refcount */ + mg = sv_magicext(sv, data, PERL_MAGIC_ext, w->vtbl, + (const char *) wiz, HEf_SVKEY); SvREFCNT_dec(data); mg->mg_private = SIG_WIZ; -#if MGf_COPY if (w->cb_copy) mg->mg_flags |= MGf_COPY; -#endif /* MGf_COPY */ -#if 0 /* MGf_DUP */ +#if 0 if (w->cb_dup) mg->mg_flags |= MGf_DUP; -#endif /* MGf_DUP */ +#endif #if MGf_LOCAL if (w->cb_local) mg->mg_flags |= MGf_LOCAL; @@ -843,7 +857,8 @@ STATIC UV vmg_cast(pTHX_ SV *sv, const SV *wiz, SV **args, I32 items) { } } - vmg_sv_magicuvar(sv, (const char *) &uf, sizeof(uf)); + sv_magic(sv, NULL, PERL_MAGIC_uvar, (const char *) &uf, sizeof(uf)); + vmg_mg_magical(sv); /* Our hash now carries uvar magic. The uvar/clear shortcoming has to be * handled by our uvar callback. */ } @@ -940,6 +955,8 @@ STATIC UV vmg_dispell(pTHX_ SV *sv, const SV *wiz) { } #endif /* VMG_UVAR */ + vmg_mg_magical(sv); + return 1; } @@ -959,18 +976,14 @@ STATIC void vmg_op_info_init(pTHX_ unsigned int opinfo) { #define vmg_op_info_init(W) vmg_op_info_init(aTHX_ (W)) switch (opinfo) { case VMG_OP_INFO_NAME: -#if VMG_THREADSAFE - MUTEX_LOCK(&vmg_op_name_init_mutex); -#endif + VMG_LOCK(&vmg_op_name_init_mutex); if (!vmg_op_name_init) { OPCODE t; for (t = 0; t < OP_max; ++t) vmg_op_name_len[t] = strlen(PL_op_name[t]); vmg_op_name_init = 1; } -#if VMG_THREADSAFE - MUTEX_UNLOCK(&vmg_op_name_init_mutex); -#endif + VMG_UNLOCK(&vmg_op_name_init_mutex); break; case VMG_OP_INFO_OBJECT: { dMY_CXT; @@ -1191,7 +1204,6 @@ STATIC int vmg_svt_free(pTHX_ SV *sv, MAGIC *mg) { return ret; } -#if MGf_COPY STATIC int vmg_svt_copy(pTHX_ SV *sv, MAGIC *mg, SV *nsv, const char *key, # if VMG_HAS_PERL_MAINT(5, 11, 0, 33256) || VMG_HAS_PERL(5, 12, 0) I32 keylen @@ -1217,13 +1229,12 @@ STATIC int vmg_svt_copy(pTHX_ SV *sv, MAGIC *mg, SV *nsv, const char *key, return ret; } -#endif /* MGf_COPY */ -#if 0 /* MGf_DUP */ +#if 0 STATIC int vmg_svt_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *param) { return 0; } -#endif /* MGf_DUP */ +#endif #if MGf_LOCAL STATIC int vmg_svt_local(pTHX_ SV *nsv, MAGIC *mg) { @@ -1431,20 +1442,13 @@ SV *_wizard(...) PROTOTYPE: DISABLE PREINIT: I32 i = 0; - UV opinfo; MGWIZ *w; MGVTBL *t; - SV *cb; + SV *cb, *op_info, *copy_key; CODE: dMY_CXT; - if (items != 7 -#if MGf_COPY - + 1 -#endif /* MGf_COPY */ -#if MGf_DUP - + 1 -#endif /* MGf_DUP */ + if (items != 9 #if MGf_LOCAL + 1 #endif /* MGf_LOCAL */ @@ -1453,31 +1457,22 @@ CODE: #endif /* VMG_UVAR */ ) { croak(vmg_wrongargnum); } - Newx(t, 1, MGVTBL); - Newx(w, 1, MGWIZ); + op_info = ST(i++); + w = vmg_mgwiz_alloc(SvOK(op_info) ? SvUV(op_info) : 0); + t = w->vtbl; VMG_SET_CB(ST(i++), data); - cb = ST(i++); - opinfo = SvOK(cb) ? SvUV(cb) : 0; - w->opinfo = (U8) ((opinfo < 255) ? opinfo : 255); - if (w->opinfo) - vmg_op_info_init(w->opinfo); - VMG_SET_SVT_CB(ST(i++), get); VMG_SET_SVT_CB(ST(i++), set); VMG_SET_SVT_CB(ST(i++), len); VMG_SET_SVT_CB(ST(i++), clear); VMG_SET_SVT_CB(ST(i++), free); -#if MGf_COPY VMG_SET_SVT_CB(ST(i++), copy); -#endif /* MGf_COPY */ -#if MGf_DUP /* VMG_SET_SVT_CB(ST(i++), dup); */ i++; t->svt_dup = NULL; w->cb_dup = NULL; -#endif /* MGf_DUP */ #if MGf_LOCAL VMG_SET_SVT_CB(ST(i++), local); #endif /* MGf_LOCAL */ @@ -1486,16 +1481,14 @@ CODE: VMG_SET_CB(ST(i++), store); VMG_SET_CB(ST(i++), exists); VMG_SET_CB(ST(i++), delete); - cb = ST(i++); + + copy_key = ST(i++); if (w->cb_fetch || w->cb_store || w->cb_exists || w->cb_delete) - w->uvar = SvTRUE(cb) ? 2 : 1; - else - w->uvar = 0; + w->uvar = SvTRUE(copy_key) ? 2 : 1; #endif /* VMG_UVAR */ #if VMG_MULTIPLICITY w->owner = aTHX; #endif /* VMG_MULTIPLICITY */ - w->vtbl = t; #if VMG_THREADSAFE ptable_store(MY_CXT.wizards, w, w); #endif /* VMG_THREADSAFE */