Author: chromatic
Date: Mon Apr 23 09:46:53 2007
New Revision: 18306
Modified:
trunk/compilers/imcc/pbc.c
trunk/include/parrot/objects.h
trunk/lib/Parrot/Pmc2c/delegate.pm
trunk/src/objects.c
trunk/src/pmc/delegate.pmc
trunk/src/pmc/parrotobject.pmc
trunk/t/pmc/object-meths.t
Log:
Refactor vtable overriding and delegate.c generation (Alek Storm, RT #42408).
Minor code cleanups, while I was in there.
Modified: trunk/compilers/imcc/pbc.c
==============================================================================
--- trunk/compilers/imcc/pbc.c (original)
+++ trunk/compilers/imcc/pbc.c Mon Apr 23 09:46:53 2007
@@ -637,20 +637,20 @@
add_const_pmc_sub(Interp *interp, SymReg *r,
int offs, int end)
{
- int i, k;
- INTVAL type;
- PMC *ns_pmc;
- PMC *sub_pmc;
- struct Parrot_sub *sub;
- PackFile_Constant *pfc;
- SymReg *ns;
- int ns_const = -1;
- char *real_name;
+ int i, k;
+ int ns_const = -1;
+ INTVAL type;
+ INTVAL vtable_index;
+ char *real_name;
+ char *c_name;
+ IMC_Unit *unit;
+ PMC *ns_pmc;
+ PMC *sub_pmc;
+ struct Parrot_sub *sub;
+ PackFile_Constant *pfc;
PackFile_ConstTable *ct;
- IMC_Unit *unit;
- STRING *vtable_name;
- char *c_name;
- int vtable_index;
+ SymReg *ns;
+ STRING *vtable_name;
unit = globals.cs->subs->unit;
@@ -737,8 +737,8 @@
vtable_name = sub->name;
/* Check this is a valid vtable method to override. */
+ vtable_index = Parrot_get_vtable_index(interp, vtable_name);
c_name = string_to_cstring(interp, vtable_name);
- vtable_index = Parrot_get_vtable_index(interp, c_name);
if (vtable_index == -1) {
IMCC_fatal(interp, 1,
@@ -751,17 +751,18 @@
sub->vtable_index = vtable_index;
}
- pfc->type = PFC_PMC;
- pfc->u.key = sub_pmc;
+ pfc->type = PFC_PMC;
+ pfc->u.key = sub_pmc;
unit->sub_pmc = sub_pmc;
+
IMCC_debug(interp, DEBUG_PBC_CONST,
"add_const_pmc_sub '%s' flags %d color %d (%s) "
"lex_info %s :outer(%s)\n",
r->name, r->pcc_sub->pragma, k,
- (char*) sub_pmc->vtable->whoami->strstart,
+ (char *) sub_pmc->vtable->whoami->strstart,
sub->lex_info ? "yes" : "no",
sub->outer_sub ?
- (char*)PMC_sub(sub->outer_sub)->name->strstart :
+ (char *)PMC_sub(sub->outer_sub)->name->strstart :
"*none*"
);
/*
Modified: trunk/include/parrot/objects.h
==============================================================================
--- trunk/include/parrot/objects.h (original)
+++ trunk/include/parrot/objects.h Mon Apr 23 09:46:53 2007
@@ -57,7 +57,7 @@
PARROT_API void Parrot_set_class_fallback(Parrot_Interp, STRING *, INTVAL,
STRING *);
PARROT_API void Parrot_invalidate_method_cache(Interp*, STRING *_class, STRING
*meth);
PARROT_API STRING *readable_name(Parrot_Interp, PMC *);
-PARROT_API int Parrot_get_vtable_index(Interp *, const char *name);
+PARROT_API INTVAL Parrot_get_vtable_index(Interp *, STRING *name);
PARROT_API PMC *Parrot_find_vtable_meth(Interp* interp, PMC *pmc, STRING
*meth);
/* Objects, classes and PMCarrays all use the same data scheme:
Modified: trunk/lib/Parrot/Pmc2c/delegate.pm
==============================================================================
--- trunk/lib/Parrot/Pmc2c/delegate.pm (original)
+++ trunk/lib/Parrot/Pmc2c/delegate.pm Mon Apr 23 09:46:53 2007
@@ -52,19 +52,6 @@
return join '', @types;
}
-=item C<gen_ret($type)>
-
-Generate the C code for a C<return> statement.
-
-=cut
-
-sub gen_ret {
- my ( $self, $type ) = @_;
-
- #return "ret_val = *($1*) " if ($type =~ /((?:INT|FLOAT)VAL)/);
- return "ret_val = ($type) ";
-}
-
=item C<body($method, $line, $out_name)>
Returns the C code for the method body. C<$line> is used to accumulate
@@ -95,42 +82,29 @@
$arg = ", " . join( ' ', @args ) if @args;
my $sig = $self->signature($parameters);
$sig = $self->trans( $method->{type} ) . $sig;
- my $ret = '';
- my $ret_def = '';
- my $func_ret = '(void) ';
+ my $func_ret = '';
my $ret_type = '';
if ( $method->{type} ne 'void' ) {
my $type = $method->{type};
- $ret_def = "$type ret_val;";
- $func_ret = $self->gen_ret( $method->{type} );
- $ret = "return ret_val;";
+ $func_ret = "return ($type)";
if ( $type !~ /\*/ ) {
$ret_type = "_ret" . lc substr $type, 0, 1;
$ret_type = "_reti" if $ret_type eq '_retu';
}
}
- my $umeth = uc $meth;
- my $delegate_meth = "PARROT_VTABLE_${umeth}_METHNAME";
# I think that these will be out by one - NWC
my $l = $self->line_directive( $line, "delegate.c" );
my $cout = <<EOC;
$l
-${decl} {
-EOC
- $cout .= " $ret_def\n" if $ret_def;
- $cout .= <<EOC;
- STRING *meth = CONST_STRING(interp, "__$meth");
- STRING *meth_v = CONST_STRING(interp, "$meth");
- PMC *sub = Parrot_find_vtable_meth(interp, pmc, meth_v);
+${decl}{
+ STRING *meth = CONST_STRING(interp, "$meth");
+ PMC *sub = Parrot_find_vtable_meth(interp, pmc, meth);
if (PMC_IS_NULL(sub))
- sub = find_or_die(interp, pmc, meth);
+ vtable_meth_not_found(interp, pmc, "$meth");
${func_ret}Parrot_run_meth_fromc_args$ret_type(interp, sub,
pmc, meth, "$sig"$arg);
-EOC
- $cout .= " $ret\n" if $ret;
- $cout .= <<EOC;
}
EOC
Modified: trunk/src/objects.c
==============================================================================
--- trunk/src/objects.c (original)
+++ trunk/src/objects.c Mon Apr 23 09:46:53 2007
@@ -29,7 +29,7 @@
/*
-=item C<int Parrot_get_vtable_index(Interp *, const char *name)>
+=item C<INTVAL Parrot_get_vtable_index(Interp *, STRING *name)>
Return index if C<name> is a valid vtable slot name.
@@ -37,68 +37,90 @@
*/
-int
-Parrot_get_vtable_index(Interp *interp, const char *name)
+INTVAL
+Parrot_get_vtable_index(Interp *interp, STRING *name)
{
- int i;
- const char *meth;
- for (i = 0; (meth = Parrot_vtable_slot_names[i]) != NULL; ++i) {
- if (!*meth)
+ const char *meth_c;
+ char *name_c = string_to_cstring(interp, name);
+ INTVAL i;
+
+ for (i = 0; (meth_c = Parrot_vtable_slot_names[i]); ++i) {
+ if (!*meth_c)
continue;
+
/* XXX slot_names still have __ in front */
- if (strcmp(name, meth + 2) == 0)
+ if (strcmp(name_c, meth_c + 2) == 0) {
+ string_cstring_free(name_c);
return i;
+ }
}
+
+ string_cstring_free(name_c);
return -1;
}
+static PMC*
+find_vtable_meth_ns(Interp *interp, PMC *ns, INTVAL vtable_index)
+{
+ INTVAL k = VTABLE_elements(interp, ns);
+ PMC *key = VTABLE_nextkey_keyed(interp, key_new(interp), ns,
+ ITERATE_FROM_START);
+
+ const char *meth = Parrot_vtable_slot_names[vtable_index];
+ STRING *meth_str = string_from_cstring(interp, meth, strlen(meth));
+
+ int j;
+
+ for (j = 0; j < k; ++j) {
+ STRING *ns_key = parrot_hash_get_idx(interp, PMC_struct_val(ns), key);
+ PMC *res = VTABLE_get_pmc_keyed_str(interp, ns, ns_key);
+
+ /* success if matching vtable index or double-underscored name */
+ if (res->vtable->base_type == enum_class_Sub &&
+ (PMC_sub(res)->vtable_index == vtable_index ||
+ string_compare(interp, meth_str, ns_key) == 0))
+ return res;
+ }
+
+ return PMCNULL;
+}
+
PMC*
-Parrot_find_vtable_meth(Interp* interp, PMC *pmc, STRING *meth) {
+Parrot_find_vtable_meth(Interp* interp, PMC *pmc, STRING *meth)
+{
PMC *_class = pmc;
- PMC *ns = NULL;
- PMC *mro;
- PMC *key;
- char *slot_name;
- int vtable_index;
INTVAL i, n, j, k;
+ PMC *ns, *mro, *key, *self_class;
/* Get index in Parrot_vtable_slot_names[]. */
- slot_name = string_to_cstring(interp, meth);
- vtable_index = Parrot_get_vtable_index(interp, slot_name);
- string_cstring_free(slot_name);
+ INTVAL vtable_index = Parrot_get_vtable_index(interp, meth);
+
if (vtable_index == -1)
- return NULL;
+ return NULL;
/* Get class. */
if (PObj_is_object_TEST(pmc)) {
- _class = GET_CLASS((Buffer *)PMC_data(pmc), pmc);
+ _class = self_class = GET_CLASS((Buffer *)PMC_data(pmc), pmc);
}
/* Get MRO and iterate over it to find method with a matching
- vtable index. */
+ vtable index or double-underscored name. */
mro = _class->vtable->mro;
- n = VTABLE_elements(interp, mro);
+ n = VTABLE_elements(interp, mro);
+
for (i = 0; i < n; ++i) {
_class = VTABLE_get_pmc_keyed_int(interp, mro, i);
- ns = VTABLE_pmc_namespace(interp, _class);
+ ns = VTABLE_pmc_namespace(interp, _class);
+
if (!PMC_IS_NULL(ns)) {
- k = VTABLE_elements(interp, ns);
- key = VTABLE_nextkey_keyed(interp, key_new(interp), ns,
- ITERATE_FROM_START);
- for (j = 0; j < k; ++j) {
- STRING *ns_key =
- (STRING *)parrot_hash_get_idx(interp,
- (Hash *)PMC_struct_val(ns), key);
- PMC *res = VTABLE_get_pmc_keyed_str(interp, ns, ns_key);
- if (res->vtable->base_type == enum_class_Sub &&
- PMC_sub(res)->vtable_index == vtable_index)
- return res;
- }
+ PMC *res = find_vtable_meth_ns(interp, ns, vtable_index);
+ if (!PMC_IS_NULL(res))
+ return res;
}
}
- /* If we get here, not found in the current class. */
- return NULL;
+ /* If we get here, method is not overridden in the class. */
+ return PMCNULL;
}
STRING*
@@ -252,34 +274,6 @@
/*
-=item C<static PMC *find_vtable_override_byname(Interp *interp,
- PMC *_class,
- STRING *method_name)>
-
-Tries to locate a PIR override method for the given v-table method in the
-given class. If one is found, returns the method.
-
-=cut
-
-*/
-
-static PMC*
-find_vtable_override_byname(Interp *interp, PMC *_class,
- PMC *class_name, STRING *method_name)
-{
- /* First try it in the :vtable namespace. */
- STRING *no_underscores = string_substr(interp, method_name,
- 2, method_name->strlen - 2, NULL, 0);
- PMC *res = Parrot_find_vtable_meth(interp, _class, no_underscores);
- if (!PMC_IS_NULL(res))
- return res;
-
- /* Otherwise, do lookup in the old way. */
- return Parrot_find_global_k(interp, class_name, method_name);
-}
-
-/*
-
=item C<static void create_deleg_pmc_vtable(Interp *, PMC *_class,
PMC *class_name, int full)>
@@ -318,10 +312,13 @@
for (i = 0; (meth = Parrot_vtable_slot_names[i]) != NULL; ++i) {
if (!*meth)
continue;
- meth_str.strstart = const_cast(meth);
- meth_str.strlen = meth_str.bufused = strlen(meth);
- meth_str.hashval = 0;
- if (find_vtable_override_byname(interp, _class, class_name,
&meth_str)) {
+
+ /* strip underscores from method name */
+ meth_str.strstart = const_cast(meth + 2);
+ meth_str.strlen = meth_str.bufused = strlen(meth) - 2;
+ meth_str.hashval = 0;
+
+ if (!PMC_IS_NULL(Parrot_find_vtable_meth(interp, _class, &meth_str))) {
/*
* the method exists; keep the ParrotObject aka delegate vtable
slot
*/
@@ -775,8 +772,9 @@
do_initcall(Interp *interp, PMC* _class, PMC *object, PMC *init)
{
PMC * const classsearch_array = _class->vtable->mro;
- PMC *parent_class;
- INTVAL i, nparents;
+ PMC *parent_class;
+ INTVAL i, nparents;
+
/*
* 1) if class has a CONSTRUCT property run it on the object
* no redispatch
@@ -784,11 +782,11 @@
* XXX isn't CONSTRUCT for creating new objects?
*/
STRING *meth_str;
- PMC *meth = get_init_meth(interp, _class,
+ PMC *meth = get_init_meth(interp, _class,
CONST_STRING(interp, "CONSTRUCT"), &meth_str);
- int default_meth;
+ int default_meth;
- if (meth) {
+ if (!PMC_IS_NULL(meth)) {
if (init)
Parrot_run_meth_fromc_args(interp, meth,
object, meth_str, "vP", init);
@@ -834,31 +832,27 @@
CONST_STRING(interp, "BUILD"), &meth_str);
/* no method found and no BUILD property set? */
if (!meth && meth_str == NULL) {
- PMC *ns;
- STRING *meth_str_v;
+ PMC *ns;
+ INTVAL vtable_index;
+
/* use __init or __init_pmc (depending on if an argument was
passed)
* as fallback constructor method, if it exists */
- if (init) {
- meth_str = CONST_STRING(interp, "__init_pmc");
- meth_str_v = CONST_STRING(interp, "init_pmc");
- }
- else {
- meth_str = CONST_STRING(interp, "__init");
- meth_str_v = CONST_STRING(interp, "init");
- }
- ns = VTABLE_pmc_namespace(interp, parent_class);
+ if (init)
+ meth_str = CONST_STRING(interp, "init_pmc");
+ else
+ meth_str = CONST_STRING(interp, "init");
+
+ ns = VTABLE_pmc_namespace(interp, parent_class);
+
/* can't use find_method, it walks mro */
- meth = Parrot_find_vtable_meth(interp, _class,
- meth_str_v);
- if (PMC_IS_NULL(meth))
- meth = VTABLE_get_pmc_keyed_str(interp, ns, meth_str);
- if (meth == PMCNULL)
- meth = NULL;
+ vtable_index = Parrot_get_vtable_index(interp, meth_str);
+ meth = find_vtable_meth_ns(interp, ns, vtable_index);
default_meth = 1;
}
else
default_meth = 0;
- if (meth) {
+
+ if (!PMC_IS_NULL(meth)) {
if (init)
Parrot_run_meth_fromc_args(interp, meth,
object, meth_str, "vP", init);
Modified: trunk/src/pmc/delegate.pmc
==============================================================================
--- trunk/src/pmc/delegate.pmc (original)
+++ trunk/src/pmc/delegate.pmc Mon Apr 23 09:46:53 2007
@@ -1,5 +1,5 @@
/*
-Copyright (C) 2003, The Perl Foundation.
+Copyright (C) 2003-2007, The Perl Foundation.
$Id$
=head1 NAME
@@ -20,109 +20,36 @@
*/
-
#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;
- char *meth_name = string_to_cstring(interp, meth);
- if (PObj_is_object_TEST(pmc)) {
- char *obj_name = string_to_cstring(interp, PMC_str_val(
- get_attrib_num((SLOTTYPE *)PMC_data(_class),
- PCD_CLASS_NAME)));
- _class = GET_CLASS(PMC_data(pmc), pmc);
- real_exception(interp, NULL, E_LookupError,
- "Can't find method '%s' for object '%s'", meth_name, obj_name);
- string_cstring_free(obj_name);
- }
- else {
- real_exception(interp, NULL, E_LookupError,
- "Can't find method '%s' - erroneous PMC",
- string_to_cstring(interp, meth));
- }
- string_cstring_free(meth_name);
- }
- return returnPMC;
-}
-
-/*
-
-=back
-
-All these functions to run code can leak a full parrot register file, as
+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)
+vtable_meth_not_found(Interp *interp, PMC *pmc, const char *meth)
{
- 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);
+ char *_class;
+
+ if (PObj_is_class_TEST(pmc))
+ _class = string_to_cstring(interp, PMC_str_val(
+ get_attrib_num(
+ (SLOTTYPE *)PMC_data(GET_CLASS(PMC_data(pmc), pmc)),
+ PCD_CLASS_NAME)));
+ else
+ _class = string_to_cstring(interp, pmc->vtable->whoami);
+
+ real_exception(interp, NULL, E_LookupError,
+ "Can't find vtable method '%s' in class '%s'", meth, _class);
+
+ string_cstring_free(_class);
}
pmclass delegate {
@@ -135,10 +62,6 @@
=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.
@@ -152,11 +75,25 @@
*/
void init() {
- noarg_noreturn(INTERP, SELF, SELF, PARROT_VTABLE_INIT_METHNAME, 0);
+ STRING *meth = CONST_STRING(interp, "init");
+ PMC *sub = Parrot_find_vtable_meth(INTERP, SELF, meth);
+ if (!PMC_IS_NULL(sub))
+ Parrot_run_meth_fromc(interp, sub, SELF, meth);
}
- void init_pmc(PMC* _class) {
- noarg_noreturn(INTERP, SELF, _class, PARROT_VTABLE_INIT_METHNAME, 0);
+ void init_pmc(PMC* initializer) {
+ STRING *meth = CONST_STRING(interp, "init_pmc");
+ PMC *sub = Parrot_find_vtable_meth(INTERP, SELF, meth);
+ if (!PMC_IS_NULL(sub))
+ Parrot_run_meth_fromc_args(interp, sub, pmc, meth, "vP",
initializer);
+ }
+
+ PMC* instantiate(PMC* sig) {
+ STRING *meth = CONST_STRING(interp, "instantiate");
+ PMC *sub = Parrot_find_vtable_meth(INTERP, SELF, meth);
+ if (PMC_IS_NULL(sub))
+ return SUPER(sig);
+ return (PMC*) Parrot_run_meth_fromc(INTERP, sub, SELF, meth);
}
void destroy() {
@@ -167,20 +104,6 @@
/* 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);
}
@@ -208,11 +131,10 @@
*/
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);
+ STRING *meth = CONST_STRING(interp, "invoke");
+ PMC *sub = Parrot_find_vtable_meth(INTERP, SELF, meth);
if (PMC_IS_NULL(sub))
- sub = find_or_die(interp, pmc, meth);
+ vtable_meth_not_found(INTERP, SELF, "invoke");
INTERP->current_object = SELF;
return VTABLE_invoke(interp, sub, next);
}
Modified: trunk/src/pmc/parrotobject.pmc
==============================================================================
--- trunk/src/pmc/parrotobject.pmc (original)
+++ trunk/src/pmc/parrotobject.pmc Mon Apr 23 09:46:53 2007
@@ -26,17 +26,6 @@
#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);
-}
-
pmclass ParrotObject extends ParrotClass need_ext {
/*
@@ -162,96 +151,79 @@
*/
- PMC* find_method(STRING* name) {
- PMC *_class = VTABLE_get_class(INTERP, SELF);
- STRING *meth = CONST_STRING(interp, "__find_method");
- STRING *meth_v = CONST_STRING(interp, "find_method");
- PMC *sub = Parrot_find_vtable_meth(interp, SELF, meth_v);
- if (PMC_IS_NULL(sub))
- sub = find_meth(interp, SELF, meth);
+ PMC* find_method(STRING *name) {
+ STRING *meth = CONST_STRING(interp, "find_method");
+ PMC *_class = VTABLE_get_class(INTERP, SELF);
+ PMC *sub = Parrot_find_vtable_meth(interp, SELF, meth);
+
if (PMC_IS_NULL(sub))
return VTABLE_find_method(INTERP, _class, name);
- return (PMC*) Parrot_run_meth_fromc_args(interp, sub,
+ return (PMC *) Parrot_run_meth_fromc_args(interp, sub,
SELF, meth, "PS", name);
}
PMC* get_attr(INTVAL idx) {
- STRING *meth = CONST_STRING(interp, "__get_attr");
- STRING *meth_v = CONST_STRING(interp, "get_attr");
- PMC *sub = Parrot_find_vtable_meth(interp, SELF, meth_v);
- if (PMC_IS_NULL(sub))
- sub = find_meth(interp, SELF, meth);
+ STRING *meth = CONST_STRING(interp, "get_attr");
+ PMC *sub = Parrot_find_vtable_meth(interp, SELF, meth);
+
if (PMC_IS_NULL(sub))
return Parrot_get_attrib_by_num(INTERP, SELF, idx);
- return (PMC*) Parrot_run_meth_fromc_args(interp, sub,
+ return (PMC *) Parrot_run_meth_fromc_args(interp, sub,
SELF, meth, "PI", idx);
}
- PMC* get_attr_str(STRING* idx) {
- STRING *meth = CONST_STRING(interp, "__get_attr_str");
- STRING *meth_v = CONST_STRING(interp, "get_attr_str");
- PMC *sub = Parrot_find_vtable_meth(interp, SELF, meth_v);
- PMC* r;
- if (PMC_IS_NULL(sub))
- sub = find_meth(interp, SELF, meth);
+ PMC* get_attr_str(STRING *idx) {
+ STRING *meth = CONST_STRING(interp, "get_attr_str");
+ PMC *sub = Parrot_find_vtable_meth(interp, SELF, meth);
+
if (PMC_IS_NULL(sub))
- r = Parrot_get_attrib_by_str(INTERP, SELF, idx);
- else r = (PMC*) Parrot_run_meth_fromc_args(interp, sub,
+ return Parrot_get_attrib_by_str(INTERP, SELF, idx);
+
+ return (PMC *) Parrot_run_meth_fromc_args(interp, sub,
SELF, meth, "PS", idx);
- return r;
}
- void set_attr(INTVAL idx, PMC* value) {
- STRING *meth = CONST_STRING(interp, "__set_attr");
- STRING *meth_v = CONST_STRING(interp, "set_attr");
- PMC *sub = Parrot_find_vtable_meth(interp, SELF, meth_v);
+ void set_attr(INTVAL idx, PMC *value) {
+ STRING *meth = CONST_STRING(interp, "set_attr");
+ 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)) {
Parrot_set_attrib_by_num(INTERP, SELF, idx, value);
- return;
- }
- (PMC*) Parrot_run_meth_fromc_args(interp, sub,
- SELF, meth, "vIP", idx, value);
+ else
+ Parrot_run_meth_fromc_args(interp, sub, SELF, meth,
+ "vIP", idx, value);
}
- void set_attr_str(STRING* idx, PMC* value) {
- STRING *meth = CONST_STRING(interp, "__set_attr_str");
- STRING *meth_v = CONST_STRING(interp, "set_attr_str");
- PMC *sub = Parrot_find_vtable_meth(interp, SELF, meth_v);
+ void set_attr_str(STRING *idx, PMC *value) {
+ STRING *meth = CONST_STRING(interp, "set_attr_str");
+ 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)) {
Parrot_set_attrib_by_str(INTERP, SELF, idx, value);
- return;
- }
- (PMC*) Parrot_run_meth_fromc_args(interp, sub,
- SELF, meth, "vSP", idx, value);
+ else
+ Parrot_run_meth_fromc_args(interp, sub, SELF, meth,
+ "vSP", idx, value);
}
PMC* get_class() {
- STRING *meth = CONST_STRING(interp, "__get_class");
- STRING *meth_v = CONST_STRING(interp, "get_class");
- PMC *sub = Parrot_find_vtable_meth(interp, SELF, meth_v);
- if (PMC_IS_NULL(sub))
- sub = find_meth(interp, SELF, meth);
+ STRING *meth = CONST_STRING(interp, "get_class");
+ PMC *sub = Parrot_find_vtable_meth(interp, SELF, meth);
+ int type_num;
+
if (PMC_IS_NULL(sub)) {
- if (!PObj_is_PMC_shared_TEST(SELF)) {
+ 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;
-
+ type_num = SELF->vtable->base_type;
return INTERP->vtables[type_num]->pmc_class;
}
- }
- return (PMC*) Parrot_run_meth_fromc_args(interp, sub,
- SELF, meth, "P");
+ }
+ return (PMC *) Parrot_run_meth_fromc_args(interp, sub, SELF, meth,
"P");
}
/*
@@ -290,267 +262,261 @@
*/
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 = Parrot_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 {
+ STRING *meth = CONST_STRING(INTERP, "get_integer_keyed_int");
+ PMC *sub = Parrot_find_vtable_meth(INTERP, pmc, meth);
+
+ if (PMC_IS_NULL(sub)) {
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);
+ 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);
+
+ return deleg_pmc.SUPER(key);
}
}
+ return Parrot_run_meth_fromc_args_reti(INTERP, sub,
+ pmc, meth, "II", 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 = Parrot_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 {
+ STRING *meth = CONST_STRING(INTERP, "get_number_keyed_int");
+ PMC *sub = Parrot_find_vtable_meth(INTERP, pmc, meth);
+
+ if (PMC_IS_NULL(sub)) {
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);
+ 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);
+
+ return deleg_pmc.SUPER(key);
}
}
+ return Parrot_run_meth_fromc_args_retf(INTERP, sub,
+ pmc, meth, "NI", 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 = Parrot_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 {
+ STRING *meth = CONST_STRING(INTERP, "get_string_keyed_int");
+ PMC *sub = Parrot_find_vtable_meth(INTERP, pmc, meth);
+
+ if (PMC_IS_NULL(sub)) {
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);
+ 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);
+
+ return deleg_pmc.SUPER(key);
}
}
+ return (STRING*)Parrot_run_meth_fromc_args(INTERP, sub,
+ pmc, meth, "SI", 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 = Parrot_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 {
+ STRING *meth = CONST_STRING(INTERP, "get_pmc_keyed_int");
+ PMC *sub = Parrot_find_vtable_meth(INTERP, pmc, meth);
+
+ if (PMC_IS_NULL(sub)) {
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);
+ 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);
+
+ return deleg_pmc.SUPER(key);
}
}
+ return (PMC*)Parrot_run_meth_fromc_args(INTERP, sub,
+ pmc, meth, "PI", 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 = Parrot_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 {
+ STRING *meth = CONST_STRING(INTERP, "set_integer_keyed_int");
+ PMC *sub = Parrot_find_vtable_meth(INTERP, pmc, meth);
+
+ if (PMC_IS_NULL(sub)) {
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);
+ 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);
}
}
+ else
+ Parrot_run_meth_fromc_args(INTERP, sub,
+ pmc, meth, "vII", 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 = Parrot_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 {
+ STRING *meth = CONST_STRING(INTERP, "set_number_keyed_int");
+ PMC *sub = Parrot_find_vtable_meth(INTERP, pmc, meth);
+
+ if (PMC_IS_NULL(sub)) {
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);
+ 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);
}
}
+ else
+ Parrot_run_meth_fromc_args(INTERP, sub,
+ pmc, meth, "vIN", 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 = Parrot_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 {
+ STRING *meth = CONST_STRING(INTERP, "set_string_keyed_int");
+ PMC *sub = Parrot_find_vtable_meth(INTERP, pmc, meth);
+
+ if (PMC_IS_NULL(sub)) {
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);
+ 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);
}
}
+ else
+ Parrot_run_meth_fromc_args(INTERP, sub,
+ pmc, meth, "vIS", 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 = Parrot_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 {
+ STRING *meth = CONST_STRING(INTERP, "set_pmc_keyed_int");
+ PMC *sub = Parrot_find_vtable_meth(INTERP, pmc, meth);
+
+ if (PMC_IS_NULL(sub)) {
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);
+ 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);
}
}
+ else
+ Parrot_run_meth_fromc_args(INTERP, sub,
+ pmc, meth, "vIP", 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 = Parrot_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 {
+ STRING *meth = CONST_STRING(INTERP, "delete_keyed_int");
+ PMC *sub = Parrot_find_vtable_meth(INTERP, pmc, meth);
+
+ if (PMC_IS_NULL(sub)) {
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);
+ 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);
}
}
+ else
+ Parrot_run_meth_fromc_args(INTERP, sub,
+ pmc, meth, "vI", 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 = Parrot_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 {
+ STRING *meth = CONST_STRING(INTERP, "defined_keyed_int");
+ PMC *sub = Parrot_find_vtable_meth(INTERP, pmc, meth);
+
+ if (PMC_IS_NULL(sub)) {
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);
+ 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);
+
+ return deleg_pmc.SUPER(key);
}
}
+ return Parrot_run_meth_fromc_args_reti(INTERP, sub,
+ pmc, meth, "II", 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 = Parrot_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 {
+ STRING *meth = CONST_STRING(INTERP, "exists_keyed_int");
+ PMC *sub = Parrot_find_vtable_meth(INTERP, pmc, meth);
+
+ if (PMC_IS_NULL(sub)) {
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);
+ 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);
+
+ return deleg_pmc.SUPER(key);
}
}
+ return Parrot_run_meth_fromc_args_reti(INTERP, sub,
+ pmc, meth, "II", key);
}
PMC* share_ro() {
@@ -562,14 +528,14 @@
if (PObj_is_PMC_shared_TEST(SELF))
return SELF;
- ret = pt_shared_fixup(INTERP, 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);
-
+ n = PMC_int_val(ret);
data = (PMC **) PMC_data(ret);
for (i = 0; i < n; ++i)
Modified: trunk/t/pmc/object-meths.t
==============================================================================
--- trunk/t/pmc/object-meths.t (original)
+++ trunk/t/pmc/object-meths.t Mon Apr 23 09:46:53 2007
@@ -6,7 +6,7 @@
use warnings;
use lib qw( . lib ../lib ../../lib );
use Test::More;
-use Parrot::Test tests => 43;
+use Parrot::Test tests => 44;
=head1 NAME
@@ -707,6 +707,28 @@
done
OUTPUT
+pir_output_is( <<'CODE', <<'OUTPUT', "constructor - vtable override" );
+.sub main :main
+ $P0 = newclass 'Foo'
+ $P1 = subclass 'Foo', 'Bar'
+ $P2 = new 'Bar'
+.end
+
+.namespace ['Foo']
+.sub init :vtable :method
+ print "foo init\n"
+.end
+
+.namespace ['Bar']
+.sub init :vtable :method
+ print "bar init\n"
+.end
+
+CODE
+foo init
+bar init
+OUTPUT
+
pir_output_is( <<'CODE', <<'OUTPUT', "same method name in two namespaces" );
.namespace ["A"]
