X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=Magic.xs;h=207fcb383a75a3162632239b0cc74c7ff5335504;hb=64d80b88646a16ec430354d4139798d152f0e3ca;hp=c6d7454253ae85cd695ac5771c90f833e62155c0;hpb=409cfea21be163f1168685893a9a61a5cfc45b8e;p=perl%2Fmodules%2FVariable-Magic.git

diff --git a/Magic.xs b/Magic.xs
index c6d7454..207fcb3 100644
--- a/Magic.xs
+++ b/Magic.xs
@@ -49,12 +49,17 @@
 #endif
 
 #ifndef VMG_MULTIPLICITY
-# if defined(MULTIPLICITY) || defined(PERL_IMPLICIT_CONTEXT)
+# if defined(MULTIPLICITY)
 #  define VMG_MULTIPLICITY 1
 # else
 #  define VMG_MULTIPLICITY 0
 # endif
 #endif
+#if VMG_MULTIPLICITY
+# ifndef PERL_IMPLICIT_CONTEXT
+#  error MULTIPLICITY builds must set PERL_IMPLICIT_CONTEXT
+# endif
+#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
@@ -214,7 +219,7 @@
 
 #else
 
-STATIC void vmg_mg_magical(SV *sv) {
+static void vmg_mg_magical(SV *sv) {
  const MAGIC *mg;
 
  SvMAGICAL_off(sv);
@@ -248,7 +253,7 @@ typedef struct {
  SVOP target;
 } vmg_trampoline;
 
-STATIC void vmg_trampoline_init(vmg_trampoline *t, OP *(*cb)(pTHX)) {
+static void vmg_trampoline_init(vmg_trampoline *t, OP *(*cb)(pTHX)) {
  t->temp.op_type    = OP_STUB;
  t->temp.op_ppaddr  = 0;
  t->temp.op_next    = (OP *) &t->target;
@@ -263,7 +268,7 @@ STATIC void vmg_trampoline_init(vmg_trampoline *t, OP *(*cb)(pTHX)) {
  t->target.op_sv      = NULL;
 }
 
-STATIC OP *vmg_trampoline_bump(pTHX_ vmg_trampoline *t, SV *sv, OP *o) {
+static OP *vmg_trampoline_bump(pTHX_ vmg_trampoline *t, SV *sv, OP *o) {
 #define vmg_trampoline_bump(T, S, O) vmg_trampoline_bump(aTHX_ (T), (S), (O))
  t->temp         = *o;
  t->temp.op_next = (OP *) &t->target;
@@ -278,7 +283,7 @@ STATIC OP *vmg_trampoline_bump(pTHX_ vmg_trampoline *t, SV *sv, OP *o) {
 
 /* --- Cleaner version of sv_magicext() ------------------------------------ */
 
-STATIC MAGIC *vmg_sv_magicext(pTHX_ SV *sv, SV *obj, const MGVTBL *vtbl, const void *ptr, I32 len) {
+static MAGIC *vmg_sv_magicext(pTHX_ SV *sv, SV *obj, const MGVTBL *vtbl, const void *ptr, I32 len) {
 #define vmg_sv_magicext(S, O, V, P, L) vmg_sv_magicext(aTHX_ (S), (O), (V), (P), (L))
  MAGIC *mg;
 
@@ -288,6 +293,17 @@ STATIC MAGIC *vmg_sv_magicext(pTHX_ SV *sv, SV *obj, const MGVTBL *vtbl, const v
 
  mg->mg_private = 0;
 
+ if (vtbl->svt_copy)
+  mg->mg_flags |= MGf_COPY;
+#if MGf_DUP
+ if (vtbl->svt_dup)
+  mg->mg_flags |= MGf_DUP;
+#endif /* MGf_DUP */
+#if MGf_LOCAL
+ if (vtbl->svt_local)
+  mg->mg_flags |= MGf_LOCAL;
+#endif /* MGf_LOCAL */
+
  if (mg->mg_flags & MGf_REFCOUNTED)
   SvREFCNT_dec(obj);
 
@@ -296,7 +312,7 @@ STATIC MAGIC *vmg_sv_magicext(pTHX_ SV *sv, SV *obj, const MGVTBL *vtbl, const v
 
 /* --- Safe version of call_sv() ------------------------------------------- */
 
-STATIC I32 vmg_call_sv(pTHX_ SV *sv, I32 flags, int (*cleanup)(pTHX_ void *), void *ud) {
+static I32 vmg_call_sv(pTHX_ SV *sv, I32 flags, int (*cleanup)(pTHX_ void *), void *ud) {
 #define vmg_call_sv(S, F, C, U) vmg_call_sv(aTHX_ (S), (F), (C), (U))
  I32 ret, cxix;
  PERL_CONTEXT saved_cx;
@@ -370,7 +386,7 @@ typedef enum {
  OPc_MAX
 } opclass;
 
-STATIC const char *const vmg_opclassnames[] = {
+static const char *const vmg_opclassnames[] = {
  "B::NULL",
  "B::OP",
  "B::UNOP",
@@ -389,7 +405,7 @@ STATIC const char *const vmg_opclassnames[] = {
  NULL
 };
 
-STATIC opclass vmg_opclass(const OP *o) {
+static opclass vmg_opclass(const OP *o) {
 #if 0
  if (!o)
   return OPc_NULL;
@@ -469,9 +485,9 @@ STATIC opclass vmg_opclass(const OP *o) {
 
 /* --- Error messages ------------------------------------------------------ */
 
-STATIC const char vmg_invalid_wiz[]    = "Invalid wizard object";
-STATIC const char vmg_wrongargnum[]    = "Wrong number of arguments";
-STATIC const char vmg_argstorefailed[] = "Error while storing arguments";
+static const char vmg_invalid_wiz[]    = "Invalid wizard object";
+static const char vmg_wrongargnum[]    = "Wrong number of arguments";
+static const char vmg_argstorefailed[] = "Error while storing arguments";
 
 /* --- Context-safe global data -------------------------------------------- */
 
@@ -500,7 +516,7 @@ typedef struct {
  U32     refcount;
 } vmg_vtable;
 
-STATIC vmg_vtable *vmg_vtable_alloc(pTHX) {
+static vmg_vtable *vmg_vtable_alloc(pTHX) {
 #define vmg_vtable_alloc() vmg_vtable_alloc(aTHX)
  vmg_vtable *t;
 
@@ -514,9 +530,9 @@ STATIC vmg_vtable *vmg_vtable_alloc(pTHX) {
 
 #define vmg_vtable_vtbl(T) (T)->vtbl
 
-STATIC perl_mutex vmg_vtable_refcount_mutex;
+static perl_mutex vmg_vtable_refcount_mutex;
 
-STATIC vmg_vtable *vmg_vtable_dup(pTHX_ vmg_vtable *t) {
+static vmg_vtable *vmg_vtable_dup(pTHX_ vmg_vtable *t) {
 #define vmg_vtable_dup(T) vmg_vtable_dup(aTHX_ (T))
  VMG_LOCK(&vmg_vtable_refcount_mutex);
  ++t->refcount;
@@ -525,7 +541,7 @@ STATIC vmg_vtable *vmg_vtable_dup(pTHX_ vmg_vtable *t) {
  return t;
 }
 
-STATIC void vmg_vtable_free(pTHX_ vmg_vtable *t) {
+static void vmg_vtable_free(pTHX_ vmg_vtable *t) {
 #define vmg_vtable_free(T) vmg_vtable_free(aTHX_ (T))
  U32 refcount;
 
@@ -543,7 +559,7 @@ STATIC void vmg_vtable_free(pTHX_ vmg_vtable *t) {
 
 typedef MGVTBL vmg_vtable;
 
-STATIC vmg_vtable *vmg_vtable_alloc(pTHX) {
+static vmg_vtable *vmg_vtable_alloc(pTHX) {
 #define vmg_vtable_alloc() vmg_vtable_alloc(aTHX)
  vmg_vtable *t;
 
@@ -578,9 +594,9 @@ typedef struct {
 #endif /* VMG_UVAR */
 } vmg_wizard;
 
-STATIC void vmg_op_info_init(pTHX_ unsigned int opinfo);
+static void vmg_op_info_init(pTHX_ unsigned int opinfo);
 
-STATIC vmg_wizard *vmg_wizard_alloc(pTHX_ UV opinfo) {
+static vmg_wizard *vmg_wizard_alloc(pTHX_ UV opinfo) {
 #define vmg_wizard_alloc(O) vmg_wizard_alloc(aTHX_ (O))
  vmg_wizard *w;
 
@@ -596,7 +612,7 @@ STATIC vmg_wizard *vmg_wizard_alloc(pTHX_ UV opinfo) {
  return w;
 }
 
-STATIC void vmg_wizard_free(pTHX_ vmg_wizard *w) {
+static void vmg_wizard_free(pTHX_ vmg_wizard *w) {
 #define vmg_wizard_free(W) vmg_wizard_free(aTHX_ (W))
  if (!w)
   return;
@@ -639,7 +655,7 @@ STATIC void vmg_wizard_free(pTHX_ vmg_wizard *w) {
  z->cb_ ## N = (w->cb_ ## N) ? SvREFCNT_inc(sv_dup(w->cb_ ## N, params)) \
                              : NULL;
 
-STATIC const vmg_wizard *vmg_wizard_dup(pTHX_ const vmg_wizard *w, CLONE_PARAMS *params) {
+static const vmg_wizard *vmg_wizard_dup(pTHX_ const vmg_wizard *w, CLONE_PARAMS *params) {
 #define vmg_wizard_dup(W, P) vmg_wizard_dup(aTHX_ (W), (P))
  vmg_wizard *z;
 
@@ -679,7 +695,7 @@ STATIC const vmg_wizard *vmg_wizard_dup(pTHX_ const vmg_wizard *w, CLONE_PARAMS
 
 /* --- Wizard SV objects --------------------------------------------------- */
 
-STATIC int vmg_wizard_sv_free(pTHX_ SV *sv, MAGIC *mg) {
+static int vmg_wizard_sv_free(pTHX_ SV *sv, MAGIC *mg) {
  vmg_wizard_free((vmg_wizard *) mg->mg_ptr);
 
  return 0;
@@ -687,7 +703,7 @@ STATIC int vmg_wizard_sv_free(pTHX_ SV *sv, MAGIC *mg) {
 
 #if VMG_THREADSAFE
 
-STATIC int vmg_wizard_sv_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *params) {
+static int vmg_wizard_sv_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *params) {
  mg->mg_ptr = (char *) vmg_wizard_dup((const vmg_wizard *) mg->mg_ptr, params);
 
  return 0;
@@ -695,7 +711,7 @@ STATIC int vmg_wizard_sv_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *params) {
 
 #endif /* VMG_THREADSAFE */
 
-STATIC MGVTBL vmg_wizard_sv_vtbl = {
+static MGVTBL vmg_wizard_sv_vtbl = {
  NULL,               /* get */
  NULL,               /* set */
  NULL,               /* len */
@@ -712,7 +728,7 @@ STATIC MGVTBL vmg_wizard_sv_vtbl = {
 #endif /* MGf_LOCAL */
 };
 
-STATIC SV *vmg_wizard_sv_new(pTHX_ const vmg_wizard *w) {
+static SV *vmg_wizard_sv_new(pTHX_ const vmg_wizard *w) {
 #define vmg_wizard_sv_new(W) vmg_wizard_sv_new(aTHX_ (W))
  SV *wiz;
 
@@ -722,13 +738,8 @@ STATIC SV *vmg_wizard_sv_new(pTHX_ const vmg_wizard *w) {
  wiz = newSViv(PTR2IV(w));
 #endif
 
- if (w) {
-  MAGIC *mg;
-  mg = vmg_sv_magicext(wiz, NULL, &vmg_wizard_sv_vtbl, w, 0);
-#if VMG_THREADSAFE
-  mg->mg_flags |= MGf_DUP;
-#endif
- }
+ vmg_sv_magicext(wiz, NULL, &vmg_wizard_sv_vtbl, w, 0);
+
  SvREADONLY_on(wiz);
 
  return wiz;
@@ -738,7 +749,7 @@ STATIC SV *vmg_wizard_sv_new(pTHX_ const vmg_wizard *w) {
 
 #define vmg_sv_has_wizard_type(S) (SvTYPE(S) >= SVt_PVMG)
 
-STATIC const vmg_wizard *vmg_wizard_from_sv_nocheck(const SV *wiz) {
+static const vmg_wizard *vmg_wizard_from_sv_nocheck(const SV *wiz) {
  MAGIC *mg;
 
  for (mg = SvMAGIC(wiz); mg; mg = mg->mg_moremagic) {
@@ -759,7 +770,7 @@ STATIC const vmg_wizard *vmg_wizard_from_sv_nocheck(const SV *wiz) {
 
 #define vmg_wizard_from_sv(W) (vmg_sv_has_wizard_type(W) ? vmg_wizard_from_sv_nocheck(W) : NULL)
 
-STATIC const vmg_wizard *vmg_wizard_from_mg(const MAGIC *mg) {
+static const vmg_wizard *vmg_wizard_from_mg(const MAGIC *mg) {
  if (mg->mg_type == PERL_MAGIC_ext && mg->mg_len == HEf_SVKEY) {
   SV *sv = (SV *) mg->mg_ptr;
 
@@ -774,7 +785,7 @@ STATIC const vmg_wizard *vmg_wizard_from_mg(const MAGIC *mg) {
 
 /* --- User-level functions implementation --------------------------------- */
 
-STATIC const MAGIC *vmg_find(const SV *sv, const vmg_wizard *w) {
+static const MAGIC *vmg_find(const SV *sv, const vmg_wizard *w) {
  const MAGIC *mg;
  IV wid;
 
@@ -795,7 +806,7 @@ STATIC const MAGIC *vmg_find(const SV *sv, const vmg_wizard *w) {
 
 /* ... Construct private data .............................................. */
 
-STATIC SV *vmg_data_new(pTHX_ SV *ctor, SV *sv, SV **args, I32 items) {
+static SV *vmg_data_new(pTHX_ SV *ctor, SV *sv, SV **args, I32 items) {
 #define vmg_data_new(C, S, A, I) vmg_data_new(aTHX_ (C), (S), (A), (I))
  I32 i;
  SV *nsv;
@@ -829,7 +840,7 @@ STATIC SV *vmg_data_new(pTHX_ SV *ctor, SV *sv, SV **args, I32 items) {
  return nsv;
 }
 
-STATIC SV *vmg_data_get(pTHX_ SV *sv, const vmg_wizard *w) {
+static SV *vmg_data_get(pTHX_ SV *sv, const vmg_wizard *w) {
 #define vmg_data_get(S, W) vmg_data_get(aTHX_ (S), (W))
  const MAGIC *mg = vmg_find(sv, w);
 
@@ -840,7 +851,7 @@ STATIC SV *vmg_data_get(pTHX_ SV *sv, const vmg_wizard *w) {
 
 #if VMG_UVAR
 
-STATIC I32 vmg_svt_val(pTHX_ IV, SV *);
+static I32 vmg_svt_val(pTHX_ IV, SV *);
 
 typedef struct {
  struct ufuncs new_uf;
@@ -849,7 +860,7 @@ typedef struct {
 
 #endif /* VMG_UVAR */
 
-STATIC void vmg_mg_del(pTHX_ SV *sv, MAGIC *prevmagic, MAGIC *mg, MAGIC *moremagic) {
+static void vmg_mg_del(pTHX_ SV *sv, MAGIC *prevmagic, MAGIC *mg, MAGIC *moremagic) {
 #define vmg_mg_del(S, P, M, N) vmg_mg_del(aTHX_ (S), (P), (M), (N))
  dMY_CXT;
 
@@ -884,7 +895,7 @@ STATIC void vmg_mg_del(pTHX_ SV *sv, MAGIC *prevmagic, MAGIC *mg, MAGIC *moremag
  }
 }
 
-STATIC int vmg_magic_chain_free(pTHX_ MAGIC *mg, MAGIC *skip) {
+static int vmg_magic_chain_free(pTHX_ MAGIC *mg, MAGIC *skip) {
 #define vmg_magic_chain_free(M, S) vmg_magic_chain_free(aTHX_ (M), (S))
  int skipped = 0;
 
@@ -902,7 +913,7 @@ STATIC int vmg_magic_chain_free(pTHX_ MAGIC *mg, MAGIC *skip) {
  return skipped;
 }
 
-STATIC UV vmg_cast(pTHX_ SV *sv, const vmg_wizard *w, const SV *wiz, SV **args, I32 items) {
+static UV vmg_cast(pTHX_ SV *sv, const vmg_wizard *w, const SV *wiz, SV **args, I32 items) {
 #define vmg_cast(S, W, WIZ, A, I) vmg_cast(aTHX_ (S), (W), (WIZ), (A), (I))
  MAGIC  *mg;
  MGVTBL *t;
@@ -919,17 +930,6 @@ STATIC UV vmg_cast(pTHX_ SV *sv, const vmg_wizard *w, const SV *wiz, SV **args,
  t  = vmg_vtable_vtbl(w->vtable);
  mg = vmg_sv_magicext(sv, data, t, wiz, HEf_SVKEY);
 
- if (t->svt_copy)
-  mg->mg_flags |= MGf_COPY;
-#if 0
- if (t->svt_dup)
-  mg->mg_flags |= MGf_DUP;
-#endif
-#if MGf_LOCAL
- if (t->svt_local)
-  mg->mg_flags |= MGf_LOCAL;
-#endif /* MGf_LOCAL */
-
  if (SvTYPE(sv) < SVt_PVHV)
   goto done;
 
@@ -984,7 +984,7 @@ done:
  return 1;
 }
 
-STATIC UV vmg_dispell(pTHX_ SV *sv, const vmg_wizard *w) {
+static UV vmg_dispell(pTHX_ SV *sv, const vmg_wizard *w) {
 #define vmg_dispell(S, W) vmg_dispell(aTHX_ (S), (W))
 #if VMG_UVAR
  U32 uvars = 0;
@@ -1074,13 +1074,13 @@ STATIC UV vmg_dispell(pTHX_ SV *sv, const vmg_wizard *w) {
 #define VMG_OP_INFO_OBJECT 2
 
 #if VMG_THREADSAFE
-STATIC perl_mutex vmg_op_name_init_mutex;
+static perl_mutex vmg_op_name_init_mutex;
 #endif
 
-STATIC U32           vmg_op_name_init      = 0;
-STATIC unsigned char vmg_op_name_len[MAXO] = { 0 };
+static U32           vmg_op_name_init      = 0;
+static unsigned char vmg_op_name_len[MAXO] = { 0 };
 
-STATIC void vmg_op_info_init(pTHX_ unsigned int opinfo) {
+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:
@@ -1108,7 +1108,7 @@ STATIC void vmg_op_info_init(pTHX_ unsigned int opinfo) {
  }
 }
 
-STATIC SV *vmg_op_info(pTHX_ unsigned int opinfo) {
+static SV *vmg_op_info(pTHX_ unsigned int opinfo) {
 #define vmg_op_info(W) vmg_op_info(aTHX_ (W))
  if (!PL_op)
   return &PL_sv_undef;
@@ -1137,7 +1137,7 @@ STATIC SV *vmg_op_info(pTHX_ unsigned int opinfo) {
 #define VMG_CB_CALL_OPINFO     (VMG_OP_INFO_NAME|VMG_OP_INFO_OBJECT) /* 1|2 */
 #define VMG_CB_CALL_GUARD      4
 
-STATIC int vmg_dispell_guard_oncroak(pTHX_ void *ud) {
+static int vmg_dispell_guard_oncroak(pTHX_ void *ud) {
  dMY_CXT;
 
  MY_CXT.depth--;
@@ -1153,7 +1153,7 @@ STATIC int vmg_dispell_guard_oncroak(pTHX_ void *ud) {
  return 1;
 }
 
-STATIC int vmg_dispell_guard_free(pTHX_ SV *sv, MAGIC *mg) {
+static int vmg_dispell_guard_free(pTHX_ SV *sv, MAGIC *mg) {
  vmg_magic_chain_free((MAGIC *) mg->mg_ptr, NULL);
 
  return 0;
@@ -1161,7 +1161,7 @@ STATIC int vmg_dispell_guard_free(pTHX_ SV *sv, MAGIC *mg) {
 
 #if VMG_THREADSAFE
 
-STATIC int vmg_dispell_guard_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *params) {
+static int vmg_dispell_guard_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *params) {
  /* The freed magic tokens aren't cloned by perl because it cannot reach them
   * (they have been detached from their parent SV when they were enqueued).
   * Hence there's nothing to purge in the new thread. */
@@ -1172,7 +1172,7 @@ STATIC int vmg_dispell_guard_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *params) {
 
 #endif /* VMG_THREADSAFE */
 
-STATIC MGVTBL vmg_dispell_guard_vtbl = {
+static MGVTBL vmg_dispell_guard_vtbl = {
  NULL,                   /* get */
  NULL,                   /* set */
  NULL,                   /* len */
@@ -1189,7 +1189,7 @@ STATIC MGVTBL vmg_dispell_guard_vtbl = {
 #endif /* MGf_LOCAL */
 };
 
-STATIC SV *vmg_dispell_guard_new(pTHX_ MAGIC *root) {
+static SV *vmg_dispell_guard_new(pTHX_ MAGIC *root) {
 #define vmg_dispell_guard_new(R) vmg_dispell_guard_new(aTHX_ (R))
  SV *guard;
 
@@ -1199,7 +1199,7 @@ STATIC SV *vmg_dispell_guard_new(pTHX_ MAGIC *root) {
  return guard;
 }
 
-STATIC int vmg_cb_call(pTHX_ SV *cb, unsigned int flags, SV *sv, ...) {
+static int vmg_cb_call(pTHX_ SV *cb, unsigned int flags, SV *sv, ...) {
  va_list ap;
  int ret = 0;
  unsigned int i, args, opinfo;
@@ -1268,13 +1268,13 @@ STATIC int vmg_cb_call(pTHX_ SV *cb, unsigned int flags, SV *sv, ...) {
 
 /* ... Default no-op magic callback ........................................ */
 
-STATIC int vmg_svt_default_noop(pTHX_ SV *sv, MAGIC *mg) {
+static int vmg_svt_default_noop(pTHX_ SV *sv, MAGIC *mg) {
  return 0;
 }
 
 /* ... get magic ........................................................... */
 
-STATIC int vmg_svt_get(pTHX_ SV *sv, MAGIC *mg) {
+static int vmg_svt_get(pTHX_ SV *sv, MAGIC *mg) {
  const vmg_wizard *w = vmg_wizard_from_mg_nocheck(mg);
 
  return vmg_cb_call1(w->cb_get, w->opinfo, sv, mg->mg_obj);
@@ -1284,7 +1284,7 @@ STATIC int vmg_svt_get(pTHX_ SV *sv, MAGIC *mg) {
 
 /* ... set magic ........................................................... */
 
-STATIC int vmg_svt_set(pTHX_ SV *sv, MAGIC *mg) {
+static int vmg_svt_set(pTHX_ SV *sv, MAGIC *mg) {
  const vmg_wizard *w = vmg_wizard_from_mg_nocheck(mg);
 
  return vmg_cb_call1(w->cb_set, w->opinfo, sv, mg->mg_obj);
@@ -1294,7 +1294,7 @@ STATIC int vmg_svt_set(pTHX_ SV *sv, MAGIC *mg) {
 
 /* ... len magic ........................................................... */
 
-STATIC U32 vmg_sv_len(pTHX_ SV *sv) {
+static U32 vmg_sv_len(pTHX_ SV *sv) {
 #define vmg_sv_len(S) vmg_sv_len(aTHX_ (S))
  STRLEN len;
 #if VMG_HAS_PERL(5, 9, 3)
@@ -1306,7 +1306,7 @@ STATIC U32 vmg_sv_len(pTHX_ SV *sv) {
  return DO_UTF8(sv) ? utf8_length(s, s + len) : len;
 }
 
-STATIC U32 vmg_svt_len(pTHX_ SV *sv, MAGIC *mg) {
+static U32 vmg_svt_len(pTHX_ SV *sv, MAGIC *mg) {
  const vmg_wizard *w = vmg_wizard_from_mg_nocheck(mg);
  unsigned int opinfo = w->opinfo;
  U32 len, ret;
@@ -1351,7 +1351,7 @@ STATIC U32 vmg_svt_len(pTHX_ SV *sv, MAGIC *mg) {
  return ret;
 }
 
-STATIC U32 vmg_svt_len_noop(pTHX_ SV *sv, MAGIC *mg) {
+static U32 vmg_svt_len_noop(pTHX_ SV *sv, MAGIC *mg) {
  U32    len = 0;
  svtype t   = SvTYPE(sv);
 
@@ -1366,7 +1366,7 @@ STATIC U32 vmg_svt_len_noop(pTHX_ SV *sv, MAGIC *mg) {
 
 /* ... clear magic ......................................................... */
 
-STATIC int vmg_svt_clear(pTHX_ SV *sv, MAGIC *mg) {
+static int vmg_svt_clear(pTHX_ SV *sv, MAGIC *mg) {
  const vmg_wizard *w = vmg_wizard_from_mg_nocheck(mg);
  unsigned int flags  = w->opinfo;
 
@@ -1383,7 +1383,7 @@ STATIC int vmg_svt_clear(pTHX_ SV *sv, MAGIC *mg) {
 
 #if VMG_PROPAGATE_ERRSV_NEEDS_TRAMPOLINE
 
-STATIC OP *vmg_pp_propagate_errsv(pTHX) {
+static OP *vmg_pp_propagate_errsv(pTHX) {
  SVOP *o = cSVOPx(PL_op);
 
  if (o->op_sv) {
@@ -1397,7 +1397,7 @@ STATIC OP *vmg_pp_propagate_errsv(pTHX) {
 
 #endif /* VMG_PROPAGATE_ERRSV_NEEDS_TRAMPOLINE */
 
-STATIC int vmg_propagate_errsv_free(pTHX_ SV *sv, MAGIC *mg) {
+static int vmg_propagate_errsv_free(pTHX_ SV *sv, MAGIC *mg) {
  if (mg->mg_obj)
   sv_setsv(ERRSV, mg->mg_obj);
 
@@ -1407,7 +1407,7 @@ STATIC int vmg_propagate_errsv_free(pTHX_ SV *sv, MAGIC *mg) {
 /* perl is already kind enough to handle the cloning of the mg_obj member,
    hence we don't need to define a dup magic callback. */
 
-STATIC MGVTBL vmg_propagate_errsv_vtbl = {
+static MGVTBL vmg_propagate_errsv_vtbl = {
  0,                        /* get */
  0,                        /* set */
  0,                        /* len */
@@ -1426,7 +1426,7 @@ typedef struct {
  I32  base;
 } vmg_svt_free_cleanup_ud;
 
-STATIC int vmg_svt_free_cleanup(pTHX_ void *ud_) {
+static int vmg_svt_free_cleanup(pTHX_ void *ud_) {
  vmg_svt_free_cleanup_ud *ud = VOID2(vmg_svt_free_cleanup_ud *, ud_);
 
  if (ud->in_eval) {
@@ -1482,7 +1482,7 @@ STATIC int vmg_svt_free_cleanup(pTHX_ void *ud_) {
  }
 }
 
-STATIC int vmg_svt_free(pTHX_ SV *sv, MAGIC *mg) {
+static int vmg_svt_free(pTHX_ SV *sv, MAGIC *mg) {
  vmg_svt_free_cleanup_ud ud;
  const vmg_wizard *w;
  int ret = 0;
@@ -1568,7 +1568,7 @@ STATIC int vmg_svt_free(pTHX_ SV *sv, MAGIC *mg) {
 
 /* ... copy magic .......................................................... */
 
-STATIC int vmg_svt_copy(pTHX_ SV *sv, MAGIC *mg, SV *nsv, const char *key, VMG_SVT_COPY_KEYLEN_TYPE keylen) {
+static int vmg_svt_copy(pTHX_ SV *sv, MAGIC *mg, SV *nsv, const char *key, VMG_SVT_COPY_KEYLEN_TYPE keylen) {
  const vmg_wizard *w = vmg_wizard_from_mg_nocheck(mg);
  SV *keysv;
  int ret;
@@ -1591,14 +1591,14 @@ STATIC int vmg_svt_copy(pTHX_ SV *sv, MAGIC *mg, SV *nsv, const char *key, VMG_S
  return ret;
 }
 
-STATIC int vmg_svt_copy_noop(pTHX_ SV *sv, MAGIC *mg, SV *nsv, const char *key, VMG_SVT_COPY_KEYLEN_TYPE keylen) {
+static int vmg_svt_copy_noop(pTHX_ SV *sv, MAGIC *mg, SV *nsv, const char *key, VMG_SVT_COPY_KEYLEN_TYPE keylen) {
  return 0;
 }
 
 /* ... dup magic ........................................................... */
 
 #if 0
-STATIC int vmg_svt_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *param) {
+static int vmg_svt_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *param) {
  return 0;
 }
 #define vmg_svt_dup_noop vmg_svt_dup
@@ -1608,7 +1608,7 @@ STATIC int vmg_svt_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *param) {
 
 #if MGf_LOCAL
 
-STATIC int vmg_svt_local(pTHX_ SV *nsv, MAGIC *mg) {
+static int vmg_svt_local(pTHX_ SV *nsv, MAGIC *mg) {
  const vmg_wizard *w = vmg_wizard_from_mg_nocheck(mg);
 
  return vmg_cb_call1(w->cb_local, w->opinfo, nsv, mg->mg_obj);
@@ -1622,7 +1622,7 @@ STATIC int vmg_svt_local(pTHX_ SV *nsv, MAGIC *mg) {
 
 #if VMG_UVAR
 
-STATIC OP *vmg_pp_reset_rmg(pTHX) {
+static OP *vmg_pp_reset_rmg(pTHX) {
  SVOP *o = cSVOPx(PL_op);
 
  SvRMAGICAL_on(o->op_sv);
@@ -1631,7 +1631,7 @@ STATIC OP *vmg_pp_reset_rmg(pTHX) {
  return NORMAL;
 }
 
-STATIC I32 vmg_svt_val(pTHX_ IV action, SV *sv) {
+static I32 vmg_svt_val(pTHX_ IV action, SV *sv) {
  vmg_uvar_ud *ud;
  MAGIC *mg, *umg, *moremagic;
  SV *key = NULL, *newkey = NULL;
@@ -1745,68 +1745,158 @@ STATIC I32 vmg_svt_val(pTHX_ IV action, SV *sv) {
 
 #endif /* VMG_UVAR */
 
-/* --- Macros for the XS section ------------------------------------------- */
+/* --- Module setup/teardown ----------------------------------------------- */
 
-#ifdef CvISXSUB
-# define VMG_CVOK(C) \
-   ((CvISXSUB(C) ? (void *) CvXSUB(C) : (void *) CvROOT(C)) ? 1 : 0)
-#else
-# define VMG_CVOK(C) (CvROOT(C) || CvXSUB(C))
-#endif
+#if VMG_THREADSAFE
 
-#define VMG_CBOK(S) ((SvTYPE(S) == SVt_PVCV) ? VMG_CVOK(S) : SvOK(S))
+static I32 vmg_loaded = 0;
 
-#define VMG_SET_CB(S, N) {       \
- SV *cb = (S);                   \
- if (SvOK(cb) && SvROK(cb)) {    \
-  cb = SvRV(cb);                 \
-  if (VMG_CBOK(cb))              \
-   SvREFCNT_inc_simple_void(cb); \
-  else                           \
-   cb = NULL;                    \
- } else {                        \
-  cb = NULL;                     \
- }                               \
- w->cb_ ## N = cb;               \
+/* We must use preexistent global mutexes or we will never be able to destroy
+ * them. */
+# if VMG_HAS_PERL(5, 9, 3)
+#  define VMG_LOADED_LOCK   MUTEX_LOCK(&PL_my_ctx_mutex)
+#  define VMG_LOADED_UNLOCK MUTEX_UNLOCK(&PL_my_ctx_mutex)
+# else
+#  define VMG_LOADED_LOCK   OP_REFCNT_LOCK
+#  define VMG_LOADED_UNLOCK OP_REFCNT_UNLOCK
+# endif
+
+static void vmg_global_teardown_late_locked(pTHX) {
+#define vmg_global_teardown_late_locked() vmg_global_teardown_late_locked(aTHX)
+ MUTEX_DESTROY(&vmg_op_name_init_mutex);
+ MUTEX_DESTROY(&vmg_vtable_refcount_mutex);
+
+ return;
 }
 
-#define VMG_SET_SVT_CB(S, N) {   \
- SV *cb = (S);                   \
- if (SvOK(cb) && SvROK(cb)) {    \
-  cb = SvRV(cb);                 \
-  if (VMG_CBOK(cb)) {            \
-   t->svt_ ## N = vmg_svt_ ## N; \
-   SvREFCNT_inc_simple_void(cb); \
-  } else {                       \
-   t->svt_ ## N = vmg_svt_ ## N ## _noop; \
-   cb           = NULL;          \
-  }                              \
- } else {                        \
-  t->svt_ ## N = NULL;           \
-  cb           = NULL;           \
- }                               \
- w->cb_ ## N = cb;               \
+static int vmg_global_teardown_free(pTHX_ SV *sv, MAGIC *mg) {
+ VMG_LOADED_LOCK;
+
+ if (vmg_loaded == 0)
+  vmg_global_teardown_late_locked();
+
+ VMG_LOADED_UNLOCK;
+
+ return 0;
 }
 
-/* --- XS ------------------------------------------------------------------ */
+static MGVTBL vmg_global_teardown_vtbl = {
+ 0,
+ 0,
+ 0,
+ 0,
+ vmg_global_teardown_free
+#if MGf_COPY
+ , 0
+#endif
+#if MGf_DUP
+ , 0
+#endif
+#if MGf_LOCAL
+ , 0
+#endif
+};
 
-MODULE = Variable::Magic            PACKAGE = Variable::Magic
+static signed char vmg_destruct_level(pTHX) {
+#define vmg_destruct_level() vmg_destruct_level(aTHX)
+ signed char lvl;
 
-PROTOTYPES: ENABLE
+ lvl = PL_perl_destruct_level;
 
-BOOT:
-{
+#ifdef DEBUGGING
+ {
+  const char *s = PerlEnv_getenv("PERL_DESTRUCT_LEVEL");
+  if (s) {
+   int i;
+#if VMG_HAS_PERL(5, 21, 3)
+   if (strEQ(s, "-1")) {
+    i = -1;
+   } else {
+# if VMG_HAS_PERL(5, 21, 10)
+    UV uv;
+    if (Perl_grok_atoUV(s, &uv, NULL) && uv <= INT_MAX)
+     i = (int) uv;
+    else
+     i = 0;
+# else /* VMG_HAS_PERL(5, 21, 3) && !VMG_HAS_PERL(5, 21, 10) */
+    i = Perl_grok_atou(s, NULL);
+# endif
+   }
+#else /* !VMG_HAS_PERL(5, 21, 3) */
+   i = atoi(s);
+#endif
+   if (lvl < i)
+    lvl = i;
+  }
+ }
+#endif
+
+ return lvl;
+}
+
+#endif /* VMG_THREADSAFE */
+
+static void vmg_teardown(pTHX_ void *interp) {
+ dMY_CXT;
+
+#if VMG_MULTIPLICITY
+ if (aTHX != interp)
+  return;
+#endif
+
+#if VMG_THREADSAFE
+ VMG_LOADED_LOCK;
+
+ if (vmg_loaded == 1) {
+  vmg_loaded = 0;
+  if (vmg_destruct_level() == 0) {
+   vmg_global_teardown_late_locked();
+  } else {
+   if (!PL_strtab)
+    PL_strtab = newHV();
+   vmg_sv_magicext((SV *) PL_strtab, NULL, &vmg_global_teardown_vtbl, NULL, 0);
+  }
+ } else {
+  assert(vmg_loaded > 1);
+  --vmg_loaded;
+ }
+
+ VMG_LOADED_UNLOCK;
+#endif
+
+ if (MY_CXT.depth == 0 && MY_CXT.freed_tokens) {
+  vmg_magic_chain_free(MY_CXT.freed_tokens, NULL);
+  MY_CXT.freed_tokens = NULL;
+ }
+
+ return;
+}
+
+static void vmg_setup(pTHX) {
+#define vmg_setup() vmg_setup(aTHX)
  HV *stash;
  int c;
-
  MY_CXT_INIT;
+
+#if VMG_THREADSAFE
+ VMG_LOADED_LOCK;
+
+ if (vmg_loaded <= 0) {
+  assert(vmg_loaded == 0);
+  MUTEX_INIT(&vmg_vtable_refcount_mutex);
+  MUTEX_INIT(&vmg_op_name_init_mutex);
+ }
+ ++vmg_loaded;
+
+ VMG_LOADED_UNLOCK;
+#endif
+
  for (c = OPc_NULL; c < OPc_MAX; ++c)
   MY_CXT.b__op_stashes[c] = NULL;
 
  MY_CXT.depth        = 0;
  MY_CXT.freed_tokens = NULL;
 
- /* XS doesn't like a blank line here */
 #if VMG_PROPAGATE_ERRSV_NEEDS_TRAMPOLINE
  vmg_trampoline_init(&MY_CXT.propagate_errsv, vmg_pp_propagate_errsv);
 #endif
@@ -1814,12 +1904,6 @@ BOOT:
  vmg_trampoline_init(&MY_CXT.reset_rmg, vmg_pp_reset_rmg);
 #endif
 
- /* XS doesn't like a blank line here */
-#if VMG_THREADSAFE
- MUTEX_INIT(&vmg_vtable_refcount_mutex);
- MUTEX_INIT(&vmg_op_name_init_mutex);
-#endif
-
  stash = gv_stashpv(__PACKAGE__, 1);
  newCONSTSUB(stash, "MGf_COPY",  newSVuv(MGf_COPY));
  newCONSTSUB(stash, "MGf_DUP",   newSVuv(MGf_DUP));
@@ -1847,6 +1931,68 @@ BOOT:
  newCONSTSUB(stash, "VMG_FORKSAFE",        newSVuv(VMG_FORKSAFE));
  newCONSTSUB(stash, "VMG_OP_INFO_NAME",    newSVuv(VMG_OP_INFO_NAME));
  newCONSTSUB(stash, "VMG_OP_INFO_OBJECT",  newSVuv(VMG_OP_INFO_OBJECT));
+
+#if VMG_MULTIPLICITY
+ call_atexit(vmg_teardown, aTHX);
+#else
+ call_atexit(vmg_teardown, NULL);
+#endif
+
+ return;
+}
+
+/* --- Macros for the XS section ------------------------------------------- */
+
+#ifdef CvISXSUB
+# define VMG_CVOK(C) \
+   ((CvISXSUB(C) ? (void *) CvXSUB(C) : (void *) CvROOT(C)) ? 1 : 0)
+#else
+# define VMG_CVOK(C) (CvROOT(C) || CvXSUB(C))
+#endif
+
+#define VMG_CBOK(S) ((SvTYPE(S) == SVt_PVCV) ? VMG_CVOK(S) : SvOK(S))
+
+#define VMG_SET_CB(S, N) {       \
+ SV *cb = (S);                   \
+ if (SvOK(cb) && SvROK(cb)) {    \
+  cb = SvRV(cb);                 \
+  if (VMG_CBOK(cb))              \
+   SvREFCNT_inc_simple_void(cb); \
+  else                           \
+   cb = NULL;                    \
+ } else {                        \
+  cb = NULL;                     \
+ }                               \
+ w->cb_ ## N = cb;               \
+}
+
+#define VMG_SET_SVT_CB(S, N) {   \
+ SV *cb = (S);                   \
+ if (SvOK(cb) && SvROK(cb)) {    \
+  cb = SvRV(cb);                 \
+  if (VMG_CBOK(cb)) {            \
+   t->svt_ ## N = vmg_svt_ ## N; \
+   SvREFCNT_inc_simple_void(cb); \
+  } else {                       \
+   t->svt_ ## N = vmg_svt_ ## N ## _noop; \
+   cb           = NULL;          \
+  }                              \
+ } else {                        \
+  t->svt_ ## N = NULL;           \
+  cb           = NULL;           \
+ }                               \
+ w->cb_ ## N = cb;               \
+}
+
+/* --- XS ------------------------------------------------------------------ */
+
+MODULE = Variable::Magic            PACKAGE = Variable::Magic
+
+PROTOTYPES: ENABLE
+
+BOOT:
+{
+ vmg_setup();
 }
 
 #if VMG_THREADSAFE
@@ -1875,6 +2021,10 @@ PPCODE:
   }
   MY_CXT.depth        = old_depth;
   MY_CXT.freed_tokens = NULL;
+  VMG_LOADED_LOCK;
+  assert(vmg_loaded > 0);
+  ++vmg_loaded;
+  VMG_LOADED_UNLOCK;
  }
  XSRETURN(0);