/*
Copyright (C) 2001-2003, The Perl Foundation.
$Id: parrotobject.pmc 16275 2006-12-28 01:20:44Z particle $

=head1 NAME

src/pmc/parrotobject.pmc - Parrot Object

=head1 DESCRIPTION

A Parrot Object is reasonably simple. Its data pointer points to an
array with the attributes of the object in it. The int cache value holds
the attribute count of this instance.

The object is actually constructed by the instantiation code in
F<src/objects.c>, at least for right now.

=head2 Methods

=over 4

=cut

*/

#include "parrot/parrot.h"
#include "pmc_deleg_pmc.h"

/* XXX duplicated from delegate.pmc */
static PMC *
find_meth(Interp* interp, PMC *pmc, STRING *meth) {
    PMC *class = pmc;

    if (PObj_is_object_TEST(pmc)) {
        class = GET_CLASS((Buffer *)PMC_data(pmc), pmc);
    }
    return Parrot_find_method_with_cache(interp, class, meth);
}

static PMC*
find_vtable_meth(Interp* interp, PMC *pmc, STRING *meth) {
    PMC *class = pmc;
    PMC *ns = NULL;
    PMC *mro;
    INTVAL i, n;

    /* Get class. */
    if (PObj_is_object_TEST(pmc)) {
        class = GET_CLASS((Buffer *)PMC_data(pmc), pmc);
    }

    /* Get MRO and iterate over it to find method. */
    mro = class->vtable->mro;
    n = VTABLE_elements(interp, mro);
    for (i = 0; i < n; ++i) {
        class = VTABLE_get_pmc_keyed_int(interp, mro, i);
        ns = VTABLE_namespace(interp, class);
        if (!PMC_IS_NULL(ns)) {
            /* Try and locate the vtable namespace and find the method. */
            STRING *vtable_ns_name = string_from_const_cstring(interp,
                "\0VTABLE\0", 8);
            PMC *vtable_ns = Parrot_get_namespace_keyed_str(interp, ns,
                vtable_ns_name);
            if (!PMC_IS_NULL(vtable_ns))
            {
                PMC *res = VTABLE_get_pmc_keyed_str(interp, vtable_ns,
                    meth);
                if (!PMC_IS_NULL(res))
                    return res;
            }
        }
    }

    /* If we get here, not found in the current class. */
    return NULL;
}

