I tried to apply Bram's patch from last year, but it had a lot of fuzz (especially related to the removal of register stacks). Here's what I ended up with.
It doesn't work, so I'm not applying it as it is... but if there's still a problem, this might be a better starting point. -- c
=== include/parrot/interpreter.h ================================================================== --- include/parrot/interpreter.h (revision 28361) +++ include/parrot/interpreter.h (local) @@ -279,7 +279,6 @@ #define CHUNKED_CTX_MEM 0 /* no longer works, but will be reinstated * some day; see src/register.c for details. */ - typedef struct _context_mem { #if CHUNKED_CTX_MEM char *data; /* ctx + register store */ @@ -410,6 +409,10 @@ opcode_t *current_args; /* ptr into code w/ set_args op */ opcode_t *current_params; /* ... w/ get_params op */ opcode_t *current_returns; /* ... w/ get_returns op */ + + parrot_context_t *fromc_result_ctx; /* ptr to context of set_returns, + * if we're about to pass return + * values to C */ PMC *args_signature; /* non-const args signature PMC */ PMC *params_signature; /* non-const params sig PMC */ PMC *returns_signature; /* non-const returns sig PMC */ === include/parrot/register.h ================================================================== --- include/parrot/register.h (revision 28361) +++ include/parrot/register.h (local) @@ -108,6 +108,15 @@ void Parrot_set_context_threshold(SHIM_INTERP, SHIM(struct Parrot_Context *ctxp)); +void copy_context_registers(PARROT_INTERP, + ARGMOD(struct Parrot_Context *dest), + ARGMOD(struct Parrot_Context *src)) + __attribute__nonnull__(1) + __attribute__nonnull__(2) + __attribute__nonnull__(3) + FUNC_MODIFIES(*dest) + FUNC_MODIFIES(*src); + void create_initial_context(PARROT_INTERP) __attribute__nonnull__(1); === src/gc/register.c ================================================================== --- src/gc/register.c (revision 28361) +++ src/gc/register.c (local) @@ -25,14 +25,14 @@ /* HEADERIZER BEGIN: static */ /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ -static void clear_regs(PARROT_INTERP, ARGMOD(parrot_context_t *ctx)) +static void clear_regs(PARROT_INTERP, ARGMOD(Parrot_Context *ctx)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*ctx); static void init_context(PARROT_INTERP, - ARGMOD(parrot_context_t *ctx), - ARGIN_NULLOK(const parrot_context_t *old)) + ARGMOD(Parrot_Context *ctx), + ARGIN_NULLOK(const Parrot_Context *old)) __attribute__nonnull__(1) __attribute__nonnull__(2) FUNC_MODIFIES(*ctx); @@ -210,7 +210,7 @@ parrot_gc_context(PARROT_INTERP) { #if CHUNKED_CTX_MEM - parrot_context_t ctx; + Parrot_context_t ctx; if (!interp->ctx_mem.threshold) return; @@ -233,7 +233,7 @@ */ static void -clear_regs(PARROT_INTERP, ARGMOD(parrot_context_t *ctx)) +clear_regs(PARROT_INTERP, ARGMOD(Parrot_Context *ctx)) { int i; @@ -282,8 +282,8 @@ */ static void -init_context(PARROT_INTERP, ARGMOD(parrot_context_t *ctx), - ARGIN_NULLOK(const parrot_context_t *old)) +init_context(PARROT_INTERP, ARGMOD(Parrot_Context *ctx), + ARGIN_NULLOK(const Parrot_Context *old)) { ctx->ref_count = 0; /* RT#46191 1 - Exceptions !!! */ ctx->current_results = NULL; @@ -347,7 +347,7 @@ ctx->n_regs_used[REGNO_NUM] = old->n_regs_used[REGNO_NUM]; ctx->n_regs_used[REGNO_STR] = old->n_regs_used[REGNO_STR]; ctx->n_regs_used[REGNO_PMC] = old->n_regs_used[REGNO_PMC]; - diff = (const long *)ctx - (const long *) old; + diff = (INTVAL *)ctx - (INTVAL *) old; interp->ctx.bp.regs_i += diff; interp->ctx.bp_ps.regs_s += diff; @@ -577,6 +577,12 @@ slot = CALCULATE_SLOT_NUM(ctxp->regs_mem_size); PARROT_ASSERT(slot < interp->ctx_mem.n_free_slots); + +#ifndef NDEBUG + if (ptr == interp->ctx_mem.free_list[slot]) + internal_exception(1, + "Error: tried to free an already-freed context\n" ); +#endif *(void **)ptr = interp->ctx_mem.free_list[slot]; interp->ctx_mem.free_list[slot] = ptr; } @@ -683,7 +689,47 @@ REG_NUM(interp, i) = 0.0; } +/* +=item C<void copy_context_registers> + +Copy all registers from one context to another. + +=cut + +*/ + +void +copy_context_registers(PARROT_INTERP, ARGMOD(Parrot_Context *dest), + ARGMOD(Parrot_Context *src)) +{ + int i; + int max = src->n_regs_used[REGNO_INT]; + + assert(max == dest->n_regs_used[REGNO_INT]); + + for (i = 0; i < max; ++i) + CTX_REG_INT(dest, i) = CTX_REG_INT(src, i); + + max = src->n_regs_used[REGNO_NUM]; + assert(max == dest->n_regs_used[REGNO_NUM]); + + for (i = 0; i < max; ++i) + CTX_REG_NUM(dest, i) = CTX_REG_NUM(src, i); + + max = src->n_regs_used[REGNO_STR]; + assert(max == dest->n_regs_used[REGNO_STR]); + + for (i = 0; i < max; ++i) + CTX_REG_STR(dest, i) = CTX_REG_STR(src, i); + + max = src->n_regs_used[REGNO_PMC]; + assert(max == dest->n_regs_used[REGNO_PMC]); + + for (i = 0; i < max; ++i) + CTX_REG_PMC(dest, i) = CTX_REG_PMC(src, i); +} + /* =back === src/inter_run.c ================================================================== --- src/inter_run.c (revision 28361) +++ src/inter_run.c (local) @@ -53,6 +53,7 @@ =item C<void runops> Run parrot ops. Set exception handler and/or resume after exception. +This is the low level run ops routine that just takes an offset. =cut @@ -149,7 +150,7 @@ parrot_context_t *ctx; /* we need one return continuation with a NULL offset */ - PMC * const ret_c = new_ret_continuation_pmc(interp, NULL); + PMC * const ret_c = new_ret_continuation_pmc(interp, NULL); interp->current_cont = ret_c; #if defined GC_VERBOSE && GC_VERBOSE PObj_report_SET(ret_c); /* s. also dod.c */ @@ -191,12 +192,19 @@ const char *sig_p; parrot_context_t * const old_ctx = CONTEXT(interp); - interp->current_cont = new_ret_continuation_pmc(interp, NULL); + interp->current_cont = new_ret_continuation_pmc(interp, NULL); interp->current_object = obj; + + /* call the invoke entry to get the address in the bytecode */ dest = VTABLE_invoke(interp, sub, NULL); - if (!dest) { + + if (!dest) real_exception(interp, NULL, 1, "Subroutine returned a NULL address"); - } + + /* Build the call signature. If we have an object, need to make sure we + * get an O as the first parameter (the final else branch does this). + * We always skip over the first character since that's the return type. */ + if (PMC_IS_NULL(obj)) { /* skip over the return type */ sig_p = sig + 1; @@ -215,6 +223,7 @@ sig_p = new_sig; } + /* If we have arguments, do the passing of them. */ if (*sig_p && dest[0] == PARROT_OP_get_params_pc) { dest = parrot_pass_args_fromc(interp, sig_p, dest, old_ctx, ap); } @@ -227,9 +236,29 @@ } */ - ctx = CONTEXT(interp); - offset = dest - interp->code->base.data; + interp->fromc_result_ctx = 0; + ctx = CONTEXT(interp); + offset = dest - interp->code->base.data; + + /* If set_returns was called somewhere, there is a copy of the context we + * need to return in interp->fromc_result_ctx. */ + if (interp->fromc_result_ctx) { + ctx = interp->fromc_result_ctx; + /* Make sure it is freed by Parrot_free_context(.., .., 0) + * when finally returning to C. Non-copied contexts have a + * ref_count of 0 by now, so --ref_count will be -1 in + * Parrot_free_context, and -1 != 0 so non-copied contexts + * will not really be freed. This is good, as they have + * already been freed by RetContinuation->invoke. */ + ctx->ref_count++; + } + + /* Reset fromc_result_ctx for maybe an outer runloop */ + interp->fromc_result_ctx = 0; + + /* Hand back the context so we can get the args out of it. */ runops(interp, offset); + return ctx; } @@ -296,11 +325,14 @@ { va_list args; parrot_context_t *ctx; + PMC *retval; va_start(args, sig); ctx = runops_args(interp, sub, PMCNULL, NULL, sig, args); va_end(args); - return (PMC *)set_retval(interp, *sig, ctx); + retval = (PMC *)set_retval(interp, *sig, ctx); + Parrot_free_context(interp, ctx, 0); + return retval; } /* @@ -339,6 +371,7 @@ ctx = runops_args(interp, sub, PMCNULL, NULL, sig, args); va_end(args); retval = set_retval(interp, *sig, ctx); + Parrot_free_context(interp, ctx, 0); interp->current_args = cargs; interp->current_params = params; @@ -365,11 +398,14 @@ { va_list args; parrot_context_t *ctx; + INTVAL retval; va_start(args, sig); ctx = runops_args(interp, sub, PMCNULL, NULL, sig, args); va_end(args); - return set_retval_i(interp, *sig, ctx); + retval = set_retval_i(interp, *sig, ctx); + Parrot_free_context(interp, ctx, 0); + return retval; } /* @@ -390,11 +426,14 @@ { va_list args; parrot_context_t *ctx; + FLOATVAL retval; va_start(args, sig); ctx = runops_args(interp, sub, PMCNULL, NULL, sig, args); va_end(args); - return set_retval_f(interp, *sig, ctx); + retval = set_retval_f(interp, *sig, ctx); + Parrot_free_context(interp, ctx, 0); + return retval; } /* @@ -416,11 +455,14 @@ { va_list args; parrot_context_t *ctx; + void *retval; va_start(args, sig); ctx = runops_args(interp, sub, obj, meth, sig, args); va_end(args); - return set_retval(interp, *sig, ctx); + retval = set_retval(interp, *sig, ctx); + Parrot_free_context(interp, ctx, 0); + return retval; } /* @@ -441,11 +483,14 @@ { va_list args; parrot_context_t *ctx; + INTVAL retval; va_start(args, sig); ctx = runops_args(interp, sub, obj, meth, sig, args); va_end(args); - return set_retval_i(interp, *sig, ctx); + retval = set_retval_i(interp, *sig, ctx); + Parrot_free_context(interp, ctx, 0); + return retval; } /* @@ -466,11 +511,14 @@ { va_list args; parrot_context_t *ctx; + FLOATVAL retval; va_start(args, sig); ctx = runops_args(interp, sub, obj, meth, sig, args); va_end(args); - return set_retval_f(interp, *sig, ctx); + retval = set_retval_f(interp, *sig, ctx); + Parrot_free_context(interp, ctx, 0); + return retval; } /* @@ -554,10 +602,11 @@ Parrot_run_meth_fromc_arglist(PARROT_INTERP, ARGIN(PMC *sub), ARGIN_NULLOK(PMC *obj), ARGIN(STRING *meth), ARGIN(const char *sig), va_list args) { - parrot_context_t *ctx; + parrot_context_t *ctx = runops_args(interp, sub, obj, meth, sig, args); + void *retval = set_retval(interp, *sig, ctx); - ctx = runops_args(interp, sub, obj, meth, sig, args); - return set_retval(interp, *sig, ctx); + Parrot_free_context(interp, ctx, 0); + return retval; } /* === src/ops/core.ops ================================================================== --- src/ops/core.ops (revision 28361) +++ src/ops/core.ops (local) @@ -544,7 +544,7 @@ op set_returns(inconst PMC) :flow { opcode_t * const _this = CUR_OPCODE; - parrot_context_t *ctx; + parrot_context_t *ctx, *copy; PMC *ccont; PMC *signature = $1; INTVAL argc; @@ -571,6 +571,21 @@ parrot_pass_args(interp, ctx, caller_ctx, src_indexes, dest_indexes, PARROT_PASS_RESULTS); } + else { + if (interp->fromc_result_ctx) + internal_exception(1, "Error: called set_returns twice in one context.\n"); + + copy = Parrot_dup_context(interp, ctx); + copy_context_registers(interp, copy, ctx); + interp->fromc_result_ctx = copy; + + /* If we don't do this, running with -D80 will crash */ + copy->current_sub = ctx->current_sub; + /* Parrot_dup_context sets the current context to the copy (which + has a current_cont of NULL), restore the original */ + CONTEXT(interp) = ctx; + } + argc = SIG_ELEMS(signature); goto OFFSET(argc + 2); } === t/op/calling.t ================================================================== --- t/op/calling.t (revision 28361) +++ t/op/calling.t (local) @@ -1,5 +1,5 @@ #!perl -# Copyright (C) 2001-2007, The Perl Foundation. +# Copyright (C) 2001-2008, The Perl Foundation. # $Id$ use strict; @@ -7,7 +7,7 @@ use lib qw( . lib ../lib ../../lib ); use Test::More; -use Parrot::Test tests => 97; +use Parrot::Test tests => 98; =head1 NAME @@ -2489,6 +2489,37 @@ /too many arguments passed\(1\) - 0 params expected/ OUTPUT +pir_output_is( <<'CODE', <<'OUTPUT', "RT #41583 - Tail calls from within vtable methods broken" ); +.sub main :main + $P1 = newclass "Foo" + $P2 = new "Foo" + + ## Should return 2, but doesn't. + $I1 = elements $P2 + $S1 = $I1 + say $S1 + end +.end + +.namespace ["Foo"] + +.sub elements :method :vtable + I0 = 13 + I1 = 2 + .return identity(I1) +.end + +.sub identity + .param int arg + ## arg is I0, taken from the elements context (which is set + ## to 13). If we put "I0 = 14" here and don't optimize, we + ## return 2. (elements's context's I1) + .return (arg) +.end +CODE +2 +OUTPUT + # Local Variables: # mode: cperl # cperl-indent-level: 4