X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=mop.c;h=25358f8bbf6e3364b375c83f83c58f97ae2e4788;hb=7ec7b950c0cc43c8ba1f2c53a8ebffcfc23ef858;hp=11a856b7f24327a956165bb65c642f439923e00f;hpb=d846ade3f993c0e6c140bb28284022e602b8988e;p=gitmo%2FClass-MOP.git

diff --git a/mop.c b/mop.c
index 11a856b..25358f8 100644
--- a/mop.c
+++ b/mop.c
@@ -3,10 +3,10 @@
 void
 mop_call_xs (pTHX_ void (*subaddr) (pTHX_ CV *), CV *cv, SV **mark)
 {
-	dSP;
-	PUSHMARK(mark);
-	(*subaddr)(aTHX_ cv);
-	PUTBACK;
+    dSP;
+    PUSHMARK(mark);
+    (*subaddr)(aTHX_ cv);
+    PUTBACK;
 }
 
 #if PERL_VERSION >= 10
@@ -76,13 +76,19 @@ mop_call0 (pTHX_ SV *const self, SV *const method)
 }
 
 int
-get_code_info (SV *coderef, char **pkg, char **name)
+mop_get_code_info (SV *coderef, char **pkg, char **name)
 {
     if (!SvOK(coderef) || !SvROK(coderef) || SvTYPE(SvRV(coderef)) != SVt_PVCV) {
         return 0;
     }
 
     coderef = SvRV(coderef);
+
+    /* sub is still being compiled */
+    if (!CvGV(coderef)) {
+        return 0;
+    }
+
     /* I think this only gets triggered with a mangled coderef, but if
        we hit it without the guard, we segfault. The slightly odd return
        value strikes me as an improvement (mst)
@@ -103,7 +109,7 @@ get_code_info (SV *coderef, char **pkg, char **name)
 }
 
 void
-get_package_symbols (HV *stash, type_filter_t filter, get_package_symbols_cb_t cb, void *ud)
+mop_get_package_symbols (HV *stash, type_filter_t filter, get_package_symbols_cb_t cb, void *ud)
 {
     HE *he;
 
@@ -189,9 +195,88 @@ collect_all_symbols (const char *key, STRLEN keylen, SV *val, void *ud)
 }
 
 HV *
-get_all_package_symbols (HV *stash, type_filter_t filter)
+mop_get_all_package_symbols (HV *stash, type_filter_t filter)
 {
     HV *ret = newHV ();
-    get_package_symbols (stash, filter, collect_all_symbols, ret);
+    mop_get_package_symbols (stash, filter, collect_all_symbols, ret);
     return ret;
 }
+
+/* the order of these has to match with those in mop.h */
+static struct {
+    const char *name;
+    const char *value;
+    SV *key;
+    U32 hash;
+} prehashed_keys[key_last] = {
+    DECLARE_KEY(name),
+    DECLARE_KEY(package),
+    DECLARE_KEY(package_name),
+    DECLARE_KEY(body),
+    DECLARE_KEY_WITH_VALUE(package_cache_flag, "_package_cache_flag"),
+    DECLARE_KEY(methods),
+    DECLARE_KEY(VERSION),
+    DECLARE_KEY(ISA)
+};
+
+inline SV *
+mop_prehashed_key_for (mop_prehashed_key_t key)
+{
+    return prehashed_keys[key].key;
+}
+
+inline U32
+mop_prehashed_hash_for (mop_prehashed_key_t key)
+{
+    return prehashed_keys[key].hash;
+}
+
+void
+mop_prehash_keys ()
+{
+    int i;
+
+    for (i = 0; i < key_last; i++) {
+        const char *value = prehashed_keys[i].value;
+        prehashed_keys[i].key = newSVpv(value, strlen(value));
+        PERL_HASH(prehashed_keys[i].hash, value, strlen(value));
+    }
+}
+
+SV *
+mop_simple_reader (SV *self, mop_prehashed_key_t key)
+{
+    register HE *he;
+
+    if (!SvROK(self)) {
+        croak("can't call %s as a class method", prehashed_keys[key].name);
+    }
+
+    if (SvTYPE(SvRV(self)) != SVt_PVHV) {
+        croak("object is not a hashref");
+    }
+
+    if (!(he = hv_fetch_ent((HV *)SvRV(self), prehashed_keys[key].key, 0, prehashed_keys[key].hash))) {
+        return &PL_sv_undef;
+    }
+
+    return SvREFCNT_inc(HeVAL(he));
+}
+
+XS(mop_xs_simple_reader)
+{
+#ifdef dVAR
+    dVAR; dXSARGS;
+#else
+    dXSARGS;
+#endif
+
+    if (items != 1) {
+        croak("expected exactly one argument");
+    }
+
+    ST(0) = mop_simple_reader (ST(0), CvXSUBANY(cv).any_i32);
+    sv_2mortal(ST(0));
+    XSRETURN(1);
+}
+