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:
parent
14b9aa95e6
commit
03f16599e3
1 changed files with 19 additions and 19 deletions
|
@ -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;
|
||||
}
|
||||
}
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue