Class::MOP::Attribute->meta->add_method('clone' => sub {
my $self = shift;
- my $cloned = $self->meta->clone_object($self, @_);
- $cloned->BUILD();
- return $cloned;
+ return $self->meta->clone_object($self, @_);
});
## --------------------------------------------------------
confess("A required attribute must have either 'init_arg', 'builder', or 'default'");
}
- my $self = $class->_new(\%options);
- $self->BUILD(); # Initializer in XS
- return $self;
+ return $class->_new(\%options);
}
sub _new {
my %options = @_;
(blessed($self))
|| confess "Can only clone an instance";
- my $cloned = bless { %{$self}, %options } => ref($self);
- $cloned->BUILD();
- return $cloned;
+ return bless { %{$self}, %options } => ref($self);
}
sub initialize_instance_slot {
void (*weaken_slot) (pTHX_ SV* const mi, SV* const instance);
} mop_instance_vtbl;
+SV* mop_instance_create_instance(pTHX_ HV* const stash);
+bool mop_instance_has_slot(pTHX_ SV* const instance, SV* const slot);
+SV* mop_instance_get_slot(pTHX_ SV* const instance, SV* const slot);
+SV* mop_instance_set_slot(pTHX_ SV* const instance, SV* const slot, SV* const value);
+SV* mop_instance_delete_slot(pTHX_ SV* const instance, SV* const slot);
+void mop_instance_weaken_slot(pTHX_ SV* const instance, SV* const slot);
+
const mop_instance_vtbl* mop_get_default_instance_vtbl(pTHX);
#define MOP_mg_obj(mg) ((mg)->mg_obj)
SV* mop_accessor_get_self(pTHX_ I32 const ax, I32 const items, CV* const cv);
-MAGIC* mop_accessor_get_mg(pTHX_ CV* const cv);
+MAGIC* mop_attr_get_mg(pTHX_ SV* const attr);
CV* mop_install_accessor(pTHX_ const char* const fq_name, const char* const key, I32 const keylen, XSUBADDR_t const accessor_impl, const mop_instance_vtbl* vtbl);
CV* mop_instantiate_xs_accessor(pTHX_ SV* const accessor, XSUBADDR_t const accessor_impl, mop_instance_vtbl* const vtbl);
#include "mop.h"
-static MGVTBL mop_attr_vtbl;
-
-
-MAGIC*
-mop_attr_get_mg(pTHX_ SV* const attr){
- if(!SvROK(attr)) croak("Invalid object");
-
- return mop_mg_find(aTHX_ SvRV(attr), &mop_attr_vtbl, MOPf_DIE_ON_FAIL);
-}
-
MODULE = Class::MOP::Attribute PACKAGE = Class::MOP::Attribute
INSTALL_SIMPLE_PREDICATE(Attribute, initializer);
INSTALL_SIMPLE_PREDICATE(Attribute, default);
-void
-BUILD(SV* self)
-PREINIT:
- mop_instance_vtbl* vtbl;
-CODE:
- if(!( SvROK(self) && SvOBJECT(SvRV(self)) )){
- croak("Invalid object");
- }
- sv_magicext(SvRV(self), NULL, PERL_MAGIC_ext, &mop_attr_vtbl, NULL, 0);
-
#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;
+#define _generate_constructor_method_xs(self, vtbl) mop_generate_constructor_method_xs(aTHX_ self, (mop_instance_vtbl*)vtbl)
- 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;
+static MGVTBL mop_constructor_vtbl;
- if (!mop_get_code_info(coderef, &cvpkg_name, &cv_name)) {
- continue;
- }
+static CV*
+mop_generate_constructor_method_xs(pTHX_ SV* const metaclass, mop_instance_vtbl* const instance_vtbl){
+ // CV* const xsub = newXS(NULL, mop_xs_constructor, __FILE__);
- /* 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;
- }
- }
+ assert(instance_vtbl);
- 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
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);
+CV*
+_generate_constructor_method_xs(SV* self, void* instance_vtbl)
} \
} STMT_END
-static SV*
+SV*
mop_instance_create_instance(pTHX_ HV* const stash) {
assert(stash);
return sv_bless( newRV_noinc((SV*)newHV()), stash );
}
-static bool
+bool
mop_instance_has_slot(pTHX_ SV* const instance, SV* const slot) {
assert(instance);
assert(slot);
return hv_exists_ent((HV*)SvRV(instance), slot, 0U);
}
-static SV*
+SV*
mop_instance_get_slot(pTHX_ SV* const instance, SV* const slot) {
HE* he;
assert(instance);
return he ? HeVAL(he) : NULL;
}
-static SV*
+SV*
mop_instance_set_slot(pTHX_ SV* const instance, SV* const slot, SV* const value) {
HE* he;
SV* sv;
return sv;
}
-static SV*
+SV*
mop_instance_delete_slot(pTHX_ SV* const instance, SV* const slot) {
assert(instance);
assert(slot);
return hv_delete_ent((HV*)SvRV(instance), slot, 0, 0U);
}
-static void
+void
mop_instance_weaken_slot(pTHX_ SV* const instance, SV* const slot) {
HE* he;
assert(instance);
FREETMPS;
LEAVE;
- return FALSE;
+ return ok;
}
return FALSE;
STRLEN klen;
const char* const kpv = SvPV_const(key, klen);
+ SV* const keysv = newSVpvn_share(kpv, klen, 0U);
- MAGIC* mg = mop_attr_get_mg(aTHX_ attr);
+ MAGIC* mg;
CV* const xsub = newXS(NULL, accessor_impl, __FILE__);
sv_2mortal((SV*)xsub);
- MOP_mg_obj(mg) = newSVpvn_share(kpv, klen, 0U);
- MOP_mg_obj_refcounted_on(mg);
+ mg = sv_magicext((SV*)xsub, keysv, PERL_MAGIC_ext, &mop_accessor_vtbl, (char*)vtbl, 0);
+ SvREFCNT_dec(keysv); /* sv_magicext() increases refcnt in mg_obj */
- CvXSUBANY(xsub).any_ptr = sv_magicext((SV*)xsub, MOP_mg_obj(mg), PERL_MAGIC_ext, MOP_mg_virtual(mg), (char*)vtbl, 0);
+ /* NOTE:
+ * although we use MAGIC for gc, we also store mg to CvXSUBANY slot for efficiency (gfx)
+ */
+ CvXSUBANY(xsub).any_ptr = mg;
return xsub;
}
projects / gitmo/Class-MOP.git / commitdiff