Share the vtables with threaded perls

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

diff --git a/Magic.xs b/Magic.xs
index 5b3be56845e500fd76caa1429a2c9f0e2faac45d..3fb9739614332542a19485443cc7d737c4a6fa50 100644 (file)
--- 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) {
@@ -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
@@ -431,22 +431,87 @@ STATIC const char vmg_argstorefailed[] = "Error while storing arguments";
 #define SIG_WZO ((U16) (0x3891))
 #define SIG_WIZ ((U16) (0x3892))
 
-/* --- MGWIZ structure ----------------------------------------------------- */
+/* --- <vmg_vtable> structure ---------------------------------------------- */
+
+#if VMG_THREADSAFE
 
 typedef struct {
  MGVTBL *vtbl;
+ U32     refcount;
+} vmg_vtable;
+
+STATIC vmg_vtable *vmg_vtable_alloc(pTHX) {
+#define vmg_vtable_alloc() vmg_vtable_alloc(aTHX)
+ vmg_vtable *t;
+
+ t = VOID2(vmg_vtable *, PerlMemShared_malloc(sizeof *t));
+
+ t->vtbl     = VOID2(MGVTBL *, PerlMemShared_malloc(sizeof *t->vtbl));
+ t->refcount = 1;
+
+ return t;
+}
+
+#define vmg_vtable_vtbl(T) (T)->vtbl
+
+#if VMG_THREADSAFE
+STATIC perl_mutex vmg_vtable_refcount_mutex;
+#endif
+
+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;
+ VMG_UNLOCK(&vmg_vtable_refcount_mutex);
+
+ return t;
+}
+
+STATIC void vmg_vtable_free(pTHX_ vmg_vtable *t) {
+#define vmg_vtable_free(T) vmg_vtable_free(aTHX_ (T))
+ U32 refcount;
+
+ VMG_LOCK(&vmg_vtable_refcount_mutex);
+ refcount = --t->refcount;
+ VMG_UNLOCK(&vmg_vtable_refcount_mutex);
+
+ if (!refcount) {
+  PerlMemShared_free(t->vtbl);
+  PerlMemShared_free(t);
+ }
+}
+
+#else /* VMG_THREADSAFE */
+
+typedef MGVTBL vmg_vtable;
+
+STATIC vmg_vtable *vmg_vtable_alloc(pTHX) {
+#define vmg_vtable_alloc() vmg_vtable_alloc(aTHX)
+ vmg_vtable *t;
+
+ Newx(t, 1, vmg_vtable);
+
+ return t;
+}
+
+#define vmg_vtable_vtbl(T) ((MGVTBL *) (T))
+
+#define vmg_vtable_free(T) Safefree(T)
+
+#endif /* !VMG_THREADSAFE */
+
+/* --- MGWIZ structure ----------------------------------------------------- */
+
+typedef struct {
+ vmg_vtable *vtable;
 
  U8 opinfo;
  U8 uvar;
 
  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 */
@@ -473,8 +538,7 @@ STATIC MGWIZ *vmg_mgwiz_alloc(pTHX_ UV opinfo) {
  if (w->opinfo)
   vmg_op_info_init(aTHX_ w->opinfo);
 
- Newx(t, 1, MGVTBL);
- w->vtbl = t;
+ w->vtable = vmg_vtable_alloc();
 
  return w;
 }
@@ -499,12 +563,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 */
@@ -515,7 +577,7 @@ STATIC void vmg_mgwiz_free(pTHX_ MGWIZ *w) {
  SvREFCNT_dec(w->cb_delete);
 #endif /* VMG_UVAR */
 
- Safefree(w->vtbl);
+ vmg_vtable_free(w->vtable);
  Safefree(w);
 
  return;
@@ -529,18 +591,14 @@ STATIC void vmg_mgwiz_free(pTHX_ MGWIZ *w) {
 
 STATIC MGWIZ *vmg_mgwiz_clone(pTHX_ const MGWIZ *w) {
 #define vmg_mgwiz_clone(W) vmg_mgwiz_clone(aTHX_ (W))
- MGVTBL *t;
  MGWIZ *z;
 
  if (!w)
   return NULL;
 
- Newx(t, 1, MGVTBL);
- Copy(w->vtbl, t, 1, MGVTBL);
-
  Newx(z, 1, MGWIZ);
 
- z->vtbl   = t;
+ z->vtable = vmg_vtable_dup(w->vtable);
  z->uvar   = w->uvar;
  z->opinfo = w->opinfo;
 
@@ -550,12 +608,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 */
@@ -631,12 +685,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 */
@@ -813,18 +863,16 @@ STATIC UV vmg_cast(pTHX_ SV *sv, const SV *wiz, SV **args, I32 items) {
 
  data = (w->cb_data) ? vmg_data_new(w->cb_data, sv, args, items) : NULL;
  /* sv_magicext() calls mg_magical and increments data's refcount */
- mg   = sv_magicext(sv, data, PERL_MAGIC_ext, w->vtbl,
+ mg   = sv_magicext(sv, data, PERL_MAGIC_ext, vmg_vtable_vtbl(w->vtable),
                               (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;
@@ -992,18 +1040,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;
@@ -1224,7 +1268,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
@@ -1250,13 +1293,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) {
@@ -1397,6 +1439,7 @@ BOOT:
 #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
@@ -1470,13 +1513,7 @@ PREINIT:
 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 */
@@ -1487,7 +1524,7 @@ CODE:
 
  op_info = ST(i++);
  w = vmg_mgwiz_alloc(SvOK(op_info) ? SvUV(op_info) : 0);
- t = w->vtbl;
+ t = vmg_vtable_vtbl(w->vtable);
 
  VMG_SET_CB(ST(i++), data);
 
@@ -1496,15 +1533,11 @@ CODE:
  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 */