Refactor MOP Instance API in XS

diff --git a/mop.h b/mop.h
index 5b5a0a1..7778bf4 100644 (file)
--- a/mop.h
+++ b/mop.h
@@ -65,30 +65,52 @@ HV  *mop_get_all_package_symbols (HV *stash, type_filter_t filter);
 
 /* Class::MOP::Instance stuff */
 
+/* MI: Meta Instance object of Class::MOP::Method */
+
+/* All the MOP_mg_* macros require MAGIC* mg for the first argument */
+/* All the MOP_mi_* macros require AV* mi    for the first argument */
+
 typedef struct {
-    SV*  (*create_instance)(pTHX);
-    bool (*has_slot)       (pTHX_ SV* const instance, SV* const slot_name);
-    SV*  (*get_slot)       (pTHX_ SV* const instance, SV* const slot_name);
-    SV*  (*set_slot)       (pTHX_ SV* const instance, SV* const slot_name, SV* const value);
-    SV*  (*delete_slot)    (pTHX_ SV* const instance, SV* const slot_name);
-    void (*weaken_slot)    (pTHX_ SV* const instance, SV* const slot_name);
+    SV*  (*create_instance)(pTHX_ MAGIC* const mg);
+    bool (*has_slot)       (pTHX_ MAGIC* const mg, SV* const instance);
+    SV*  (*get_slot)       (pTHX_ MAGIC* const mg, SV* const instance);
+    SV*  (*set_slot)       (pTHX_ MAGIC* const mg, SV* const instance, SV* const value);
+    SV*  (*delete_slot)    (pTHX_ MAGIC* const mg, SV* const instance);
+    void (*weaken_slot)    (pTHX_ MAGIC* const mg, SV* const instance);
 } mop_instance_vtbl;
 
 const mop_instance_vtbl* mop_get_default_instance_vtbl(pTHX);
 
-#define MOP_mg_meta(mg) ((AV*)(mg)->mg_obj)
+#define MOP_MI_SLOT   0
+#define MOP_MI_last   1
+
+#define MOP_mg_mi(mg)    ((AV*)(mg)->mg_obj)
+#define MOP_mg_vtbl(mg)  ((const mop_instance_vtbl*)(mg)->mg_ptr)
+#define MOP_mg_flags(mg) ((mg)->mg_private)
+
 #ifdef DEBUGGING
-#define MOP_mg_key(mg)  (*av_fetch( MOP_mg_meta(mg) , 0, TRUE))
+#define MOP_mi_access(mi, a)  *mop_debug_mi_access(aTHX_ (mi) , (a))
+SV** mop_debug_mi_access(pTHX_ AV* const mi, I32 const attr_ix);
 #else
-#define MOP_mg_key(mg)  (AvARRAY( MOP_mg_meta(mg))[0])
+#define MOP_mi_access(mi, a)  AvARRAY((mi))[(a)]
 #endif
-#define MOP_mg_vtbl(mg) ((const mop_instance_vtbl*)(mg)->mg_ptr)
+
+#define MOP_mi_slot(mi)   MOP_mi_access((mi), MOP_MI_SLOT)
+#define MOP_mg_slot(mg)   MOP_mi_slot(MOP_mg_mi(mg))
+
+#define MOP_mg_create_instance(mg) MOP_mg_vtbl(mg)->create_instance (aTHX_ (mg))
+#define MOP_mg_has_slot(mg, o)     MOP_mg_vtbl(mg)->has_slot        (aTHX_ (mg), (o))
+#define MOP_mg_get_slot(mg, o)     MOP_mg_vtbl(mg)->get_slot        (aTHX_ (mg), (o))
+#define MOP_mg_set_slot(mg, o, v)  MOP_mg_vtbl(mg)->set_slot        (aTHX_ (mg), (o), (v))
+#define MOP_mg_delete_slot(mg, o)  MOP_mg_vtbl(mg)->delete_slot     (aTHX_ (mg), (o))
+#define MOP_mg_weaken_slot(mg, o)  MOP_mg_vtbl(mg)->weaken_slot     (aTHX_ (mg), (o))
+
 
 /* Class::MOP::Method::Accessor stuff */
 
