X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=mop.c;h=a5ded4f0b04bf4a279dea32cab2d5a2bc8c98df6;hb=46fccbab1ce2ee3a115b69e05a383f42dbf78890;hp=425cd4850ecde0f435b25875100eca95f7985af6;hpb=caa6b5cd10ef5addf2f06670ed5c97e95381936c;p=gitmo%2FClass-MOP.git diff --git a/mop.c b/mop.c index 425cd48..a5ded4f 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; @@ -93,23 +93,21 @@ get_code_info (SV *coderef, char **pkg, char **name) we hit it without the guard, we segfault. The slightly odd return value strikes me as an improvement (mst) */ -#ifdef isGV_with_GP + if ( isGV_with_GP(CvGV(coderef)) ) { -#endif - *pkg = HvNAME( GvSTASH(CvGV(coderef)) ); + GV *gv = CvGV(coderef); + *pkg = HvNAME( GvSTASH(gv) ? GvSTASH(gv) : CvSTASH(coderef) ); *name = GvNAME( CvGV(coderef) ); -#ifdef isGV_with_GP } else { *pkg = "__UNKNOWN__"; *name = "__ANON__"; } -#endif return 1; } 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; @@ -127,54 +125,31 @@ get_package_symbols (HV *stash, type_filter_t filter, get_package_symbols_cb_t c } while ( (he = hv_iternext(stash)) ) { - SV *const gv = HeVAL(he); - SV *sv = NULL; - char *key; + GV * const gv = (GV*)HeVAL(he); STRLEN keylen; - char *package; - SV *fq; + const char * const key = HePV(he, keylen); + SV *sv = NULL; - switch( SvTYPE(gv) ) { -#ifndef SVt_RV - case SVt_RV: -#endif - case SVt_PV: - case SVt_IV: - /* expand the gv into a real typeglob if it - * contains stub functions and we were asked to - * return CODE symbols */ - if (filter == TYPE_FILTER_CODE) { - if (SvROK(gv)) { - /* we don't really care about the length, - but that's the API */ - key = HePV(he, keylen); - package = HvNAME(stash); - fq = newSVpvf("%s::%s", package, key); - sv = (SV *)get_cv(SvPV_nolen(fq), 0); - break; - } - - key = HePV(he, keylen); - gv_init((GV *)gv, stash, key, keylen, GV_ADDMULTI); - } - /* fall through */ - case SVt_PVGV: - switch (filter) { - case TYPE_FILTER_CODE: sv = (SV *)GvCVu(gv); break; - case TYPE_FILTER_ARRAY: sv = (SV *)GvAV(gv); break; - case TYPE_FILTER_IO: sv = (SV *)GvIO(gv); break; - case TYPE_FILTER_HASH: sv = (SV *)GvHV(gv); break; - case TYPE_FILTER_SCALAR: sv = (SV *)GvSV(gv); break; - default: - croak("Unknown type"); - } - break; - default: - continue; + if(isGV(gv)){ + switch (filter) { + case TYPE_FILTER_CODE: sv = (SV *)GvCVu(gv); break; + case TYPE_FILTER_ARRAY: sv = (SV *)GvAV(gv); break; + case TYPE_FILTER_IO: sv = (SV *)GvIO(gv); break; + case TYPE_FILTER_HASH: sv = (SV *)GvHV(gv); break; + case TYPE_FILTER_SCALAR: sv = (SV *)GvSV(gv); break; + default: + croak("Unknown type"); + } + } + /* expand the gv into a real typeglob if it + * contains stub functions or constants and we + * were asked to return CODE references */ + else if (filter == TYPE_FILTER_CODE) { + gv_init(gv, stash, key, keylen, GV_ADDMULTI); + sv = (SV *)GvCV(gv); } if (sv) { - const char *key = HePV(he, keylen); if (!cb(key, keylen, sv, ud)) { return; } @@ -195,9 +170,89 @@ 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), + DECLARE_KEY_WITH_VALUE(_version, "-version") +}; + +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); +} +