if (!w)
return;
- if (w->cb_data) SvREFCNT_dec(SvRV(w->cb_data));
- if (w->cb_get) SvREFCNT_dec(SvRV(w->cb_get));
- if (w->cb_set) SvREFCNT_dec(SvRV(w->cb_set));
- if (w->cb_len) SvREFCNT_dec(SvRV(w->cb_len));
- if (w->cb_clear) SvREFCNT_dec(SvRV(w->cb_clear));
- if (w->cb_free) SvREFCNT_dec(SvRV(w->cb_free));
+ if (w->cb_data) SvREFCNT_dec(w->cb_data);
+ if (w->cb_get) SvREFCNT_dec(w->cb_get);
+ if (w->cb_set) SvREFCNT_dec(w->cb_set);
+ if (w->cb_len) SvREFCNT_dec(w->cb_len);
+ if (w->cb_clear) SvREFCNT_dec(w->cb_clear);
+ if (w->cb_free) SvREFCNT_dec(w->cb_free);
#if MGf_COPY
- if (w->cb_copy) SvREFCNT_dec(SvRV(w->cb_copy));
+ if (w->cb_copy) SvREFCNT_dec(w->cb_copy);
#endif /* MGf_COPY */
#if 0 /* MGf_DUP */
- if (w->cb_dup) SvREFCNT_dec(SvRV(w->cb_dup));
+ if (w->cb_dup) SvREFCNT_dec(w->cb_dup);
#endif /* MGf_DUP */
#if MGf_LOCAL
- if (w->cb_local) SvREFCNT_dec(SvRV(w->cb_local));
+ if (w->cb_local) SvREFCNT_dec(w->cb_local);
#endif /* MGf_LOCAL */
#if VMG_UVAR
- if (w->cb_fetch) SvREFCNT_dec(SvRV(w->cb_fetch));
- if (w->cb_store) SvREFCNT_dec(SvRV(w->cb_store));
- if (w->cb_exists) SvREFCNT_dec(SvRV(w->cb_exists));
- if (w->cb_delete) SvREFCNT_dec(SvRV(w->cb_delete));
+ if (w->cb_fetch) SvREFCNT_dec(w->cb_fetch);
+ if (w->cb_store) SvREFCNT_dec(w->cb_store);
+ if (w->cb_exists) SvREFCNT_dec(w->cb_exists);
+ if (w->cb_delete) SvREFCNT_dec(w->cb_delete);
#endif /* VMG_UVAR */
Safefree(w->vtbl);
ptable_store(ud->wizards, ent->key, w);
}
+STATIC void vmg_thread_cleanup(pTHX_ void *);
+
+STATIC void vmg_thread_cleanup(pTHX_ void *ud) {
+ int *level = ud;
+
+ if (*level) {
+ --*level;
+ LEAVE;
+ SAVEDESTRUCTOR_X(vmg_thread_cleanup, level);
+ ENTER;
+ } else {
+ dMY_CXT;
+ PerlMemShared_free(level);
+ ptable_free(MY_CXT.wizards);
+ }
+}
#endif /* VMG_THREADSAFE */
/* --- Wizard objects ------------------------------------------------------ */
STATIC SV *vmg_wizard_new(pTHX_ const MGWIZ *w) {
#define vmg_wizard_new(W) vmg_wizard_new(aTHX_ (W))
- SV *wiz = newSVuv(PTR2UV(w));
+ SV *wiz = newSVuv(PTR2IV(w));
if (w) {
MAGIC *mg = sv_magicext(wiz, NULL, PERL_MAGIC_ext, &vmg_wizard_vtbl, NULL, 0);
return wiz;
}
-STATIC SV *vmg_wizard_validate(pTHX_ SV *wiz) {
+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(wiz);
croak(vmg_invalid_wiz);
}
-#define vmg_wizard_id(W) SvUV((SV *) (W))
+#define vmg_wizard_id(W) SvIVX((const SV *) (W))
#define vmg_wizard_main_mgwiz(W) INT2PTR(const MGWIZ *, vmg_wizard_id(W))
/* ... Wizard destructor ................................................... */
#if VMG_THREADSAFE
-STATIC const MGWIZ *vmg_wizard_mgwiz(pTHX_ SV *wiz) {
-#define vmg_wizard_mgwiz(W) vmg_wizard_mgwiz(aTHX_ ((SV *) (W)))
+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);
/* --- User-level functions implementation --------------------------------- */
-STATIC const MAGIC *vmg_find(pTHX_ const SV *sv, SV *wiz) {
-#define vmg_find(S, W) vmg_find(aTHX_ (S), (W))
+STATIC const MAGIC *vmg_find(const SV *sv, const SV *wiz) {
const MAGIC *mg, *moremagic;
UV wid;
return nsv;
}
-STATIC SV *vmg_data_get(pTHX_ SV *sv, SV *wiz) {
+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;
}
#endif /* VMG_UVAR */
-STATIC UV vmg_cast(pTHX_ SV *sv, SV *wiz, AV *args) {
+STATIC UV vmg_cast(pTHX_ SV *sv, const SV *wiz, AV *args) {
#define vmg_cast(S, W, A) vmg_cast(aTHX_ (S), (W), (A))
MAGIC *mg, *moremagic = NULL;
SV *data;
return 1;
}
-STATIC UV vmg_dispell(pTHX_ SV *sv, SV *wiz) {
+STATIC UV vmg_dispell(pTHX_ SV *sv, const SV *wiz) {
#define vmg_dispell(S, W) vmg_dispell(aTHX_ (S), (W))
#if VMG_UVAR
U32 uvars = 0;
PUSHs(mg->mg_obj ? mg->mg_obj : &PL_sv_undef);
if (t < SVt_PVAV) {
STRLEN l;
- U8 *s = (U8 *) SvPV_const(sv, l);
+ const U8 *s = (const U8 *) SvPV_const(sv, l);
if (DO_UTF8(sv))
len = utf8_length(s, s + l);
else
PROTOTYPE: DISABLE
PREINIT:
ptable *t;
- int *level;
U32 had_b__op_stash = 0;
opclass c;
-CODE:
+PPCODE:
{
my_cxt_t ud;
dMY_CXT;
? gv_stashpv(vmg_opclassnames[c], 1) : NULL;
}
}
+ {
+ int *level;
+ level = PerlMemShared_malloc(sizeof *level);
+ *level = 1;
+ LEAVE;
+ SAVEDESTRUCTOR_X(vmg_thread_cleanup, level);
+ ENTER;
+ }
+ XSRETURN(0);
#endif /* VMG_THREADSAFE */
PROTOTYPE: DISABLE
PREINIT:
I32 i = 0;
- char buf[8];
MGWIZ *w;
MGVTBL *t;
- MAGIC *mg;
- SV *wiz;
SV *cb;
CODE:
dMY_CXT;
AV *args = NULL;
SV *ret;
CODE:
- wiz = vmg_wizard_validate(wiz);
if (items > 2) {
I32 i;
args = newAV();
if (av_store(args, i - 2, arg) == NULL) croak(vmg_argstorefailed);
}
}
- ret = newSVuv(vmg_cast(SvRV(sv), wiz, args));
+ ret = newSVuv(vmg_cast(SvRV(sv), vmg_wizard_validate(wiz), args));
SvREFCNT_dec(args);
RETVAL = ret;
OUTPUT:
PREINIT:
SV *data;
PPCODE:
- wiz = vmg_wizard_validate(wiz);
- data = vmg_data_get(SvRV(sv), wiz);
+ data = vmg_data_get(SvRV(sv), vmg_wizard_validate(wiz));
if (!data)
XSRETURN_EMPTY;
ST(0) = data;
SV *dispell(SV *sv, SV *wiz)
PROTOTYPE: \[$@%&*]$
-PREINIT:
- U16 sig;
CODE:
- wiz = vmg_wizard_validate(wiz);
- RETVAL = newSVuv(vmg_dispell(SvRV(sv), wiz));
+ RETVAL = newSVuv(vmg_dispell(SvRV(sv), vmg_wizard_validate(wiz)));
OUTPUT:
RETVAL