pmclass ParrotObject extends ParrotClass need_ext {

/*

=item C<void init()>

Raises an exception to make sure all users call C<new> on the registered
class PMC and not the ParrotObject itself.

During C<Parrot_class_register()> this C<init()> method gets replaced by
C<Parrot_instantiate_object()>.

=cut

*/

    void init() {
        real_exception(interp, NULL, E_NotImplementedError,
                "Can't create new ParrotObjects - "
            "use the registered class instead");
    }

/*

=item C<void destroy()>

Call the '__finalize' method if it exists and destruct the object.

XXX Finalization from within the C<destroy> method is of course
wrong. The finalization code could resurrect the object, by e.g.
storing it into some structure. But as destruction is also done in
this step, the stored object is unusable (in best case) or even
recycled to a new PMC. All access to such a zombie would be really
interesting.

TODO

  - create a tobe_finalized list in the GC
  - don't destroy these objects immediately
  - create a dedicated finalize vtable
  - run the finalization code after GC has finished
  - run all finalizers in MRO order
  - postpone destruction to the next GC cycle

=cut

*/

    void destroy() {
        PMC* class;
        PMC* meth, *ns;
        STRING* fin;

        /* XXX have a better way to check for dead objects or classes
         */
        if ((UINTVAL)SELF->vtable == 0xdeadbeef)
            return;
        class = SELF->vtable->class;
        if ((UINTVAL)class->vtable == 0xdeadbeef)
            return;
        if (PObj_get_FLAGS(SELF) & PObj_need_finalize_FLAG) {
            fin = CONST_STRING(INTERP, "__finalize");
            ns = VTABLE_namespace(interp, class);
            meth = VTABLE_get_pmc_keyed_str(interp, ns, fin);
            if (!PMC_IS_NULL(meth)) {
                /*
                   TODO
                   - catch exceptions
                   - run some safe mode
                   - run all finalizers in mro order?
                 */
                Parrot_runops_fromc_args_event(interp, meth, "vP", SELF);
            }
        }
        SUPER();
    }

/*

=item C<STRING *name()>

Shortcut for .class().name()

XXX - this is bad and should go

=cut

*/

    STRING* name() {
        PMC *class = VTABLE_get_class(INTERP, SELF);
        return VTABLE_name(INTERP, class);
    }


/*

=item C<PMC *find_method(STRING *name)>

Finds the method for C<*name>.

=item C<PMC* get_attr(INTVAL idx)>

Return attribute number C<idx>.

=item C<PMC* get_attr_str(STRING *name)>

Return attribute named C<name>.

=item C<void set_attr(INTVAL idx, PMC *val)>

Set attribute number C<idx>.

=item C<void set_attr_str(STRING *name, PMC *val)>

Set attribute named C<name>.

=item C<PMC *get_class()>

Return the class of this object.

=cut

*/

    PMC* find_method(STRING* name) {
        PMC *class = VTABLE_get_class(INTERP, SELF);
        return VTABLE_find_method(INTERP, class, name);
    }

    PMC* get_attr(INTVAL idx) {
        return Parrot_get_attrib_by_num(INTERP, SELF, idx);
    }

    PMC* get_attr_str(STRING* idx) {
        return Parrot_get_attrib_by_str(INTERP, SELF, idx);
    }

    void set_attr(INTVAL idx, PMC* value) {
        Parrot_set_attrib_by_num(INTERP, SELF, idx, value);
    }

    void set_attr_str(STRING* idx, PMC* value) {
        Parrot_set_attrib_by_str(INTERP, SELF, idx, value);
    }

    PMC* get_class() {
        if (!PObj_is_PMC_shared_TEST(SELF)) {
            return GET_CLASS(PMC_data(SELF), SELF);
        }
        else {
            /* get the class object for this interpreter */
            /* XXX this is rather a hack, it is, however, necessary:
             * otherwise we will be accessing the wrong interpreter's
             * namespace
             */
            int type_num = SELF->vtable->base_type;

            return INTERP->vtables[type_num]->class;
        }
    }

/*

=item C<INTVAL get_integer_keyed_int(INTVAL key)>

=item C<FLOATVAL get_number_keyed_int(INTVAL key)>

=item C<STRING *get_string_keyed_int(INTVAL key)>

=item C<PMC *get_pmc_keyed_int(INTVAL key)>

=item C<void set_integer_keyed_int(INTVAL key, INTVAL value)>

=item C<void set_number_keyed_int(INTVAL key, FLOATVAL value)>

=item C<void set_string_keyed_int(INTVAL key, STRING* value)>

=item C<void set_pmc_keyed_int(INTVAL key, PMC* value)>

=item C<void delete_keyed_int(INTVAL key)>

=item C<INTVAL defined_keyed_int(INTVAL key)>

=item C<INTVAL exists_keyed_int(INTVAL key)>

These methods have default implementations in F<src/pmc/default.pmc>
which redirect to PMC keys. Test if a specialized method exists, else
use fallback.

If the parent isa PMC, the fallback is the C<deleg_pmc> method, else
it's just SUPER aka the default implementation.

=cut

*/

    INTVAL get_integer_keyed_int(INTVAL key) {
        STRING *meth = CONST_STRING(interp, "__get_integer_keyed_int");
        STRING *meth_v = CONST_STRING(interp, "get_integer_keyed_int");
        PMC *sub = find_vtable_meth(interp, pmc, meth_v);
        if (PMC_IS_NULL(sub))
            sub = find_meth(interp, pmc, meth);
        if (sub) {
            return Parrot_run_meth_fromc_args_reti(interp, sub,
                                              pmc, meth, "II", key);
        }
        else {
            PMC *mro = SELF->vtable->mro;
            if (VTABLE_elements(INTERP, mro) == 1)
                return SUPER(key);
            else {
                PMC *parent = VTABLE_get_pmc_keyed_int(INTERP,SELF->vtable->mro, 1);
                if (PObj_is_class_TEST(parent))
                    return SUPER(key);
                else
                    return deleg_pmc.SUPER(key);
            }
        }
    }

    FLOATVAL get_number_keyed_int(INTVAL key) {
        STRING *meth = CONST_STRING(interp, "__get_number_keyed_int");
        STRING *meth_v = CONST_STRING(interp, "get_number_keyed_int");
        PMC *sub = find_vtable_meth(interp, pmc, meth_v);
        if (PMC_IS_NULL(sub))
            sub = find_meth(interp, pmc, meth);
        if (sub) {
            return Parrot_run_meth_fromc_args_retf(interp, sub,
                                              pmc, meth, "NI", key);
        }
        else {
            PMC *mro = SELF->vtable->mro;
            if (VTABLE_elements(INTERP, mro) == 1)
                return SUPER(key);
            else {
                PMC *parent = VTABLE_get_pmc_keyed_int(INTERP,SELF->vtable->mro, 1);
                if (PObj_is_class_TEST(parent))
                    return SUPER(key);
                else
                    return deleg_pmc.SUPER(key);
            }
        }
    }

    STRING* get_string_keyed_int(INTVAL key) {
        STRING *meth = CONST_STRING(interp, "__get_string_keyed_int");
        STRING *meth_v = CONST_STRING(interp, "get_string_keyed_int");
        PMC *sub = find_vtable_meth(interp, pmc, meth_v);
        if (PMC_IS_NULL(sub))
            sub = find_meth(interp, pmc, meth);
        if (sub) {
            return Parrot_run_meth_fromc_args(interp, sub,
                                              pmc, meth, "SI", key);
        }
        else {
            PMC *mro = SELF->vtable->mro;
            if (VTABLE_elements(INTERP, mro) == 1)
                return SUPER(key);
            else {
                PMC *parent = VTABLE_get_pmc_keyed_int(INTERP,SELF->vtable->mro, 1);
                if (PObj_is_class_TEST(parent))
                    return SUPER(key);
                else
                    return deleg_pmc.SUPER(key);
            }
        }
    }

    PMC* get_pmc_keyed_int(INTVAL key) {
        STRING *meth = CONST_STRING(interp, "__get_pmc_keyed_int");
        STRING *meth_v = CONST_STRING(interp, "get_pmc_keyed_int");
        PMC *sub = find_vtable_meth(interp, pmc, meth_v);
        if (PMC_IS_NULL(sub))
            sub = find_meth(interp, pmc, meth);
        if (sub) {
            return Parrot_run_meth_fromc_args(interp, sub,
                                              pmc, meth, "PI", key);
        }
        else {
            PMC *mro = SELF->vtable->mro;
            if (VTABLE_elements(INTERP, mro) == 1)
                return SUPER(key);
            else {
                PMC *parent = VTABLE_get_pmc_keyed_int(INTERP,SELF->vtable->mro, 1);
                if (PObj_is_class_TEST(parent))
                    return SUPER(key);
                else
                    return deleg_pmc.SUPER(key);
            }
        }
    }

    void set_integer_keyed_int(INTVAL key, INTVAL value) {
        STRING *meth = CONST_STRING(interp, "__set_integer_keyed_int");
        STRING *meth_v = CONST_STRING(interp, "set_integer_keyed_int");
        PMC *sub = find_vtable_meth(interp, pmc, meth_v);
        if (PMC_IS_NULL(sub))
            sub = find_meth(interp, pmc, meth);
        if (sub) {
            (void) Parrot_run_meth_fromc_args(interp, sub,
                    pmc, meth, "vII", key, value);
        }
        else {
            PMC *mro = SELF->vtable->mro;
            if (VTABLE_elements(INTERP, mro) == 1)
                SUPER(key, value);
            else {
                PMC *parent = VTABLE_get_pmc_keyed_int(INTERP,SELF->vtable->mro, 1);
                if (PObj_is_class_TEST(parent))
                    SUPER(key, value);
                else
                    deleg_pmc.SUPER(key, value);
            }
        }
    }

    void set_number_keyed_int(INTVAL key, FLOATVAL value) {
        STRING *meth = CONST_STRING(interp, "__set_number_keyed_int");
        STRING *meth_v = CONST_STRING(interp, "set_number_keyed_int");
        PMC *sub = find_vtable_meth(interp, pmc, meth_v);
        if (PMC_IS_NULL(sub))
            sub = find_meth(interp, pmc, meth);
        if (sub) {
            (void) Parrot_run_meth_fromc_args(interp, sub,
                                              pmc, meth, "vIN", key, value);
        }
        else {
            PMC *mro = SELF->vtable->mro;
            if (VTABLE_elements(INTERP, mro) == 1)
                SUPER(key, value);
            else {
                PMC *parent = VTABLE_get_pmc_keyed_int(INTERP,SELF->vtable->mro, 1);
                if (PObj_is_class_TEST(parent))
                    SUPER(key, value);
                else
                    deleg_pmc.SUPER(key, value);
            }
        }
    }

    void set_string_keyed_int(INTVAL key, STRING* value) {
        STRING *meth = CONST_STRING(interp, "__set_string_keyed_int");
        STRING *meth_v = CONST_STRING(interp, "set_string_keyed_int");
        PMC *sub = find_vtable_meth(interp, pmc, meth_v);
        if (PMC_IS_NULL(sub))
            sub = find_meth(interp, pmc, meth);
        if (sub) {
            (void) Parrot_run_meth_fromc_args(interp, sub,
                                              pmc, meth, "vIS", key, value);
        }
        else {
            PMC *mro = SELF->vtable->mro;
            if (VTABLE_elements(INTERP, mro) == 1)
                SUPER(key, value);
            else {
                PMC *parent = VTABLE_get_pmc_keyed_int(INTERP,SELF->vtable->mro, 1);
                if (PObj_is_class_TEST(parent))
                    SUPER(key, value);
                else
                    deleg_pmc.SUPER(key, value);
            }
        }
    }

    void set_pmc_keyed_int(INTVAL key, PMC* value) {
        STRING *meth = CONST_STRING(interp, "__set_pmc_keyed_int");
        STRING *meth_v = CONST_STRING(interp, "set_pmc_keyed_int");
        PMC *sub = find_vtable_meth(interp, pmc, meth_v);
        if (PMC_IS_NULL(sub))
            sub = find_meth(interp, pmc, meth);
        if (sub) {
            (void) Parrot_run_meth_fromc_args(interp, sub,
                                              pmc, meth, "vIP", key, value);
        }
        else {
            PMC *mro = SELF->vtable->mro;
            if (VTABLE_elements(INTERP, mro) == 1)
                SUPER(key, value);
            else {
                PMC *parent = VTABLE_get_pmc_keyed_int(INTERP,SELF->vtable->mro, 1);
                if (PObj_is_class_TEST(parent))
                    SUPER(key, value);
                else
                    deleg_pmc.SUPER(key, value);
            }
        }
    }

    void delete_keyed_int(INTVAL key) {
        STRING *meth = CONST_STRING(interp, "__delete_keyed_int");
        STRING *meth_v = CONST_STRING(interp, "delete_keyed_int");
        PMC *sub = find_vtable_meth(interp, pmc, meth_v);
        if (PMC_IS_NULL(sub))
            sub = find_meth(interp, pmc, meth);
        if (sub) {
            (void) Parrot_run_meth_fromc_args(interp, sub,
                                              pmc, meth, "vI", key);
        }
        else {
            PMC *mro = SELF->vtable->mro;
            if (VTABLE_elements(INTERP, mro) == 1)
                SUPER(key);
            else {
                PMC *parent = VTABLE_get_pmc_keyed_int(INTERP,SELF->vtable->mro, 1);
                if (PObj_is_class_TEST(parent))
                    SUPER(key);
                else
                    deleg_pmc.SUPER(key);
            }
        }
    }

    INTVAL defined_keyed_int(INTVAL key) {
        STRING *meth = CONST_STRING(interp, "__defined_keyed_int");
        STRING *meth_v = CONST_STRING(interp, "defined_keyed_int");
        PMC *sub = find_vtable_meth(interp, pmc, meth_v);
        if (PMC_IS_NULL(sub))
            sub = find_meth(interp, pmc, meth);
        if (sub) {
            return Parrot_run_meth_fromc_args_reti(interp, sub,
                                              pmc, meth, "II", key);
        }
        else {
            PMC *mro = SELF->vtable->mro;
            if (VTABLE_elements(INTERP, mro) == 1)
                return SUPER(key);
            else {
                PMC *parent = VTABLE_get_pmc_keyed_int(INTERP,SELF->vtable->mro, 1);
                if (PObj_is_class_TEST(parent))
                    return SUPER(key);
                else
                    return deleg_pmc.SUPER(key);
            }
        }
    }

    INTVAL exists_keyed_int(INTVAL key) {
        STRING *meth = CONST_STRING(interp, "__exists_keyed_int");
        STRING *meth_v = CONST_STRING(interp, "exists_keyed_int");
        PMC *sub = find_vtable_meth(interp, pmc, meth_v);
        if (PMC_IS_NULL(sub))
            sub = find_meth(interp, pmc, meth);
        if (sub) {
            return Parrot_run_meth_fromc_args_reti(interp, sub,
                                              pmc, meth, "II", key);
        }
        else {
            PMC *mro = SELF->vtable->mro;
            if (VTABLE_elements(INTERP, mro) == 1)
                return SUPER(key);
            else {
                PMC *parent = VTABLE_get_pmc_keyed_int(INTERP,SELF->vtable->mro, 1);
                if (PObj_is_class_TEST(parent))
                    return SUPER(key);
                else
                    return deleg_pmc.SUPER(key);
            }
        }
    }

    PMC* share_ro() {
        PMC *ret;
        PMC *true;
        PMC **data;
        INTVAL i, n;

        if (PObj_is_PMC_shared_TEST(SELF))
            return SELF;

        ret = pt_shared_fixup(INTERP, SELF);
        true = pmc_new(INTERP, enum_class_Integer);
        VTABLE_set_integer_native(INTERP, true, 1);
        VTABLE_setprop(INTERP, ret, CONST_STRING(interp, "_ro"), true);
        PObj_is_PMC_shared_SET(SELF);

        n = PMC_int_val(ret);

        data = (PMC **) PMC_data(ret);

        for (i = 0; i < n; ++i)
            data[i] = VTABLE_share_ro(INTERP, data[i]);

        /* 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.
         */
        {
            PMC *new_class;
            new_class = ret->vtable->class;
            assert(new_class);
            assert(ret->vtable->share_ro == Parrot_ParrotObject_share_ro);
            SET_CLASS((SLOTTYPE *) PMC_data(ret), ret, new_class);
        }
        return ret;
    }

/*

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

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

Used to archive the object.

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

Used to unarchive the object.

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

=cut

*/

    void visit(visit_info *info) {
        PMC **class_data, **pos;
        INTVAL i, n;

        class_data = (PMC **)PMC_data(SELF);

        /* 1) visit class */
        pos = &SELF->vtable->class;
        info->thaw_ptr = pos;
        (info->visit_pmc_now)(INTERP, *pos, info);

        /* 2) visit the attributes */
        n = PMC_int_val(SELF);
        for (i = 0; i < n; ++i) {
            info->thaw_ptr = class_data + i;
            (info->visit_pmc_now)(INTERP, class_data[i], info);
        }
    }
    void freeze(visit_info *info) {
        IMAGE_IO *io = info->image_io;
        io->vtable->push_integer(INTERP, io, PMC_int_val(SELF));
    }

    void thaw(visit_info *info) {
        IMAGE_IO *io = info->image_io;
        if (info->extra_flags == EXTRA_IS_PROP_HASH) {
            SUPER(info);
        }
        else if (info->extra_flags == EXTRA_IS_NULL) {
            INTVAL n = io->vtable->shift_integer(INTERP, io);
            set_attrib_array_size(SELF, n);
        }
    }

    void thawfinish(visit_info *info) {
        PMC *class = SELF->vtable->class;
        PMC *vtable_pmc = get_attrib_num((SLOTTYPE *)PMC_data(class),
                PCD_OBJECT_VTABLE);
        SELF->vtable = PMC_struct_val(vtable_pmc);
        set_attrib_flags(SELF);
        PObj_is_object_SET(SELF);
    }
}

/*

=back

=cut

*/

/*
 * Local variables:
 *   c-file-style: "parrot"
 * End:
 * vim: expandtab shiftwidth=4:
 */
