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
