use magic stashing to manage C instances

the meta instance now refers to the SV

mop_{instance,attr}_get_c_instance() functions added, which lazily build
the C instance as necessary and stash it in the magic

this implements indirect reference counting for the C structures such
that they can refer to each other safely (by referring to the Perl side
MOP objects)

diff --git a/cmop/mop_attr.c b/cmop/mop_attr.c
index c4a5866..e82b371 100644 (file)
--- a/cmop/mop_attr.c
+++ b/cmop/mop_attr.c
@@ -21,7 +21,7 @@ struct mop_attr_St {
        default_t default_value;
        CV *initializer;
 
-       SV *perl_attr;
+       SV *perl_attr_rv;
 };
 
 static void
@@ -248,7 +248,7 @@ mop_attr_new_from_perl_attr (SV *perl_attr)
        dXCPT;
 
        Newxz (attr, 1, mop_attr_t);
-       attr->perl_attr = newSVsv (perl_attr); /* RAFL IS TEH BEST OMGIGOD */
+       attr->perl_attr_rv = SvRV(perl_attr); /* the attr already refers to us, so don't change the refcnt */
 
        XCPT_TRY_START {
                initialize_slots (attr, perl_attr);
@@ -297,10 +297,24 @@ mop_attr_destroy (mop_attr_t *attr)
                        break;
        }
 
-       SvREFCNT_dec (attr->perl_attr);
        Safefree (attr);
 }
 
+mop_attr_t *_attr_build_c_instance(SV *perl_attr) {
+    mop_attr_t *attr = mop_attr_new_from_perl_attr(perl_attr);
+    mop_stash_in_mg(SvRV(perl_attr), NULL, (void *)attr, mop_attr_destroy);
+    return attr;
+}
+
+mop_attr_t *mop_attr_get_c_instance (SV *perl_attr) {
+    mop_attr_t *attr = mop_get_stashed_ptr_in_mg(SvRV(perl_attr));
+
+    if ( attr )
+        return attr;
+    else
+        return _attr_build_c_instance(perl_attr);
+}
+
 U32
 mop_attr_get_flags (mop_attr_t *attr)
 {
@@ -310,5 +324,5 @@ mop_attr_get_flags (mop_attr_t *attr)
 SV *
 mop_attr_get_perl_attr (mop_attr_t *attr)
 {
-       return attr->perl_attr;
+       return sv_2mortal(newRV_inc(attr->perl_attr_rv));
 }

diff --git a/cmop/mop_instance.c b/cmop/mop_instance.c
index 051d839..ed405b5 100644 (file)
--- a/cmop/mop_instance.c
+++ b/cmop/mop_instance.c
@@ -3,8 +3,7 @@
 struct mop_instance_St {
        mop_instance_type_t type;
        HV *stash;
-       UV n_attrs;
-       mop_attr_t **attrs;
+    AV *attrs;
 };
 
 mop_instance_t *
@@ -15,8 +14,7 @@ mop_instance_new (mop_instance_type_t type, HV *stash)
        Newx (instance, 1, mop_instance_t);
        instance->type = type;
        instance->stash = stash;
-       instance->n_attrs = 0;
-       instance->attrs = NULL;
+       instance->attrs = newAV();
 
        SvREFCNT_inc ((SV *)stash);
 
@@ -42,7 +40,7 @@ initialize_attrs_from_perl_instance (mop_instance_t *instance, SV *perl_instance
 
        while (count--) {
                SV *perl_attr = POPs;
-               mop_instance_add_attribute (instance, mop_attr_new_from_perl_attr (perl_attr));
+               mop_instance_add_attribute (instance, perl_attr);
        }
 
        PUTBACK;
@@ -94,17 +92,28 @@ mop_instance_new_from_perl_instance (SV *perl_instance)
 void
 mop_instance_destroy (mop_instance_t *instance)
 {
-       U32 i;
+    SvREFCNT_dec (instance->attrs);
 
-       for (i = 0; i < instance->n_attrs; i++) {
-               mop_attr_destroy (instance->attrs[i]);
-       }
-
-       Safefree (instance->attrs);
        SvREFCNT_dec ((SV *)instance->stash);
        Safefree (instance);
 }
 
+mop_instance_t *_instance_build_c_instance(SV *perl_instance) {
+    mop_instance_t *instance = mop_instance_new_from_perl_instance(perl_instance);
+    mop_stash_in_mg(SvRV(perl_instance), NULL, (void *)instance, mop_instance_destroy);
+    return instance;
+}
+
+mop_instance_t *mop_instance_get_c_instance (SV *perl_instance) {
+    mop_instance_t *instance = mop_get_stashed_ptr_in_mg(SvRV(perl_instance));
+
+    if ( instance )
+        return instance;
+    else
+        return _instance_build_c_instance(perl_instance);
+}
+
+
 mop_instance_type_t
 mop_instance_get_type (mop_instance_t *instance)
 {
@@ -118,9 +127,9 @@ mop_instance_get_stash (mop_instance_t *instance)
 }
 
 void
-mop_instance_add_attribute (mop_instance_t *instance, mop_attr_t *attr)
+mop_instance_add_attribute (mop_instance_t *instance, SV *perl_attr)
 {
-       Renew (instance->attrs, instance->n_attrs + 1, mop_attr_t *);
-       instance->attrs[instance->n_attrs] = attr;
-       instance->n_attrs++;
+    SV *copy = newSVsv(perl_attr);
+       av_push( instance->attrs, copy );
+    mop_attr_get_c_instance(copy);
 }

diff --git a/include/mop_instance.h b/include/mop_instance.h
index 1bed007..d83233f 100644 (file)
--- a/include/mop_instance.h
+++ b/include/mop_instance.h
@@ -12,6 +12,6 @@ void mop_instance_destroy (mop_instance_t *instance);
 
 mop_instance_type_t mop_instance_get_type (mop_instance_t *instance);
 HV *mop_instance_get_stash (mop_instance_t *instance);
-void mop_instance_add_attribute (mop_instance_t *instance, mop_attr_t *attr);
+void mop_instance_add_attribute (mop_instance_t *instance, SV *perl_attr);
 
 #endif

diff --git a/xs/Instance.xs b/xs/Instance.xs
index a2f6e36..17cb7d1 100644 (file)
--- a/xs/Instance.xs
+++ b/xs/Instance.xs
@@ -10,8 +10,5 @@ create_c_instance (self)
     PREINIT:
         mop_instance_t *instance;
     CODE:
-        instance = mop_instance_new_from_perl_instance (self);
-        __asm__ __volatile__ ("int $03");
-        if (instance) {
-            mop_instance_destroy (instance);
-        }
+        (void)mop_instance_get_c_instance(self);
+