From: Yuval Kogman <nothingmuch@woobling.org>
Date: Sun, 19 Apr 2009 19:30:53 +0000 (+0200)
Subject: use magic stashing to manage C instances
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d67688d9ab3000febe11bc475e3741a13beffb2e;p=gitmo%2FClass-MOP.git

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
--- 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
--- 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
--- 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
--- 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);
+