X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=mop.c;h=126568d78352871b4a0e8dcf5cc0f43dbbe9158c;hb=b2579597765fec7be3eea23b9c579d6e4d9aac21;hp=425cd4850ecde0f435b25875100eca95f7985af6;hpb=caa6b5cd10ef5addf2f06670ed5c97e95381936c;p=gitmo%2FClass-MOP.git diff --git a/mop.c b/mop.c index 425cd48..126568d 100644 --- a/mop.c +++ b/mop.c @@ -1,12 +1,12 @@ #include "mop.h" void -mop_call_xs (pTHX_ void (*subaddr) (pTHX_ CV *), CV *cv, SV **mark) +mop_call_xs (pTHX_ XSPROTO(subaddr), CV *cv, SV **mark) { - dSP; - PUSHMARK(mark); - (*subaddr)(aTHX_ cv); - PUTBACK; + dSP; + PUSHMARK(mark); + (*subaddr)(aTHX_ cv); + PUTBACK; } #if PERL_VERSION >= 10 @@ -76,7 +76,7 @@ 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; @@ -109,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; @@ -195,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; } + +#define DECLARE_KEY(name) { #name, #name, NULL, 0 } +#define DECLARE_KEY_WITH_VALUE(name, value) { #name, value, NULL, 0 } + +/* 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) +}; + +SV * +mop_prehashed_key_for (mop_prehashed_key_t key) +{ + return prehashed_keys[key].key; +} + +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)); + } +} + +XS(mop_xs_simple_reader) +{ +#ifdef dVAR + dVAR; dXSARGS; +#else + dXSARGS; +#endif + register HE *he; + mop_prehashed_key_t key = (mop_prehashed_key_t)CvXSUBANY(cv).any_i32; + SV *self; + + if (items != 1) { + croak("expected exactly one argument"); + } + + self = ST(0); + + 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))) { + ST(0) = HeVAL(he); + } + else { + ST(0) = &PL_sv_undef; + } + + XSRETURN(1); +} +