/*
Copyright (C) 2001-2008, The Perl Foundation.
$Id: /mirror/trunk/src/pmc/object.pmc 35849 2009-01-20T16:45:43.388528Z Whiteknight  $

=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/parrot.h"
#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);
    INTVAL                          cur_hll = CONTEXT(interp)->current_HLL;
    int                             num_classes, i;

    CONTEXT(interp)->current_HLL = 0;

    /* First see if we can find it in the cache. */
    if (VTABLE_exists_keyed_str(interp, _class->attrib_cache, name)) {
        INTVAL retval =
            VTABLE_get_integer_keyed_str(interp, _class->attrib_cache, name);
        CONTEXT(interp)->current_HLL = 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         = string_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);

            CONTEXT(interp)->current_HLL = cur_hll;
            return index;
        }
    }

    CONTEXT(interp)->current_HLL = 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      = string_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 need_ext {
    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()>

Free the object's underlying struct.

=cut

*/
    VTABLE void destroy() {
        mem_sys_free(PMC_data(SELF));
    }

/*

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

            if (obj->_class)
                pobject_lives(interp, (PObj*)obj->_class);
            if (obj->attrib_store)
                pobject_lives(interp, (PObj*)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        *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);
        PMC           *method        = PMCNULL;
        STRING        *find_method   = CONST_STRING(interp, "find_method");

        /* 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       alien_parents_pos  = VTABLE_elements(interp,
                                                      _class->attrib_metadata);
        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);

            /* 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"))) {
                const Parrot_Class_attributes * const class_info = PARROT_CLASS(cur_class);
                if (VTABLE_exists_keyed_str(interp, class_info->methods, name)) {
                    /* Found it! */
                    method = VTABLE_get_pmc_keyed_str(interp, class_info->methods, name);
                    break;
                }
            }
            else {
                /* Delegate the lookup to the class. */
                PMC * const del_class = VTABLE_get_pmc_keyed_int(interp, obj->attrib_store,
                    alien_parents_pos);
                method = VTABLE_find_method(interp, del_class, name);

                if (!PMC_IS_NULL(method)) {
                    /* Found it. However, if we just hand this back and it's
                     * an NCI and we call it, we will get the wrong invocant
                     * passed. Therefore, we need to close the NCI and make it
                     * into a BoundNCI. */
                    if (method->vtable->base_type == enum_class_NCI) {
                        method         = VTABLE_clone(interp, method);
                        method->vtable = interp->vtables[enum_class_Bound_NCI];
                        VTABLE_set_pmc(interp, method, del_class);
                    }

                    /* Found a method, so we're done. */
                    break;
                }

                alien_parents_pos++;
            }
        }

        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 (INTVAL)Parrot_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 *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 *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 * 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 *meth_name     = CONST_STRING(interp, "invoke");
            STRING *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 *)Parrot_default_invoke(interp, pmc, next);
    }

/*

=item C<INTVAL type()>

Returns the integer type of the object's class.

=cut

*/

    VTABLE INTVAL type() {
        PMC *_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);
        Parrot_Class_attributes  * const _class    = PARROT_CLASS(obj->_class);
        STRING        * const meth_name = CONST_STRING(interp, "clone");
        PMC           * cloned;
        Parrot_Object_attributes * cloned_guts;

        /* See if we have a custom override of the method first. */
        const int num_classes = VTABLE_elements(interp, _class->all_parents);
        int i, num_attrs;
        for (i = 0; i < num_classes; i++) {
            /* Get the class. */
            PMC * const cur_class = VTABLE_get_pmc_keyed_int(interp, _class->all_parents, i);

            /* Look for a method and run it if we find one. */
            PMC * const meth =
                Parrot_oo_find_vtable_override_for_class(interp, cur_class, meth_name);
            if (!PMC_IS_NULL(meth))
                return (PMC*)Parrot_run_meth_fromc_args(interp, meth, pmc, meth_name, "P");
        }

        /* If we get here, no custom clone. Create a new object PMC. */
        cloned = pmc_new_noinit(interp, enum_class_Object);

        /* Set custom DOD mark and destroy on the object. */
        PObj_custom_mark_SET(cloned);
        PObj_active_destroy_SET(cloned);

        /* Flag that it is an object */
        PObj_is_object_SET(cloned);

        /* Now create the underlying structure, and clone attributes list.class. */
        cloned_guts               = mem_allocate_zeroed_typed(Parrot_Object_attributes);
        cloned_guts->_class       = obj->_class;
        cloned_guts->attrib_store = VTABLE_clone(INTERP, obj->attrib_store);
        PMC_data(cloned)          = cloned_guts;
        num_attrs                 = VTABLE_elements(INTERP, cloned_guts->attrib_store);
        for (i = 0; i < num_attrs; i++) {
            PMC *to_clone = VTABLE_get_pmc_keyed_int(INTERP, cloned_guts->attrib_store, i);
            if (!PMC_IS_NULL(to_clone)) {
                VTABLE_set_pmc_keyed_int(INTERP, cloned_guts->attrib_store, i,
                        VTABLE_clone(INTERP, to_clone));
            }
        }

        /* Some of the attributes may have been the PMCs providing storage for any
         * PMCs we inherited from; also need to clone those. */
        if (CLASS_has_alien_parents_TEST(obj->_class)) {
            /* Locate any PMC parents. */
            for (i = 0; i < num_classes; i++) {
                PMC * const cur_class = VTABLE_get_pmc_keyed_int(interp, _class->all_parents, i);
                if (cur_class->vtable->base_type == enum_class_PMCProxy) {
                    /* Clone this PMC too. */
                    STRING *proxy         = CONST_STRING(interp, "proxy");
                    VTABLE_set_attr_keyed(interp, cloned, cur_class, proxy,
                        VTABLE_clone(interp,
                            VTABLE_get_attr_keyed(interp, cloned, cur_class, proxy)));
                }
            }
        }

        /* And we have ourselves a clone. */
        return cloned;
    }

/*

=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);
        }
        else if (info->extra_flags == EXTRA_IS_NULL) {
            /* Allocate the object's core data struct */
            PMC_data(SELF) = mem_allocate_zeroed_typed(Parrot_Object_attributes);
        }
    }

/*

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

Called after the object has been thawed.

=cut

*/

    void thawfinish(visit_info *info) {
        /* Set custom DOD mark and destroy on the object. */
        PObj_custom_mark_SET(SELF);
        PObj_active_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;
        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 * 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(INTVAL type)>

Changes the PMC to a PMC of a new type

=cut

*/

    VTABLE void morph(INTVAL type) {
        PMC    * const classobj = VTABLE_get_class(interp, SELF);
        STRING * 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)) {
            PMC * const _class = Parrot_oo_get_class_str(interp, interp->vtables[type]->whoami);
            Parrot_run_meth_fromc_args(interp, method, SELF, meth_name, "vP", _class);
        }
        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:
 */
