1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-09 21:40:33 +02:00

Fix call/cc with the RTL VM

* libguile/vm.c (vm_return_to_continuation): The RTL VM saves the
  registers for the caller of call/cc, but the caller will expect values
  in the normal MV return location: above the frame.  Make it so, number
  four!
This commit is contained in:
Andy Wingo 2013-11-01 19:28:36 +01:00
parent 14b9aa95e6
commit 03f16599e3

View file

@ -150,7 +150,7 @@ vm_return_to_continuation (SCM vm, SCM cont, size_t n, SCM *argv)
scm_misc_error (NULL, "Too few values returned to continuation",
SCM_EOL);
if (vp->stack_size < cp->stack_size + n + 1)
if (vp->stack_size < cp->stack_size + n + 4)
scm_misc_error ("vm-engine", "not enough space to reinstate continuation",
scm_list_2 (vm, cont));
@ -167,22 +167,22 @@ vm_return_to_continuation (SCM vm, SCM cont, size_t n, SCM *argv)
vp->fp = cp->fp;
memcpy (vp->stack_base, cp->stack_base, cp->stack_size * sizeof (SCM));
if (n == 1 || !cp->mvra)
{
vp->ip = cp->ra;
vp->sp++;
*vp->sp = argv_copy[0];
}
else
{
size_t i;
/* Push on an empty frame, as the continuation expects. */
for (i = 0; i < 4; i++)
{
vp->sp++;
*vp->sp = SCM_BOOL_F;
}
/* Push the return values. */
for (i = 0; i < n; i++)
{
vp->sp++;
*vp->sp = argv_copy[i];
}
vp->sp++;
*vp->sp = scm_from_size_t (n);
vp->ip = cp->mvra;
}
}