/*
Copyright (C) 2005-2008, The Perl Foundation.
$Id: /mirror/trunk/languages/lua/src/pmc/luauserdata.pmc 34462 2008-12-27T17:23:27.572097Z fperrad  $

=head1 NAME

pmc/luauserdata.pmc - Lua Userdata

=head1 DESCRIPTION

C<LuaUserdata> extends C<LuaAny> to provide a class with the behaviour of
the Lua C<Userdata> type.

=head2 Overloaded Methods

=over 4

=cut

*/

#include "lua_private.h"

#define u_val(pmc) (PARROT_LUAUSERDATA(pmc))->val
#define u_env(pmc) (PARROT_LUAUSERDATA(pmc))->env

static PMC* curr_func(PARROT_INTERP) {
    Parrot_Context *sub_ctx = CONTEXT(interp)->caller_ctx;
    while (1) {
        PMC *cont;
        if (sub_ctx->current_sub && PMC_metadata(sub_ctx->current_sub))
            return sub_ctx->current_sub;
        cont = sub_ctx->current_cont;
        if (!cont)
            break;
        sub_ctx = PMC_cont(cont)->to_ctx;
        if (!sub_ctx)
            break;
    }
    return NULL;
}

static PMC* getcurrenv(PARROT_INTERP) {
    PMC *env = NULL;
    PMC *sub = curr_func(interp);
    if (sub) {
        env = PMC_metadata(sub);
    }
    return env;
}


pmclass LuaUserdata
    extends  LuaAny
    provides scalar
    dynpmc
    need_ext
    group    lua_group
    hll      lua {

    ATTR PMC    *val;
    ATTR PMC    *env;

/*

=item C<void init()>

Initializes the userdata.

=cut

*/
    VTABLE void init() {
        Parrot_LuaUserdata_attributes *u = mem_allocate_zeroed_typed(Parrot_LuaUserdata_attributes);
        PMC_data(SELF) = u;
        u_env(SELF) = getcurrenv(INTERP);
        PMC_metadata(SELF) = NULL;
        PObj_custom_mark_destroy_SETALL(SELF);
    }

/*

=item C<void mark()>

Marks the userdata as live.

=cut

*/
    VTABLE void mark() {
        if (u_val(SELF))
            pobject_lives(INTERP, (PObj *)u_val(SELF));
        if (u_env(SELF))
            pobject_lives(INTERP, (PObj *)u_env(SELF));
        if (PMC_metadata(SELF))
            pobject_lives(INTERP, (PObj *)PMC_metadata(SELF));
    }

/*

=item C<void destroy()>

Call finalizer and free the userdata.

=cut

*/
    VTABLE void destroy() {
        Parrot_LuaUserdata_attributes *u = PARROT_LUAUSERDATA(SELF);
        PMC *meth = find_meth(INTERP, SELF, "__gc");

        if (meth)
            (void)Parrot_runops_fromc_args(INTERP, meth, "vP", SELF);

        if (u) {
            mem_sys_free(u);
            PMC_data(SELF) = NULL;
        }
    }

/*

=item C<STRING* get_string()>

=cut

*/
    VTABLE STRING* get_string() {
        return Parrot_sprintf_c(INTERP, "userdata: %08X", SELF);
    }

/*

=item C<STRING* name()>

Return the string "userdata".

=cut

*/
    VTABLE STRING* name() {
        return const_string(INTERP, "userdata");
    }

/*

=item C<PMC* clone()>

=cut

*/
    VTABLE PMC* clone() {
        return SELF;
    }

/*

=item C<void set_pmc(PMC *value)>

=cut

*/
    VTABLE void set_pmc(PMC *value) {
        /* TODO: should be get_attr_str() and getfenv() */
        u_val(SELF)        = u_val(value);
        u_env(SELF)        = u_env(value);
        PMC_metadata(SELF) = PMC_metadata(value);
    }

/*

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

=cut

*/
    VTABLE PMC* get_attr_str(STRING *key) {
        return u_val(SELF);
    }

/*

=item C<void set_attr_str(STRING *key, PMC *value)>

=cut

*/
    VTABLE void set_attr_str(STRING *key, PMC *value) {
        u_val(SELF) = value;
    }

/*

=back

=head2 non-Vtable Methods

=over 4

=item C<INTVAL is_equal(PMC *value)>

The C<==> operation. Compares reference (not in depth).

=cut

*/
    MULTI INTVAL is_equal(LuaUserdata value) {
        PMC *meth = find_meth(INTERP, SELF, "__eq");
        if (meth) {
            PMC *retval = Parrot_runops_fromc_args(INTERP, meth, "PPP",
                                                   SELF, value);
            if (PMC_IS_NULL(retval))
                return (INTVAL)0;

            return VTABLE_get_bool(INTERP, retval);
        }

        if (SELF == value)
            return (INTVAL)1;
        else
            return (INTVAL)0;
    }

    MULTI INTVAL is_equal(DEFAULT value) {
            return (INTVAL)0;
    }

/*

=item C<INTVAL cmp(PMC *value)>

=cut

*/
    MULTI INTVAL cmp(LuaUserdata value) {
#if 0
        PMC *meth = find_meth(INTERP, SELF, "__cmp");
        if (meth) {
            PMC *retval = Parrot_runops_fromc_args(INTERP, meth, "PPP",
                                                   SELF, value);

            if (retval)
                return (INTVAL)VTABLE_get_number(INTERP, retval);
        }
#else
        PMC *_lt = find_meth(INTERP, SELF, "__lt");

        if (_lt) {
            PMC *retval = Parrot_runops_fromc_args(INTERP, _lt, "PPP",
                                                   SELF, value);
            INTVAL r = retval ? VTABLE_get_bool(INTERP, retval) : (INTVAL)0;

            if (r)
                return (INTVAL)-1;
            else {
                PMC *_le = find_meth(INTERP, SELF, "__le");
                if (_le) {
                    retval = Parrot_runops_fromc_args(INTERP, _le, "PPP",
                                                      SELF, value);
                    r = retval ?
                        VTABLE_get_bool(INTERP, retval) : (INTVAL)0;

                    if (r)
                        return (INTVAL)0;
                    else
                        return (INTVAL)1;
                }
                else {
                    retval = Parrot_runops_fromc_args(INTERP, _lt, "PPP",
                                                      value, SELF);
                    r      = retval
                        ? VTABLE_get_bool(INTERP, retval) : (INTVAL)0;

                    if (r)
                        return (INTVAL)1;
                    else
                        return (INTVAL)0;
                }
            }
        }
#endif
        Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_ILL_INHERIT,
            "attempt to compare two userdata values");
    }

    MULTI INTVAL cmp(DEFAULT value) {
        Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_ILL_INHERIT,
            "attempt to compare userdata with %Ss",
                VTABLE_name(INTERP, value));
    }

