From: gfx Date: Fri, 10 Jul 2009 08:57:03 +0000 (+0900) Subject: Make all the simple readers and predicates XS template X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1bc0cb6be3c6fde35e28fcdab61c31b2f1ae5931;p=gitmo%2FClass-MOP.git Make all the simple readers and predicates XS template About 3% faster. --- diff --git a/lib/Class/MOP/Attribute.pm b/lib/Class/MOP/Attribute.pm index 57dbf85..11a9a17 100644 --- a/lib/Class/MOP/Attribute.pm +++ b/lib/Class/MOP/Attribute.pm @@ -159,30 +159,30 @@ sub _set_initial_slot_value { # the next bunch of methods will get bootstrapped # away in the Class::MOP bootstrapping section -sub associated_class { $_[0]->{'associated_class'} } -sub associated_methods { $_[0]->{'associated_methods'} } - -sub has_accessor { defined($_[0]->{'accessor'}) } -sub has_reader { defined($_[0]->{'reader'}) } -sub has_writer { defined($_[0]->{'writer'}) } -sub has_predicate { defined($_[0]->{'predicate'}) } -sub has_clearer { defined($_[0]->{'clearer'}) } -sub has_builder { defined($_[0]->{'builder'}) } -sub has_init_arg { defined($_[0]->{'init_arg'}) } -sub has_default { defined($_[0]->{'default'}) } -sub has_initializer { defined($_[0]->{'initializer'}) } -sub has_insertion_order { defined($_[0]->{'insertion_order'}) } - -sub accessor { $_[0]->{'accessor'} } -sub reader { $_[0]->{'reader'} } -sub writer { $_[0]->{'writer'} } -sub predicate { $_[0]->{'predicate'} } -sub clearer { $_[0]->{'clearer'} } -sub builder { $_[0]->{'builder'} } -sub init_arg { $_[0]->{'init_arg'} } -sub initializer { $_[0]->{'initializer'} } -sub definition_context { $_[0]->{'definition_context'} } -sub insertion_order { $_[0]->{'insertion_order'} } +#sub associated_class { $_[0]->{'associated_class'} } +#sub associated_methods { $_[0]->{'associated_methods'} } + +#sub has_accessor { defined($_[0]->{'accessor'}) } +#sub has_reader { defined($_[0]->{'reader'}) } +#sub has_writer { defined($_[0]->{'writer'}) } +#sub has_predicate { defined($_[0]->{'predicate'}) } +#sub has_clearer { defined($_[0]->{'clearer'}) } +#sub has_builder { defined($_[0]->{'builder'}) } +#sub has_init_arg { defined($_[0]->{'init_arg'}) } +#sub has_default { defined($_[0]->{'default'}) } +#sub has_initializer { defined($_[0]->{'initializer'}) } +#sub has_insertion_order { defined($_[0]->{'insertion_order'}) } + +#sub accessor { $_[0]->{'accessor'} } +#sub reader { $_[0]->{'reader'} } +#sub writer { $_[0]->{'writer'} } +#sub predicate { $_[0]->{'predicate'} } +#sub clearer { $_[0]->{'clearer'} } +#sub builder { $_[0]->{'builder'} } +#sub init_arg { $_[0]->{'init_arg'} } +#sub initializer { $_[0]->{'initializer'} } +#sub definition_context { $_[0]->{'definition_context'} } +#sub insertion_order { $_[0]->{'insertion_order'} } sub _set_insertion_order { $_[0]->{'insertion_order'} = $_[1] } # end bootstrapped away method section. diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm index c2679a7..63deff1 100644 --- a/lib/Class/MOP/Class.pm +++ b/lib/Class/MOP/Class.pm @@ -324,18 +324,6 @@ sub create { ## Attribute readers -# NOTE: -# all these attribute readers will be bootstrapped -# away in the Class::MOP bootstrap section - -sub get_attribute_map { $_[0]->{'attributes'} } -sub attribute_metaclass { $_[0]->{'attribute_metaclass'} } -sub instance_metaclass { $_[0]->{'instance_metaclass'} } -sub immutable_trait { $_[0]->{'immutable_trait'} } -sub constructor_class { $_[0]->{'constructor_class'} } -sub constructor_name { $_[0]->{'constructor_name'} } -sub destructor_class { $_[0]->{'destructor_class'} } - # Instance Construction & Cloning sub new_object { diff --git a/lib/Class/MOP/Instance.pm b/lib/Class/MOP/Instance.pm index ad787e3..bc1defb 100644 --- a/lib/Class/MOP/Instance.pm +++ b/lib/Class/MOP/Instance.pm @@ -70,7 +70,7 @@ sub _new { sub _class_name { $_[0]->{_class_name} ||= $_[0]->associated_metaclass->name } -sub associated_metaclass { $_[0]{'associated_metaclass'} } +#sub associated_metaclass { $_[0]{'associated_metaclass'} } sub create_instance { my $self = shift; diff --git a/lib/Class/MOP/Method.pm b/lib/Class/MOP/Method.pm index 9a0cdda..6481f03 100644 --- a/lib/Class/MOP/Method.pm +++ b/lib/Class/MOP/Method.pm @@ -67,7 +67,7 @@ sub _new { ## accessors -sub associated_metaclass { shift->{'associated_metaclass'} } +#sub associated_metaclass { shift->{'associated_metaclass'} } sub attach_to_class { my ( $self, $class ) = @_; @@ -85,7 +85,7 @@ sub fully_qualified_name { $self->package_name . '::' . $self->name; } -sub original_method { (shift)->{'original_method'} } +#sub original_method { (shift)->{'original_method'} } sub _set_original_method { $_[0]->{'original_method'} = $_[1] } diff --git a/mop.c b/mop.c index 0d170be..b7b1248 100644 --- a/mop.c +++ b/mop.c @@ -9,7 +9,7 @@ mop_call_xs (pTHX_ XSPROTO(subaddr), CV *cv, SV **mark) PUTBACK; } -#if PERL_VERSION >= 10 +#if PERL_BCDVERSION >= 0x5010000 UV mop_check_package_cache_flag (pTHX_ HV *stash) { @@ -177,59 +177,40 @@ mop_get_all_package_symbols (HV *stash, type_filter_t filter) 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) -}; +static MGVTBL mop_accessor_vtbl; /* the MAGIC identity */ -SV * -mop_prehashed_key_for (mop_prehashed_key_t key) -{ - return prehashed_keys[key].key; -} +void +mop_install_simple_reader(const char* const fq_name, const char* const key, const int accessor_type){ + CV* const xsub = newXS((char*)fq_name, mop_xs_simple_reader, __FILE__); + SV* const keysv = newSVpvn_share(key, strlen(key), 0U); -U32 -mop_prehashed_hash_for (mop_prehashed_key_t key) -{ - return prehashed_keys[key].hash; + sv_magicext((SV*)xsub, keysv, PERL_MAGIC_ext, &mop_accessor_vtbl, NULL, 0); + SvREFCNT_dec(keysv); /* sv_magicext() increases refcnt in mg_obj */ + + CvXSUBANY(xsub).any_i32 = accessor_type; } -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)); +static MAGIC* +mop_mg_find_by_vtbl(SV* const sv, const MGVTBL* const vtbl){ + MAGIC* mg; + + assert(sv != NULL); + for(mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic){ + if(mg->mg_virtual == vtbl){ + break; + } } + return mg; } XS(mop_xs_simple_reader) { -#ifdef dVAR dVAR; dXSARGS; -#else - dXSARGS; -#endif + MAGIC* const mg = mop_mg_find_by_vtbl((SV*)cv, &mop_accessor_vtbl); + SV* const key = mg->mg_obj; register HE *he; - mop_prehashed_key_t key = (mop_prehashed_key_t)CvXSUBANY(cv).any_i32; SV *self; + SV *retval; if (items != 1) { croak("expected exactly one argument"); @@ -238,20 +219,30 @@ XS(mop_xs_simple_reader) self = ST(0); if (!SvROK(self)) { - croak("can't call %s as a class method", prehashed_keys[key].name); + croak("can't call %s as a class method", GvNAME(CvGV(cv))); } 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); + if ((he = hv_fetch_ent((HV *)SvRV(self), key, 0, 0U))) { + switch(XSANY.any_i32){ + case SIMPLE_READER: + retval = HeVAL(he); + break; + case SIMPLE_PREDICATE: + retval = boolSV(SvOK(HeVAL(he))); + break; + default: + croak("panic: not reached"); + retval = NULL; /* -W */ + } } else { - ST(0) = &PL_sv_undef; + retval = &PL_sv_undef; } + ST(0) = retval; XSRETURN(1); } - diff --git a/mop.h b/mop.h index 288c8ad..849ad1d 100644 --- a/mop.h +++ b/mop.h @@ -18,37 +18,34 @@ void mop_call_xs (pTHX_ XSPROTO(subaddr), CV *cv, SV **mark); -typedef enum { - KEY_name, - KEY_package, - KEY_package_name, - KEY_body, - KEY_package_cache_flag, - KEY_methods, - KEY_VERSION, - KEY_ISA, - key_last, -} mop_prehashed_key_t; - -#define KEY_FOR(name) mop_prehashed_key_for(KEY_ ##name) -#define HASH_FOR(name) mop_prehashed_hash_for(KEY_ ##name) - -void mop_prehash_keys (void); -SV *mop_prehashed_key_for (mop_prehashed_key_t key); -U32 mop_prehashed_hash_for (mop_prehashed_key_t key); + +#define MAKE_KEYSV(name) newSVpvn_share(#name, sizeof(#name)-1, 0U) + +void mop_install_simple_reader(const char* const fq_name, const char* const key, const int accessor_type); + +#define SIMPLE_READER 1 +#define SIMPLE_PREDICATE 2 #define INSTALL_SIMPLE_READER(klass, name) INSTALL_SIMPLE_READER_WITH_KEY(klass, name, name) -#define INSTALL_SIMPLE_READER_WITH_KEY(klass, name, key) \ - { \ - CV *cv = newXS("Class::MOP::" #klass "::" #name, mop_xs_simple_reader, __FILE__); \ - CvXSUBANY(cv).any_i32 = KEY_ ##key; \ - } +#define INSTALL_SIMPLE_READER_WITH_KEY(klass, name, key) mop_install_simple_reader("Class::MOP::" #klass "::" #name, #key, SIMPLE_READER) + +#define INSTALL_SIMPLE_PREDICATE(klass, name) INSTALL_SIMPLE_PREDICATE_WITH_KEY(klass, name, name) +#define INSTALL_SIMPLE_PREDICATE_WITH_KEY(klass, name, key) mop_install_simple_reader("Class::MOP::" #klass "::has_" #name, #key, SIMPLE_PREDICATE) + XS(mop_xs_simple_reader); extern SV *mop_method_metaclass; extern SV *mop_associated_metaclass; extern SV *mop_wrap; +extern SV *mop_methods; +extern SV *mop_name; +extern SV *mop_body; +extern SV *mop_package; +extern SV *mop_package_name; +extern SV *mop_package_cache_flag; +extern SV *mop_VERSION; +extern SV *mop_ISA; UV mop_check_package_cache_flag(pTHX_ HV *stash); int mop_get_code_info (SV *coderef, char **pkg, char **name); diff --git a/xs/Attribute.xs b/xs/Attribute.xs index 0375cb4..6097b7c 100644 --- a/xs/Attribute.xs +++ b/xs/Attribute.xs @@ -6,3 +6,25 @@ PROTOTYPES: DISABLE BOOT: INSTALL_SIMPLE_READER(Attribute, name); + INSTALL_SIMPLE_READER(Attribute, associated_class); + INSTALL_SIMPLE_READER(Attribute, associated_methods); + INSTALL_SIMPLE_READER(Attribute, accessor); + INSTALL_SIMPLE_READER(Attribute, reader); + INSTALL_SIMPLE_READER(Attribute, writer); + INSTALL_SIMPLE_READER(Attribute, predicate); + INSTALL_SIMPLE_READER(Attribute, clearer); + INSTALL_SIMPLE_READER(Attribute, builder); + INSTALL_SIMPLE_READER(Attribute, init_arg); + INSTALL_SIMPLE_READER(Attribute, initializer); + INSTALL_SIMPLE_READER(Attribute, insertion_order); + INSTALL_SIMPLE_READER(Attribute, definition_context); + + INSTALL_SIMPLE_PREDICATE(Attribute, accessor); + INSTALL_SIMPLE_PREDICATE(Attribute, reader); + INSTALL_SIMPLE_PREDICATE(Attribute, writer); + INSTALL_SIMPLE_PREDICATE(Attribute, predicate); + INSTALL_SIMPLE_PREDICATE(Attribute, clearer); + INSTALL_SIMPLE_PREDICATE(Attribute, builder); + INSTALL_SIMPLE_PREDICATE(Attribute, init_arg); + INSTALL_SIMPLE_PREDICATE(Attribute, initializer); + INSTALL_SIMPLE_PREDICATE(Attribute, default); diff --git a/xs/Class.xs b/xs/Class.xs new file mode 100644 index 0000000..d779683 --- /dev/null +++ b/xs/Class.xs @@ -0,0 +1,129 @@ +#include "mop.h" + +static void +mop_update_method_map(pTHX_ SV *const self, SV *const class_name, HV *const stash, HV *const map) +{ + const char *const class_name_pv = HvNAME(stash); /* must be HvNAME(stash), not SvPV_nolen_const(class_name) */ + SV *method_metaclass_name; + char *method_name; + I32 method_name_len; + SV *coderef; + HV *symbols; + dSP; + + symbols = mop_get_all_package_symbols(stash, TYPE_FILTER_CODE); + sv_2mortal((SV*)symbols); + (void)hv_iterinit(symbols); + while ( (coderef = hv_iternextsv(symbols, &method_name, &method_name_len)) ) { + CV *cv = (CV *)SvRV(coderef); + char *cvpkg_name; + char *cv_name; + SV *method_slot; + SV *method_object; + + if (!mop_get_code_info(coderef, &cvpkg_name, &cv_name)) { + continue; + } + + /* this checks to see that the subroutine is actually from our package */ + if ( !(strEQ(cvpkg_name, "constant") && strEQ(cv_name, "__ANON__")) ) { + if ( strNE(cvpkg_name, class_name_pv) ) { + continue; + } + } + + method_slot = *hv_fetch(map, method_name, method_name_len, TRUE); + if ( SvOK(method_slot) ) { + SV *const body = mop_call0(aTHX_ method_slot, mop_body); /* $method_object->body() */ + if ( SvROK(body) && ((CV *) SvRV(body)) == cv ) { + continue; + } + } + + method_metaclass_name = mop_call0(aTHX_ self, mop_method_metaclass); /* $self->method_metaclass() */ + + /* + $method_object = $method_metaclass->wrap( + $cv, + associated_metaclass => $self, + package_name => $class_name, + name => $method_name + ); + */ + ENTER; + SAVETMPS; + + PUSHMARK(SP); + EXTEND(SP, 8); + PUSHs(method_metaclass_name); /* invocant */ + mPUSHs(newRV_inc((SV *)cv)); + PUSHs(mop_associated_metaclass); + PUSHs(self); + PUSHs(mop_package_name); + PUSHs(class_name); + PUSHs(mop_name); + mPUSHs(newSVpv(method_name, method_name_len)); + PUTBACK; + + call_sv(mop_wrap, G_SCALAR | G_METHOD); + SPAGAIN; + method_object = POPs; + PUTBACK; + /* $map->{$method_name} = $method_object */ + sv_setsv(method_slot, method_object); + + FREETMPS; + LEAVE; + } +} + +MODULE = Class::MOP::Class PACKAGE = Class::MOP::Class + +BOOT: + INSTALL_SIMPLE_READER_WITH_KEY(Class, get_attribute_map, attributes); + /* INSTALL_SIMPLE_READER_WITH_KEY(Class, _method_map, methods); */ + INSTALL_SIMPLE_READER(Class, attribute_metaclass); + INSTALL_SIMPLE_READER(Class, method_metaclass); + INSTALL_SIMPLE_READER(Class, wrapped_method_metaclass); + INSTALL_SIMPLE_READER(Class, instance_metaclass); + INSTALL_SIMPLE_READER(Class, immutable_trait); + INSTALL_SIMPLE_READER(Class, constructor_name); + INSTALL_SIMPLE_READER(Class, constructor_class); + INSTALL_SIMPLE_READER(Class, destructor_class); + + +PROTOTYPES: DISABLE + +void +get_method_map(self) + SV *self + PREINIT: + HV *const obj = (HV *)SvRV(self); + SV *const class_name = HeVAL( hv_fetch_ent(obj, mop_package, 0, 0U) ); + HV *const stash = gv_stashsv(class_name, 0); + UV current; + SV *cache_flag; + SV *map_ref; + PPCODE: + if (!stash) { + mXPUSHs(newRV_noinc((SV *)newHV())); + return; + } + + current = mop_check_package_cache_flag(aTHX_ stash); + cache_flag = HeVAL( hv_fetch_ent(obj, mop_package_cache_flag, TRUE, 0U)); + map_ref = HeVAL( hv_fetch_ent(obj, mop_methods, TRUE, 0U)); + + /* $self->{methods} does not yet exist (or got deleted) */ + if ( !SvROK(map_ref) || SvTYPE(SvRV(map_ref)) != SVt_PVHV ) { + SV *new_map_ref = newRV_noinc((SV *)newHV()); + sv_2mortal(new_map_ref); + sv_setsv(map_ref, new_map_ref); + } + + if ( !SvOK(cache_flag) || SvUV(cache_flag) != current ) { + mop_update_method_map(aTHX_ self, class_name, stash, (HV *)SvRV(map_ref)); + sv_setuv(cache_flag, mop_check_package_cache_flag(aTHX_ stash)); /* update_cache_flag() */ + } + + XPUSHs(map_ref); diff --git a/xs/Instance.xs b/xs/Instance.xs new file mode 100755 index 0000000..ecef003 --- /dev/null +++ b/xs/Instance.xs @@ -0,0 +1,8 @@ +#include "mop.h" + +MODULE = Class::MOP::Instance PACKAGE = Class::MOP::Instance + +PROTOTYPES: DISABLE + +BOOT: + INSTALL_SIMPLE_READER(Instance, associated_metaclass); diff --git a/xs/MOP.xs b/xs/MOP.xs index 959df7a..a1bffab 100644 --- a/xs/MOP.xs +++ b/xs/MOP.xs @@ -3,6 +3,15 @@ SV *mop_method_metaclass; SV *mop_associated_metaclass; SV *mop_wrap; +SV *mop_methods; +SV *mop_name; +SV *mop_body; +SV *mop_package; +SV *mop_package_name; +SV *mop_package_cache_flag; + +SV *mop_VERSION; +SV *mop_ISA; static bool find_method (const char *key, STRLEN keylen, SV *val, void *ud) @@ -18,21 +27,29 @@ find_method (const char *key, STRLEN keylen, SV *val, void *ud) EXTERN_C XS(boot_Class__MOP__Package); EXTERN_C XS(boot_Class__MOP__Attribute); EXTERN_C XS(boot_Class__MOP__Method); +EXTERN_C XS(boot_Class__MOP__Instance); MODULE = Class::MOP PACKAGE = Class::MOP PROTOTYPES: DISABLE BOOT: - mop_prehash_keys(); - - mop_method_metaclass = newSVpvs("method_metaclass"); - mop_wrap = newSVpvs("wrap"); - mop_associated_metaclass = newSVpvs("associated_metaclass"); + mop_method_metaclass = MAKE_KEYSV(method_metaclass); + mop_wrap = MAKE_KEYSV(wrap); + mop_associated_metaclass = MAKE_KEYSV(associated_metaclass); + mop_methods = MAKE_KEYSV(methods); + mop_name = MAKE_KEYSV(name); + mop_body = MAKE_KEYSV(body); + mop_package = MAKE_KEYSV(package); + mop_package_name = MAKE_KEYSV(package_name); + mop_package_cache_flag = MAKE_KEYSV(_package_cache_flag); + mop_VERSION = MAKE_KEYSV(VERSION); + mop_ISA = MAKE_KEYSV(ISA); MOP_CALL_BOOT (boot_Class__MOP__Package); MOP_CALL_BOOT (boot_Class__MOP__Attribute); MOP_CALL_BOOT (boot_Class__MOP__Method); + MOP_CALL_BOOT (boot_Class__MOP__Instance); # use prototype here to be compatible with get_code_info from Sub::Identify void @@ -70,8 +87,8 @@ is_class_loaded(klass=&PL_sv_undef) XSRETURN_NO; } - if (hv_exists_ent (stash, KEY_FOR(VERSION), HASH_FOR(VERSION))) { - HE *version = hv_fetch_ent(stash, KEY_FOR(VERSION), 0, HASH_FOR(VERSION)); + if (hv_exists_ent (stash, mop_VERSION, 0U)) { + HE *version = hv_fetch_ent(stash, mop_VERSION, 0, 0U); SV *version_sv; if (version && HeVAL(version) && (version_sv = GvSV(HeVAL(version)))) { if (SvROK(version_sv)) { @@ -87,8 +104,8 @@ is_class_loaded(klass=&PL_sv_undef) } } - if (hv_exists_ent (stash, KEY_FOR(ISA), HASH_FOR(ISA))) { - HE *isa = hv_fetch_ent(stash, KEY_FOR(ISA), 0, HASH_FOR(ISA)); + if (hv_exists_ent (stash, mop_ISA, 0U)) { + HE *isa = hv_fetch_ent(stash, mop_ISA, 0, 0U); if (isa && HeVAL(isa) && GvAV(HeVAL(isa)) && av_len(GvAV(HeVAL(isa))) != -1) { XSRETURN_YES; } diff --git a/xs/Method.xs b/xs/Method.xs index 590cd06..13dcf31 100644 --- a/xs/Method.xs +++ b/xs/Method.xs @@ -8,3 +8,5 @@ BOOT: INSTALL_SIMPLE_READER(Method, name); INSTALL_SIMPLE_READER(Method, package_name); INSTALL_SIMPLE_READER(Method, body); + INSTALL_SIMPLE_READER(Method, associated_metaclass); + INSTALL_SIMPLE_READER(Method, original_method); diff --git a/xs/Package.xs b/xs/Package.xs index 362c407..8fedaaf 100644 --- a/xs/Package.xs +++ b/xs/Package.xs @@ -100,7 +100,7 @@ get_all_package_symbols(self, filter=TYPE_FILTER_NONE) PUTBACK; - if ( (he = hv_fetch_ent((HV *)SvRV(self), KEY_FOR(package), 0, HASH_FOR(package))) ) { + if ( (he = hv_fetch_ent((HV *)SvRV(self), mop_package, 0, 0U)) ) { stash = gv_stashsv(HeVAL(he), 0); }