Bram Geron (via RT) wrote:
> Tail calls from within v-table methods are broken, the tail-called sub
> (or method) will not return correct values.
>
> When method A tailcalls sub B, B's set_returns stores its opcode
> number (and with it, which registers should be returned), but the
> low-level vtable code gets the registers from A's context.
> (Runops_args stores a pointer to A's context just before it is called,
> wrongly assuming A has the final set_returns. Runops_args returns the
> context to a function that then does return value passing on it.)
>
> Maybe the solution is to store the current context in a new field in
> the interp structure; I don't know, I'm rather bad at C.
>
> Example:
> This should print 2, but it prints 13.
>
>
The problem is that when we make a call over the C boundary (e.g. call
back into PIR), we do that by getting the invoke v-table method of the
sub PMC to create the context etc. for the call for us, and then capture
that context. We then return that context after the sub has executed,
and in theory can get the parameters from it.
Enter tail calls. The assumption that the context of the sub we called
is the context with the results we want in it is now invalid, since a
tailcall now replaces the context. That means we end up holding a
reference to a freed context (essentially, freed memory!)
My attempt at fixing this is to construct a fake context for the sub we
call to set_returns into. Even if it does a tail call, then it will
still end up putting the return values there - it's just normal calling
semantics.
Happily, the attached patch makes your program work. Unfortunately, it
breaks other stuff and I'm having a hard time seeing why right now. The
breakage includes PGE. So something I've done is quite wrong somehow,
but I'm not sure where. So I'm throwing the patch out on the list in
hope someone may stop something stupid I've done. Perhaps someone who's
more familiar with the whole contexts thing than I.
Thanks,
Jonathan
Index: src/ops/core.ops
===================================================================
--- src/ops/core.ops (revision 17321)
+++ src/ops/core.ops (working copy)
@@ -564,14 +564,9 @@
ctx = CONTEXT(interp->ctx);
ccont = ctx->current_cont;
- if (PMC_cont(ccont)->address) {
- /* else it's from runops_fromc */
+ /* If we have a context to put the return values in... */
+ if (PMC_cont(ccont)->to_ctx) {
parrot_context_t * const caller_ctx = PMC_cont(ccont)->to_ctx;
- if (! caller_ctx) {
- /* there is no point calling real_exception here, because
- PDB_backtrace can't deal with a missing to_ctx either. */
- internal_exception(1, "No caller_ctx for continuation %p.",
ccont);
- }
src_indexes = interp->current_returns;
dest_indexes = caller_ctx->current_results;
@@ -581,6 +576,13 @@
parrot_pass_args(interp, ctx, caller_ctx, src_indexes,
dest_indexes, PARROT_PASS_RESULTS);
}
+ else if (!PMC_cont(ccont)->address) {
+ /* Problem - we have a return bytecode address, but no context!
There
+ * is no point calling real_exception here, because PDB_backtrace
+ * can't deal with a missing to_ctx either. */
+ internal_exception(1, "No caller_ctx for continuation %p.",
ccont);
+ }
+
argc = SIG_ELEMS(signature);
goto OFFSET(argc + 2);
}
Index: src/inter_run.c
===================================================================
--- src/inter_run.c (revision 17321)
+++ src/inter_run.c (working copy)
@@ -29,6 +29,7 @@
runops(Interp *interp, size_t offset)>
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
@@ -156,18 +157,74 @@
opcode_t offset, *dest;
parrot_context_t *ctx;
parrot_context_t *old_ctx;
+ INTVAL *fake_context_registers;
+ opcode_t fake_return_bytecode[1] = { 0 };
+ int i;
+
/*
* FIXME argument count limited - check strlen of sig
*/
char new_sig[10];
const char *sig_p;
+ /* Set the object we're calling with, if any. */
+ interp->current_object = obj;
+
+ /* We set up a new return continuation with a NULL address, so we
will
+ * eventually fall back out of the runloop to here. */
old_ctx = CONTEXT(interp->ctx);
- interp->current_cont = new_ret_continuation_pmc(interp, NULL);
- interp->current_object = obj;
+ interp->current_cont = new_ret_continuation_pmc(interp, NULL);
+
+ /* We may need to capture the return values too. We set up a fake
register
+ * frame within a context to put them in to - one register of each
type. */
+ fake_context_registers = mem_sys_allocate(4 * sizeof(INTVAL));
+ for (i = 0; i < 4; i++)
+ fake_context_registers[i] = 1;
+ ctx = Parrot_alloc_context(interp, fake_context_registers);
+ ctx->caller_ctx = NULL;
+ ctx->current_sub = NULL;
+ ctx->current_results = fake_return_bytecode;
+
+ /* Also need to build a fake results signature. */
+ ctx->results_signature = pmc_new(interp,
enum_class_FixedIntegerArray);
+ dod_register_pmc(interp, ctx->results_signature);
+ if (strlen(sig) > 0) {
+ VTABLE_set_integer_native(interp, ctx->results_signature, 1);
+ switch (sig[0])
+ {
+ case 'I':
+ VTABLE_set_integer_keyed_int(interp, ctx->results_signature,
0, 0);
+ break;
+ case 'S':
+ VTABLE_set_integer_keyed_int(interp, ctx->results_signature,
0, 1);
+ break;
+ case 'P':
+ VTABLE_set_integer_keyed_int(interp, ctx->results_signature,
0, 2);
+ break;
+ case 'N':
+ VTABLE_set_integer_keyed_int(interp, ctx->results_signature,
0, 3);
+ break;
+ }
+ }
+ else {
+ VTABLE_set_integer_native(interp, ctx->results_signature, 0);
+ }
+
+ /* Set this as the context for the return continuation. */
+ PMC_cont(interp->current_cont)->to_ctx = ctx;
+ ctx->current_cont = interp->current_cont;
+
+ /* Call the invoke v-table method to give us the address in the
bytecode. */
dest = VTABLE_invoke(interp, sub, NULL);
if (!dest)
internal_exception(1, "Subroutine returned a NULL address");
+
+ /* Set the caller context, now invoke has set the context in the
interpreter. */
+ CONTEXT(interp->ctx)->caller_ctx = ctx;
+
+ /* 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;
@@ -184,7 +241,8 @@
strcpy(new_sig + 1, sig + 1);
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);
}
@@ -197,9 +255,17 @@
}
*/
- ctx = CONTEXT(interp->ctx);
+ /* Compute the offset into the bytecode and let rip. */
offset = dest - interp->code->base.data;
runops(interp, offset);
+
+ /* Clean up. */
+ dod_unregister_pmc(interp, ctx->results_signature);
+ CONTEXT(interp->ctx) = old_ctx;
+ interp->ctx.bp = old_ctx->bp;
+ interp->ctx.bp_ps = old_ctx->bp_ps;
+
+ /* Hand back the context so we can get the args out of it. */
return ctx;
}
@@ -280,17 +346,8 @@
PMC *sub, PMC *obj, STRING *meth)
{
parrot_context_t *ctx;
- opcode_t offset, *dest;
-
- interp->current_cont = new_ret_continuation_pmc(interp, NULL);
- interp->current_object = obj;
- dest = VTABLE_invoke(interp, sub, (void*)1);
- if (!dest)
- internal_exception(1, "Subroutine returned a NULL address");
- ctx = CONTEXT(interp->ctx);
- offset = dest - interp->code->base.data;
- runops(interp, offset);
- return set_retval(interp, 0, ctx);
+ ctx = runops_args(interp, sub, obj, meth, "vO", NULL);
+ return NULL; /* No sig, assume void. */
}
void *
@@ -303,7 +360,8 @@
va_start(args, sig);
ctx = runops_args(interp, sub, PMCNULL, NULL, sig, args);
va_end(args);
- return set_retval(interp, *sig, ctx);
+ return sig[0] == 'S' ? (void*)CTX_REG_STR(ctx, 0) :
+ sig[0] == 'P' ? (void*)CTX_REG_PMC(ctx, 0) : NULL;
}
void *
@@ -328,7 +386,8 @@
va_start(args, sig);
ctx = runops_args(interp, sub, PMCNULL, NULL, sig, args);
va_end(args);
- retval = set_retval(interp, *sig, ctx);
+ retval = sig[0] == 'S' ? (void*)CTX_REG_STR(ctx, 0) :
+ sig[0] == 'P' ? (void*)CTX_REG_PMC(ctx, 0) : NULL;
interp->current_args = cargs;
interp->current_params = params;
@@ -347,7 +406,7 @@
va_start(args, sig);
ctx = runops_args(interp, sub, PMCNULL, NULL, sig, args);
va_end(args);
- return set_retval_i(interp, *sig, ctx);
+ return CTX_REG_INT(ctx, 0);
}
FLOATVAL
@@ -360,7 +419,7 @@
va_start(args, sig);
ctx = runops_args(interp, sub, PMCNULL, NULL, sig, args);
va_end(args);
- return set_retval_f(interp, *sig, ctx);
+ return CTX_REG_NUM(ctx, 0);
}
void*
@@ -373,7 +432,8 @@
va_start(args, sig);
ctx = runops_args(interp, sub, obj, meth, sig, args);
va_end(args);
- return set_retval(interp, *sig, ctx);
+ return sig[0] == 'S' ? (void*)CTX_REG_STR(ctx, 0) :
+ sig[0] == 'P' ? (void*)CTX_REG_PMC(ctx, 0) : NULL;
}
INTVAL
@@ -386,7 +446,7 @@
va_start(args, sig);
ctx = runops_args(interp, sub, obj, meth, sig, args);
va_end(args);
- return set_retval_i(interp, *sig, ctx);
+ return CTX_REG_INT(ctx, 0);
}
FLOATVAL
@@ -399,7 +459,7 @@
va_start(args, sig);
ctx = runops_args(interp, sub, obj, meth, sig, args);
va_end(args);
- return set_retval_f(interp, *sig, ctx);
+ return CTX_REG_NUM(ctx, 0);
}
void *
@@ -409,7 +469,8 @@
parrot_context_t *ctx;
ctx = runops_args(interp, sub, PMCNULL, NULL, sig, args);
- return set_retval(interp, *sig, ctx);
+ return sig[0] == 'S' ? (void*)CTX_REG_STR(ctx, 0) :
+ sig[0] == 'P' ? (void*)CTX_REG_PMC(ctx, 0) : NULL;
}
INTVAL
@@ -419,7 +480,7 @@
parrot_context_t *ctx;
ctx = runops_args(interp, sub, PMCNULL, NULL, sig, args);
- return set_retval_i(interp, *sig, ctx);
+ return CTX_REG_INT(ctx, 0);
}
FLOATVAL
@@ -429,7 +490,7 @@
parrot_context_t *ctx;
ctx = runops_args(interp, sub, PMCNULL, NULL, sig, args);
- return set_retval_f(interp, *sig, ctx);
+ return CTX_REG_NUM(ctx, 0);
}
void*
@@ -439,7 +500,8 @@
parrot_context_t *ctx;
ctx = runops_args(interp, sub, obj, meth, sig, args);
- return set_retval(interp, *sig, ctx);
+ return sig[0] == 'S' ? (void*)CTX_REG_STR(ctx, 0) :
+ sig[0] == 'P' ? (void*)CTX_REG_PMC(ctx, 0) : NULL;
}
INTVAL
@@ -449,7 +511,7 @@
parrot_context_t *ctx;
ctx = runops_args(interp, sub, obj, meth, sig, args);
- return set_retval_i(interp, *sig, ctx);
+ return CTX_REG_INT(ctx, 0);
}
FLOATVAL
@@ -459,7 +521,7 @@
parrot_context_t *ctx;
ctx = runops_args(interp, sub, obj, meth, sig, args);
- return set_retval_f(interp, *sig, ctx);
+ return CTX_REG_NUM(ctx, 0);
}
/*
