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

partial-cont-call works

Browse source 
* libguile/vm-i-system.c (partial-cont-call): Sync registers before
  splatting a partial continuation, and cache them back afterwards.

* libguile/vm.c (vm_reinstate_partial_continuation): Actually implement,
  except dynamic-wind.
This commit is contained in:
Andy Wingo 2010-02-24 16:56:45 +01:00
parent 6d804376e9
commit 078014374c
2 changed files with 53 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

8
libguile/vm-i-system.c
View file

@ -999,8 +999,12 @@ VM_DEFINE_INSTRUCTION (94, partial_cont_call, "partial-cont-call", 0, -1, 0)
POP (extwinds); POP (extwinds);
POP (intwinds); POP (intwinds);
POP (vmcont); POP (vmcont);
SYNC_REGISTER ();
vm_reinstate_partial_continuation (vm, vmcont, intwinds, extwinds); vm_reinstate_partial_continuation (vm, vmcont, intwinds, extwinds,
sp + 1 - fp, fp);
CACHE_REGISTER ();
program = SCM_FRAME_PROGRAM (fp);
CACHE_PROGRAM ();
NEXT; NEXT;
} }

50
libguile/vm.c
View file

@ -229,10 +229,54 @@ vm_abort (SCM vm, size_t n, scm_t_int64 vm_cookie)
} }
static void static void
vm_reinstate_partial_continuation (SCM vm, SCM vm_cont, SCM intwinds, vm_reinstate_partial_continuation (SCM vm, SCM cont, SCM intwinds,
SCM extwinds) SCM extwinds, size_t n, SCM *argv)
{ {
abort (); struct scm_vm *vp;
struct scm_vm_cont *cp;
SCM *argv_copy, *base;
size_t i;
argv_copy = alloca (n * sizeof(SCM));
memcpy (argv_copy, argv, n * sizeof(SCM));
vp = SCM_VM_DATA (vm);
cp = SCM_VM_CONT_DATA (cont);
base = SCM_FRAME_UPPER_ADDRESS (vp->fp) + 1;
#define RELOC(scm_p) (scm_p + cp->reloc + (base - cp->stack_base))
if ((base - vp->stack_base) + cp->stack_size + n + 1 > vp->stack_size)
{
/* puts ("FIXME: Need to expand"); */
abort ();
}
memcpy (base, cp->stack_base, cp->stack_size * sizeof (SCM));
/* now relocate frame pointers */
{
SCM *fp;
for (fp = RELOC (cp->fp);
SCM_FRAME_LOWER_ADDRESS (fp) > base;
fp = SCM_FRAME_DYNAMIC_LINK (fp))
SCM_FRAME_SET_DYNAMIC_LINK (fp, RELOC (SCM_FRAME_DYNAMIC_LINK (fp)));
}
vp->sp = base - 1 + cp->stack_size;
vp->fp = RELOC (cp->fp);
vp->ip = cp->mvra;
#undef RELOC
/* now push args. ip is in a MV context. */
for (i = 0; i < n; i++)
{
vp->sp++;
*vp->sp = argv_copy[i];
}
vp->sp++;
*vp->sp = scm_from_size_t (n);
} }