-#define dMOP_METHOD_COMMON                                            \
-    SV* const self      = mop_accessor_get_self(aTHX_ ax, items, cv); \
-    MAGIC* const mg     = mop_accessor_get_mg(aTHX_ cv)               \
+#define dMOP_self      SV* const self = mop_accessor_get_self(aTHX_ ax, items, cv)
+#define dMOP_mg(xsub)  MAGIC* mg      = (MAGIC*)CvXSUBANY(xsub).any_ptr
+#define dMOP_METHOD_COMMON  dMOP_self; dMOP_mg(cv)
 
 
 SV*    mop_accessor_get_self(pTHX_ I32 const ax, I32 const items, CV* const cv);

diff --git a/xs/Instance.xs b/xs/Instance.xs
index acd2aa9..997a831 100644 (file)
--- a/xs/Instance.xs
+++ b/xs/Instance.xs
@@ -10,47 +10,49 @@
     } STMT_END
 
 static SV*
-mop_instance_create_instance(pTHX) {
+mop_instance_create_instance(pTHX_ MAGIC* const mg PERL_UNUSED_DECL) {
     return newRV_noinc((SV*)newHV());
 }
 
 static bool
-mop_instance_has_slot(pTHX_ SV* const instance, SV* const slot_name) {
+mop_instance_has_slot(pTHX_ MAGIC* const mg, SV* const instance) {
     CHECK_INSTANCE(instance);
-    return hv_exists_ent((HV*)SvRV(instance), slot_name, 0U);
+    return hv_exists_ent((HV*)SvRV(instance), MOP_mg_slot(mg), 0U);
 }
 
 static SV*
-mop_instance_get_slot(pTHX_ SV* const instance, SV* const slot_name) {
+mop_instance_get_slot(pTHX_ MAGIC* const mg, SV* const instance) {
     HE* he;
     CHECK_INSTANCE(instance);
-    he = hv_fetch_ent((HV*)SvRV(instance), slot_name, FALSE, 0U);
+    he = hv_fetch_ent((HV*)SvRV(instance), MOP_mg_slot(mg), FALSE, 0U);
     return he ? HeVAL(he) : NULL;
 }
 
 static SV*
-mop_instance_set_slot(pTHX_ SV* const instance, SV* const slot_name, SV* const value) {
+mop_instance_set_slot(pTHX_ MAGIC* const mg, SV* const instance, SV* const value) {
     HE* he;
     SV* sv;
     CHECK_INSTANCE(instance);
-    he = hv_fetch_ent((HV*)SvRV(instance), slot_name, TRUE, 0U);
+    he = hv_fetch_ent((HV*)SvRV(instance), MOP_mg_slot(mg), TRUE, 0U);
     sv = HeVAL(he);
     sv_setsv_mg(sv, value);
     return sv;
 }
 
 static SV*
-mop_instance_delete_slot(pTHX_ SV* const instance, SV* const slot_name) {
+mop_instance_delete_slot(pTHX_ MAGIC* const mg, SV* const instance) {
     CHECK_INSTANCE(instance);
-    return hv_delete_ent((HV*)SvRV(instance), slot_name, 0, 0U);
+    return hv_delete_ent((HV*)SvRV(instance), MOP_mg_slot(mg), 0, 0U);
 }
 
 static void
-mop_instance_weaken_slot(pTHX_ SV* const instance, SV* const slot_name) {
+mop_instance_weaken_slot(pTHX_ MAGIC* const mg, SV* const instance) {
     HE* he;
     CHECK_INSTANCE(instance);
-    he = hv_fetch_ent((HV*)SvRV(instance), slot_name, FALSE, 0U);
-    sv_rvweaken(HeVAL(he));
+    he = hv_fetch_ent((HV*)SvRV(instance), MOP_mg_slot(mg), FALSE, 0U);
+    if(he){
+        sv_rvweaken(HeVAL(he));
+    }
 }
 
 static const mop_instance_vtbl mop_default_instance = {

diff --git a/xs/MethodAccessor.xs b/xs/MethodAccessor.xs
index 0dfe4f3..d55cd9f 100644 (file)
--- a/xs/MethodAccessor.xs
+++ b/xs/MethodAccessor.xs
@@ -13,15 +13,21 @@ mop_install_accessor(pTHX_ const char* const fq_name, const char* const key, I32
     CV* const xsub  = newXS((char*)fq_name, accessor_impl, __FILE__);
     SV* const keysv = newSVpvn_share(key, keylen, 0U);
     AV* const meta  = newAV();
+    MAGIC* mg;
 
     if(!vtbl){
         vtbl = mop_get_default_instance_vtbl(aTHX);
     }
 
-    sv_magicext((SV*)xsub, (SV*)meta, PERL_MAGIC_ext, &mop_accessor_vtbl, (char*)vtbl, 0);
+    mg = sv_magicext((SV*)xsub, (SV*)meta, PERL_MAGIC_ext, &mop_accessor_vtbl, (char*)vtbl, 0);
     SvREFCNT_dec(meta); /* sv_magicext() increases refcnt in mg_obj */
 
-    av_store(meta, 0, keysv);
+    av_store(meta, MOP_MI_SLOT, keysv);
+
+    /* NOTE:
+     * although we use MAGIC for gc, we also store mg to any slot for efficiency (gfx)
+     */
+    CvXSUBANY(xsub).any_ptr = (void*)mg;
 
     return xsub;
 }
@@ -53,16 +59,27 @@ mop_accessor_get_self(pTHX_ I32 const ax, I32 const items, CV* const cv) {
     return self;
 }
 
+#ifdef DEBUGGING
+SV**
+mop_debug_mi_access(pTHX_ AV* const mi, I32 const attr_ix){
+    assert(mi);
+    assert(SvTYPE(mi) == SVt_PVAV);
+    assert(AvMAX(mi) >= attr_ix);
+    return &AvARRAY(mi)[attr_ix];
+}
+#endif
+
 XS(mop_xs_simple_accessor)
 {
     dVAR; dXSARGS;
     dMOP_METHOD_COMMON; /* self, mg */
     SV* value;
+
     if(items == 1){ /* reader */
-        value = MOP_mg_vtbl(mg)->get_slot(aTHX_ self, MOP_mg_key(mg));
+        value = MOP_mg_get_slot(mg, self);
     }
     else if (items == 2){ /* writer */
-        value = MOP_mg_vtbl(mg)->set_slot(aTHX_ self, MOP_mg_key(mg), ST(1));
+        value = MOP_mg_set_slot(mg, self, ST(1));
     }
     else{
         croak("expected exactly one or two argument");
@@ -83,7 +100,7 @@ XS(mop_xs_simple_reader)
         croak("expected exactly one argument");
     }
 
-    value = MOP_mg_vtbl(mg)->get_slot(aTHX_ self, MOP_mg_key(mg));
+    value = MOP_mg_get_slot(mg, self);
     ST(0) = value ? value : &PL_sv_undef;
     XSRETURN(1);
 }
@@ -97,7 +114,7 @@ XS(mop_xs_simple_writer)
         croak("expected exactly two argument");
     }
 
-    ST(0) = MOP_mg_vtbl(mg)->set_slot(aTHX_ self, MOP_mg_key(mg), ST(1));
+    ST(0) = MOP_mg_set_slot(mg, self, ST(1));
     XSRETURN(1);
 }
 
@@ -111,7 +128,7 @@ XS(mop_xs_simple_clearer)
         croak("expected exactly one argument");
     }
 
-    value = MOP_mg_vtbl(mg)->delete_slot(aTHX_ self, MOP_mg_key(mg));
+    value = MOP_mg_delete_slot(mg, self);
     ST(0) = value ? value : &PL_sv_undef;
     XSRETURN(1);
 }
@@ -126,7 +143,7 @@ XS(mop_xs_simple_predicate)
         croak("expected exactly one argument");
     }
 
-    ST(0) = boolSV( MOP_mg_vtbl(mg)->has_slot(aTHX_ self, MOP_mg_key(mg)) );
+    ST(0) = boolSV( MOP_mg_has_slot(mg, self) );
     XSRETURN(1);
 }
 
@@ -141,7 +158,7 @@ XS(mop_xs_simple_predicate_for_metaclass)
         croak("expected exactly one argument");
     }
 
-    value = MOP_mg_vtbl(mg)->get_slot(aTHX_ self, MOP_mg_key(mg));
+    value = MOP_mg_get_slot(mg, self);
     ST(0) = boolSV( value && SvOK(value ));
     XSRETURN(1);
 }