delegate.pmc

/*
Copyright (C) 2003, The Perl Foundation.
$Id$

=head1 NAME

src/pmc/delegate.pmc - Delegate PMC

=head1 DESCRIPTION

Delegate each and every function to parrot bytecode.

Almost all methods are auto-generated in lib/Parrot/Pmc2c.pm

=head2 Functions

=over 4

=cut

*/


#include "parrot/parrot.h"
#include "delegate.str"
#include <assert.h>


/*

=item C<static PMC *
find_meth(Interp *interp, PMC *pmc, STRING *name)>

Finds and returns the delegated method with string C<name>.

=cut

*/


static PMC *
find_meth(Interp *interp, PMC *pmc, STRING *meth) {
    PMC *class = pmc;

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

/*

=item C<static PMC *
find_or_die(Interp *interp, PMC *pmc, STRING *name)>

Returns the result of calling C<find_meth()> with the arguments, raising
an exception if no method is found.

=cut

*/

static PMC *
find_or_die(Interp *interp, PMC *pmc, STRING *meth) {
    PMC *returnPMC = find_meth(interp, pmc, meth);
    if (PMC_IS_NULL(returnPMC)) {
        PMC *class = pmc;
        if (PObj_is_object_TEST(pmc)) {
            class = GET_CLASS(PMC_data(pmc), pmc);
            real_exception(interp, NULL, E_LookupError,
                "Can't find method '%s' for object '%s'",
                string_to_cstring(interp, meth),
                string_to_cstring(interp, PMC_str_val(
                        get_attrib_num((SLOTTYPE *)PMC_data(class),
                            PCD_CLASS_NAME))));
        }
        else {
            real_exception(interp, NULL, E_LookupError,
                "Can't find method '%s' - erroneous PMC",
                string_to_cstring(interp, meth));
        }
    }
    return returnPMC;
}

/*

=back

All these functions to run code can leak a full parrot register file, as
well as potentially permanently unroot some PMCs or strings, if the
vtable method throws an exception. It really ought be caught rather than
let flow through.

=over 4

=item C<PARROT_INLINE static void
noarg_noreturn(Interp *interp, PMC *obj, const char *meth, int die)>

Calls the delegated method with no arguments or return value. If C<die>
is true then an exception will be raised if the method is not found.

=cut

*/

static void
noarg_noreturn(Interp *interp, PMC *obj, PMC* class,
        const char *name, int die)
{
    STRING *meth = const_string(interp, name);
    STRING *meth_v = const_string(interp, name + 2);
    PMC *method = Parrot_find_vtable_meth(interp, class, meth);
    if (PMC_IS_NULL(method))
        method = die ? find_or_die(interp, class, meth) :
            find_meth(interp, class, meth);
    if (PMC_IS_NULL(method)) {
        if (Interp_trace_TEST(interp, PARROT_TRACE_FIND_METH_FLAG)) {
            PIO_eprintf(interp, "# not found\n");
        }
        return;
    }
    Parrot_run_meth_fromc(interp, method, obj, meth);
}

pmclass delegate {

/*

=back

=head2 Methods

=over 4

=item C<void init()>

Calls the delegated C<__init()> method if it exists.

=item C<PMC* instantiate(PMC* sig)>

Calls the delegated C<__instantiate> method if it exists.

XXX Actually the PMC compiler should emit different code, if a method is
present in src/pmc/default.pmc. Some defaulted methods like this one have
useful defaults and don't throw exceptions.

=cut

*/

    void init() {
        noarg_noreturn(INTERP, SELF, SELF, PARROT_VTABLE_INIT_METHNAME, 0);
    }

    void init_pmc(PMC* class) {
        noarg_noreturn(INTERP, SELF, class, PARROT_VTABLE_INIT_METHNAME, 0);
    }

    void destroy() {
        /* don't delegate destroy */
    }

    void mark() {
        /* don't delegate mark */
    }

    PMC* instantiate(PMC* sig) {
        STRING *meth = const_string(INTERP,
                PARROT_VTABLE_INSTANTIATE_METHNAME);
        PMC *sub = Parrot_find_vtable_meth(INTERP, SELF, meth);
        if (PMC_IS_NULL(sub))
            sub = find_meth(INTERP, SELF, meth);

        if (PMC_IS_NULL(sub)) {
            /* run default fallback that constructs an empty object */
            return SUPER(sig);
        }
        return (PMC*) Parrot_run_meth_fromc(INTERP, sub, SELF, meth);
    }

    void add_method(STRING *method_name, PMC *sub_pmc) {
        SUPER(method_name, sub_pmc);
    }

    STRING* name() {
        return SELF->vtable->whoami;
    }

    PMC* namespace() {
        return SELF->vtable->_namespace;
    }

    INTVAL type() {
        return SUPER();
    }

/*

=item C<opcode_t *invoke(void *next)>

Invokes a subroutine.

=cut

*/

    opcode_t* invoke(void *next) {
        STRING *meth = CONST_STRING(interp, "__invoke");
        STRING *meth_v = CONST_STRING(interp, "invoke");
        PMC *sub = Parrot_find_vtable_meth(interp, pmc, meth_v);
        if (PMC_IS_NULL(sub))
            sub = find_or_die(interp, pmc, meth);
        INTERP->current_object = SELF;
        return VTABLE_invoke(interp, sub, next);
    }

}

/*

=back

=cut

*/

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