About 3% faster.
# 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.
## 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 {
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;
## accessors
-sub associated_metaclass { shift->{'associated_metaclass'} }
+#sub associated_metaclass { shift->{'associated_metaclass'} }
sub attach_to_class {
my ( $self, $class ) = @_;
$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] }
PUTBACK;
}
-#if PERL_VERSION >= 10
+#if PERL_BCDVERSION >= 0x5010000
UV
mop_check_package_cache_flag (pTHX_ HV *stash)
{
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");
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);
}
-
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);
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);
--- /dev/null
+#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);
--- /dev/null
+#include "mop.h"
+
+MODULE = Class::MOP::Instance PACKAGE = Class::MOP::Instance
+
+PROTOTYPES: DISABLE
+
+BOOT:
+ INSTALL_SIMPLE_READER(Instance, associated_metaclass);
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)
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
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)) {
}
}
- 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;
}
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);
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);
}
projects / gitmo/Class-MOP.git / commitdiff