object.pmc

/*
Copyright (C) 2001-2011, Parrot Foundation.

=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/pmc_class.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_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_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 */

/* This finds the index of an attribute in an object's attribute store and
 * returns it. Returns -1 if the attribute does not exist. */

/*

=item C<static INTVAL get_attrib_index(PARROT_INTERP, PMC *self, STRING *name)>

=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));
    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_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. */
            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;
}

/*

=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);
    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_concat(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;
}

/*

=item C<static PMC * find_cached(PARROT_INTERP, PMC *_class, STRING *name)>

=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)>

=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);
}

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)) {
            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() {
        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,
                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) {
        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) {
        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, -1,
                        "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() {
        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() {
        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() {
        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 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) {
        PMC * const m = VTABLE_find_method(INTERP, SELF, method_name);
        return !PMC_IS_NULL(m);
    }


/*

=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) {
        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) {
        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) {
        /* 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) {
        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(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));

                if ((VTABLE_elements(INTERP, call_sig) == 0
                ||   VTABLE_get_pmc_keyed_int(INTERP, call_sig, 0) != SELF))
                    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() {
        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(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) {
        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.

=cut

*/

    VTABLE void freeze(PMC *info) {
    }

    VTABLE void thaw(PMC *info) {
    }


/*

=item C<void thawfinish(PMC *info)>

Called after the object has been thawed.

=cut

*/

    VTABLE void thawfinish(PMC *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) {
        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);
        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' :
 */