#define MOP_CALL_BOOT(name) mop_call_xs(aTHX_ name, cv, mark);
-#ifndef XSPROTO
-#define XSPROTO(name) XS(name)
-#endif
-
void mop_call_xs (pTHX_ XSPROTO(subaddr), CV *cv, SV **mark);
-
#define MAKE_KEYSV(name) newSVpvn_share(#name, sizeof(#name)-1, 0U)
XS(mop_xs_simple_accessor);
SV* mop_class_of(pTHX_ SV* const sv);
+/* Class::MOP::Class */
+
+AV* mop_class_get_all_attributes(pTHX_ SV* const metaclass);
/* Class::MOP Magic stuff */
/* Class::MOP::Attribute stuff */
-MAGIC* mop_attr_get_mg(pTHX_ SV* const attr);
+
+#define MOP_attr_slot(meta) MOP_av_at(meta, MOP_ATTR_SLOT)
+#define MOP_attr_init_arg(meta) MOP_av_at(meta, MOP_ATTR_INIT_ARG)
+#define MOP_attr_default(meta) MOP_av_at(meta, MOP_ATTR_DEFAULT)
+#define MOP_attr_builder(meta) MOP_av_at(meta, MOP_ATTR_BUILDER)
+
+enum mop_attr_ix_t{
+ MOP_ATTR_SLOT,
+
+ MOP_ATTR_INIT_ARG,
+ MOP_ATTR_DEFAULT,
+ MOP_ATTR_BUILDER,
+
+ MOP_ATTR_last,
+};
+
+enum mop_attr_flags_t{ /* keep 16 bits */
+ MOP_ATTRf_HAS_INIT_ARG = 0x0001,
+ MOP_ATTRf_HAS_DEFAULT = 0x0002,
+ MOP_ATTRf_IS_DEFAULT_A_CODEREF = 0x0004,
+ MOP_ATTRf_HAS_BUILDER = 0x0008,
+ MOP_ATTRf_HAS_INITIALIZER = 0x0010,
+
+ MOP_ATTRf_DEBUG = 0x8000
+};
+
+MAGIC* mop_attr_mg(pTHX_ SV* const attr, SV* const instance);
+void mop_attr_initialize_instance_slot(pTHX_ SV* const attr, const mop_instance_vtbl* const vtbl, SV* const instance, HV* const args);
/* Class::MOP::Method::Accessor stuff */
SV* mop_accessor_get_self(pTHX_ I32 const ax, I32 const items, 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_mg(pTHX_ SV* const attr, SV* const instance){
+ MAGIC* mg;
+
+ if(!IsObject(attr)) {
+ croak("Invalid Attribute object");
+ }
+
+ /* attribute mg:
+ mg_obj: meta information (AV*)
+ mg_ptr: meta instance virtual table (mop_instance_vtbl*)
+ */
+
+ if(!(SvMAGICAL(SvRV(attr)) && (mg = mop_mg_find(aTHX_ SvRV(attr), &mop_attr_vtbl, 0))) ) {
+ U16 flags = 0;
+ AV* const meta = newAV();
+ SV* name;
+ SV* sv;
+
+ mg = sv_magicext(SvRV(attr), (SV*)meta, PERL_MAGIC_ext, &mop_attr_vtbl, NULL, 0);
+ SvREFCNT_dec(meta);
+ av_extend(meta, MOP_ATTR_last - 1);
+
+ ENTER;
+ SAVETMPS;
+
+ name = mop_call0(aTHX_ attr, mop_name);
+ av_store(meta, MOP_ATTR_SLOT, newSVsv_share(name));
+
+ if(SvOK( sv = mop_call0_pvs(attr, "init_arg") )) {
+ flags |= MOP_ATTRf_HAS_INIT_ARG;
+
+ av_store(meta, MOP_ATTR_INIT_ARG, newSVsv_share(sv));
+ }
+
+ /* NOTE: Setting both default and builder is not allowed */
+ if(SvOK( sv = mop_call0_pvs(attr, "builder") )) {
+ SV* const builder = sv;
+ flags |= MOP_ATTRf_HAS_BUILDER;
+
+ if(SvOK( sv = mop_call1(aTHX_ instance, mop_can, builder) )){
+ av_store(meta, MOP_ATTR_BUILDER, newSVsv(sv));
+ }
+ else{
+ croak("%s does not support builder method '%"SVf"' for attribute '%"SVf"'",
+ sv_reftype(SvRV(instance), TRUE), builder, name);
+ }
+ }
+ else if(SvOK( sv = mop_call0_pvs(attr, "default") )) {
+ if(SvTRUEx( mop_call0_pvs(attr, "is_default_a_coderef") )){
+ flags |= MOP_ATTRf_HAS_BUILDER;
+ av_store(meta, MOP_ATTR_BUILDER, newSVsv(sv));
+ }
+ else {
+ flags |= MOP_ATTRf_HAS_DEFAULT;
+ av_store(meta, MOP_ATTR_DEFAULT, newSVsv(sv));
+ }
+ }
+
+ MOP_mg_flags(mg) = flags;
+
+ if(flags & MOP_ATTRf_DEBUG) {
+ warn("%s: setup attr_mg for '%"SVf"'\n", sv_reftype(SvRV(instance), TRUE), name);
+ }
+
+ FREETMPS;
+ LEAVE;
+ }
+
+ return mg;
+}
+
+void
+mop_attr_initialize_instance_slot(pTHX_ SV* const attr, const mop_instance_vtbl* const vtbl, SV* const instance, HV* const args){
+ MAGIC* const mg = mop_attr_mg(aTHX_ attr, instance);
+ AV* const meta = (AV*)MOP_mg_obj(mg);
+ U16 const flags = MOP_mg_flags(mg);
+ HE* arg;
+ SV* value;
+
+ if(flags & MOP_ATTRf_DEBUG){
+ warn("%s: initialize_instance_slot '%"SVf"' (0x%04x)\n", sv_reftype(SvRV(instance), TRUE), MOP_attr_slot(meta), (unsigned)flags);
+ }
+
+ if( flags & MOP_ATTRf_HAS_INIT_ARG && (arg = hv_fetch_ent(args, MOP_attr_init_arg(meta), FALSE, 0U)) ){
+ value = hv_iterval(args, arg);
+ }
+ else if(flags & MOP_ATTRf_HAS_DEFAULT) {
+ value = MOP_attr_default(meta); /* it's always a non-ref value */
+ }
+ else if(flags & MOP_ATTRf_HAS_BUILDER) {
+ SV* const builder = MOP_attr_builder(meta); /* code-ref default value or builder */
+ dSP;
+
+ ENTER;
+ SAVETMPS;
+
+ PUSHMARK(SP);
+ XPUSHs(instance);
+ PUTBACK;
+
+ call_sv(builder, G_SCALAR);
+
+ SPAGAIN;
+ value = POPs;
+ SvREFCNT_inc_simple_void_NN(value);
+ PUTBACK;
+
+ FREETMPS;
+ LEAVE;
+
+ sv_2mortal(value);
+ }
+ else{
+ value = NULL;
+ }
+
+ if(value){
+ if(flags & MOP_ATTRf_HAS_INITIALIZER){
+ /* $attr->set_initial_value($meta_instance, $instance, $value) */
+ dSP;
+
+ PUSHMARK(SP);
+ EXTEND(SP, 4);
+ PUSHs(attr);
+ PUSHs(instance);
+ mPUSHs(value);
+ PUTBACK;
+
+ call_method("set_initial_value", G_VOID | G_DISCARD);
+ }
+ else{
+ vtbl->set_slot(aTHX_ instance, MOP_attr_slot(meta), value);
+ }
+ }
+}
+
+
MODULE = Class::MOP::Attribute PACKAGE = Class::MOP::Attribute
PROTOTYPES: DISABLE
#include "mop.h"
+
+AV*
+mop_class_get_all_attributes(pTHX_ SV* const metaclass){
+ AV* const attrs = newAV();
+ dSP;
+ I32 n;
+
+ PUSHMARK(SP);
+ XPUSHs(metaclass);
+ PUTBACK;
+
+ n = call_method("get_all_attributes", G_ARRAY);
+ SPAGAIN;
+
+ if(n){
+ av_extend(attrs, n - 1);
+ while(n){
+ (void)av_store(attrs, --n, newSVsv(POPs));
+ }
+ }
+
+ PUTBACK;
+
+ return attrs;
+}
+
+
MODULE = Class::MOP::Class PACKAGE = Class::MOP::Class
PROTOTYPES: DISABLE
#include "mop.h"
-static MGVTBL mop_attr_vtbl;
-
-#define MOP_attr_slot(meta) MOP_av_at(meta, MOP_ATTR_SLOT)
-#define MOP_attr_init_arg(meta) MOP_av_at(meta, MOP_ATTR_INIT_ARG)
-#define MOP_attr_default(meta) MOP_av_at(meta, MOP_ATTR_DEFAULT)
-#define MOP_attr_builder(meta) MOP_av_at(meta, MOP_ATTR_BUILDER)
-
-enum mop_attr_ix_t{
- MOP_ATTR_SLOT,
-
- MOP_ATTR_INIT_ARG,
- MOP_ATTR_DEFAULT,
- MOP_ATTR_BUILDER,
-
- MOP_ATTR_last,
-};
-
-enum mop_attr_flags_t{ /* must be 16 bits */
- MOP_ATTRf_HAS_INIT_ARG = 0x0001,
- MOP_ATTRf_HAS_DEFAULT = 0x0002,
- MOP_ATTRf_IS_DEFAULT_A_CODEREF = 0x0004,
- MOP_ATTRf_HAS_BUILDER = 0x0008,
- MOP_ATTRf_HAS_INITIALIZER = 0x0010,
-
-
- MOP_ATTRf_DEBUG = 0x8000
-};
-
-static MAGIC*
-mop_attr_mg(pTHX_ SV* const attr, SV* const instance){
- MAGIC* mg;
-
- if(!IsObject(attr)) {
- croak("Invalid Attribute object");
- }
-
- /* attribute mg:
- mg_obj: meta information (AV*)
- mg_ptr: meta instance virtual table (mop_instance_vtbl*)
- */
-
- if(!(SvMAGICAL(SvRV(attr)) && (mg = mop_mg_find(aTHX_ SvRV(attr), &mop_attr_vtbl, 0))) ) {
- U16 flags = 0;
- AV* const meta = newAV();
- SV* name;
- SV* sv;
-
- mg = sv_magicext(SvRV(attr), (SV*)meta, PERL_MAGIC_ext, &mop_attr_vtbl, NULL, 0);
- SvREFCNT_dec(meta);
- av_extend(meta, MOP_ATTR_last - 1);
-
- ENTER;
- SAVETMPS;
-
- name = mop_call0(aTHX_ attr, mop_name);
- av_store(meta, MOP_ATTR_SLOT, newSVsv_share(name));
-
- if(SvOK( sv = mop_call0_pvs(attr, "init_arg") )) {
- flags |= MOP_ATTRf_HAS_INIT_ARG;
-
- av_store(meta, MOP_ATTR_INIT_ARG, newSVsv_share(sv));
- }
-
- /* NOTE: Setting both default and builder is not allowed */
- if(SvOK( sv = mop_call0_pvs(attr, "builder") )) {
- SV* const builder = sv;
- flags |= MOP_ATTRf_HAS_BUILDER;
-
- if(SvOK( sv = mop_call1(aTHX_ instance, mop_can, builder) )){
- av_store(meta, MOP_ATTR_BUILDER, newSVsv(sv));
- }
- else{
- croak("%s does not support builder method '%"SVf"' for attribute '%"SVf"'",
- sv_reftype(SvRV(instance), TRUE), builder, name);
- }
- }
- else if(SvOK( sv = mop_call0_pvs(attr, "default") )) {
- if(SvTRUEx( mop_call0_pvs(attr, "is_default_a_coderef") )){
- flags |= MOP_ATTRf_HAS_BUILDER;
- av_store(meta, MOP_ATTR_BUILDER, newSVsv(sv));
- }
- else {
- flags |= MOP_ATTRf_HAS_DEFAULT;
- av_store(meta, MOP_ATTR_DEFAULT, newSVsv(sv));
- }
- }
-
- MOP_mg_flags(mg) = flags;
-
- if(flags & MOP_ATTRf_DEBUG) {
- warn("%s: setup attr_mg for '%"SVf"'\n", sv_reftype(SvRV(instance), TRUE), name);
- }
-
- FREETMPS;
- LEAVE;
- }
-
- return mg;
-}
-
static MGVTBL mop_constructor_vtbl;
static HV*
return args;
}
-static void
-mop_attr_initialize_instance_slot(pTHX_ SV* const attr, const mop_instance_vtbl* const vtbl, SV* const instance, HV* const args){
- MAGIC* const mg = mop_attr_mg(aTHX_ attr, instance);
- AV* const meta = (AV*)MOP_mg_obj(mg);
- U16 const flags = MOP_mg_flags(mg);
- HE* arg;
- SV* value;
-
- if(flags & MOP_ATTRf_DEBUG){
- warn("%s: initialize_instance_slot '%"SVf"' (0x%04x)\n", sv_reftype(SvRV(instance), TRUE), MOP_attr_slot(meta), (unsigned)flags);
- }
-
- if( flags & MOP_ATTRf_HAS_INIT_ARG && (arg = hv_fetch_ent(args, MOP_attr_init_arg(meta), FALSE, 0U)) ){
- value = hv_iterval(args, arg);
- }
- else if(flags & MOP_ATTRf_HAS_DEFAULT) {
- value = MOP_attr_default(meta); /* it's always a non-ref value */
- }
- else if(flags & MOP_ATTRf_HAS_BUILDER) {
- SV* const builder = MOP_attr_builder(meta); /* code-ref default value or builder */
- dSP;
-
- ENTER;
- SAVETMPS;
-
- PUSHMARK(SP);
- XPUSHs(instance);
- PUTBACK;
-
- call_sv(builder, G_SCALAR);
-
- SPAGAIN;
- value = POPs;
- SvREFCNT_inc_simple_void_NN(value);
- PUTBACK;
-
- FREETMPS;
- LEAVE;
-
- sv_2mortal(value);
- }
- else{
- value = NULL;
- }
-
- if(value){
- if(flags & MOP_ATTRf_HAS_INITIALIZER){
- /* $attr->set_initial_value($meta_instance, $instance, $value) */
- dSP;
-
- PUSHMARK(SP);
- EXTEND(SP, 4);
- PUSHs(attr);
- PUSHs(instance);
- mPUSHs(value);
- PUTBACK;
-
- call_method("set_initial_value", G_VOID | G_DISCARD);
- }
- else{
- vtbl->set_slot(aTHX_ instance, MOP_attr_slot(meta), value);
- }
- }
-}
-
-static AV*
-mop_class_get_all_attributes(pTHX_ SV* const metaclass){
- AV* const attrs = newAV();
- dSP;
- I32 n;
-
- PUSHMARK(SP);
- XPUSHs(metaclass);
- PUTBACK;
-
- n = call_method("get_all_attributes", G_ARRAY);
- SPAGAIN;
-
- if(n){
- av_extend(attrs, n - 1);
- while(n){
- (void)av_store(attrs, --n, newSVsv(POPs));
- }
- }
-
- PUTBACK;
-
- return attrs;
-}
XS(mop_xs_constructor);
XS(mop_xs_constructor)
projects / gitmo/Class-MOP.git / commitdiff