2 Copyright (C) 2001-2008, The Perl Foundation.
7 src/pmc/object.pmc - An instance of a class
11 Implements an instance of a class.
21 #include "parrot/parrot.h"
22 #include "parrot/oo_private.h"
23 #include "pmc_class.h"
25 /* This finds the index of an attribute in an object's attribute store and
26 * returns it. Returns -1 if the attribute does not exist. */
28 get_attrib_index(PARROT_INTERP, PMC *self, STRING *name)
30 Parrot_Class * const _class = PARROT_CLASS(self);
33 /* First see if we can find it in the cache. */
34 if (VTABLE_exists_keyed_str(interp, _class->attrib_cache, name))
35 return VTABLE_get_integer_keyed_str(interp, _class->attrib_cache, name);
37 /* No hit. We need to walk up the list of parents to try and find the
39 num_classes = VTABLE_elements(interp, _class->all_parents);
41 for (i = 0; i < num_classes; i++) {
42 /* Get the class and its attribute metadata hash. */
43 PMC * const cur_class = VTABLE_get_pmc_keyed_int(interp,
44 _class->all_parents, i);
46 /* Build a string representing the fully qualified attribute name. */
47 STRING *fq_name = VTABLE_get_string(interp, cur_class);
48 fq_name = string_append(interp, fq_name, name);
51 if (VTABLE_exists_keyed_str(interp, _class->attrib_index, fq_name)) {
52 /* Found it. Get value, cache it and we're done. */
53 const INTVAL index = VTABLE_get_integer_keyed_str(interp,
54 _class->attrib_index, fq_name);
55 VTABLE_set_integer_keyed_str(interp, _class->attrib_cache, name,
65 /* This variation bypasses the cache and finds the index of a particular
66 * parent's attribute in an object's attribute store and returns it. Returns -1
67 * if the attribute does not exist. */
70 get_attrib_index_keyed(PARROT_INTERP, PMC *self, PMC *key, STRING *name)
72 Parrot_Class * const _class = PARROT_CLASS(self);
73 PMC * const class_cache = VTABLE_get_pmc_keyed_str(interp,
74 _class->attrib_cache, VTABLE_get_string(interp, key));
78 if (!PMC_IS_NULL(class_cache))
79 if (VTABLE_exists_keyed_str(interp, class_cache, name))
80 return VTABLE_get_integer_keyed_str(interp, class_cache, name);
82 /* Build a string representing the fully qualified attribute name. */
83 parent_class = Parrot_oo_get_class(interp, key);
84 fq_name = VTABLE_get_string(interp, parent_class);
85 fq_name = string_append(interp, fq_name, name);
88 if (VTABLE_exists_keyed_str(interp, _class->attrib_index, fq_name)) {
89 /* Found it. Get value and we're done. */
90 const INTVAL index = VTABLE_get_integer_keyed_str(interp,
91 _class->attrib_index, fq_name);
98 pmclass Object need_ext {
99 ATTR PMC *_class; /* The class this is an instance of. */
100 ATTR PMC *attrib_store; /* The attributes store - a resizable PMC array. */
106 Raises an exception; you can only instantiate objects from a class.
113 real_exception(interp, NULL, INVALID_OPERATION,
114 "Object must be created by a class.");
120 =item C<void init_pmc(PMC *class)>
122 Raises an exception; you can only instantiate objects from a class.
128 VTABLE void init_pmc(PMC *worreva) {
129 real_exception(interp, NULL, INVALID_OPERATION,
130 "Object must be created by a class.");
135 =item C<void destroy()>
137 Free the object's underlying struct.
142 VTABLE void destroy() {
143 mem_sys_free(PMC_data(SELF));
148 =item C<STRING *name()>
150 Returns the fully qualified name of the object's class.
156 VTABLE STRING *name() {
157 PMC * const _class = VTABLE_get_class(interp, SELF);
158 STRING * const name = CONST_STRING(interp, "name");
160 /* If there's a vtable override for 'name' run that instead. */
161 PMC * const method = Parrot_oo_find_vtable_override(interp, _class, name);
163 if (!PMC_IS_NULL(method))
164 return (STRING *)Parrot_run_meth_fromc_args(interp, method, SELF, name, "S");
166 return VTABLE_get_string(interp, _class);
173 Mark any referenced strings and PMCs.
179 if (PARROT_OBJECT(SELF)) {
180 Parrot_Object * const obj = PARROT_OBJECT(SELF);
183 pobject_lives(interp, (PObj*)obj->_class);
184 if (obj->attrib_store)
185 pobject_lives(interp, (PObj*)obj->attrib_store);
191 =item C<PMC *get_attr_str(STRING *name)>
193 Gets the value of an attribute for this object. Will find the first attribute
194 of the given name walking up the inheritance tree.
199 VTABLE PMC *get_attr_str(STRING *name) {
200 Parrot_Object * const obj = PARROT_OBJECT(SELF);
201 STRING * const get_attr = CONST_STRING(interp, "get_attr_str");
204 /* If there's a vtable override for 'get_attr_str' run that first. */
205 PMC * const method = Parrot_oo_find_vtable_override(interp,
206 VTABLE_get_class(interp, SELF), get_attr);
208 if (!PMC_IS_NULL(method))
209 return (PMC *)Parrot_run_meth_fromc_args(interp, method, SELF,
210 get_attr, "PS", name);
212 /* Look up the index. */
213 index = get_attrib_index(interp, obj->_class, name);
215 /* If lookup failed, exception. */
217 real_exception(interp, NULL, ATTRIB_NOT_FOUND,
218 "No such attribute '%S'", name);
220 return VTABLE_get_pmc_keyed_int(interp, obj->attrib_store, index);
225 =item C<PMC *get_attr_keyed(PMC *key, STRING *name)>
227 Gets the value of an attribute for this object. Will only look for attributes
228 defined in the parent identified by the given key.
233 VTABLE PMC *get_attr_keyed(PMC *key, STRING *name) {
234 Parrot_Object * const obj = PARROT_OBJECT(SELF);
236 /* Look up the index. */
237 const INTVAL index = get_attrib_index_keyed(interp, obj->_class, key, name);
239 /* If lookup failed, exception. */
241 real_exception(interp, NULL, ATTRIB_NOT_FOUND,
242 "No such attribute '%S' in class '%S'", name,
243 VTABLE_get_string(interp, key));
245 return VTABLE_get_pmc_keyed_int(interp, obj->attrib_store, index);
250 =item C<void set_attr_str(STRING *name, PMC *value)>
252 Sets the value of an attribute for this object. Will set the first attribute
253 of the given name walking up the inheritance tree.
258 VTABLE void set_attr_str(STRING *name, PMC *value) {
259 Parrot_Object * const obj = PARROT_OBJECT(SELF);
260 STRING *vtable_meth_name = CONST_STRING(interp, "set_attr_str");
263 /* If there's a vtable override for 'set_attr_str' run that first. */
264 PMC * const method = Parrot_oo_find_vtable_override(interp,
265 VTABLE_get_class(interp, SELF), vtable_meth_name);
266 if (!PMC_IS_NULL(method)) {
267 PMC *unused = (PMC *)Parrot_run_meth_fromc_args(interp, method,
268 SELF, vtable_meth_name, "vSP", name, value);
273 index = get_attrib_index(interp, obj->_class, name);
275 /* If lookup failed, exception. */
277 real_exception(interp, NULL, ATTRIB_NOT_FOUND,
278 "No such attribute '%S'", name);
280 VTABLE_set_pmc_keyed_int(interp, obj->attrib_store, index, value);
285 =item C<void set_attr_keyed(PMC *key, STRING *name, PMC *value)>
287 Sets the value of an attribute for this object. Will only set attributes
288 defined in the parent identified by the given key.
293 VTABLE void set_attr_keyed(PMC *key, STRING *name, PMC *value) {
294 Parrot_Object * const obj = PARROT_OBJECT(SELF);
295 const INTVAL index = get_attrib_index_keyed(interp, obj->_class, key, name);
297 /* If lookup failed, exception. */
299 real_exception(interp, NULL, ATTRIB_NOT_FOUND,
300 "No such attribute '%S' in class '%S'", name,
301 VTABLE_get_string(interp, key));
303 VTABLE_set_pmc_keyed_int(interp, obj->attrib_store, index, value);
308 =item C<PMC *find_method(STRING *name)>
310 Queries this object's class to find the method with the given name.
315 VTABLE PMC *find_method(STRING *name) {
316 Parrot_Object * const obj = PARROT_OBJECT(SELF);
317 Parrot_Class * const _class = PARROT_CLASS(obj->_class);
318 PMC *method = PMCNULL;
319 STRING *find_method = CONST_STRING(interp, "find_method");
321 /* Walk and search. One day, we'll use the cache first. */
322 const int num_classes = VTABLE_elements(interp,
323 _class->all_parents);
324 const int all_in_universe = !CLASS_has_alien_parents_TEST(obj->_class);
325 int alien_parents_pos = VTABLE_elements(interp,
326 _class->attrib_metadata);
329 for (i = 0; i < num_classes; i++) {
331 PMC * const cur_class =
332 VTABLE_get_pmc_keyed_int(interp, _class->all_parents, i);
334 /* If there's a vtable override for 'find_method' in the current
335 * class, run that first. */
336 method = Parrot_oo_find_vtable_override_for_class(interp, cur_class,
339 if (!PMC_IS_NULL(method))
340 return (PMC *)Parrot_run_meth_fromc_args(interp, method, SELF,
341 find_method, "PS", name);
343 /* If it's from this universe or the class doesn't inherit from
344 * anything outside of it... */
345 if (all_in_universe || VTABLE_isa(interp, cur_class, CONST_STRING(interp, "Class"))) {
346 const Parrot_Class * const class_info = PARROT_CLASS(cur_class);
347 if (VTABLE_exists_keyed_str(interp, class_info->methods, name)) {
349 method = VTABLE_get_pmc_keyed_str(interp, class_info->methods, name);
354 /* Delegate the lookup to the class. */
355 PMC * const del_class = VTABLE_get_pmc_keyed_int(interp, obj->attrib_store,
357 method = VTABLE_find_method(interp, del_class, name);
359 if (!PMC_IS_NULL(method)) {
360 /* Found it. However, if we just hand this back and it's
361 * an NCI and we call it, we will get the wrong invocant
362 * passed. Therefore, we need to close the NCI and make it
363 * into a BoundNCI. */
364 if (method->vtable->base_type == enum_class_NCI) {
365 method = VTABLE_clone(interp, method);
366 method->vtable = interp->vtables[enum_class_Bound_NCI];
367 VTABLE_set_pmc(interp, method, del_class);
370 /* Found a method, so we're done. */
383 =item C<PMC *get_class()>
385 Get the class PMC representing the class that this object is an instance of.
390 VTABLE PMC *get_class() {
391 PMC * const classobj = PARROT_OBJECT(SELF)->_class;
392 STRING *get_class = CONST_STRING(interp, "get_class");
393 /* If there's a vtable override for 'get_class' run that instead. */
394 PMC * const method = Parrot_oo_find_vtable_override(interp,
395 classobj, get_class);
397 if (!PMC_IS_NULL(method))
398 return (PMC *)Parrot_run_meth_fromc_args(interp, method, SELF,
406 =item C<INTVAL can(STRING *method_name)>
408 Returns 0 if the class does not have a method with the given name and a
409 non-zero value if it does.
414 VTABLE INTVAL can(STRING *method_name) {
415 /* Just use find_method and see it if finds anything. */
416 const PMC * const method = VTABLE_find_method(interp, SELF, method_name);
417 return !PMC_IS_NULL(method);
422 =item C<INTVAL isa_pmc(PMC *classname)>
424 Returns whether the object's class is or inherits from C<*classname>.
430 VTABLE INTVAL isa_pmc(PMC *lookup) {
431 if (PMC_IS_NULL(lookup))
437 /* Dispatch isa to the object's class */
438 return VTABLE_isa_pmc(interp, VTABLE_get_class(interp, SELF), lookup);
443 =item C<INTVAL isa(STRING *classname)>
445 Returns whether the class is or inherits from C<*classname>.
451 VTABLE INTVAL isa(STRING *classname) {
454 if (SUPER(classname))
457 _class = VTABLE_get_class(interp, SELF);
458 return VTABLE_isa(interp, _class, classname);
463 =item C<INTVAL does(STRING *role_name)>
465 Returns whether the object's class does the role with name C<*role_name>.
471 VTABLE INTVAL does(STRING *role_name) {
475 /* Dispatch to the object's class */
476 return VTABLE_does(interp, VTABLE_get_class(interp, SELF), role_name);
481 =item C<INTVAL does_pmc(PMC *role)>
483 Returns whether the object's class does C<*role>.
489 VTABLE INTVAL does_pmc(PMC *role) {
490 if (PMC_IS_NULL(role))
496 /* Dispatch to the object's class */
497 return VTABLE_does_pmc(interp, VTABLE_get_class(interp, SELF), role);
502 =item C<opcode_t *invoke(void *next)>
504 Invokes the object (if this vtable function is overridden).
510 opcode_t * invoke(void *next) {
511 Parrot_Object * const obj = PARROT_OBJECT(pmc);
512 Parrot_Class * const _class = PARROT_CLASS(obj->_class);
514 /* Walk and search for the vtable method. */
515 const int num_classes = VTABLE_elements(interp, _class->all_parents);
518 for (i = 0; i < num_classes; i++) {
520 STRING *meth_name = CONST_STRING(interp, "invoke");
521 STRING *proxy = CONST_STRING(interp, "proxy");
522 PMC * const cur_class =
523 VTABLE_get_pmc_keyed_int(interp, _class->all_parents, i);
526 Parrot_oo_find_vtable_override_for_class(interp, cur_class,
528 if (!PMC_IS_NULL(meth))
529 return VTABLE_invoke(interp, meth, next);
531 if (cur_class->vtable->base_type == enum_class_PMCProxy) {
532 /* Get the PMC instance and call the vtable method on that. */
533 PMC * const del_object =
534 VTABLE_get_attr_keyed(interp, pmc, cur_class, proxy);
536 if (!PMC_IS_NULL(del_object))
537 return VTABLE_invoke(interp, del_object, next);
541 return (opcode_t *)Parrot_default_invoke(interp, pmc, next);
546 =item C<INTVAL type()>
548 Returns the integer type of the object's class.
554 VTABLE INTVAL type() {
555 PMC *_class = VTABLE_get_class(interp, SELF);
556 return VTABLE_type(interp, _class);
561 =item C<PMC * clone()>
563 Creates a clone of the object.
569 VTABLE PMC * clone() {
570 Parrot_Object * const obj = PARROT_OBJECT(pmc);
571 Parrot_Class * const _class = PARROT_CLASS(obj->_class);
572 STRING * const meth_name = CONST_STRING(interp, "clone");
574 Parrot_Object * cloned_guts;
576 /* See if we have a custom override of the method first. */
577 const int num_classes = VTABLE_elements(interp, _class->all_parents);
579 for (i = 0; i < num_classes; i++) {
581 PMC * const cur_class = VTABLE_get_pmc_keyed_int(interp, _class->all_parents, i);
583 /* Look for a method and run it if we find one. */
585 Parrot_oo_find_vtable_override_for_class(interp, cur_class, meth_name);
586 if (!PMC_IS_NULL(meth))
587 return (PMC*)Parrot_run_meth_fromc_args(interp, meth, pmc, meth_name, "P");
590 /* If we get here, no custom clone. Create a new object PMC. */
591 cloned = pmc_new_noinit(interp, enum_class_Object);
593 /* Set custom DOD mark and destroy on the object. */
594 PObj_custom_mark_SET(cloned);
595 PObj_active_destroy_SET(cloned);
597 /* Flag that it is an object */
598 PObj_is_object_SET(cloned);
600 /* Now create the underlying structure, and clone attributes list.class. */
601 cloned_guts = mem_allocate_zeroed_typed(Parrot_Object);
602 cloned_guts->_class = obj->_class;
603 cloned_guts->attrib_store = VTABLE_clone(INTERP, obj->attrib_store);
604 PMC_data(cloned) = cloned_guts;
606 /* Some of the attributes may have been the PMCs providing storage for any
607 * PMCs we inherited from; also need to clone those. */
608 if (CLASS_has_alien_parents_TEST(obj->_class)) {
609 /* Locate any PMC parents. */
610 for (i = 0; i < num_classes; i++) {
611 PMC * const cur_class = VTABLE_get_pmc_keyed_int(interp, _class->all_parents, i);
612 if (cur_class->vtable->base_type == enum_class_PMCProxy) {
613 /* Clone this PMC too. */
614 STRING *proxy = CONST_STRING(interp, "proxy");
615 VTABLE_set_attr_keyed(interp, cloned, cur_class, proxy,
617 VTABLE_get_attr_keyed(interp, pmc, cur_class, proxy)));
622 /* And we have ourselves a clone. */
628 =item C<void visit(visit_info *info)>
630 This is used by freeze/thaw to visit the contents of the object.
632 C<*info> is the visit info, (see F<include/parrot/pmc_freeze.h>).
638 VTABLE void visit(visit_info *info) {
639 Parrot_Object * const obj_data = PARROT_OBJECT(SELF);
643 pos = &obj_data->_class;
644 info->thaw_ptr = pos;
645 (info->visit_pmc_now)(INTERP, *pos, info);
647 /* 2) visit the attributes */
648 pos = &obj_data->attrib_store;
649 info->thaw_ptr = pos;
650 (info->visit_pmc_now)(INTERP, *pos, info);
655 =item C<void thaw(visit_info *info)>
657 Used to unarchive the object.
663 VTABLE void thaw(visit_info *info) {
664 if (info->extra_flags == EXTRA_IS_PROP_HASH) {
667 else if (info->extra_flags == EXTRA_IS_NULL) {
668 /* Allocate the object's core data struct */
669 PMC_data(SELF) = mem_allocate_zeroed_typed(Parrot_Object);
675 =item C<void thawfinish(visit_info *info)>
677 Called after the object has been thawed.
683 void thawfinish(visit_info *info) {
684 /* Set custom DOD mark and destroy on the object. */
685 PObj_custom_mark_SET(SELF);
686 PObj_active_destroy_SET(SELF);
688 /* Flag that it is an object */
689 PObj_is_object_SET(SELF);
694 =item C<PMC * share_ro()>
696 Used to mark a PMC as read-only shared.
701 VTABLE PMC *share_ro() {
702 PMC *ret, *_true, *data;
705 Parrot_Interp master;
707 PMC *vtable_cache = PMCNULL;
709 if (PObj_is_PMC_shared_TEST(SELF))
712 master = interpreter_array[0];
713 classobj = VTABLE_get_class(INTERP, SELF);
714 type_num = SELF->vtable->base_type;
716 /* keep the original vtable from going away... */
717 vtable_cache = PARROT_CLASS(classobj)->vtable_cache;
718 if (PMC_IS_NULL(vtable_cache)) {
719 vtable_cache = pmc_new(INTERP, enum_class_VtableCache);
720 PMC_struct_val(vtable_cache) = INTERP->vtables[type_num];
721 PARROT_CLASS(classobj)->vtable_cache = vtable_cache;
724 add_pmc_sync(INTERP, vtable_cache);
725 PObj_is_PMC_shared_SET(vtable_cache);
727 /* make sure metadata doesn't go away unexpectedly */
728 if (PMC_metadata(pmc))
729 PMC_metadata(pmc) = pt_shared_fixup(interp, PMC_metadata(pmc));
731 PARROT_ASSERT(master->vtables[type_num]->pmc_class);
732 /* don't want the referenced class disappearing on us */
733 LOCK_INTERPRETER(master);
734 SELF->vtable->pmc_class = master->vtables[type_num]->pmc_class;
735 UNLOCK_INTERPRETER(master);
738 _true = pmc_new(INTERP, enum_class_Integer);
740 /* Setting the '_ro' property switches to the read-only vtable */
741 VTABLE_set_integer_native(INTERP, _true, 1);
742 VTABLE_setprop(INTERP, ret, CONST_STRING(interp, "_ro"), _true);
743 SELF->vtable->pmc_class = master->vtables[type_num]->pmc_class;
744 add_pmc_sync(INTERP, ret);
745 PObj_is_PMC_shared_SET(ret);
747 data = PARROT_CLASS(classobj)->parents;
748 n = VTABLE_elements(INTERP, data);
750 for (i = 0; i < n; ++i) {
751 PMC * cur_class = VTABLE_get_pmc_keyed_int(INTERP, data, i);
752 VTABLE_set_pmc_keyed_int(INTERP, data, i, VTABLE_share_ro(INTERP, cur_class));
755 /* XXX This is perhaps not the best way to fix this up, but we
756 * need to ensure that the class object won't go away when
757 * this interpreter dies.
759 PARROT_ASSERT(ret->vtable->pmc_class);
760 PARROT_ASSERT(ret->vtable->share_ro == Parrot_Object_share_ro);
767 =item C<void morph(INTVAL type)>
769 Changes the PMC to a PMC of a new type
775 VTABLE void morph(INTVAL type) {
786 F<docs/pdds/pdd15_objects.pod>.
794 * c-file-style: "parrot"
796 * vim: expandtab shiftwidth=4: