Stop passing arguments to the data callback through an AV

[perl/modules/Variable-Magic.git] / Magic.xs

diff --git a/Magic.xs b/Magic.xs
index 6ffe42dd6f88b517276adad6552d00aeb6b0bb5c..6ec752bcf14a3f5565b7a5372c5bb91bfa021a71 100644 (file)
--- a/Magic.xs
+++ b/Magic.xs
@@ -363,26 +363,26 @@ STATIC void vmg_mgwiz_free(pTHX_ MGWIZ *w) {
  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);
@@ -394,8 +394,7 @@ STATIC void vmg_mgwiz_free(pTHX_ MGWIZ *w) {
 #if VMG_THREADSAFE
 
 #define VMG_CLONE_CB(N) \
- z->cb_ ## N = (w->cb_ ## N) ? newRV_noinc(vmg_clone(SvRV(w->cb_ ## N), \
-                                           w->owner))                   \
+ z->cb_ ## N = (w->cb_ ## N) ? vmg_clone(w->cb_ ## N, w->owner) \
                              : NULL;
 
 STATIC MGWIZ *vmg_mgwiz_clone(pTHX_ const MGWIZ *w) {
@@ -517,7 +516,7 @@ 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(PTR2UV(w));
+ SV *wiz = newSVuv(PTR2IV(w));
 
  if (w) {
   MAGIC *mg = sv_magicext(wiz, NULL, PERL_MAGIC_ext, &vmg_wizard_vtbl, NULL, 0);
@@ -528,7 +527,7 @@ STATIC SV *vmg_wizard_new(pTHX_ const MGWIZ *w) {
  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);
@@ -539,7 +538,7 @@ STATIC SV *vmg_wizard_validate(pTHX_ SV *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 ................................................... */
@@ -566,8 +565,8 @@ STATIC int vmg_wizard_free(pTHX_ SV *sv, MAGIC *mg) {
 
 #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);
@@ -588,12 +587,32 @@ STATIC const MGWIZ *vmg_wizard_mgwiz(pTHX_ SV *wiz) {
 
 /* --- User-level functions implementation --------------------------------- */
 
+STATIC const MAGIC *vmg_find(const SV *sv, const SV *wiz) {
+ const MAGIC *mg, *moremagic;
+ UV wid;
+
+ if (SvTYPE(sv) < SVt_PVMG)
+  return NULL;
+
+ wid = vmg_wizard_id(wiz);
+ for (mg = SvMAGIC(sv); mg; mg = moremagic) {
+  moremagic = mg->mg_moremagic;
+  if (mg->mg_type == PERL_MAGIC_ext && mg->mg_private == SIG_WIZ) {
+   UV zid = vmg_wizard_id(mg->mg_ptr);
+   if (zid == wid)
+    return mg;
+  }
+ }
+
+ return NULL;
+}
+
 /* ... Construct private data .............................................. */
 
-STATIC SV *vmg_data_new(pTHX_ SV *ctor, SV *sv, AV *args) {
-#define vmg_data_new(C, S, A) vmg_data_new(aTHX_ (C), (S), (A))
+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;
- I32 i, alen = (args == NULL) ? 0 : av_len(args);
 
  dSP;
 
@@ -601,10 +620,10 @@ STATIC SV *vmg_data_new(pTHX_ SV *ctor, SV *sv, AV *args) {
  SAVETMPS;
 
  PUSHMARK(SP);
- EXTEND(SP, alen + 1);
+ EXTEND(SP, items + 1);
  PUSHs(sv_2mortal(newRV_inc(sv)));
- for (i = 0; i < alen; ++i)
-  PUSHs(*av_fetch(args, i, 0));
+ for (i = 0; i < items; ++i)
+  PUSHs(args[i]);
  PUTBACK;
 
  call_sv(ctor, G_SCALAR);
@@ -624,25 +643,10 @@ STATIC SV *vmg_data_new(pTHX_ SV *ctor, SV *sv, AV *args) {
  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))
- MAGIC *mg, *moremagic;
-
- if (SvTYPE(sv) >= SVt_PVMG) {
-  UV wid = vmg_wizard_id(wiz);
-  for (mg = SvMAGIC(sv); mg; mg = moremagic) {
-   moremagic = mg->mg_moremagic;
-   if (mg->mg_type == PERL_MAGIC_ext && mg->mg_private == SIG_WIZ) {
-    UV zid = vmg_wizard_id(mg->mg_ptr);
-    if (zid == wid)
-     break;
-   }
-  }
-  if (mg)
-   return mg->mg_obj;
- }
-
- return NULL;
+ const MAGIC *mg = vmg_find(sv, wiz);
+ return mg ? mg->mg_obj : NULL;
 } 
 
 /* ... Magic cast/dispell .................................................. */
@@ -662,28 +666,20 @@ STATIC void vmg_uvar_del(SV *sv, MAGIC *prevmagic, MAGIC *mg, MAGIC *moremagic)
 }
 #endif /* VMG_UVAR */
 
-STATIC UV vmg_cast(pTHX_ SV *sv, SV *wiz, AV *args) {
-#define vmg_cast(S, W, A) vmg_cast(aTHX_ (S), (W), (A))
- MAGIC *mg = NULL, *moremagic = NULL;
- SV *data;
- const MGWIZ *w = vmg_wizard_mgwiz(wiz);
- U32 oldgmg     = SvGMAGICAL(sv);
+STATIC UV vmg_cast(pTHX_ SV *sv, const SV *wiz, SV **args, I32 items) {
+#define vmg_cast(S, W, A, I) vmg_cast(aTHX_ (S), (W), (A), (I))
+ MAGIC       *mg, *moremagic = NULL;
+ SV          *data;
+ const MGWIZ *w;
+ U32          oldgmg;
 
- if (SvTYPE(sv) >= SVt_PVMG) {
-  UV wid = vmg_wizard_id(wiz);
-  for (mg = SvMAGIC(sv); mg; mg = moremagic) {
-   moremagic = mg->mg_moremagic;
-   if (mg->mg_type == PERL_MAGIC_ext && mg->mg_private == SIG_WIZ) {
-    UV zid = vmg_wizard_id(mg->mg_ptr);
-    if (zid == wid)
-     break;
-   }
-  }
-  if (mg)
-   return 1;
- }
+ if (vmg_find(sv, wiz))
+  return 1;
+
+ w = vmg_wizard_mgwiz(wiz);
+ oldgmg = SvGMAGICAL(sv);
 
- data = (w->cb_data) ? vmg_data_new(w->cb_data, sv, args) : NULL;
+ 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);
  mg->mg_private = SIG_WIZ;
 #if MGf_COPY
@@ -752,7 +748,7 @@ done:
  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;
@@ -992,7 +988,7 @@ STATIC U32 vmg_svt_len(pTHX_ SV *sv, MAGIC *mg) {
  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
@@ -1235,18 +1231,29 @@ STATIC I32 vmg_svt_val(pTHX_ IV action, SV *sv) {
 
 #define VMG_SET_CB(S, N)              \
  cb = (S);                            \
- w->cb_ ## N = (SvOK(cb) && SvROK(cb)) ? newRV_inc(SvRV(cb)) : NULL;
+ w->cb_ ## N = (SvOK(cb) && SvROK(cb)) ? SvREFCNT_inc(SvRV(cb)) : NULL;
 
 #define VMG_SET_SVT_CB(S, N)          \
  cb = (S);                            \
  if (SvOK(cb) && SvROK(cb)) {         \
   t->svt_ ## N = vmg_svt_ ## N;       \
-  w->cb_  ## N = newRV_inc(SvRV(cb)); \
+  w->cb_  ## N = SvREFCNT_inc(SvRV(cb)); \
  } else {                             \
   t->svt_ ## N = NULL;                \
   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
@@ -1265,6 +1272,7 @@ BOOT:
  MY_CXT.b__op_stashes[0] = NULL;
 #if VMG_THREADSAFE
  MUTEX_INIT(&vmg_op_name_init_mutex);
+ call_atexit(vmg_cleanup, NULL);
 #endif
 
  stash = gv_stashpv(__PACKAGE__, 1);
@@ -1296,10 +1304,9 @@ CLONE(...)
 PROTOTYPE: DISABLE
 PREINIT:
  ptable *t;
- int    *level;
  U32     had_b__op_stash = 0;
  opclass c;
-CODE:
+PPCODE:
  {
   my_cxt_t ud;
   dMY_CXT;
@@ -1322,6 +1329,7 @@ CODE:
                               ? gv_stashpv(vmg_opclassnames[c], 1) : NULL;
   }
  }
+ XSRETURN(0);
 
 #endif /* VMG_THREADSAFE */
 
@@ -1329,11 +1337,8 @@ SV *_wizard(...)
 PROTOTYPE: DISABLE
 PREINIT:
  I32 i = 0;
- char buf[8];
  MGWIZ *w;
  MGVTBL *t;
- MAGIC *mg;
- SV *wiz;
  SV *cb;
 CODE:
  dMY_CXT;
@@ -1404,21 +1409,15 @@ OUTPUT:
 SV *cast(SV *sv, SV *wiz, ...)
 PROTOTYPE: \[$@%&*]$@
 PREINIT:
- AV *args = NULL;
+ SV **args = NULL;
+ I32 i = 0;
  SV *ret;
 CODE:
- wiz = vmg_wizard_validate(wiz);
  if (items > 2) {
-  I32 i;
-  args = newAV();
-  av_fill(args, items - 2);
-  for (i = 2; i < items; ++i) {
-   SV *arg = ST(i);
-   SvREFCNT_inc(arg);
-   if (av_store(args, i - 2, arg) == NULL) croak(vmg_argstorefailed);
-  }
+  i = items - 2;
+  args = &ST(2);
  }
- ret = newSVuv(vmg_cast(SvRV(sv), wiz, args));
+ ret = newSVuv(vmg_cast(SvRV(sv), vmg_wizard_validate(wiz), args, i));
  SvREFCNT_dec(args);
  RETVAL = ret;
 OUTPUT:
@@ -1430,8 +1429,7 @@ PROTOTYPE: \[$@%&*]$
 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;
@@ -1439,10 +1437,7 @@ PPCODE:
 
 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