Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tree: 0ae5d55426
Fetching contributors…

Cannot retrieve contributors at this time

236 lines (166 sloc) 5.089 kb
/*
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:
*/
Jump to Line
Something went wrong with that request. Please try again.