2 Copyright (C) 2001-2003, The Perl Foundation.
7 objects.c - Class and object
11 Handles class and object manipulation.
21 #define PARROT_IN_OBJECTS_C
22 #include "parrot/parrot.h"
25 #include "objects.str"
27 static void parrot_class_register(Interp
* , PMC
*name
,
28 PMC
*new_class
, PMC
*parent
, PMC
*mro
);
32 =item C<int Parrot_get_vtable_index(Interp *, const char *name)>
34 Return index if C<name> is a valid vtable slot name.
41 Parrot_get_vtable_index(Interp
*interp
, const char *name
)
45 for (i
= 0; (meth
= Parrot_vtable_slot_names
[i
]); ++i
) {
48 /* XXX slot_names still have __ in front */
49 if (strcmp(name
, meth
+ 2) == 0)
56 Parrot_find_vtable_meth(Interp
* interp
, PMC
*pmc
, STRING
*meth
) {
63 /* Get index in Parrot_vtable_slot_names[]. */
64 int vtable_index
= Parrot_get_vtable_index(interp
,
65 string_to_cstring(interp
, meth
));
66 if (vtable_index
== -1)
70 if (PObj_is_object_TEST(pmc
)) {
71 class = GET_CLASS((Buffer
*)PMC_data(pmc
), pmc
);
74 /* Get MRO and iterate over it to find method with a matching
76 mro
= class->vtable
->mro
;
77 n
= VTABLE_elements(interp
, mro
);
78 for (i
= 0; i
< n
; ++i
) {
79 class = VTABLE_get_pmc_keyed_int(interp
, mro
, i
);
80 ns
= VTABLE_namespace(interp
, class);
81 if (!PMC_IS_NULL(ns
)) {
82 k
= VTABLE_elements(interp
, ns
);
83 key
= VTABLE_nextkey_keyed(interp
, key_new(interp
), ns
,
85 for (j
= 0; j
< k
; ++j
) {
86 STRING
*ns_key
= parrot_hash_get_idx(interp
, PMC_struct_val(ns
), key
);
87 PMC
*res
= VTABLE_get_pmc_keyed_str(interp
, ns
, ns_key
);
88 if (res
->vtable
->base_type
== enum_class_Sub
&&
89 PMC_sub(res
)->vtable_index
== vtable_index
)
95 /* If we get here, not found in the current class. */
100 readable_name(Interp
*interp
, PMC
*name
)
102 if (name
->vtable
->base_type
== enum_class_String
)
103 return VTABLE_get_string(interp
, name
);
105 STRING
*j
= CONST_STRING(interp
, ";");
106 PMC
*ar
= pmc_new(interp
, enum_class_ResizableStringArray
);
107 assert(name
->vtable
->base_type
== enum_class_Key
);
109 VTABLE_push_string(interp
, ar
, key_string(interp
, name
));
110 name
= key_next(interp
, name
);
112 return string_join(interp
, j
, ar
);
117 fail_if_exist(Interp
*interp
, PMC
*name
)
122 PMC
* const classname_hash
= interp
->class_hash
;
123 PMC
* type_pmc
= VTABLE_get_pointer_keyed(interp
,
124 classname_hash
, name
);
125 if (PMC_IS_NULL(type_pmc
) ||
126 type_pmc
->vtable
->base_type
== enum_class_NameSpace
)
129 type
= VTABLE_get_integer(interp
, type_pmc
);
130 /* TODO get printable name */
131 class_name
= VTABLE_get_string(interp
, name
);
132 if (type
> enum_type_undef
) {
133 real_exception(interp
, NULL
, INVALID_OPERATION
,
134 "Class %Ss already registered!\n", class_name
);
136 if (type
< enum_type_undef
) {
137 real_exception(interp
, NULL
, INVALID_OPERATION
,
138 "native type with name '%s' already exists - "
139 "can't register Class", data_types
[type
].name
);
144 * FIXME make array clone shallow
147 clone_array(Interp
*interp
, PMC
*source_array
)
149 PMC
* const new_array
= pmc_new(interp
,
150 source_array
->vtable
->base_type
);
151 const INTVAL count
= VTABLE_elements(interp
, source_array
);
155 * preserve type, we have OrderedHash and Array
156 * XXX this doesn't preserve the keys of the ordered hash
157 * (but the keys aren't used -leo)
159 VTABLE_set_integer_native(interp
, new_array
, count
);
160 for (i
= 0; i
< count
; i
++) {
161 VTABLE_set_pmc_keyed_int(interp
, new_array
, i
,
162 VTABLE_get_pmc_keyed_int(interp
, source_array
, i
));
167 /* Take the class and completely rebuild the attribute stuff for
168 it. Horribly destructive, and definitely not a good thing to do if
169 there are instantiated objects for the class */
171 rebuild_attrib_stuff(Interp
*interp
, PMC
*class)
174 SLOTTYPE
*class_slots
;
175 PMC
*attr_offset_hash
;
183 PMC
* const orig_class
= class;
186 /* attrib count isn't set yet, a GC causedd by concat could
187 * corrupt data under construction
189 Parrot_block_DOD(interp
);
191 class_slots
= PMC_data(class);
192 attr_offset_hash
= pmc_new(interp
, enum_class_Hash
);
193 set_attrib_num(class, class_slots
, PCD_ATTRIBUTES
, attr_offset_hash
);
195 mro
= class->vtable
->mro
;
196 n_mro
= VTABLE_elements(interp
, mro
);
199 * walk from oldest parent downto n_class == 0 which is this class
202 for (n_class
= n_mro
- 1; n_class
>= 0; --n_class
) {
203 class = VTABLE_get_pmc_keyed_int(interp
, mro
, n_class
);
204 if (!PObj_is_class_TEST(class)) {
205 /* this Class isa PMC - no attributes there
210 class_slots
= PMC_data(class);
211 classname
= VTABLE_get_string(interp
,
212 get_attrib_num(class_slots
, PCD_CLASS_NAME
));
213 attribs
= get_attrib_num(class_slots
, PCD_CLASS_ATTRIBUTES
);
214 attr_count
= VTABLE_elements(interp
, attribs
);
218 STRING
* const partial_name
=
219 string_concat(interp
, classname
,
220 string_from_cstring(interp
, "\0", 1),
222 for (offset
= 0; offset
< attr_count
; offset
++) {
223 STRING
* const attr_name
=
224 VTABLE_get_string_keyed_int(interp
, attribs
, offset
);
225 STRING
* const full_name
=
226 string_concat(interp
, partial_name
, attr_name
, 0);
228 * store this attribute with short and full name
230 VTABLE_set_integer_keyed_str(interp
, attr_offset_hash
,
231 attr_name
, cur_offset
);
232 VTABLE_set_integer_keyed_str(interp
, attr_offset_hash
,
233 full_name
, cur_offset
);
240 assert(class == orig_class
);
243 /* And note the totals */
244 CLASS_ATTRIB_COUNT(class) = cur_offset
;
245 Parrot_unblock_DOD(interp
);
250 =item C<static PMC *find_vtable_override_byname(Interp *interp,
252 STRING *method_name)>
254 Tries to locate a PIR override method for the given v-table method in the
255 given class. If one is found, returns the method.
262 find_vtable_override_byname(Interp
*interp
, PMC
*class,
263 PMC
*class_name
, STRING
*method_name
)
265 /* First try it in the :vtable namespace. */
266 STRING
*no_underscores
= string_substr(interp
, method_name
,
267 2, method_name
->strlen
- 2, NULL
, 0);
268 PMC
*res
= Parrot_find_vtable_meth(interp
, class, no_underscores
);
269 if (!PMC_IS_NULL(res
))
272 /* Otherwise, do lookup in the old way. */
273 return Parrot_find_global_k(interp
, class_name
, method_name
);
278 =item C<static void create_deleg_pmc_vtable(Interp *, PMC *class,
279 PMC *class_name, int full)>
281 Create a vtable that dispatches either to the contained PMC in the first
282 attribute (deleg_pmc) or to an overridden method (delegate), depending
283 on the existence of the method for this class.
290 create_deleg_pmc_vtable(Interp
*interp
, PMC
*class,
291 PMC
*class_name
, int full
)
298 PMC
* const vtable_pmc
= get_attrib_num((SLOTTYPE
*)PMC_data(class),
300 VTABLE
* const vtable
= PMC_struct_val(vtable_pmc
);
301 VTABLE
* const ro_vtable
= vtable
->ro_variant_vtable
;
302 VTABLE
* const deleg_pmc_vtable
=
303 interp
->vtables
[enum_class_deleg_pmc
];
304 VTABLE
* const object_vtable
=
305 interp
->vtables
[enum_class_ParrotObject
];
306 VTABLE
* const ro_object_vtable
= object_vtable
->ro_variant_vtable
;
307 VTABLE
* const delegate_vtable
= interp
->vtables
[enum_class_delegate
];
309 memset(&meth_str
, 0, sizeof (meth_str
));
310 meth_str
.encoding
= Parrot_fixed_8_encoding_ptr
;
311 meth_str
.charset
= Parrot_default_charset_ptr
;
312 for (i
= 0; (meth
= Parrot_vtable_slot_names
[i
]); ++i
) {
315 meth_str
.strstart
= const_cast(meth
);
316 meth_str
.strlen
= meth_str
.bufused
= strlen(meth
);
317 meth_str
.hashval
= 0;
318 if (find_vtable_override_byname(interp
, class, class_name
, &meth_str
)) {
320 * the method exists; keep the ParrotObject aka delegate vtable slot
322 ((void **)vtable
)[i
] = ((void**)object_vtable
)[i
];
324 ((void **)ro_vtable
)[i
] = ((void**)ro_object_vtable
)[i
];
327 PIO_eprintf(interp
, "deleg_pmc class '%Ss' found '%s'\n",
333 * the method doesn't exist; put in the deleg_pmc vtable,
334 * but only if ParrotObject hasn't overridden the method
336 if (((void **)delegate_vtable
)[i
] == ((void**)object_vtable
)[i
]) {
338 ((void **)ro_vtable
)[i
] = ((void**)deleg_pmc_vtable
)[i
];
339 ((void **)vtable
)[i
] = ((void**)deleg_pmc_vtable
)[i
];
342 ((void **)vtable
)[i
] = ((void**)object_vtable
)[i
];
344 ((void **)ro_vtable
)[i
] = ((void**)ro_object_vtable
)[i
];
353 =item C<const char* Parrot_MMD_method_name(Interp*, INTVAL)>
355 Return the method name for the given MMD enum.
357 =item C<INTVAL Parrot_MMD_method_idx(Interp*, STRING *)>
359 Return the MMD function number for method name or -1 on failure.
361 TODO allow dynamic expansion at runtime.
367 Parrot_MMD_method_name(Interp
*interp
, INTVAL idx
)
371 if (idx
>= MMD_USER_FIRST
)
373 return Parrot_mmd_func_names
[idx
];
377 Parrot_MMD_method_idx(Interp
*interp
, char *name
)
381 for (i
= 0; i
< MMD_USER_FIRST
; ++i
) {
382 if (!strcmp(Parrot_mmd_func_names
[i
], name
))
392 Parrot_single_subclass(Interp *interp, PMC *base_class,
393 PMC *child_class_name)>
395 Subclass a class. Single parent class, nice and straightforward. If
396 C<child_class> is C<NULL>, this is an anonymous subclass we're creating,
397 which happens commonly enough to warrant an actual single-subclass
405 Parrot_single_subclass(Interp
*interp
, PMC
*base_class
,
409 SLOTTYPE
*child_class_array
;
410 PMC
*parents
, *temp_pmc
, *mro
;
413 /* Set the classname, if we have one */
414 if (!PMC_IS_NULL(name
)) {
415 fail_if_exist(interp
, name
);
418 /* XXX not really threadsafe but good enough for now */
419 static int anon_count
;
421 STRING
*child_class_name
= Parrot_sprintf_c(interp
,
422 "%c%canon_%d", 0, 0, ++anon_count
);
423 name
= pmc_new(interp
, enum_class_String
);
424 VTABLE_set_string_native(interp
, name
, child_class_name
);
427 * ParrotClass is the baseclass anyway, so build just a new class
429 if (base_class
== interp
->vtables
[enum_class_ParrotClass
]->class) {
430 return pmc_new_init(interp
, enum_class_ParrotClass
, name
);
432 parent_is_class
= PObj_is_class_TEST(base_class
);
434 child_class
= pmc_new(interp
, enum_class_ParrotClass
);
435 /* Hang an array off the data pointer */
436 set_attrib_array_size(child_class
, PCD_MAX
);
437 child_class_array
= PMC_data(child_class
);
438 set_attrib_flags(child_class
);
439 /* We will have five entries in this array */
441 /* We have the same number of attributes as our parent */
442 CLASS_ATTRIB_COUNT(child_class
) = parent_is_class
443 ? CLASS_ATTRIB_COUNT(base_class
) : 0;
445 /* Our parent class array has a single member in it */
446 parents
= pmc_new(interp
, enum_class_ResizablePMCArray
);
447 VTABLE_set_integer_native(interp
, parents
, 1);
448 VTABLE_set_pmc_keyed_int(interp
, parents
, 0, base_class
);
449 set_attrib_num(child_class
, child_class_array
, PCD_PARENTS
, parents
);
452 set_attrib_num(child_class
, child_class_array
, PCD_CLASS_NAME
, name
);
454 /* Our mro list is a clone of our parent's mro
455 * list, with our self unshifted onto the beginning
457 mro
= VTABLE_clone(interp
, base_class
->vtable
->mro
);
458 VTABLE_unshift_pmc(interp
, mro
, child_class
);
460 /* But we have no attributes of our own. Yet */
461 temp_pmc
= pmc_new(interp
, enum_class_ResizablePMCArray
);
462 set_attrib_num(child_class
, child_class_array
, PCD_CLASS_ATTRIBUTES
,
465 parrot_class_register(interp
, name
, child_class
,
468 rebuild_attrib_stuff(interp
, child_class
);
470 if (!parent_is_class
) {
471 /* we append one attribute to hold the PMC */
472 Parrot_add_attribute(interp
, child_class
,
473 CONST_STRING(interp
, "__value"));
475 * then create a vtable derived from ParrotObject and
476 * deleg_pmc - the ParrotObject vtable is already built
478 create_deleg_pmc_vtable(interp
, child_class
, name
, 1);
482 * if any parent isa PMC, then still individual vtables might
483 * be overridden in this subclass
486 int i
, n
, any_pmc_parent
;
488 n
= VTABLE_elements(interp
, mro
);
491 /* 0 = this, 1 = parent (handled above), 2 = grandpa */
492 for (i
= 2; i
< n
; ++i
) {
493 parent
= VTABLE_get_pmc_keyed_int(interp
, mro
, i
);
494 if (!PObj_is_class_TEST(parent
)) {
500 create_deleg_pmc_vtable(interp
, child_class
, name
, 0);
508 Parrot_new_class(Interp *interp, PMC *class, PMC *class_name)>
510 Creates a new class, named C<class_name>.
517 Parrot_new_class(Interp
*interp
, PMC
*class, PMC
*name
)
519 SLOTTYPE
*class_array
;
522 /* check against duplicate newclasses */
523 fail_if_exist(interp
, name
);
525 /* Hang an array off the data pointer, empty of course */
526 set_attrib_array_size(class, PCD_MAX
);
527 class_array
= PMC_data(class);
528 /* set_attrib_flags(class); init does it */
530 /* Our parent class array has nothing in it */
531 set_attrib_num(class, class_array
, PCD_PARENTS
,
532 pmc_new(interp
, enum_class_ResizablePMCArray
));
533 /* TODO create all class structures in constant PMC pool
537 * create MRO (method resolution order) array
538 * first entry is this class itself
540 mro
= pmc_new(interp
, enum_class_ResizablePMCArray
);
541 VTABLE_push_pmc(interp
, mro
, class);
545 set_attrib_num(class, class_array
, PCD_CLASS_ATTRIBUTES
,
546 pmc_new(interp
, enum_class_ResizablePMCArray
));
548 /* Set the classname */
549 set_attrib_num(class, class_array
, PCD_CLASS_NAME
, name
);
551 parrot_class_register(interp
, name
, class, NULL
, mro
);
553 rebuild_attrib_stuff(interp
, class);
559 Parrot_class_lookup(Interp *interp, STRING *class_name)>
562 Parrot_class_lookup_p(Interp *interp, PMC *class_name)>
564 Looks for the class named C<class_name> and returns it if it exists.
565 Otherwise it returns C<PMCNULL>.
572 Parrot_class_lookup(Interp
*interp
, STRING
*class_name
)
574 const INTVAL type
= pmc_type(interp
, class_name
);
576 PMC
* const pmc
= interp
->vtables
[type
]->class;
584 Parrot_class_lookup_p(Interp
*interp
, PMC
*class_name
)
586 const INTVAL type
= pmc_type_p(interp
, class_name
);
588 PMC
* const pmc
= interp
->vtables
[type
]->class;
596 register_type(Interp
*interp
, PMC
*name
)
599 PMC
* classname_hash
, *item
;
601 /* so pt_shared_fixup() can safely do a type lookup */
602 LOCK_INTERPRETER(interp
);
603 classname_hash
= interp
->class_hash
;
605 type
= interp
->n_vtable_max
++;
606 /* Have we overflowed the table? */
607 if (type
>= interp
->n_vtable_alloced
) {
608 parrot_realloc_vtables(interp
);
610 /* set entry in name->type hash */
611 item
= pmc_new(interp
, enum_class_Integer
);
612 PMC_int_val(item
) = type
;
613 VTABLE_set_pmc_keyed(interp
, classname_hash
, name
, item
);
614 UNLOCK_INTERPRETER(interp
);
622 parrot_class_register(Interp *interp, PMC *class_name,
623 PMC *new_class, PMC *mro)>
625 This is the way to register a new Parrot class as an instantiable
626 type. Doing this involves putting it in the class hash, setting its
627 vtable so that the C<init> method initializes objects of the class rather than
628 the class itself, and adding it to the interpreter's base type table so
629 you can create a new C<foo> in PASM like this: C<new Px, foo>.
636 parrot_class_register(Interp
*interp
, PMC
*name
,
637 PMC
*new_class
, PMC
*parent
, PMC
*mro
)
639 VTABLE
*new_vtable
, *parent_vtable
;
644 new_type
= register_type(interp
, name
);
645 /* Build a new vtable for this class
646 * The child class PMC gets the vtable of its parent class or
647 * a ParrotClass vtable
649 parent_vtable
= new_class
->vtable
;
650 if (parent
&& PObj_is_class_TEST(parent
))
651 parent_vtable
= parent
->vtable
;
653 parent_vtable
= new_class
->vtable
;
654 new_vtable
= Parrot_clone_vtable(interp
, parent_vtable
);
656 /* Set the vtable's type to the newly allocated type */
657 new_vtable
->base_type
= new_type
;
658 /* And cache our class PMC in the vtable so we can find it later */
659 new_vtable
->class = new_class
;
660 new_vtable
->mro
= mro
;
662 if (parent_vtable
->ro_variant_vtable
)
663 new_vtable
->ro_variant_vtable
=
664 Parrot_clone_vtable(interp
, parent_vtable
->ro_variant_vtable
);
666 /* Reset the init method to our instantiation method */
667 new_vtable
->init
= Parrot_instantiate_object
;
668 new_vtable
->init_pmc
= Parrot_instantiate_object_init
;
669 new_class
->vtable
= new_vtable
;
671 /* Put our new vtable in the global table */
672 interp
->vtables
[new_type
] = new_vtable
;
674 /* check if we already have a NameSpace */
675 top
= CONTEXT(interp
->ctx
)->current_namespace
;
676 ns
= VTABLE_get_pmc_keyed(interp
, top
, name
);
677 /* XXX nested, use current as base ? */
678 if (PMC_IS_NULL(ns
)) {
679 /* XXX try HLL namespace too XXX */
680 top
= Parrot_get_ctx_HLL_namespace(interp
);
681 ns
= VTABLE_get_pmc_keyed(interp
, top
, name
);
683 if (PMC_IS_NULL(ns
)) {
684 ns
= pmc_new(interp
, enum_class_NameSpace
);
685 VTABLE_set_pmc_keyed(interp
, top
, name
, ns
);
687 /* attach namspace to vtable */
688 new_vtable
->_namespace
= ns
;
690 if (new_vtable
->ro_variant_vtable
) {
691 VTABLE
* const ro_vt
= new_vtable
->ro_variant_vtable
;
692 ro_vt
->base_type
= new_vtable
->base_type
;
693 ro_vt
->class = new_vtable
->class;
694 ro_vt
->mro
= new_vtable
->mro
;
695 ro_vt
->_namespace
= new_vtable
->_namespace
;
699 * prepare object vtable - again that of the parent or
700 * a ParrotObject vtable
702 if (parent
&& PObj_is_class_TEST(parent
)) {
704 get_attrib_num((SLOTTYPE
*)PMC_data(parent
), PCD_OBJECT_VTABLE
);
705 parent_vtable
= PMC_struct_val(vtable_pmc
);
708 parent_vtable
= interp
->vtables
[enum_class_ParrotObject
];
710 new_vtable
= Parrot_clone_vtable(interp
, parent_vtable
);
711 if (parent_vtable
->ro_variant_vtable
)
712 new_vtable
->ro_variant_vtable
=
713 Parrot_clone_vtable(interp
, parent_vtable
->ro_variant_vtable
);
714 new_vtable
->base_type
= new_type
;
715 new_vtable
->mro
= mro
;
716 new_vtable
->class = new_class
;
718 set_attrib_num(new_class
, (SLOTTYPE
*)PMC_data(new_class
), PCD_OBJECT_VTABLE
,
719 vtable_pmc
= constant_pmc_new(interp
, enum_class_VtableCache
));
720 PMC_struct_val(vtable_pmc
) = new_vtable
;
721 /* attach namspace to object vtable too */
722 new_vtable
->_namespace
= ns
;
724 if (new_vtable
->ro_variant_vtable
) {
725 VTABLE
* const ro_vt
= new_vtable
->ro_variant_vtable
;
726 ro_vt
->base_type
= new_vtable
->base_type
;
727 ro_vt
->class = new_vtable
->class;
728 ro_vt
->mro
= new_vtable
->mro
;
729 ro_vt
->_namespace
= new_vtable
->_namespace
;
734 get_init_meth(Interp
*interp
, PMC
*class,
735 STRING
*prop_str
, STRING
**meth_str
)
739 PMC
*props
, *ns
, *method
;
744 prop
= VTABLE_getprop(interp
, class, prop_str
);
745 if (!VTABLE_defined(interp
, prop
))
747 meth
= VTABLE_get_string(interp
, prop
);
749 if ( !(props
= PMC_metadata(class)))
751 b
= parrot_hash_get_bucket(interp
,
752 (Hash
*) PMC_struct_val(props
), prop_str
);
755 meth
= PMC_str_val((PMC
*) b
->value
);
759 ns
= VTABLE_namespace(interp
, class);
760 method
= VTABLE_get_pmc_keyed_str(interp
, ns
, meth
);
761 return PMC_IS_NULL(method
) ? NULL
: method
;
766 do_initcall(Interp
*interp
, PMC
* class, PMC
*object
, PMC
*init
)
768 PMC
* const classsearch_array
= class->vtable
->mro
;
772 * 1) if class has a CONSTRUCT property run it on the object
775 * XXX isn't CONSTRUCT for creating new objects?
778 PMC
*meth
= get_init_meth(interp
, class,
779 CONST_STRING(interp
, "CONSTRUCT"), &meth_str
);
784 Parrot_run_meth_fromc_args(interp
, meth
,
785 object
, meth_str
, "vP", init
);
787 Parrot_run_meth_fromc_args(interp
, meth
,
788 object
, meth_str
, "v");
791 * 2. if class has a BUILD property call it for all classes
792 * in reverse search order - this class last.
794 * Note: mro contains this class as first element
796 nparents
= VTABLE_elements(interp
, classsearch_array
);
797 for (i
= nparents
- 1; i
>= 0; --i
) {
798 parent_class
= VTABLE_get_pmc_keyed_int(interp
,
799 classsearch_array
, i
);
800 /* if it's a PMC, we put one PMC of that type into
801 * the attribute slot #0 and call init() on that PMC
803 if (!PObj_is_class_TEST(parent_class
)) {
804 PMC
*attr
, *next_parent
;
808 * but only if init isn't inherited
809 * or rather just on the last non-class parent
812 next_parent
= VTABLE_get_pmc_keyed_int(interp
,
813 classsearch_array
, i
- 1);
814 if (!PObj_is_class_TEST(next_parent
)) {
817 attr
= pmc_new_noinit(interp
,
818 parent_class
->vtable
->base_type
);
819 obj_data
= PMC_data(object
);
820 set_attrib_num(object
, obj_data
, 0, attr
);
821 VTABLE_init(interp
, attr
);
824 meth
= get_init_meth(interp
, parent_class
,
825 CONST_STRING(interp
, "BUILD"), &meth_str
);
826 /* no method found and no BUILD property set? */
827 if (!meth
&& meth_str
== NULL
) {
830 /* use __init or __init_pmc (depending on if an argument was passed)
831 * as fallback constructor method, if it exists */
833 meth_str
= CONST_STRING(interp
, "__init_pmc");
834 meth_str_v
= CONST_STRING(interp
, "init_pmc");
837 meth_str
= CONST_STRING(interp
, "__init");
838 meth_str_v
= CONST_STRING(interp
, "init");
840 ns
= VTABLE_namespace(interp
, parent_class
);
841 /* can't use find_method, it walks mro */
842 meth
= Parrot_find_vtable_meth(interp
, class,
844 if (PMC_IS_NULL(meth
))
845 meth
= VTABLE_get_pmc_keyed_str(interp
, ns
, meth_str
);
854 Parrot_run_meth_fromc_args(interp
, meth
,
855 object
, meth_str
, "vP", init
);
857 Parrot_run_meth_fromc_args(interp
, meth
,
858 object
, meth_str
, "v");
860 else if (meth_str
!= NULL
&&
861 string_length(interp
, meth_str
) != 0 && !default_meth
) {
862 real_exception(interp
, NULL
, METH_NOT_FOUND
,
863 "Class BUILD method ('%Ss') not found", meth_str
);
871 Parrot_instantiate_object(Interp *interp, PMC *object, PMC *init)>
873 Creates a Parrot object. Takes a passed-in class PMC that has sufficient
874 information to describe the layout of the object and, well, makes the
881 static void instantiate_object(Interp
*, PMC
*object
, PMC
*init
);
884 Parrot_instantiate_object_init(Interp
*interp
,
885 PMC
*object
, PMC
*init
)
887 instantiate_object(interp
, object
, init
);
891 Parrot_instantiate_object(Interp
*interp
, PMC
*object
)
893 instantiate_object(interp
, object
, NULL
);
897 instantiate_object(Interp
*interp
, PMC
*object
, PMC
*init
)
899 SLOTTYPE
*new_object_array
;
900 INTVAL attrib_count
, i
;
902 PMC
* const class = object
->vtable
->class;
904 * put in the real vtable
906 PMC
* const vtable_pmc
= get_attrib_num((SLOTTYPE
*)PMC_data(class),
908 object
->vtable
= PMC_struct_val(vtable_pmc
);
910 /* Grab the attribute count from the class */
911 attrib_count
= CLASS_ATTRIB_COUNT(class);
913 /* Build the array that hangs off the new object */
914 /* First presize it */
915 set_attrib_array_size(object
, attrib_count
);
916 new_object_array
= PMC_data(object
);
918 /* fill with PMCNULL, so that access doesn't segfault */
919 for (i
= 0; i
< attrib_count
; ++i
)
920 set_attrib_num(object
, new_object_array
, i
, PMCNULL
);
922 /* turn marking on */
923 set_attrib_flags(object
);
925 /* We are an object now */
926 PObj_is_object_SET(object
);
928 /* We really ought to call the class init routines here...
929 * this assumes that an object isa delegate
931 do_initcall(interp
, class, object
, init
);
937 Parrot_add_parent(Interp *interp, PMC *class,
940 Add the parent class to the current class' parent list. This also
941 involved adding all the parent's parents, as well as all attributes of
942 the parent classes that we're adding in.
944 The MRO (method resolution order) is the C3 algorithm used by Perl6
945 and Python (>= 2.3). See also:
946 L<http://pugs.blogs.com/pugs/2005/07/day_165_r5671_j.html>
953 /* create a list if non-empty lists */
955 not_empty(Interp
*interp
, PMC
*seqs
)
958 PMC
* const nseqs
= pmc_new(interp
, enum_class_ResizablePMCArray
);
960 for (i
= 0; i
< VTABLE_elements(interp
, seqs
); ++i
) {
961 PMC
* const list
= VTABLE_get_pmc_keyed_int(interp
, seqs
, i
);
962 if (VTABLE_elements(interp
, list
))
963 VTABLE_push_pmc(interp
, nseqs
, list
);
968 /* merge the list if lists */
970 class_mro_merge(Interp
*interp
, PMC
*seqs
)
972 PMC
*res
, *seq
, *cand
, *nseqs
, *s
;
974 cand
= NULL
; /* silence compiler uninit warning */
976 res
= pmc_new(interp
, enum_class_ResizablePMCArray
);
978 nseqs
= not_empty(interp
, seqs
);
979 if (!VTABLE_elements(interp
, nseqs
))
981 for (i
= 0; i
< VTABLE_elements(interp
, nseqs
); ++i
) {
982 seq
= VTABLE_get_pmc_keyed_int(interp
, nseqs
, i
);
983 cand
= VTABLE_get_pmc_keyed_int(interp
, seq
, 0);
984 /* check if candidate is valid */
985 for (j
= 0; j
< VTABLE_elements(interp
, nseqs
); ++j
) {
986 s
= VTABLE_get_pmc_keyed_int(interp
, nseqs
, j
);
987 for (k
= 1; k
< VTABLE_elements(interp
, s
); ++k
)
988 if (VTABLE_get_pmc_keyed_int(interp
, s
, k
) == cand
) {
997 real_exception(interp
, NULL
, E_TypeError
,
998 "inconsisten class hierarchy");
999 /* push candidate onto mro result */
1000 VTABLE_push_pmc(interp
, res
, cand
);
1001 /* remove candidate from head of lists */
1002 for (i
= 0; i
< VTABLE_elements(interp
, nseqs
); ++i
) {
1003 seq
= VTABLE_get_pmc_keyed_int(interp
, nseqs
, i
);
1004 if (VTABLE_get_pmc_keyed_int(interp
, seq
, 0) == cand
) {
1005 VTABLE_shift_pmc(interp
, seq
);
1014 create_class_mro(Interp
*interp
, PMC
*class)
1016 PMC
*lparents
, *bases
;
1020 * [ [class] [mro of bases] [bases] ]
1022 PMC
* const lall
= pmc_new(interp
, enum_class_ResizablePMCArray
);
1023 PMC
* const lc
= pmc_new(interp
, enum_class_ResizablePMCArray
);
1025 VTABLE_push_pmc(interp
, lc
, class);
1026 VTABLE_push_pmc(interp
, lall
, lc
);
1028 bases
= get_attrib_num(PMC_data(class), PCD_PARENTS
);
1029 for (i
= 0; i
< VTABLE_elements(interp
, bases
); ++i
) {
1030 PMC
* const base
= VTABLE_get_pmc_keyed_int(interp
, bases
, i
);
1031 PMC
* const lmap
= PObj_is_class_TEST(base
) ?
1032 create_class_mro(interp
, base
) : base
->vtable
->mro
;
1033 VTABLE_push_pmc(interp
, lall
, lmap
);
1035 lparents
= VTABLE_clone(interp
, bases
);
1036 VTABLE_push_pmc(interp
, lall
, lparents
);
1037 return class_mro_merge(interp
, lall
);
1041 Parrot_add_parent(Interp
*interp
, PMC
*class, PMC
*parent
)
1043 PMC
*current_parent_array
;
1045 if (!PObj_is_class_TEST(class))
1046 internal_exception(1, "Class isn't a ParrotClass");
1047 if (!PObj_is_class_TEST(parent
) && parent
== parent
->vtable
->class) {
1048 /* Permit inserting non-classes so at least thaw'ing classes
1049 * is easy. Adding these parents after classes have been
1050 * subclassed is dangerous, however.
1054 if (CLASS_ATTRIB_COUNT(class) != 0) {
1055 internal_exception(1, "Subclassing built-in type too late");
1057 Parrot_add_attribute(interp
, class,
1058 CONST_STRING(interp
, "__value"));
1059 class_name
= pmc_new(interp
, enum_class_String
);
1060 VTABLE_set_string_native(interp
, class_name
,
1061 VTABLE_name(interp
, class));
1062 create_deleg_pmc_vtable(interp
, class, class_name
, 1);
1063 } else if (!PObj_is_class_TEST(parent
)) {
1064 internal_exception(1, "Parent isn't a ParrotClass");
1068 current_parent_array
= get_attrib_num(PMC_data(class), PCD_PARENTS
);
1069 VTABLE_push_pmc(interp
, current_parent_array
, parent
);
1071 class->vtable
->mro
= create_class_mro(interp
, class);
1073 rebuild_attrib_stuff(interp
, class);
1080 Parrot_remove_parent(Interp *interp, PMC *removed_class,
1081 PMC *existing_class)>
1083 This currently does nothing but return C<NULL>.
1090 Parrot_remove_parent(Interp
*interp
, PMC
*removed_class
,
1091 PMC
*existing_class
) {
1098 Parrot_multi_subclass(Interp *interp, PMC *base_class_array,
1099 STRING *child_class_name)>
1101 This currently does nothing but return C<NULL>.
1108 Parrot_multi_subclass(Interp
*interp
, PMC
*base_class_array
,
1109 STRING
*child_class_name
) {
1116 Parrot_object_isa(Interp *interp, PMC *pmc, PMC *cl)>
1118 Return whether the object C<pmc> is an instance of class C<cl>.
1125 Parrot_object_isa(Interp
*interp
, PMC
*pmc
, PMC
*cl
)
1128 INTVAL i
, classcount
;
1130 /* if this is not a class */
1131 if (!PObj_is_class_TEST(pmc
)) {
1132 pmc
= VTABLE_get_class(interp
, pmc
);
1134 mro
= pmc
->vtable
->mro
;
1135 classcount
= VTABLE_elements(interp
, mro
);
1136 for (i
= 0; i
< classcount
; ++i
) {
1137 if (VTABLE_get_pmc_keyed_int(interp
, mro
, i
) == cl
)
1146 Parrot_new_method_cache(Interp *interp)>
1148 This should create and return a new method cache PMC.
1150 Currently it does nothing but return C<NULL>.
1157 Parrot_new_method_cache(Interp
*interp
) {
1164 Parrot_find_method_with_cache(Interp *interp, PMC *class,
1165 STRING *method_name)>
1167 Find a method PMC for a named method, given the class PMC, current
1168 interp, and name of the method.
1170 This routine should use the current scope's method cache, if there is
1171 one. If not, it creates a new method cache. Or, rather, it will when
1172 we've got that bit working. For now it unconditionally goes and looks up
1173 the name in the global stash.
1176 Parrot_find_method_direct(Interp *interp, PMC *class,
1177 STRING *method_name)>
1179 Find a method PMC for a named method, given the class PMC, current
1180 interpreter, and name of the method. Don't use a possible method cache.
1182 =item void Parrot_invalidate_method_cache(Interp *, STRING *class)
1184 Clear method cache for the given class. If class is NULL caches for
1185 all classes are invalidated.
1191 static PMC
* find_method_direct(Interp
*, PMC
*, STRING
*);
1194 mark_object_cache(Interp
*interp
)
1199 init_object_cache(Interp
*interp
)
1201 Caches
* const mc
= interp
->caches
=
1202 mem_sys_allocate_zeroed(sizeof (*mc
));
1206 #define TBL_SIZE_MASK 0x1ff /* x bits 2..10 */
1207 #define TBL_SIZE (1 + TBL_SIZE_MASK)
1210 invalidate_type_caches(Interp
*interp
, UINTVAL type
)
1212 Caches
* const mc
= interp
->caches
;
1217 /* is it a valid entry */
1218 if (type
>= mc
->mc_size
|| !mc
->idx
[type
])
1220 for (i
= 0; i
< TBL_SIZE
; ++i
) {
1221 Meth_cache_entry
*e
;
1222 for (e
= mc
->idx
[type
][i
]; e
; ) {
1223 Meth_cache_entry
* const next
= e
->next
;
1228 mem_sys_free(mc
->idx
[type
]);
1229 mc
->idx
[type
] = NULL
;
1233 invalidate_all_caches(Interp
*interp
)
1236 for (i
= 1; i
< (UINTVAL
)interp
->n_vtable_max
; ++i
)
1237 invalidate_type_caches(interp
, i
);
1241 Parrot_invalidate_method_cache(Interp
*interp
, STRING
*class, STRING
*meth
)
1245 /* during interp creation and NCI registration the class_hash
1247 if (!interp
->class_hash
)
1249 if (interp
->resume_flag
& RESUME_INITIAL
)
1252 invalidate_all_caches(interp
);
1255 type
= pmc_type(interp
, class);
1259 invalidate_all_caches(interp
);
1262 invalidate_type_caches(interp
, (UINTVAL
)type
);
1266 * quick'n'dirty method cache
1267 * TODO: use a hash if method_name is not constant
1268 * i.e. from obj.$Sreg(args)
1269 * If this hash is implemented mark it during DOD
1272 Parrot_find_method_direct(Interp
*interp
, PMC
*class,
1273 STRING
*method_name
)
1275 return find_method_direct(interp
, class, method_name
);
1279 Parrot_find_method_with_cache(Interp
*interp
, PMC
*class,
1280 STRING
*method_name
)
1287 Meth_cache_entry
*e
, *old
;
1289 assert(method_name
!= 0);
1291 #if DISABLE_METH_CACHE
1292 return find_method_direct(interp
, class, method_name
);
1295 is_const
= PObj_constant_TEST(method_name
);
1297 return find_method_direct(interp
, class, method_name
);
1299 mc
= interp
->caches
;
1300 type
= class->vtable
->base_type
;
1301 bits
= (((UINTVAL
) method_name
->strstart
) >> 2) & TBL_SIZE_MASK
;
1302 if (type
>= mc
->mc_size
) {
1304 mc
->idx
= mem_sys_realloc(mc
->idx
, sizeof (UINTVAL
*) * (type
+ 1));
1307 mc
->idx
= mem_sys_allocate(sizeof (UINTVAL
*) * (type
+ 1));
1309 for (i
= mc
->mc_size
; i
<= type
; ++i
)
1311 mc
->mc_size
= type
+ 1;
1313 if (!mc
->idx
[type
]) {
1314 mc
->idx
[type
] = mem_sys_allocate(sizeof (Meth_cache_entry
*) * TBL_SIZE
);
1315 for (i
= 0; i
< TBL_SIZE
; ++i
)
1316 mc
->idx
[type
][i
] = NULL
;
1318 e
= mc
->idx
[type
][bits
];
1320 while (e
&& e
->strstart
!= method_name
->strstart
) {
1325 PMC
* const found
= find_method_direct(interp
, class, method_name
);
1326 /* when here no or no correct entry was at [bits] */
1327 e
= mem_sys_allocate(sizeof (Meth_cache_entry
));
1331 mc
->idx
[type
][bits
] = e
;
1334 e
->strstart
= method_name
->strstart
;
1341 # define TRACE_FM(i, c, m, sub)
1344 debug_trace_find_meth(Interp
*interp
, PMC
*class, STRING
*name
, PMC
*sub
)
1350 if (!Interp_trace_TEST(interp
, PARROT_TRACE_FIND_METH_FLAG
))
1352 if (PObj_is_class_TEST(class)) {
1353 SLOTTYPE
* const class_array
= PMC_data(class);
1354 PMC
*const class_name_pmc
= get_attrib_num(class_array
, PCD_CLASS_NAME
);
1355 class_name
= PMC_str_val(class_name_pmc
);
1358 class_name
= class->vtable
->whoami
;
1360 if (sub
->vtable
->base_type
== enum_class_NCI
)
1367 tracer
= interp
->debugger
?
1368 interp
->debugger
: interp
;
1370 "# find_method class '%Ss' method '%Ss': %s\n",
1371 class_name
, name
, result
);
1374 # define TRACE_FM(i, c, m, sub) \
1375 debug_trace_find_meth(i, c, m, sub)
1379 find_method_direct_1(Interp
*interp
, PMC
*class,
1380 STRING
*method_name
)
1385 PMC
* const mro
= class->vtable
->mro
;
1386 const INTVAL n
= VTABLE_elements(interp
, mro
);
1387 for (i
= 0; i
< n
; ++i
) {
1388 class = VTABLE_get_pmc_keyed_int(interp
, mro
, i
);
1389 ns
= VTABLE_namespace(interp
, class);
1390 method
= VTABLE_get_pmc_keyed_str(interp
, ns
, method_name
);
1391 TRACE_FM(interp
, class, method_name
, method
);
1392 if (!PMC_IS_NULL(method
)) {
1396 TRACE_FM(interp
, class, method_name
, NULL
);
1401 find_method_direct(Interp
*interp
, PMC
*class,
1402 STRING
*method_name
)
1404 PMC
* const found
= find_method_direct_1(interp
, class, method_name
);
1408 s1
= CONST_STRING(interp
, "__get_string");
1409 s2
= CONST_STRING(interp
, "__get_repr");
1410 if (string_equal(interp
, method_name
, s1
) == 0)
1411 return find_method_direct_1(interp
, class, s2
);
1417 Parrot_note_method_offset(Interp *interp, UINTVAL offset, PMC *method)>
1419 Notes where in the hierarchy we just found a method. Used so that we
1420 can do a next and continue the search through the hierarchy for the
1421 next instance of this method.
1425 Parrot_note_method_offset(Interp
*interp
, UINTVAL offset
, PMC
*method
)
1432 Parrot_add_attribute(Interp *interp, PMC* class, STRING* attr)>
1434 Adds the attribute C<attr> to the class.
1440 /* Life is ever so much easier if a class keeps its attributes at the
1441 end of the attribute array, since we don't have to insert and
1442 reorder attributes. Inserting's no big deal, especially since we're
1443 going to break horribly if you insert into a class that's been
1444 subclassed, but it'll do for now */
1447 Parrot_add_attribute(Interp
*interp
, PMC
* class, STRING
* attr
)
1449 STRING
*full_attr_name
;
1452 SLOTTYPE
* const class_array
= (SLOTTYPE
*)PMC_data(class);
1453 STRING
* const class_name
= VTABLE_get_string(interp
,
1454 get_attrib_num(class_array
, PCD_CLASS_NAME
));
1455 PMC
* const attr_array
= get_attrib_num(class_array
, PCD_CLASS_ATTRIBUTES
);
1456 PMC
* const attr_hash
= get_attrib_num(class_array
, PCD_ATTRIBUTES
);
1457 INTVAL idx
= VTABLE_elements(interp
, attr_array
);
1459 VTABLE_set_integer_native(interp
, attr_array
, idx
+ 1);
1460 VTABLE_set_string_keyed_int(interp
, attr_array
, idx
, attr
);
1461 full_attr_name
= string_concat(interp
, class_name
,
1462 string_from_cstring(interp
, "\0", 1), 0);
1463 full_attr_name
= string_concat(interp
, full_attr_name
, attr
, 0);
1464 /* TODO escape NUL char */
1465 if (VTABLE_exists_keyed_str(interp
, attr_hash
, full_attr_name
))
1467 c_error
= string_to_cstring(interp
, full_attr_name
);
1468 internal_exception(1, "Attribute '%s' already exists", c_error
);
1469 string_cstring_free(c_error
);
1472 * TODO check if someone is trying to add attributes to a parent class
1473 * while there are already child class attrs
1475 idx
= CLASS_ATTRIB_COUNT(class)++;
1476 VTABLE_set_integer_keyed_str(interp
, attr_hash
,
1478 VTABLE_set_integer_keyed_str(interp
, attr_hash
,
1479 full_attr_name
, idx
);
1486 Parrot_get_attrib_by_num(Interp *interp, PMC *object, INTVAL attrib)>
1488 Returns attribute number C<attrib> from C<object>. Presumably the code
1489 is asking for the correct attribute number.
1492 Parrot_get_attrib_by_str(Interp *interp, PMC *object, STRING *attr)>
1494 Returns attribute with full qualified name C<attr> from C<object>.
1501 Parrot_get_attrib_by_num(Interp
*interp
, PMC
*object
, INTVAL attrib
)
1504 * this is called from ParrotObject's vtable now, so
1505 * their is no need for checking object being a valid
1508 SLOTTYPE
* const attrib_array
= PMC_data(object
);
1509 const INTVAL attrib_count
= PMC_int_val(object
);
1511 if (attrib
>= attrib_count
|| attrib
< 0) {
1512 real_exception(interp
, NULL
, ATTRIB_NOT_FOUND
,
1513 "No such attribute #%d", (int)attrib
);
1515 return get_attrib_num(attrib_array
, attrib
);
1519 attr_str_2_num(Interp
*interp
, PMC
*object
, STRING
*attr
)
1523 SLOTTYPE
*class_array
;
1530 if (!PObj_is_object_TEST(object
))
1531 internal_exception(INTERNAL_NOT_IMPLEMENTED
,
1532 "Can't set non-core object attribs yet");
1534 class = GET_CLASS((SLOTTYPE
*)PMC_data(object
), object
);
1535 if (PObj_is_PMC_shared_TEST(object
)) {
1536 /* XXX Shared objects have the 'wrong' class stored in them
1537 * (because of the reference to the namespace and because it
1538 * references PMCs that may go away),
1539 * since we actually want one from the current interpreter. */
1540 class = VTABLE_get_class(interp
, object
);
1542 class_array
= (SLOTTYPE
*)PMC_data(class);
1543 attr_hash
= get_attrib_num(class_array
, PCD_ATTRIBUTES
);
1544 b
= parrot_hash_get_bucket(interp
,
1545 (Hash
*) PMC_struct_val(attr_hash
), attr
);
1547 return PMC_int_val((PMC
*)b
->value
);
1549 /* Create a delimiter for splitting up the Class\0attribute syntax. */
1550 delimit
= string_from_cstring(interp
, "\0", 1);
1552 /* Calculate the offset and the length of the attribute string. */
1553 idx
= string_str_index(interp
, attr
, delimit
, 0) + 1;
1555 real_exception(interp
, NULL
, ATTRIB_NOT_FOUND
,
1556 "No such attribute '%Ss'", attr
);
1559 length
= string_length(interp
, attr
) - idx
;
1561 /* Extract the attribute and object name. */
1562 attr_name
= string_substr(interp
, attr
, idx
, length
, 0, 0);
1563 obj_name
= string_substr(interp
, attr
, 0, idx
-1, 0, 0);
1565 real_exception(interp
, NULL
, ATTRIB_NOT_FOUND
,
1566 "No such attribute '%Ss\\0%Ss'",
1567 obj_name
, attr_name
);
1573 Parrot_get_attrib_by_str(Interp
*interp
, PMC
*object
, STRING
*attr
)
1575 return Parrot_get_attrib_by_num(interp
, object
,
1576 attr_str_2_num(interp
, object
, attr
));
1582 Parrot_set_attrib_by_num(Interp *interp, PMC *object,
1583 INTVAL attrib, PMC *value)>
1585 Set attribute number C<attrib> from C<object> to C<value>. Presumably the code
1586 is asking for the correct attribute number.
1589 Parrot_set_attrib_by_str(Interp *interp, PMC *object,
1590 STRING *attr, PMC *value)>
1592 Sets attribute with full qualified name C<attr> from C<object> to C<value>.
1599 Parrot_set_attrib_by_num(Interp
*interp
, PMC
*object
,
1600 INTVAL attrib
, PMC
*value
)
1602 SLOTTYPE
* const attrib_array
= PMC_data(object
);
1603 const INTVAL attrib_count
= PMC_int_val(object
);
1605 if (attrib
>= attrib_count
|| attrib
< 0) {
1606 real_exception(interp
, NULL
, ATTRIB_NOT_FOUND
,
1607 "No such attribute #%d", (int)attrib
);
1609 set_attrib_num(object
, attrib_array
, attrib
, value
);
1613 Parrot_set_attrib_by_str(Interp
*interp
, PMC
*object
,
1614 STRING
*attr
, PMC
*value
)
1617 Parrot_set_attrib_by_num(interp
, object
,
1618 attr_str_2_num(interp
, object
, attr
),
1623 Parrot_class_offset(Interp
*interp
, PMC
*object
, STRING
*class) {
1624 PMC
*class_pmc
, *mro
, *attribs
;
1625 INTVAL offset
, i
, n
, attr_count
;
1627 if (!PObj_is_object_TEST(object
))
1628 real_exception(interp
, NULL
, 1, "Not an object");
1629 class_pmc
= GET_CLASS((SLOTTYPE
*)PMC_data(object
), object
);
1630 /* unroll common case - object is this class */
1631 attribs
= get_attrib_num(PMC_data(class_pmc
), PCD_CLASS_ATTRIBUTES
);
1632 attr_count
= VTABLE_elements(interp
, attribs
);
1633 offset
= PMC_int_val(object
) - attr_count
;
1634 if (!string_equal(interp
, VTABLE_name(interp
, class_pmc
), class))
1637 mro
= class_pmc
->vtable
->mro
;
1638 n
= VTABLE_elements(interp
, mro
);
1639 for (i
= 1; i
< n
; ++i
) {
1640 class_pmc
= VTABLE_get_pmc_keyed_int(interp
, mro
, i
);
1641 attribs
= get_attrib_num(PMC_data(class_pmc
), PCD_CLASS_ATTRIBUTES
);
1642 attr_count
= VTABLE_elements(interp
, attribs
);
1643 offset
-= attr_count
;
1644 if (!string_equal(interp
,
1645 VTABLE_name(interp
, class_pmc
), class))
1648 return -1; /* error is catched in opcode */
1653 =item C<PMC *Parrot_find_class_constructor(Interp *interp,
1654 STRING *class, INTVAL classtoken)>
1656 Find and return the constructor method PMC for the named sub. The
1657 classtoken is an identifier for the class used for fast lookup, or 0
1658 if you don't have an identifier token. Which, as they're currently
1659 undefined, is pretty likely
1665 PMC
*Parrot_find_class_constructor(Interp
*interp
, STRING
*class,
1671 PMC
*Parrot_find_class_destructor(Interp
*interp
, STRING
*class,
1677 PMC
*Parrot_find_class_fallback(Interp
*interp
, STRING
*class,
1683 void Parrot_set_class_constructor(Interp
*interp
, STRING
*class,
1684 INTVAL classtoken
, STRING
*method
)
1688 void Parrot_set_class_destructor(Interp
*interp
, STRING
*class,
1689 INTVAL classtoken
, STRING
*method
)
1693 void Parrot_set_class_fallback(Interp
*interp
, STRING
*class,
1694 INTVAL classtoken
, STRING
*method
)
1704 F<include/parrot/objects.h>, F<docs/pdds/pdd15_objects.pod>.
1713 * c-file-style: "parrot"
1715 * vim: expandtab shiftwidth=4: