Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Branch: master
Fetching contributors…

Cannot retrieve contributors at this time

1012 lines (703 sloc) 27.177 kB
/*
Copyright (C) 2001-2014, Parrot Foundation.
=head1 NAME
src/pmc/object.pmc - Object PMC
=head1 DESCRIPTION
Implements an instance of a class.
TODO: If a vtable override exists, calls the found method via the slow
Parrot_ext_call, which creates a new interp, task and calls a new runloop.
=head2 Functions
=over 4
=cut
*/
#include "parrot/oo_private.h"
#include "pmc/pmc_class.h"
#include "pmc/pmc_sub.h"
/* HEADERIZER HFILE: none */
/* HEADERIZER BEGIN: static */
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
static void cache_method(PARROT_INTERP,
ARGIN(PMC *_class),
ARGIN(STRING *name),
ARGIN(PMC *method))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
__attribute__nonnull__(3)
__attribute__nonnull__(4);
PARROT_CAN_RETURN_NULL
PARROT_WARN_UNUSED_RESULT
static PMC* clone_key_arg(PARROT_INTERP, ARGIN(PMC *key))
__attribute__nonnull__(1)
__attribute__nonnull__(2);
PARROT_WARN_UNUSED_RESULT
PARROT_CAN_RETURN_NULL
static PMC * find_cached(PARROT_INTERP,
ARGIN(PMC *_class),
ARGIN(STRING *name))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
__attribute__nonnull__(3);
PARROT_WARN_UNUSED_RESULT
static INTVAL get_attrib_index(PARROT_INTERP,
ARGIN(PMC *self),
ARGIN(STRING *name))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
__attribute__nonnull__(3);
PARROT_WARN_UNUSED_RESULT
static INTVAL get_attrib_index_keyed(PARROT_INTERP,
ARGIN(PMC *self),
ARGIN(PMC *key),
ARGIN(STRING *name))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
__attribute__nonnull__(3)
__attribute__nonnull__(4);
#define ASSERT_ARGS_cache_method __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp) \
, PARROT_ASSERT_ARG(_class) \
, PARROT_ASSERT_ARG(name) \
, PARROT_ASSERT_ARG(method))
#define ASSERT_ARGS_clone_key_arg __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp) \
, PARROT_ASSERT_ARG(key))
#define ASSERT_ARGS_find_cached __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp) \
, PARROT_ASSERT_ARG(_class) \
, PARROT_ASSERT_ARG(name))
#define ASSERT_ARGS_get_attrib_index __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp) \
, PARROT_ASSERT_ARG(self) \
, PARROT_ASSERT_ARG(name))
#define ASSERT_ARGS_get_attrib_index_keyed __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp) \
, PARROT_ASSERT_ARG(self) \
, PARROT_ASSERT_ARG(key) \
, PARROT_ASSERT_ARG(name))
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
/* HEADERIZER END: static */
/*
=item C<static INTVAL get_attrib_index(PARROT_INTERP, PMC *self, STRING *name)>
Find the index of an attribute in an object's attribute store and return it.
Return -1 if the attribute does not exist.
=cut
*/
PARROT_WARN_UNUSED_RESULT
static INTVAL
get_attrib_index(PARROT_INTERP, ARGIN(PMC *self), ARGIN(STRING *name))
{
ASSERT_ARGS(get_attrib_index)
Parrot_Class_attributes * const _class = PARROT_CLASS(self);
const INTVAL cur_hll = Parrot_pcc_get_HLL(interp, CURRENT_CONTEXT(interp));
INTVAL index = -1;
int num_classes, i;
/* First see if we can find it in the cache. */
const INTVAL 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))
return retval;
/* No hit. We need to walk up the list of parents to try and find the
* attribute. */
Parrot_pcc_set_HLL(interp, CURRENT_CONTEXT(interp), 0);
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_concat(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. */
index = VTABLE_get_integer_keyed_str(interp,
_class->attrib_index, fq_name);
VTABLE_set_integer_keyed_str(interp, _class->attrib_cache, name,
index);
break;
}
}
Parrot_pcc_set_HLL(interp, CURRENT_CONTEXT(interp), cur_hll);
return index;
}
/*
=item C<static INTVAL get_attrib_index_keyed(PARROT_INTERP, PMC *self, PMC *key,
STRING *name)>
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 C<-1> if the attribute does not exist.
=cut
*/
PARROT_WARN_UNUSED_RESULT
static INTVAL
get_attrib_index_keyed(PARROT_INTERP, ARGIN(PMC *self), ARGIN(PMC *key), ARGIN(STRING *name))
{
ASSERT_ARGS(get_attrib_index_keyed)
Parrot_Class_attributes * const _class = PARROT_CLASS(self);
/* Build a string representing the fully qualified attribute name. */
PMC * const parent_class = Parrot_oo_get_class(interp, key);
STRING * const fq_name = Parrot_str_concat(interp,
VTABLE_get_string(interp, parent_class), name);
/* Look up. */
if (VTABLE_exists_keyed_str(interp, _class->attrib_index, fq_name))
return VTABLE_get_integer_keyed_str(interp,
_class->attrib_index, fq_name);
return -1;
}
/*
=item C<static PMC * find_cached(PARROT_INTERP, PMC *_class, STRING *name)>
Search for a method in a class' method cache, if available. If no cache is
available, return PMCNULL.
=cut
*/
PARROT_WARN_UNUSED_RESULT
PARROT_CAN_RETURN_NULL
static PMC *
find_cached(PARROT_INTERP, ARGIN(PMC *_class), ARGIN(STRING *name))
{
ASSERT_ARGS(find_cached)
PMC *cache;
GETATTR_Class_meth_cache(interp, _class, cache);
if (PMC_IS_NULL(cache))
return PMCNULL;
return VTABLE_get_pmc_keyed_str(interp, cache, name);
}
/*
=item C<static void cache_method(PARROT_INTERP, PMC *_class, STRING *name, PMC
*method)>
Add a method to a class' method cache. If no method cache exists, create one.
=cut
*/
static void
cache_method(PARROT_INTERP, ARGIN(PMC *_class), ARGIN(STRING *name),
ARGIN(PMC *method))
{
ASSERT_ARGS(cache_method)
PMC *cache;
GETATTR_Class_meth_cache(interp, _class, cache);
if (PMC_IS_NULL(cache)) {
cache = Parrot_pmc_new(interp, enum_class_Hash);
PARROT_GC_WRITE_BARRIER(interp, _class);
SETATTR_Class_meth_cache(interp, _class, cache);
}
VTABLE_set_pmc_keyed_str(interp, cache, name, method);
}
/*
=item C<static PMC* clone_key_arg(PARROT_INTERP, PMC *key)>
Replaces any src registers by their values. Used for C<*_keyed> overrides.
=cut
*/
PARROT_CAN_RETURN_NULL
PARROT_WARN_UNUSED_RESULT
static PMC*
clone_key_arg(PARROT_INTERP, ARGIN(PMC *key))
{
ASSERT_ARGS(clone_key_arg)
PMC *t;
if (PMC_IS_NULL(key))
return key;
if (key->vtable->base_type != enum_class_Key)
return key;
for (t = key; !PMC_IS_NULL(t); t=Parrot_key_next(interp, t)) {
/* register keys have to be cloned */
if (PObj_get_FLAGS(key) & KEY_register_FLAG) {
return VTABLE_clone(interp, key);
}
}
return key;
}
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() :no_wb {
UNUSED(SELF)
Parrot_ex_throw_from_c_noargs(INTERP, 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 *from) :no_wb {
UNUSED(SELF)
UNUSED(from)
Parrot_ex_throw_from_c_noargs(INTERP, 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() :no_wb {
UNUSED(INTERP)
UNUSED(SELF)
}
/*
=item C<STRING *name()>
Returns the fully qualified name of the object's class.
=cut
*/
VTABLE STRING *name() :no_wb {
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)) {
STRING *result = NULL;
Parrot_ext_call(INTERP, method, "Pi->S", SELF, &result);
return result;
}
else
return VTABLE_get_string(INTERP, _class);
}
/*
=item C<void mark()>
Mark any referenced strings and PMCs.
=cut
*/
VTABLE void mark() :no_wb {
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) :no_wb {
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,
obj->_class, get_attr);
if (!PMC_IS_NULL(method)) {
PMC *result = PMCNULL;
Parrot_ext_call(INTERP, method, "PiS->P", SELF, name, &result);
return result;
}
/* 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) :no_wb {
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,
obj->_class, vtable_meth_name);
if (!PMC_IS_NULL(method)) {
Parrot_ext_call(INTERP, method, "PiSP->", SELF, name, value);
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) :no_wb {
Parrot_Object_attributes * const obj = PARROT_OBJECT(SELF);
Parrot_Class_attributes * const _class = PARROT_CLASS(obj->_class);
PMC *method =
find_cached(INTERP, obj->_class, name);
if (!PMC_IS_NULL(method))
return method;
else {
STRING * const find_method = CONST_STRING(INTERP, "find_method");
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)) {
PMC *result = PMCNULL;
Parrot_ext_call(INTERP, method, "PiS->P", SELF, name, &result);
/* break out to the CACHE IF FOUND code */
method = result;
break;
}
/* 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, EXCEPTION_NO_CLASS,
"Class %Ss inherits from alien parents",
class_info->name);
}
if (!PMC_IS_NULL(method))
cache_method(INTERP, obj->_class, name, method);
return method;
}
}
/*
=item C<INTVAL get_integer()>
Invoke the PIR-defined vtable override, or call the default get_integer.
=cut
*/
VTABLE INTVAL get_integer() :no_wb {
Parrot_Object_attributes * const obj = PARROT_OBJECT(SELF);
Parrot_Class_attributes * const _class = PARROT_CLASS(obj->_class);
STRING * const meth_name = CONST_STRING(INTERP, "get_integer");
/* Walk and search for the vtable. */
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_ext_call(INTERP, meth, "Pi->I", SELF, &result);
return result;
}
if (cur_class->vtable->base_type == enum_class_PMCProxy) {
/* Get the PMC instance and call the vtable function on that. */
STRING * const proxy = CONST_STRING(INTERP, "proxy");
PMC * const del_object =
VTABLE_get_attr_str(INTERP, SELF, proxy);
if (!PMC_IS_NULL(del_object))
return (INTVAL)VTABLE_get_integer(INTERP, del_object);
}
}
return INTERP->vtables[enum_class_default]->get_integer(INTERP, SELF);
}
/*
=item C<PMC *get_class()>
Get the class PMC representing the class that this object is an instance of.
=cut
*/
VTABLE PMC *get_class() :no_wb {
UNUSED(INTERP)
return PARROT_OBJECT(SELF)->_class;
}
/*
=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() :no_wb {
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)) {
PMC *result;
Parrot_ext_call(INTERP, method, "Pi->P", SELF, &result);
return result;
}
return VTABLE_inspect_str(INTERP, classobj, CONST_STRING(INTERP, "namespace"));
}
/*
=item C<INTVAL isa_pmc(PMC *lookup)>
Returns whether the object's class is or inherits from C<lookup>.
=cut
*/
VTABLE INTVAL isa_pmc(PMC *lookup) :no_wb {
PMC * method = PMCNULL;
if (PMC_IS_NULL(lookup))
return 0;
else {
PMC * const classobj = VTABLE_get_class(INTERP, SELF);
STRING * const vtable_meth_name = CONST_STRING(INTERP, "isa_pmc");
method = Parrot_oo_find_vtable_override(INTERP, classobj,
vtable_meth_name);
}
if (!PMC_IS_NULL(method)) {
INTVAL result = 0;
Parrot_ext_call(INTERP, method, "PiP->I", SELF, lookup, &result);
return result;
}
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) :no_wb {
PMC * const classobj = VTABLE_get_class(INTERP, SELF);
STRING * const vtable_meth_name = CONST_STRING(INTERP, "isa");
PMC * const method = Parrot_oo_find_vtable_override(INTERP, classobj,
vtable_meth_name);
if (!PMC_IS_NULL(method)) {
INTVAL result = 0;
Parrot_ext_call(INTERP, method, "PiS->I", SELF, classname, &result);
return result;
}
else if (SELF->vtable->whoami == classname
|| STRING_equal(INTERP, SELF->vtable->whoami, classname))
return 1;
else
return VTABLE_isa(INTERP, classobj, 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) :no_wb {
/* 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)) {
INTVAL result;
Parrot_ext_call(INTERP, method, "PiS->I", SELF, role_name, &result);
if (result)
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) :no_wb {
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) :no_wb {
Parrot_Object_attributes * const obj = PARROT_OBJECT(SELF);
Parrot_Class_attributes * const _class = PARROT_CLASS(obj->_class);
/* Walk and search for the vtable. */
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)) {
/* Experimental code. See api.yaml */
PMC * const call_sig =
Parrot_pcc_get_signature(INTERP, CURRENT_CONTEXT(INTERP));
/* Always called as :method, even if only :vtable. GH #1013 */
VTABLE_unshift_pmc(INTERP, call_sig, SELF);
return VTABLE_invoke(INTERP, meth, next);
}
if (cur_class->vtable->base_type == enum_class_PMCProxy) {
/* Get the PMC instance and call the vtable function on that. */
PMC * const del_object =
VTABLE_get_attr_keyed(INTERP, SELF, 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, SELF, next);
}
/*
=item C<INTVAL type()>
Returns the integer type of the object's class.
=cut
*/
VTABLE INTVAL type() :no_wb {
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() :no_wb {
Parrot_Object_attributes * const obj = PARROT_OBJECT(SELF);
/* 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)) {
PMC *result;
Parrot_ext_call(INTERP, meth, "Pi->P", SELF, &result);
return result;
}
return Parrot_oo_clone_object(INTERP, SELF, NULL);
}
/*
=item C<void visit(PMC *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(PMC *info) :no_wb {
Parrot_Object_attributes * const obj_data = PARROT_OBJECT(SELF);
/* 1) visit class */
VISIT_PMC(INTERP, info, obj_data->_class);
/* 2) visit the attributes */
VISIT_PMC(INTERP, info, obj_data->attrib_store);
}
/*
=item C<void freeze(PMC *info)>
=item C<void thaw(PMC *info)>
Realias magically generated methods so they don't wreak havoc.
The C<info> arguments are ignored.
=cut
*/
VTABLE void freeze(PMC *info) :no_wb {
UNUSED(INTERP)
UNUSED(SELF)
UNUSED(info)
}
VTABLE void thaw(PMC *info) :no_wb {
UNUSED(INTERP)
UNUSED(SELF)
UNUSED(info)
}
/*
=item C<void thawfinish(PMC *info)>
Called after the object has been thawed.
=cut
*/
VTABLE void thawfinish(PMC *info) {
UNUSED(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<void morph(PMC* type)>
Changes the PMC to a PMC of a new type
=cut
*/
VTABLE void morph(PMC* type) :manual_wb {
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_ext_call(INTERP, method, "PiP->", SELF, type);
PARROT_GC_WRITE_BARRIER(INTERP, SELF);
}
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 cinoptions='\:2=2' :
*/
Jump to Line
Something went wrong with that request. Please try again.