Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Tree: 18dd1479df
Fetching contributors…

Cannot retrieve contributors at this time

820 lines (577 sloc) 23.555 kB
/*
Copyright (C) 2001-2009, Parrot Foundation.
$Id$
=head1 NAME
src/pmc/object.pmc - An instance of a class
=head1 DESCRIPTION
Implements an instance of a class.
=head2 Functions
=over 4
=cut
*/
#include "parrot/oo_private.h"
#include "pmc_class.h"
/* This finds the index of an attribute in an object's attribute store and
* returns it. Returns -1 if the attribute does not exist. */
static INTVAL
get_attrib_index(PARROT_INTERP, PMC *self, STRING *name)
{
Parrot_Class_attributes * const _class = PARROT_CLASS(self);
const INTVAL cur_hll = Parrot_pcc_get_HLL(interp, CURRENT_CONTEXT(interp));
int num_classes, i;
INTVAL retval;
Parrot_pcc_set_HLL(interp, CURRENT_CONTEXT(interp), 0);
/* First see if we can find it in the cache. */
retval = VTABLE_get_integer_keyed_str(interp,
_class->attrib_cache, name);
/* there's a semi-predicate problem with a retval of 0 */
if (retval
|| VTABLE_exists_keyed_str(interp, _class->attrib_cache, name)) {
Parrot_pcc_set_HLL(interp, CURRENT_CONTEXT(interp), cur_hll);
return retval;
}
/* No hit. We need to walk up the list of parents to try and find the
* attribute. */
num_classes = VTABLE_elements(interp, _class->all_parents);
for (i = 0; i < num_classes; i++) {
/* Get the class and its attribute metadata hash. */
PMC * const cur_class = VTABLE_get_pmc_keyed_int(interp,
_class->all_parents, i);
/* Build a string representing the fully qualified attribute name. */
STRING *fq_name = VTABLE_get_string(interp, cur_class);
fq_name = Parrot_str_append(interp, fq_name, name);
/* Look up. */
if (VTABLE_exists_keyed_str(interp, _class->attrib_index, fq_name)) {
/* Found it. Get value, cache it and we're done. */
const INTVAL index = VTABLE_get_integer_keyed_str(interp,
_class->attrib_index, fq_name);
VTABLE_set_integer_keyed_str(interp, _class->attrib_cache, name,
index);
Parrot_pcc_set_HLL(interp, CURRENT_CONTEXT(interp), cur_hll);
return index;
}
}
Parrot_pcc_set_HLL(interp, CURRENT_CONTEXT(interp), cur_hll);
return -1;
}
/* This variation bypasses the cache and finds the index of a particular
* parent's attribute in an object's attribute store and returns it. Returns -1
* if the attribute does not exist. */
static INTVAL
get_attrib_index_keyed(PARROT_INTERP, PMC *self, PMC *key, STRING *name)
{
Parrot_Class_attributes * const _class = PARROT_CLASS(self);
PMC * const class_cache = VTABLE_get_pmc_keyed_str(interp,
_class->attrib_cache, VTABLE_get_string(interp, key));
PMC *parent_class;
STRING *fq_name;
if (!PMC_IS_NULL(class_cache))
if (VTABLE_exists_keyed_str(interp, class_cache, name))
return VTABLE_get_integer_keyed_str(interp, class_cache, name);
/* Build a string representing the fully qualified attribute name. */
parent_class = Parrot_oo_get_class(interp, key);
fq_name = VTABLE_get_string(interp, parent_class);
fq_name = Parrot_str_append(interp, fq_name, name);
/* Look up. */
if (VTABLE_exists_keyed_str(interp, _class->attrib_index, fq_name)) {
/* Found it. Get value and we're done. */
const INTVAL index = VTABLE_get_integer_keyed_str(interp,
_class->attrib_index, fq_name);
return index;
}
return -1;
}
pmclass Object auto_attrs {
ATTR PMC *_class; /* The class this is an instance of. */
ATTR PMC *attrib_store; /* The attributes store - a resizable PMC array. */
/*
=item C<void init()>
Raises an exception; you can only instantiate objects from a class.
=cut
*/
VTABLE void init() {
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
"Object must be created by a class.");
}
/*
=item C<void init_pmc(PMC *class)>
Raises an exception; you can only instantiate objects from a class.
=cut
*/
VTABLE void init_pmc(PMC *worreva) {
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
"Object must be created by a class.");
}
/*
=item C<void destroy()>
Just to avoid the automatic generation of one.
=cut
*/
VTABLE void destroy() {
}
/*
=item C<STRING *name()>
Returns the fully qualified name of the object's class.
=cut
*/
VTABLE STRING *name() {
PMC * const _class = VTABLE_get_class(interp, SELF);
STRING * const name = CONST_STRING(interp, "name");
/* If there's a vtable override for 'name' run that instead. */
PMC * const method = Parrot_oo_find_vtable_override(interp, _class, name);
if (!PMC_IS_NULL(method))
return (STRING *)Parrot_run_meth_fromc_args(interp, method, SELF, name, "S");
else
return VTABLE_get_string(interp, _class);
}
/*
=item C<void mark()>
Mark any referenced strings and PMCs.
=cut
*/
VTABLE void mark() {
if (PARROT_OBJECT(SELF)) {
Parrot_Object_attributes * const obj = PARROT_OBJECT(SELF);
Parrot_gc_mark_PMC_alive(interp, obj->_class);
Parrot_gc_mark_PMC_alive(interp, obj->attrib_store);
}
}
/*
=item C<PMC *get_attr_str(STRING *name)>
Gets the value of an attribute for this object. Will find the first attribute
of the given name walking up the inheritance tree.
=cut
*/
VTABLE PMC *get_attr_str(STRING *name) {
Parrot_Object_attributes * const obj = PARROT_OBJECT(SELF);
STRING * const get_attr = CONST_STRING(interp, "get_attr_str");
INTVAL index;
/* If there's a vtable override for 'get_attr_str' run that first. */
PMC * const method = Parrot_oo_find_vtable_override(interp,
VTABLE_get_class(interp, SELF), get_attr);
if (!PMC_IS_NULL(method))
return (PMC *)Parrot_run_meth_fromc_args(interp, method, SELF,
get_attr, "PS", name);
/* Look up the index. */
index = get_attrib_index(interp, obj->_class, name);
/* If lookup failed, exception. */
if (index == -1)
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_ATTRIB_NOT_FOUND,
"No such attribute '%S'", name);
return VTABLE_get_pmc_keyed_int(interp, obj->attrib_store, index);
}
/*
=item C<PMC *get_attr_keyed(PMC *key, STRING *name)>
Gets the value of an attribute for this object. Will only look for attributes
defined in the parent identified by the given key.
=cut
*/
VTABLE PMC *get_attr_keyed(PMC *key, STRING *name) {
Parrot_Object_attributes * const obj = PARROT_OBJECT(SELF);
/* Look up the index. */
const INTVAL index = get_attrib_index_keyed(interp, obj->_class, key, name);
/* If lookup failed, exception. */
if (index == -1)
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_ATTRIB_NOT_FOUND,
"No such attribute '%S' in class '%S'", name,
VTABLE_get_string(interp, key));
return VTABLE_get_pmc_keyed_int(interp, obj->attrib_store, index);
}
/*
=item C<void set_attr_str(STRING *name, PMC *value)>
Sets the value of an attribute for this object. Will set the first attribute
of the given name walking up the inheritance tree.
=cut
*/
VTABLE void set_attr_str(STRING *name, PMC *value) {
Parrot_Object_attributes * const obj = PARROT_OBJECT(SELF);
STRING * const vtable_meth_name = CONST_STRING(interp, "set_attr_str");
INTVAL index;
/* If there's a vtable override for 'set_attr_str' run that first. */
PMC * const method = Parrot_oo_find_vtable_override(interp,
VTABLE_get_class(interp, SELF), vtable_meth_name);
if (!PMC_IS_NULL(method)) {
PMC *unused = (PMC *)Parrot_run_meth_fromc_args(interp, method,
SELF, vtable_meth_name, "vSP", name, value);
UNUSED(unused);
return;
}
index = get_attrib_index(interp, obj->_class, name);
/* If lookup failed, exception. */
if (index == -1)
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_ATTRIB_NOT_FOUND,
"No such attribute '%S'", name);
VTABLE_set_pmc_keyed_int(interp, obj->attrib_store, index, value);
}
/*
=item C<void set_attr_keyed(PMC *key, STRING *name, PMC *value)>
Sets the value of an attribute for this object. Will only set attributes
defined in the parent identified by the given key.
=cut
*/
VTABLE void set_attr_keyed(PMC *key, STRING *name, PMC *value) {
Parrot_Object_attributes * const obj = PARROT_OBJECT(SELF);
const INTVAL index = get_attrib_index_keyed(interp, obj->_class, key, name);
/* If lookup failed, exception. */
if (index == -1)
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_ATTRIB_NOT_FOUND,
"No such attribute '%S' in class '%S'", name,
VTABLE_get_string(interp, key));
VTABLE_set_pmc_keyed_int(interp, obj->attrib_store, index, value);
}
/*
=item C<PMC *find_method(STRING *name)>
Queries this object's class to find the method with the given name.
=cut
*/
VTABLE PMC *find_method(STRING *name) {
Parrot_Object_attributes * const obj = PARROT_OBJECT(SELF);
Parrot_Class_attributes * const _class = PARROT_CLASS(obj->_class);
STRING * const find_method = CONST_STRING(interp, "find_method");
PMC *method = PMCNULL;
/* Walk and search. One day, we'll use the cache first. */
const int num_classes = VTABLE_elements(interp,
_class->all_parents);
const int all_in_universe = !CLASS_has_alien_parents_TEST(obj->_class);
int i;
for (i = 0; i < num_classes; i++) {
/* Get the class. */
PMC * const cur_class =
VTABLE_get_pmc_keyed_int(interp, _class->all_parents, i);
const Parrot_Class_attributes * const class_info = PARROT_CLASS(cur_class);
/* If there's a vtable override for 'find_method' in the current
* class, run that first. */
method = Parrot_oo_find_vtable_override_for_class(interp, cur_class,
find_method);
if (!PMC_IS_NULL(method))
return (PMC *)Parrot_run_meth_fromc_args(interp, method, SELF,
find_method, "PS", name);
/* If it's from this universe or the class doesn't inherit from
* anything outside of it... */
if (all_in_universe || VTABLE_isa(interp, cur_class, CONST_STRING(interp, "Class"))) {
method = VTABLE_get_pmc_keyed_str(interp, class_info->methods, name);
/* Found it! */
if (!PMC_IS_NULL(method))
break;
}
else {
Parrot_ex_throw_from_c_args(INTERP, NULL, -1,
"Class %Ss inherits from alien parents.", class_info->name);
}
}
return method;
}
/*
=item C<INTVAL get_integer()>
Invoke the PIR-defined vtable override, or call the default get_integer.
=cut
*/
VTABLE INTVAL get_integer() {
Parrot_Object_attributes * const obj = PARROT_OBJECT(pmc);
Parrot_Class_attributes * const _class = PARROT_CLASS(obj->_class);
STRING * const meth_name = CONST_STRING(interp, "get_integer");
/* Walk and search for the vtable method. */
const int num_classes = VTABLE_elements(interp, _class->all_parents);
int i;
for (i = 0; i < num_classes; i++) {
/* Get the class. */
PMC * const cur_class = VTABLE_get_pmc_keyed_int(interp, _class->all_parents, i);
PMC * const meth = Parrot_oo_find_vtable_override_for_class(interp,
cur_class, meth_name);
if (!PMC_IS_NULL(meth)) {
INTVAL result;
Parrot_pcc_invoke_sub_from_c_args(interp, meth, "P->I", pmc, &result);
return result;
/* return (INTVAL)Parrot_run_meth_fromc_args_reti(interp, meth, pmc, meth_name, "I"); */
}
/* method name is get_integer */
if (cur_class->vtable->base_type == enum_class_PMCProxy) {
/* Get the PMC instance and call the vtable method on that. */
STRING * const proxy = CONST_STRING(interp, "proxy");
PMC * const del_object = VTABLE_get_attr_str(interp, pmc, proxy);
if (!PMC_IS_NULL(del_object)) {
return (INTVAL)VTABLE_get_integer(interp, del_object);
}
}
}
return interp->vtables[enum_class_default]->get_integer(interp, pmc);
}
/*
=item C<PMC *get_class()>
Get the class PMC representing the class that this object is an instance of.
=cut
*/
VTABLE PMC *get_class() {
PMC * const classobj = PARROT_OBJECT(SELF)->_class;
STRING * const get_class = CONST_STRING(interp, "get_class");
/* If there's a vtable override for 'get_class' run that instead. */
PMC * const method = Parrot_oo_find_vtable_override(interp,
classobj, get_class);
if (!PMC_IS_NULL(method))
return (PMC *)Parrot_run_meth_fromc_args(interp, method, SELF,
get_class, "P");
return classobj;
}
/*
=item C<PMC *get_namespace()>
Get the namespace PMC associated with the class that this object is an instance of.
=cut
*/
VTABLE PMC *get_namespace() {
PMC * const classobj = VTABLE_get_class(interp, SELF);
STRING * const get_namespace = CONST_STRING(interp, "get_namespace");
/* If there's a vtable override for 'get_namespace' run that instead. */
PMC * const method = Parrot_oo_find_vtable_override(interp,
classobj, get_namespace);
if (!PMC_IS_NULL(method))
return (PMC *)Parrot_run_meth_fromc_args(interp, method, SELF,
get_namespace, "P");
else
return VTABLE_inspect_str(interp, classobj, CONST_STRING(interp, "namespace"));
}
/*
=item C<INTVAL can(STRING *method_name)>
Returns 0 if the class does not have a method with the given name and a
non-zero value if it does.
=cut
*/
VTABLE INTVAL can(STRING *method_name) {
/* Just use find_method and see it if finds anything. */
const PMC * const method = VTABLE_find_method(interp, SELF, method_name);
return !PMC_IS_NULL(method);
}
/*
=item C<INTVAL isa_pmc(PMC *classname)>
Returns whether the object's class is or inherits from C<*classname>.
=cut
*/
VTABLE INTVAL isa_pmc(PMC *lookup) {
if (PMC_IS_NULL(lookup))
return 0;
if (SUPER(lookup))
return 1;
/* Dispatch isa to the object's class */
return VTABLE_isa_pmc(interp, VTABLE_get_class(interp, SELF), lookup);
}
/*
=item C<INTVAL isa(STRING *classname)>
Returns whether the class is or inherits from C<*classname>.
=cut
*/
VTABLE INTVAL isa(STRING *classname) {
PMC *_class;
if (SUPER(classname))
return 1;
_class = VTABLE_get_class(interp, SELF);
return VTABLE_isa(interp, _class, classname);
}
/*
=item C<INTVAL does(STRING *role_name)>
Returns whether the object's class does the role with name C<*role_name>.
=cut
*/
VTABLE INTVAL does(STRING *role_name) {
/* If it's a null string, return false */
if (!role_name)
return 0;
else {
PMC * const classobj = VTABLE_get_class(interp, SELF);
STRING * const meth_name = CONST_STRING(interp, "does");
PMC * const method = Parrot_oo_find_vtable_override(interp,
classobj, meth_name);
if (!PMC_IS_NULL(method)
&& Parrot_run_meth_fromc_args_reti(interp, method, SELF, meth_name, "IS", role_name))
return 1;
}
/* Check the superclass's vtable interface, if any. */
if (SUPER(role_name))
return 1;
/* Dispatch to the object's class */
return VTABLE_does(interp, VTABLE_get_class(interp, SELF), role_name);
}
/*
=item C<INTVAL does_pmc(PMC *role)>
Returns whether the object's class does C<*role>.
=cut
*/
VTABLE INTVAL does_pmc(PMC *role) {
if (PMC_IS_NULL(role))
return 0;
if (SUPER(role))
return 1;
/* Dispatch to the object's class */
return VTABLE_does_pmc(interp, VTABLE_get_class(interp, SELF), role);
}
/*
=item C<opcode_t *invoke(void *next)>
Invokes the object (if this vtable function is overridden).
=cut
*/
opcode_t * invoke(void *next) {
Parrot_Object_attributes * const obj = PARROT_OBJECT(pmc);
Parrot_Class_attributes * const _class = PARROT_CLASS(obj->_class);
/* Walk and search for the vtable method. */
const int num_classes = VTABLE_elements(interp, _class->all_parents);
int i;
for (i = 0; i < num_classes; i++) {
/* Get the class. */
STRING * const meth_name = CONST_STRING(interp, "invoke");
STRING * const proxy = CONST_STRING(interp, "proxy");
PMC * const cur_class =
VTABLE_get_pmc_keyed_int(interp, _class->all_parents, i);
PMC * const meth =
Parrot_oo_find_vtable_override_for_class(interp, cur_class,
meth_name);
if (!PMC_IS_NULL(meth))
return VTABLE_invoke(interp, meth, next);
if (cur_class->vtable->base_type == enum_class_PMCProxy) {
/* Get the PMC instance and call the vtable method on that. */
PMC * const del_object =
VTABLE_get_attr_keyed(interp, pmc, cur_class, proxy);
if (!PMC_IS_NULL(del_object))
return VTABLE_invoke(interp, del_object, next);
}
}
return (opcode_t *)interp->vtables[enum_class_default]->invoke(interp, pmc, next);
}
/*
=item C<INTVAL type()>
Returns the integer type of the object's class.
=cut
*/
VTABLE INTVAL type() {
PMC * const _class = VTABLE_get_class(interp, SELF);
return VTABLE_type(interp, _class);
}
/*
=item C<PMC * clone()>
Creates a clone of the object.
=cut
*/
VTABLE PMC * clone() {
Parrot_Object_attributes * const obj = PARROT_OBJECT(pmc);
/* If we have a custom override, invoke it.
* If not, use the oo function. */
STRING * const meth_name = CONST_STRING(interp, "clone");
PMC * const meth =
Parrot_oo_find_vtable_override(interp, obj->_class, meth_name);
if (!PMC_IS_NULL(meth))
return (PMC*)Parrot_run_meth_fromc_args(interp, meth, pmc, meth_name, "P");
else
return Parrot_oo_clone_object(interp, SELF, obj->_class, NULL);
}
/*
=item C<void visit(visit_info *info)>
This is used by freeze/thaw to visit the contents of the object.
C<*info> is the visit info, (see F<include/parrot/pmc_freeze.h>).
=cut
*/
VTABLE void visit(visit_info *info) {
Parrot_Object_attributes * const obj_data = PARROT_OBJECT(SELF);
PMC **pos;
/* 1) visit class */
pos = &obj_data->_class;
info->thaw_ptr = pos;
(info->visit_pmc_now)(INTERP, *pos, info);
/* 2) visit the attributes */
pos = &obj_data->attrib_store;
info->thaw_ptr = pos;
(info->visit_pmc_now)(INTERP, *pos, info);
}
/*
=item C<void thaw(visit_info *info)>
Used to unarchive the object.
=cut
*/
VTABLE void thaw(visit_info *info) {
if (info->extra_flags == EXTRA_IS_PROP_HASH) {
SUPER(info);
}
}
/*
=item C<void thawfinish(visit_info *info)>
Called after the object has been thawed.
=cut
*/
VTABLE void thawfinish(visit_info *info) {
/* Set custom GC mark and destroy on the object. */
PObj_custom_mark_SET(SELF);
PObj_custom_destroy_SET(SELF);
/* Flag that it is an object */
PObj_is_object_SET(SELF);
}
/*
=item C<PMC * share_ro()>
Used to mark a PMC as read-only shared.
=cut
*/
VTABLE PMC *share_ro() {
PMC *ret, *_true, *data;
INTVAL i, n;
PMC *classobj;
Parrot_Interp master;
INTVAL type_num;
if (PObj_is_PMC_shared_TEST(SELF))
return SELF;
master = interpreter_array[0];
classobj = VTABLE_get_class(INTERP, SELF);
type_num = SELF->vtable->base_type;
/* make sure metadata doesn't go away unexpectedly */
if (PMC_metadata(pmc))
PMC_metadata(pmc) = pt_shared_fixup(interp, PMC_metadata(pmc));
PARROT_ASSERT(master->vtables[type_num]->pmc_class);
/* don't want the referenced class disappearing on us */
LOCK_INTERPRETER(master);
SELF->vtable->pmc_class = master->vtables[type_num]->pmc_class;
UNLOCK_INTERPRETER(master);
ret = SELF;
_true = pmc_new(INTERP, enum_class_Integer);
/* Setting the '_ro' property switches to the read-only vtable */
VTABLE_set_integer_native(INTERP, _true, 1);
VTABLE_setprop(INTERP, ret, CONST_STRING(interp, "_ro"), _true);
SELF->vtable->pmc_class = master->vtables[type_num]->pmc_class;
Parrot_gc_add_pmc_sync(INTERP, ret);
PObj_is_PMC_shared_SET(ret);
data = PARROT_CLASS(classobj)->parents;
n = VTABLE_elements(INTERP, data);
for (i = 0; i < n; ++i) {
PMC * const cur_class = VTABLE_get_pmc_keyed_int(INTERP, data, i);
VTABLE_set_pmc_keyed_int(INTERP, data, i, VTABLE_share_ro(INTERP, cur_class));
}
/* XXX This is perhaps not the best way to fix this up, but we
* need to ensure that the class object won't go away when
* this interpreter dies.
*/
PARROT_ASSERT(ret->vtable->pmc_class);
PARROT_ASSERT(ret->vtable->share_ro == Parrot_Object_share_ro);
return ret;
}
/*
=item C<void morph(PMC* type)>
Changes the PMC to a PMC of a new type
=cut
*/
VTABLE void morph(PMC* type) {
PMC * const classobj = VTABLE_get_class(interp, SELF);
STRING * const meth_name = CONST_STRING(interp, "morph");
/* If there's a vtable override for 'morph' run that instead. */
PMC * const method = Parrot_oo_find_vtable_override(interp,
classobj, meth_name);
if (!PMC_IS_NULL(method))
Parrot_run_meth_fromc_args(interp, method, SELF, meth_name, "vP", type);
else
SUPER(type);
}
}
/*
=back
=head1 SEE ALSO
F<docs/pdds/pdd15_objects.pod>.
=cut
*/
/*
* Local variables:
* c-file-style: "parrot"
* End:
* vim: expandtab shiftwidth=4:
*/
Jump to Line
Something went wrong with that request. Please try again.