/*

=back

=head2 Specific Methods

=over 4

=item C<PMC *getfenv()>

=cut

*/
    METHOD PMC* getfenv() {
        PMC *retval = u_env(SELF);

        if (!retval)
            retval = pmc_new(INTERP, dynpmc_LuaNil);

        RETURN(PMC *retval);
    }

/*

=item C<PMC *get_metatable()>

=cut

*/
    METHOD PMC* get_metatable() {
        PMC *retval = PMC_metadata(SELF);

        if (!retval)
            retval = pmc_new(INTERP, dynpmc_LuaNil);

        RETURN(PMC *retval);
    }

/*

=item C<PMC* rawequal(PMC *value)>

=cut

*/
    METHOD PMC* rawequal(PMC *value) {
        PMC *retval = pmc_new(INTERP, dynpmc_LuaBoolean);

        if (PMC_type(SELF) == PMC_type(value)
        && u_val(SELF)     == u_val(value)
        && u_env(SELF)     == u_env(value))
            VTABLE_set_integer_native(INTERP, retval, 1);
        else
            VTABLE_set_integer_native(INTERP, retval, 0);

        RETURN(PMC *retval);
    }

/*

=item C<void setfenv(PMC *env)>

=cut

*/
    METHOD void setfenv(PMC *env) {
        u_env(SELF) = env;
    }

/*

=item C<void set_metatable(PMC *meta)>

=cut

*/
    METHOD void set_metatable(PMC *meta) {
        if (dynpmc_LuaNil == PMC_type(meta))
            PMC_metadata(SELF) = NULL;
        else
            PMC_metadata(SELF) = meta;
    }

}

/*

=back

=cut

*/

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