xs/MethodAccessor.xs

   1 #include "mop.h"
   2
   3
   4 static MGVTBL mop_accessor_vtbl; /* the MAGIC identity */
   5
   6 MAGIC*
   7 mop_accessor_get_mg(pTHX_ CV* const xsub){
   8     return mop_mg_find(aTHX_ (SV*)xsub, &mop_accessor_vtbl, MOPf_DIE_ON_FAIL);
   9 }
  10
  11 CV*
  12 mop_install_accessor(pTHX_ const char* const fq_name, const char* const key, I32 const keylen, XSPROTO(accessor_impl), const mop_instance_vtbl* vtbl){
  13     CV* const xsub  = newXS((char*)fq_name, accessor_impl, __FILE__);
  14     SV* const keysv = newSVpvn_share(key, keylen, 0U);
  15     AV* const meta  = newAV();
  16     MAGIC* mg;
  17
  18     if(!vtbl){
  19         vtbl = mop_get_default_instance_vtbl(aTHX);
  20     }
  21
  22     mg = sv_magicext((SV*)xsub, (SV*)meta, PERL_MAGIC_ext, &mop_accessor_vtbl, (char*)vtbl, 0);
  23     SvREFCNT_dec(meta); /* sv_magicext() increases refcnt in mg_obj */
  24
  25     av_store(meta, MOP_MI_SLOT, keysv);
  26
  27     /* NOTE:
  28      * although we use MAGIC for gc, we also store mg to any slot for efficiency (gfx)
  29      */
  30     CvXSUBANY(xsub).any_ptr = (void*)mg;
  31
  32     return xsub;
  33 }
  34
  35
  36 static CV*
  37 mop_instantiate_xs_accessor(pTHX_ SV* const accessor, XSPROTO(accessor_impl), mop_instance_vtbl* const vtbl){
  38     /* $key = $accessor->associated_attribute->name */
  39     SV* const attr = mop_call0(aTHX_ accessor, mop_associated_attribute);
  40     SV* const key  = mop_call0(aTHX_ attr, mop_name);
  41     STRLEN klen;
  42     const char* const kpv = SvPV_const(key, klen);
  43
  44     return mop_install_accessor(aTHX_ NULL /* anonymous */, kpv, klen, accessor_impl, vtbl);
  45 }
  46
  47 SV*
  48 mop_accessor_get_self(pTHX_ I32 const ax, I32 const items, CV* const cv) {
  49     SV* self;
  50
  51     if(items < 1){
  52         croak("too few arguments for %s", GvNAME(CvGV(cv)));
  53     }
  54
  55     self = ST(0);
  56     if(!(SvROK(self) && SvOBJECT(SvRV(self)))){
  57         croak("cant call %s as a class method", GvNAME(CvGV(cv)));
  58     }
  59     return self;
  60 }
  61
  62 #ifdef DEBUGGING
  63 SV**
  64 mop_debug_mi_access(pTHX_ AV* const mi, I32 const attr_ix){
  65     assert(mi);
  66     assert(SvTYPE(mi) == SVt_PVAV);
  67     assert(AvMAX(mi) >= attr_ix);
  68     return &AvARRAY(mi)[attr_ix];
  69 }
  70 #endif
  71
  72 XS(mop_xs_simple_accessor)
  73 {
  74     dVAR; dXSARGS;
  75     dMOP_METHOD_COMMON; /* self, mg */
  76     SV* value;
  77
  78     if(items == 1){ /* reader */
  79         value = MOP_mg_get_slot(mg, self);
  80     }
  81     else if (items == 2){ /* writer */
  82         value = MOP_mg_set_slot(mg, self, ST(1));
  83     }
  84     else{
  85         croak("expected exactly one or two argument");
  86     }
  87
  88     ST(0) = value ? value : &PL_sv_undef;
  89     XSRETURN(1);
  90 }
  91
  92
  93 XS(mop_xs_simple_reader)
  94 {
  95     dVAR; dXSARGS;
  96     dMOP_METHOD_COMMON; /* self, mg */
  97     SV* value;
  98
  99     if (items != 1) {
 100         croak("expected exactly one argument");
 101     }
 102
 103     value = MOP_mg_get_slot(mg, self);
 104     ST(0) = value ? value : &PL_sv_undef;
 105     XSRETURN(1);
 106 }
 107
 108 XS(mop_xs_simple_writer)
 109 {
 110     dVAR; dXSARGS;
 111     dMOP_METHOD_COMMON; /* self, mg */
 112
 113     if (items != 2) {
 114         croak("expected exactly two argument");
 115     }
 116
 117     ST(0) = MOP_mg_set_slot(mg, self, ST(1));
 118     XSRETURN(1);
 119 }
 120
 121 XS(mop_xs_simple_clearer)
 122 {
 123     dVAR; dXSARGS;
 124     dMOP_METHOD_COMMON; /* self, mg */
 125     SV* value;
 126
 127     if (items != 1) {
 128         croak("expected exactly one argument");
 129     }
 130
 131     value = MOP_mg_delete_slot(mg, self);
 132     ST(0) = value ? value : &PL_sv_undef;
 133     XSRETURN(1);
 134 }
 135
 136
 137 XS(mop_xs_simple_predicate)
 138 {
 139     dVAR; dXSARGS;
 140     dMOP_METHOD_COMMON; /* self, mg */
 141
 142     if (items != 1) {
 143         croak("expected exactly one argument");
 144     }
 145
 146     ST(0) = boolSV( MOP_mg_has_slot(mg, self) );
 147     XSRETURN(1);
 148 }
 149
 150
 151 XS(mop_xs_simple_predicate_for_metaclass)
 152 {
 153     dVAR; dXSARGS;
 154     dMOP_METHOD_COMMON; /* self, mg */
 155     SV* value;
 156
 157     if (items != 1) {
 158         croak("expected exactly one argument");
 159     }
 160
 161     value = MOP_mg_get_slot(mg, self);
 162     ST(0) = boolSV( value && SvOK(value ));
 163     XSRETURN(1);
 164 }
 165
 166 MODULE = Class::MOP::Method::Accessor   PACKAGE = Class::MOP::Method::Accessor
 167
 168 PROTOTYPES: DISABLE
 169
 170 BOOT:
 171     INSTALL_SIMPLE_READER_WITH_KEY(Method::Accessor, associated_attribute, attribute);
 172     INSTALL_SIMPLE_READER(Method::Accessor, accessor_type);
 173
 174
 175 CV*
 176 _generate_accessor_method_xs(SV* self, void* instance_vtbl)
 177 CODE:
 178     RETVAL = mop_instantiate_xs_accessor(aTHX_ self, mop_xs_simple_accessor, instance_vtbl);
 179 OUTPUT:
 180     RETVAL
 181
 182 CV*
 183 _generate_reader_method_xs(SV* self, void* instance_vtbl)
 184 CODE:
 185     RETVAL = mop_instantiate_xs_accessor(aTHX_ self, mop_xs_simple_reader, instance_vtbl);
 186 OUTPUT:
 187     RETVAL
 188
 189 CV*
 190 _generate_writer_method_xs(SV* self, void* instance_vtbl)
 191 CODE:
 192     RETVAL = mop_instantiate_xs_accessor(aTHX_ self, mop_xs_simple_writer, instance_vtbl);
 193 OUTPUT:
 194     RETVAL
 195
 196 CV*
 197 _generate_predicate_method_xs(SV* self, void* instance_vtbl)
 198 CODE:
 199     RETVAL = mop_instantiate_xs_accessor(aTHX_ self, mop_xs_simple_predicate, instance_vtbl);
 200 OUTPUT:
 201     RETVAL
 202
 203 CV*
 204 _generate_clearer_method_xs(SV* self, void* instance_vtbl)
 205 CODE:
 206     RETVAL = mop_instantiate_xs_accessor(aTHX_ self, mop_xs_simple_clearer, instance_vtbl);
 207 OUTPUT:
 208     RETVAL
 209