Commit | Line | Data |
1ea12c91 |
1 | #include "EXTERN.h" |
2 | #include "perl.h" |
3 | #include "XSUB.h" |
4 | |
1ea12c91 |
5 | /* FIXME |
6 | * needs to be made into Moose::XS::Meta::Instance and Meta::Slot for the |
7 | * metadata, with a proper destructor. XSANY still points to this struct, but |
8 | * it is shared by all functions of the same type. |
9 | * |
de2f2e97 |
10 | * Instance contains SvSTASH, and ATTR slots[] |
1ea12c91 |
11 | * |
de2f2e97 |
12 | * On recreation of the meta instance we refresh the ATTR value of all the CVs |
1ea12c91 |
13 | * we installed |
14 | * |
15 | * need a good way to handle time between invalidate and regeneration (just |
16 | * check XSANY and call get_meta_instance if null?) |
17 | */ |
18 | |
1ea12c91 |
19 | /* FIXME |
20 | * type constraints are already implemented by konobi |
21 | * should be trivial to do coercions for the core types, too |
22 | * |
23 | * TypeConstraint::Class can compare SvSTASH by ptr, and if it's neq *then* |
24 | * call ->isa (should handle vast majority of cases) |
25 | * |
26 | * base parametrized types are also trivial |
27 | * |
28 | * ClassName is get_stathpvn |
29 | */ |
30 | |
31 | /* FIXME |
de2f2e97 |
32 | * for a constructor we have ATTR *attrs, and iterate that, removing init_arg |
1ea12c91 |
33 | * we can preallocate the structure to the right size (maybe even with the |
34 | * right HEs?), and do various other prehashing hacks to gain speed |
35 | * */ |
36 | |
37 | /* FIXME |
38 | * delegations and attribute helpers: |
39 | * |
40 | * typedef struct { |
de2f2e97 |
41 | * ATTR *attr; |
1ea12c91 |
42 | * pv *method; |
43 | * } delegation; |
44 | * |
45 | * typedef struct { |
de2f2e97 |
46 | * ATTR *attr; |
1ea12c91 |
47 | * I32 *type; // hash, array, whatever + vtable for operation |
48 | * } attributehelper; |
49 | */ |
50 | |
de2f2e97 |
51 | |
52 | STATIC MGVTBL null_mg_vtbl = { |
53 | NULL, /* get */ |
54 | NULL, /* set */ |
55 | NULL, /* len */ |
56 | NULL, /* clear */ |
57 | NULL, /* free */ |
58 | #if MGf_COPY |
59 | NULL, /* copy */ |
60 | #endif /* MGf_COPY */ |
61 | #if MGf_DUP |
62 | NULL, /* dup */ |
63 | #endif /* MGf_DUP */ |
64 | #if MGf_LOCAL |
65 | NULL, /* local */ |
66 | #endif /* MGf_LOCAL */ |
67 | }; |
68 | |
f253044f |
69 | STATIC MAGIC *stash_in_mg (pTHX_ SV *sv, SV *obj) { |
70 | MAGIC *mg = sv_magicext(sv, obj, PERL_MAGIC_ext, &null_mg_vtbl, NULL, 0 ); |
71 | mg->mg_flags |= MGf_REFCOUNTED; |
72 | |
73 | return mg; |
74 | } |
75 | |
76 | STATIC SV *get_stashed_in_mg(pTHX_ SV *sv) { |
77 | MAGIC *mg, *moremagic; |
78 | |
79 | if (SvTYPE(sv) >= SVt_PVMG) { |
80 | for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { |
81 | if ((mg->mg_type == PERL_MAGIC_ext) && (mg->mg_virtual == &null_mg_vtbl)) |
82 | break; |
83 | } |
84 | if (mg) |
85 | return mg->mg_obj; |
86 | } |
87 | |
88 | return NULL; |
89 | } |
de2f2e97 |
90 | |
91 | |
92 | typedef enum { |
93 | Any = 0, |
94 | Item, |
95 | Bool, |
96 | Maybe, /* [`a] */ |
97 | Undef, |
98 | Defined, |
99 | Value, |
100 | Num, |
101 | Int, |
102 | Str, |
103 | ClassName, |
104 | Ref, |
105 | ScalarRef, |
106 | ArrayRef, /* [`a] */ |
107 | HashRef, /* [`a] */ |
108 | CodeRef, |
109 | RegexpRef, |
110 | GlobRef, |
111 | FileHandle, |
112 | Object, |
113 | Role, |
114 | |
115 | /* XS only types */ |
116 | Class, |
117 | |
118 | max_TC |
119 | } TC; |
120 | |
121 | typedef union { |
122 | TC type; |
123 | CV *cv; |
124 | HV *stash; |
125 | OP *op; |
126 | } TC_CHECK; |
127 | |
128 | typedef enum { |
129 | tc_none = 0, |
130 | tc_type, |
131 | tc_cv, |
132 | tc_stash, |
133 | tc_op, |
134 | } tc_kind; |
135 | |
136 | typedef union { |
137 | char *builder; |
138 | SV *value; |
139 | CV *sub; |
140 | OP *op; |
141 | U32 type; |
142 | } DEFAULT; |
143 | |
144 | typedef enum { |
145 | default_none = 0, |
146 | default_type, |
147 | default_builder, |
148 | default_value, |
149 | default_sub, |
150 | default_op, |
151 | } default_kind; |
152 | |
1ea12c91 |
153 | typedef struct { |
de2f2e97 |
154 | /* the meta instance struct */ |
155 | struct mi *mi; |
156 | |
157 | U32 flags; /* slot type, TC behavior, coerce, weaken, (no default | default, builder + lazy), auto_deref */ |
158 | |
159 | /* slot access fields */ |
160 | SV *slot_sv; /* value of the slot (slot name presumably) */ |
161 | U32 slot_u32; /* for optimized access (precomputed hash or otherr) */ |
162 | |
163 | DEFAULT def; /* cv, value or other, depending on flags */ |
164 | |
165 | TC_CHECK tc_check; /* cv, value or other, dependidng on flags */ |
166 | SV *type_constraint; /* meta attr */ |
167 | |
168 | CV *initializer; |
169 | CV *trigger; |
170 | |
f253044f |
171 | SV *meta_attr; /* the meta attr object */ |
de2f2e97 |
172 | AV *cvs; /* CVs which use this attr */ |
173 | } ATTR; |
174 | |
175 | /* slot flags: |
176 | * instance reading writing |
177 | * 00000000 00000000 00000000 00000000 |
178 | * ^ trigger |
179 | * ^ weak |
180 | * ^^^ tc_kind |
181 | * ^ coerce |
182 | * ^^^ default_kind |
183 | * ^ lazy |
184 | * ^ required |
185 | * ^^^^^^^ if 0 then nothing special (just hash)? FIXME TBD |
186 | */ |
187 | |
188 | #define ATTR_INSTANCE_MASK 0xff000000 |
189 | #define ATTR_READING_MASK 0x0000ff00 |
190 | #define ATTR_WRITING_MASK 0x000000ff |
191 | |
192 | #define ATTR_MASK_TYPE 0x7 |
193 | |
194 | #define ATTR_MASK_DEFAULT 0x700 |
195 | #define ATTR_SHIFT_DEAFULT 8 |
196 | |
197 | #define ATTR_LAZY 0x800 |
198 | |
199 | #define ATTR_COERCE 0x08 |
200 | #define ATTR_WEAK 0x10 |
201 | #define ATTR_TRIGGER 0x10 |
202 | |
203 | #define ATTR_ISWEAK(attr) ( attr->flags & ATTR_WEAK ) |
204 | #define ATTR_ISLAZY(attr) ( attr->flags & ATTR_LAZY ) |
205 | #define ATTR_ISCOERCE(attr) ( attr->flags & ATTR_COERCE ) |
1ea12c91 |
206 | |
de2f2e97 |
207 | #define ATTR_TYPE(f) ( attr->flags & 0x7 ) |
208 | #define ATTR_DEFAULT(f) ( ( attr->flags & ATTR_MASK_DEFAULT ) >> ATTR_SHIFT_DEFAULT ) |
1ea12c91 |
209 | |
de2f2e97 |
210 | #define ATTR_DUMB_READER(attr) !ATTR_IS_LAZY(attr) |
211 | #define ATTR_DUMB_WRITER(attr) ( ( attr->flags & ATTR_WRITING_MASK ) == 0 ) |
212 | #define ATTR_DUMB_INSTANCE(attr) ( ( attr->flags & ATTR_INSTANCE_MASK ) == 0 ) |
1ea12c91 |
213 | |
f253044f |
214 | #define dATTR ATTR *attr = (XSANY.any_i32 ? INT2PTR(ATTR *, (XSANY.any_i32)) : define_attr(aTHX_ cv)) |
de2f2e97 |
215 | |
216 | |
217 | /* FIXME define a vtable that does call_sv */ |
218 | typedef struct { |
219 | SV * (*get)(pTHX_ SV *self, ATTR *attr); |
220 | void (*set)(pTHX_ SV *self, ATTR *attr, SV *value); |
221 | bool * (*has)(pTHX_ SV *self, ATTR *attr); |
222 | SV * (*delete)(pTHX_ SV *self, ATTR *attr); |
223 | } instance_vtbl; |
224 | |
225 | |
226 | typedef enum { |
227 | hash = 0, |
228 | |
229 | /* these are not yet implemented */ |
230 | array, |
231 | fptr, |
232 | cv, |
233 | judy, |
234 | } instance_types; |
235 | |
236 | typedef struct mi { |
de2f2e97 |
237 | HV *stash; |
238 | |
239 | /* slot access method */ |
240 | instance_types type; |
241 | instance_vtbl *vtbl; |
242 | |
243 | /* attr descriptors */ |
244 | I32 num_attrs; |
245 | ATTR *attrs; |
246 | } MI; |
247 | |
248 | |
249 | STATIC void init_attr (MI *mi, ATTR *attr, HV *desc) { |
1ea12c91 |
250 | U32 hash; |
251 | STRLEN len; |
de2f2e97 |
252 | SV **key = hv_fetchs(desc, "key", 0); |
253 | SV **meta_attr = hv_fetchs(desc, "meta", 0); |
254 | char *pv; |
255 | |
256 | if ( !meta_attr ) croak("'meta' is required"); |
257 | |
f253044f |
258 | attr->meta_attr = *meta_attr; |
de2f2e97 |
259 | |
260 | attr->mi = mi; |
261 | |
262 | attr->flags = 0; |
263 | |
264 | |
265 | /* if type == hash */ |
266 | /* prehash the key */ |
267 | if ( !key ) croak("'key' is required"); |
268 | |
269 | pv = SvPV(*key, len); |
1ea12c91 |
270 | |
271 | PERL_HASH(hash, pv, len); |
1ea12c91 |
272 | |
de2f2e97 |
273 | attr->slot_sv = newSVpvn_share(pv, len, hash); |
274 | attr->slot_u32 = hash; |
275 | |
276 | attr->def.type = 0; |
277 | |
278 | attr->tc_check.type = 0; |
279 | attr->type_constraint = NULL; |
280 | |
281 | |
282 | attr->initializer = NULL; |
283 | attr->trigger = NULL; |
284 | |
285 | /* cross refs to CVs which use this struct */ |
286 | attr->cvs = newAV(); |
287 | } |
288 | |
f253044f |
289 | STATIC MI *new_mi (pTHX_ HV *stash, AV *attrs) { |
de2f2e97 |
290 | MI *mi; |
291 | I32 ix; |
292 | const I32 num = av_len(attrs) + 1; |
293 | |
294 | Newx(mi, 1, MI); |
295 | |
296 | SvREFCNT_inc_simple(stash); |
297 | mi->stash = stash; |
298 | |
de2f2e97 |
299 | mi->type = 0; /* nothing else implemented yet */ |
300 | |
301 | /* initialize attributes */ |
302 | mi->num_attrs = num; |
303 | Newx(mi->attrs, num, ATTR); |
f253044f |
304 | for ( ix = 0; ix < num; ix++ ) { |
de2f2e97 |
305 | SV **desc = av_fetch(attrs, ix, 0); |
306 | |
f253044f |
307 | if ( !desc || !*desc || !SvROK(*desc) || !(SvTYPE(SvRV(*desc)) == SVt_PVHV) ) { |
de2f2e97 |
308 | croak("Attribute descriptor has to be a hash reference"); |
f253044f |
309 | } |
de2f2e97 |
310 | |
311 | init_attr(mi, &mi->attrs[ix], (HV *)SvRV(*desc)); |
312 | } |
313 | |
314 | return mi; |
315 | } |
316 | |
f253044f |
317 | STATIC SV *new_mi_obj (pTHX_ MI *mi) { |
318 | return newRV_noinc(newSViv(PTR2IV(mi))); |
319 | } |
de2f2e97 |
320 | |
f253044f |
321 | STATIC SV *attr_to_meta_instance(pTHX_ SV *meta_attr) { |
322 | dSP; |
323 | I32 count; |
324 | SV *mi; |
325 | |
326 | if ( !meta_attr ) |
327 | croak("No attr found in magic!"); |
328 | |
329 | ENTER; |
330 | SAVETMPS; |
331 | PUSHMARK(SP); |
332 | XPUSHs(meta_attr); |
333 | PUTBACK; |
334 | count = call_pv("Moose::XS::attr_to_meta_instance", G_SCALAR); |
335 | |
336 | if ( count != 1 ) |
337 | croak("attr_to_meta_instance borked (%d args returned, expecting 1)", count); |
338 | |
339 | SPAGAIN; |
340 | mi = POPs; |
341 | |
342 | SvREFCNT_inc(mi); |
343 | |
344 | PUTBACK; |
345 | FREETMPS; |
346 | LEAVE; |
347 | |
348 | return mi; |
349 | } |
350 | |
351 | STATIC SV *perl_mi_to_c_mi(pTHX_ SV *perl_mi) { |
352 | dSP; |
353 | I32 count; |
354 | MI *mi = NULL; |
355 | SV *class; |
356 | SV *attrs; |
357 | HV *stash; |
358 | |
359 | ENTER; |
360 | SAVETMPS; |
361 | PUSHMARK(SP); |
362 | XPUSHs(perl_mi); |
363 | PUTBACK; |
364 | count = call_pv("Moose::XS::meta_instance_to_attr_descs", G_ARRAY); |
365 | |
366 | if ( count != 2 ) |
367 | croak("meta_instance_to_attr_descs borked (%d args returned, expecting 2)", count); |
368 | |
369 | SPAGAIN; |
370 | attrs = POPs; |
371 | class = POPs; |
372 | |
373 | PUTBACK; |
374 | |
375 | stash = gv_stashsv(class, 0); |
376 | |
377 | mi = new_mi(aTHX_ stash, (AV *)SvRV(attrs)); |
378 | |
379 | FREETMPS; |
380 | LEAVE; |
381 | |
382 | return new_mi_obj(aTHX_ mi); |
383 | } |
384 | |
385 | STATIC ATTR *mi_find_attr(MI *mi, SV *meta_attr) { |
386 | I32 ix; |
387 | |
388 | for ( ix = 0; ix <= mi->num_attrs; ix++ ) { |
389 | if ( SvRV(mi->attrs[ix].meta_attr) == SvRV(meta_attr) ) { |
390 | return &mi->attrs[ix]; |
de2f2e97 |
391 | } |
de2f2e97 |
392 | } |
393 | |
f253044f |
394 | sv_dump(meta_attr); |
395 | croak("Attr not found"); |
de2f2e97 |
396 | return NULL; |
397 | } |
398 | |
399 | STATIC ATTR *get_attr(pTHX_ CV *cv) { |
f253044f |
400 | SV *meta_attr = get_stashed_in_mg(aTHX_ (SV *)cv); |
401 | SV *perl_mi = attr_to_meta_instance(aTHX_ meta_attr); |
402 | SV *c_mi = get_stashed_in_mg(aTHX_ SvRV(perl_mi)); |
403 | MI *mi; |
de2f2e97 |
404 | |
f253044f |
405 | if (!c_mi) { |
406 | c_mi = perl_mi_to_c_mi(aTHX_ perl_mi); |
407 | stash_in_mg(aTHX_ perl_mi, c_mi); |
408 | } |
409 | |
410 | sv_2mortal(perl_mi); |
411 | |
412 | mi = INT2PTR(MI *, SvIV(SvRV(c_mi))); |
413 | |
414 | return mi_find_attr(mi, meta_attr); |
1ea12c91 |
415 | } |
416 | |
de2f2e97 |
417 | STATIC ATTR *define_attr (pTHX_ CV *cv) { |
418 | ATTR *attr = get_attr(aTHX_ cv); |
419 | assert(attr); |
420 | |
421 | XSANY.any_i32 = PTR2IV(attr); |
f253044f |
422 | |
423 | av_push( attr->cvs, (SV *)cv ); |
de2f2e97 |
424 | |
425 | return attr; |
426 | } |
427 | |
428 | STATIC void weaken(pTHX_ SV *sv) { |
1ea12c91 |
429 | #ifdef SvWEAKREF |
de2f2e97 |
430 | sv_rvweaken(sv); /* FIXME i think this might warn when weakening an already weak ref */ |
1ea12c91 |
431 | #else |
432 | croak("weak references are not implemented in this release of perl"); |
433 | #endif |
434 | } |
435 | |
436 | |
437 | /* meta instance protocol */ |
438 | |
de2f2e97 |
439 | STATIC SV *get_slot_value(pTHX_ SV *self, ATTR *attr) { |
1ea12c91 |
440 | HE *he; |
441 | |
442 | assert(self); |
443 | assert(SvROK(self)); |
444 | assert(SvTYPE(SvRV(self)) == SVt_PVHV); |
445 | |
de2f2e97 |
446 | assert( ATTR_DUMB_INSTANCE(attr) ); |
447 | |
448 | if ((he = hv_fetch_ent((HV *)SvRV(self), attr->slot_sv, 0, attr->slot_u32))) |
1ea12c91 |
449 | return HeVAL(he); |
450 | else |
451 | return NULL; |
452 | } |
453 | |
de2f2e97 |
454 | STATIC void set_slot_value(pTHX_ SV *self, ATTR *attr, SV *value) { |
1ea12c91 |
455 | HE *he; |
456 | |
457 | assert(self); |
458 | assert(SvROK(self)); |
459 | assert(SvTYPE(SvRV(self)) == SVt_PVHV); |
460 | |
de2f2e97 |
461 | assert( ATTR_DUMB_INSTANCE(attr) ); |
462 | |
1ea12c91 |
463 | SvREFCNT_inc(value); |
464 | |
de2f2e97 |
465 | he = hv_store_ent((HV*)SvRV(self), attr->slot_sv, value, attr->slot_u32); |
1ea12c91 |
466 | if (he != NULL) { |
de2f2e97 |
467 | if ( ATTR_ISWEAK(attr) ) |
468 | weaken(aTHX_ HeVAL(he)); /* actually only needed once at HE creation time */ |
1ea12c91 |
469 | } else { |
470 | croak("Hash store failed."); |
471 | } |
472 | } |
473 | |
de2f2e97 |
474 | STATIC bool has_slot_value(pTHX_ SV *self, ATTR *attr) { |
1ea12c91 |
475 | assert(self); |
476 | assert(SvROK(self)); |
477 | assert(SvTYPE(SvRV(self)) == SVt_PVHV); |
478 | |
de2f2e97 |
479 | assert( ATTR_DUMB_INSTANCE(attr) ); |
480 | |
481 | return hv_exists_ent((HV *)SvRV(self), attr->slot_sv, attr->slot_u32); |
482 | } |
483 | |
484 | STATIC SV *deinitialize_slot(pTHX_ SV *self, ATTR *attr) { |
485 | assert(self); |
486 | assert(SvROK(self)); |
487 | assert(SvTYPE(SvRV(self)) == SVt_PVHV); |
488 | |
489 | assert( ATTR_DUMB_INSTANCE(attr) ); |
490 | |
491 | return hv_delete_ent((HV *)SvRV(self), attr->slot_sv, 0, attr->slot_u32); |
1ea12c91 |
492 | } |
493 | |
494 | |
495 | /* simple high level api */ |
496 | |
de2f2e97 |
497 | STATIC XS(getter); |
498 | STATIC XS(getter) |
1ea12c91 |
499 | { |
500 | #ifdef dVAR |
501 | dVAR; |
502 | #endif |
503 | dXSARGS; |
de2f2e97 |
504 | dATTR; |
1ea12c91 |
505 | SV *value; |
506 | |
507 | if (items != 1) |
508 | Perl_croak(aTHX_ "Usage: %s(%s)", GvNAME(CvGV(cv)), "self"); |
509 | |
510 | SP -= items; |
511 | |
de2f2e97 |
512 | assert( ATTR_DUMB_READER(attr) ); |
513 | |
514 | value = get_slot_value(aTHX_ ST(0), attr); |
1ea12c91 |
515 | |
516 | if (value) { |
517 | ST(0) = sv_mortalcopy(value); /* mortalcopy because $_ .= "blah" for $foo->bar */ |
518 | XSRETURN(1); |
519 | } else { |
520 | XSRETURN_UNDEF; |
521 | } |
522 | } |
523 | |
de2f2e97 |
524 | STATIC XS(setter); |
525 | STATIC XS(setter) |
1ea12c91 |
526 | { |
527 | #ifdef dVAR |
528 | dVAR; |
529 | #endif |
530 | dXSARGS; |
de2f2e97 |
531 | dATTR; |
1ea12c91 |
532 | |
533 | if (items != 2) |
534 | Perl_croak(aTHX_ "Usage: %s(%s, %s)", GvNAME(CvGV(cv)), "self", "value"); |
535 | |
536 | SP -= items; |
537 | |
de2f2e97 |
538 | assert( ATTR_DUMB_WRITER(attr) ); |
539 | |
540 | set_slot_value(aTHX_ ST(0), attr, ST(1)); |
1ea12c91 |
541 | |
542 | ST(0) = ST(1); /* return value */ |
543 | XSRETURN(1); |
544 | } |
545 | |
de2f2e97 |
546 | STATIC XS(accessor); |
547 | STATIC XS(accessor) |
1ea12c91 |
548 | { |
549 | #ifdef dVAR |
550 | dVAR; |
551 | #endif |
552 | dXSARGS; |
de2f2e97 |
553 | dATTR; |
1ea12c91 |
554 | |
555 | if (items < 1) |
556 | Perl_croak(aTHX_ "Usage: %s(%s, [ %s ])", GvNAME(CvGV(cv)), "self", "value"); |
557 | |
558 | SP -= items; |
559 | |
560 | if (items > 1) { |
de2f2e97 |
561 | assert( ATTR_DUMB_READER(attr) ); |
562 | set_slot_value(aTHX_ ST(0), attr, ST(1)); |
1ea12c91 |
563 | ST(0) = ST(1); /* return value */ |
564 | } else { |
de2f2e97 |
565 | assert( ATTR_DUMB_WRITER(attr) ); |
566 | SV *value = get_slot_value(aTHX_ ST(0), attr); |
1ea12c91 |
567 | if ( value ) { |
568 | ST(0) = value; |
569 | } else { |
570 | XSRETURN_UNDEF; |
571 | } |
572 | } |
573 | |
574 | XSRETURN(1); |
575 | } |
576 | |
577 | STATIC XS(predicate); |
578 | STATIC XS(predicate) |
579 | { |
580 | #ifdef dVAR |
581 | dVAR; |
582 | #endif |
583 | dXSARGS; |
de2f2e97 |
584 | dATTR; |
1ea12c91 |
585 | |
586 | if (items != 1) |
587 | Perl_croak(aTHX_ "Usage: %s(%s)", GvNAME(CvGV(cv)), "self"); |
588 | |
589 | SP -= items; |
590 | |
de2f2e97 |
591 | if ( has_slot_value(aTHX_ ST(0), attr) ) |
1ea12c91 |
592 | XSRETURN_YES; |
593 | else |
594 | XSRETURN_NO; |
595 | } |
596 | |
597 | enum xs_body { |
de2f2e97 |
598 | xs_body_getter = 0, |
599 | xs_body_setter, |
600 | xs_body_accessor, |
1ea12c91 |
601 | xs_body_predicate, |
602 | max_xs_body |
603 | }; |
604 | |
605 | STATIC XSPROTO ((*xs_bodies[])) = { |
de2f2e97 |
606 | getter, |
607 | setter, |
608 | accessor, |
1ea12c91 |
609 | predicate, |
610 | }; |
611 | |
612 | MODULE = Moose PACKAGE = Moose::XS |
613 | |
614 | CV * |
de2f2e97 |
615 | new_sub(attr, name) |
1ea12c91 |
616 | INPUT: |
de2f2e97 |
617 | SV *attr; |
618 | SV *name; |
1ea12c91 |
619 | ALIAS: |
de2f2e97 |
620 | new_getter = xs_body_getter |
621 | new_setter = xs_body_setter |
622 | new_accessor = xs_body_accessor |
623 | new_predicate = xs_body_predicate |
1ea12c91 |
624 | PREINIT: |
625 | CV * cv; |
626 | CODE: |
627 | if ( ix >= max_xs_body ) |
628 | croak("Unknown Moose::XS body type"); |
629 | |
de2f2e97 |
630 | if ( !sv_isobject(attr) ) |
631 | croak("'attr' must be a Moose::Meta::Attribute"); |
632 | |
633 | cv = newXS(SvOK(name) ? SvPV_nolen(name) : NULL, xs_bodies[ix], __FILE__); |
1ea12c91 |
634 | |
635 | if (cv == NULL) |
636 | croak("Oi vey!"); |
637 | |
de2f2e97 |
638 | /* associate CV with meta attr */ |
f253044f |
639 | stash_in_mg(aTHX_ (SV *)cv, attr); |
de2f2e97 |
640 | |
641 | /* this will be set on first call */ |
642 | XSANY.any_i32 = 0; |
1ea12c91 |
643 | |
644 | RETVAL = cv; |
645 | OUTPUT: |
646 | RETVAL |
647 | |
648 | |
f253044f |
649 | MODULE = Moose PACKAGE = Moose::XS::Meta::Instance |
650 | |
651 | void |
652 | DESTROY(self) |
653 | INPUT: |
654 | SV *self; |
655 | PREINIT: |
656 | MI *mi = INT2PTR(MI *, SvIV(SvRV(self))); |
657 | CODE: |
658 | /* foreach attr ( delete cvs XSANY ), free attrs free mi */ |