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

Fix call/cc with the RTL VM

Browse source 
* 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
1 changed files with 19 additions and 19 deletions
Download patch file Download diff file Expand all files Collapse all files

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