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

=head1 NAME

src/pmc/parrotclass.pmc - Parrot Class

=head1 DESCRIPTION

The structure of a parrot class is reasonably straightforward. The PMC's
cached integer value is the number of attribute slots that an object of
this type requires. The data pointer holds a pointer to an array of
PMCs. That array has:

=over 4

=item PCD_PARENTS

An array of immediate parents.

=item PCD_CLASS_NAME

The class name PMC.

=item PCD_ATTRIBUTES

A hash, the keys are the classname/attrib name pair (separated by a
C<NULL>), while the value is the offset to the attribute.

=item PCD_CLASS_ATTRIBUTES

Array of attribute of this class.

=item PCD_OBJECT_VTABLE

Vtable PMC that holds the vtable for objects of this class.

=back

=head2 Methods

=over 4

=cut

*/

#include "parrot/parrot.h"

pmclass ParrotClass extends delegate need_ext {

/*

=item C<void init()>

Initializes the class flags.

=item C<void init_pmc(PMC *init)>

The actual class creation code, called from C<newclass> opcode. The C<init>
argument is not a PMC* but the C<classname> STRING.

=cut

*/

    void init() {
        /* No attributes to start with */
        PMC_int_val(SELF) = CLASS_ATTRIB_COUNT(SELF) = 0;
        /* But we are a class, really */
        PObj_is_class_SET(SELF);
        /* turn on marking of the class_data array */
        PObj_data_is_PMC_array_SET(SELF);
        /* turn on custom destruction since our PMC* array is
           dynamically allocated */
        PObj_active_destroy_SET(SELF);
    }

    void init_pmc(PMC* name) {
        SELF.init();
        Parrot_new_class(INTERP, SELF, name);
    }

/*

=item C<void destroy()>

Free the class's attribute array, if any. Also used by ParrotObjects.

=cut

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

/*

=item C<INTVAL isa(STRING *classname)>

Returns whether the class is or inherits from C<*classname>.

=cut

*/

    INTVAL isa(STRING* classname) {
        PMC *class;
        if (SUPER(classname))
            return 1;
        class = Parrot_class_lookup(INTERP, classname);
        return Parrot_object_isa(INTERP, SELF, class);
    }


/*

=item C<PMC *get_class()>

Return SELF.

=item C<STRING* name()>

Return the classname.

=cut

*/

    PMC* get_class() {
        return SELF;
    }

    STRING* name() {
        PMC **class_data, *name;
        class_data = (PMC **)PMC_data(SELF);

        if (class_data) {
            name = class_data[PCD_CLASS_NAME];
            return readable_name(interp, name);
        }
        return SELF->vtable->whoami;
    }



/*

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

This is used by freeze/thaw to visit the contents of the class.

C<*info> is the visit info, (see F<include/parrot/pmc_freeze.h>).

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

Used to archive the class.

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

Used to unarchive the class.

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

Create the class from the thawed parents and attributes array.

=cut

*/

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

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

        /* 2) direct parents array */
        if (info->what == VISIT_THAW_NORMAL ||
                info->what == VISIT_THAW_CONSTANTS)
            pos = class_data + PCD_MAX;
        else
            pos = class_data + PCD_PARENTS;
        info->thaw_ptr = pos;
        (info->visit_pmc_now)(INTERP, *pos, info);

        /* 3) attributes array */
        if (info->what == VISIT_THAW_NORMAL ||
                info->what == VISIT_THAW_CONSTANTS)
            pos = class_data + PCD_MAX + 1;
        else
            pos = class_data + PCD_CLASS_ATTRIBUTES;
        info->thaw_ptr = pos;
        (info->visit_pmc_now)(INTERP, *pos, info);

        SUPER(info);
    }

    void freeze(visit_info *info) {
        IMAGE_IO *io = info->image_io;
        PMC **class_data, **pos;

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

        /* 1) freeze class name */
        pos = class_data + PCD_CLASS_NAME;
        io->vtable->push_string(INTERP, io,
                VTABLE_get_string(INTERP, *pos));

    }

    void thaw(visit_info *info) {
        IMAGE_IO *io = info->image_io;

        /*
         * Thawing a class is tricky - it might or might not exist
         * in the interpreter, where it get thawed.
         * Additionally, it could happen that a class exists
         * but the thawed one differs.
         *
         * So here's the plan:
         * During thaw, we first extend the class_data by two,
         * thaw parents and attribs into that new area, and
         * then we see what to do.
         */
        if (info->extra_flags == EXTRA_IS_PROP_HASH) {
            SUPER(info);
        }
        else if (info->extra_flags == EXTRA_IS_NULL) {
            STRING *class_name;
            INTVAL new_type;
            PMC *real_class;

            /* thaw class name */
            class_name = io->vtable->shift_string(INTERP, io);
            /* if class exists in this interpreter, check if the
             * thawed class is the same, if not bail out, if yes
             * ignore the class, consume the byte string
             */
            new_type = pmc_type(INTERP, class_name);
            if (new_type > enum_type_undef) {
                real_class = Parrot_class_lookup(INTERP, class_name);
                info->extra = real_class;
                info->extra_flags = EXTRA_CLASS_EXISTS;
            }
            else {
                PMC *name = pmc_new(interp, enum_class_String);
                real_class = SELF;
                VTABLE_set_string_native(interp, name, class_name);
                SELF.init_pmc(name);
            }
            /* make room for thawed arrays */
            if (PMC_int_val(real_class) == PCD_MAX) {
                PMC **class_data;
                resize_attrib_array(real_class, PCD_MAX + 2);
                class_data = (PMC **)PMC_data(real_class);
                class_data[PCD_MAX] = NULL;
                class_data[PCD_MAX + 1] = NULL;
            }

        }
    }

    void thawfinish(visit_info *info) {
        INTVAL i, n, nold;
        PMC * class;
        PMC *parents, *attribs, *old;
        PMC **class_data;
        int parent_not_class = 0;

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

        old = class_data[PCD_PARENTS];
        nold = VTABLE_elements(INTERP, old);
        parents = class_data[PCD_MAX];
        if (!parents)
            n = 0;
        else
            n = VTABLE_elements(INTERP, parents);
        if (nold && n != nold)
            real_exception(INTERP, NULL, E_AssertionError,
                    "thawed class differs");
        /* TODO compare elements */
        if (!nold) {
            for (i = 0; i < n; ++i) {
                PMC *parent_class;
                parent_class = VTABLE_get_pmc_keyed_int(INTERP, parents, i);
                if (!PObj_is_class_TEST(parent_class)) {
                    assert(!parent_not_class);
                    parent_not_class++;
                    parent_class = parent_class->vtable->class;
                }
                Parrot_add_parent(INTERP, class, parent_class);
            }
        }
        /*
         * preserve the thawed attrib array
         */
        old = class_data[PCD_CLASS_ATTRIBUTES];
        nold = VTABLE_elements(INTERP, old);
        attribs = class_data[PCD_MAX + 1];
        if (!attribs)
            n = 0;
        else
            n = VTABLE_elements(INTERP, attribs);
        if (nold != parent_not_class && n != nold)
            real_exception(INTERP, NULL, E_AssertionError,
                    "thawed class differs");
        /* TODO compare attribs */

        if (nold == parent_not_class) {
            /* non-class parents already have an extra attribute for
             * delegating, which will have already been created by
             * Parrot_add_parent() and must be first
             */
            for (i = parent_not_class ? 1 : 0; i < n; ++i) {
                Parrot_add_attribute(INTERP, class,
                        VTABLE_get_string_keyed_int(INTERP, attribs, i));
            }
        }
        class_data[PCD_MAX] = NULL;
        class_data[PCD_MAX + 1] = NULL;
    }

/*

=item C<METHOD PMC* get_parents()>

Returns the array of parents for this class.

=cut

*/

    METHOD PMC* get_parents() {
        PMC * class;
        PMC **class_data;

        class      = SELF;
        class_data = (PMC**)(PMC_data(class));
        return class_data[PCD_PARENTS];
    }

}

/*

=back

=cut

*/

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