diff options
author | Andy Wingo <wingo@pobox.com> | 2010-02-24 16:56:45 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2010-02-24 16:57:33 +0100 |
commit | 078014374c066f03975bd0ef008877c5236c75ec (patch) | |
tree | a4279483a20a2c3975d37fb116b30cbd60375d12 | |
parent | 6d804376e94d17cf013a415c4bd98d632f7a91b9 (diff) | |
download | guile-078014374c066f03975bd0ef008877c5236c75ec.tar.gz |
partial-cont-call works
* 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.
-rw-r--r-- | libguile/vm-i-system.c | 8 | ||||
-rw-r--r-- | libguile/vm.c | 50 |
2 files changed, 53 insertions, 5 deletions
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c index 09293bef8..2f74a59dc 100644 --- a/libguile/vm-i-system.c +++ b/libguile/vm-i-system.c @@ -999,8 +999,12 @@ VM_DEFINE_INSTRUCTION (94, partial_cont_call, "partial-cont-call", 0, -1, 0) POP (extwinds); POP (intwinds); POP (vmcont); - - vm_reinstate_partial_continuation (vm, vmcont, intwinds, extwinds); + SYNC_REGISTER (); + vm_reinstate_partial_continuation (vm, vmcont, intwinds, extwinds, + sp + 1 - fp, fp); + CACHE_REGISTER (); + program = SCM_FRAME_PROGRAM (fp); + CACHE_PROGRAM (); NEXT; } diff --git a/libguile/vm.c b/libguile/vm.c index 572a7100a..a5f457013 100644 --- a/libguile/vm.c +++ b/libguile/vm.c @@ -229,10 +229,54 @@ vm_abort (SCM vm, size_t n, scm_t_int64 vm_cookie) } static void -vm_reinstate_partial_continuation (SCM vm, SCM vm_cont, SCM intwinds, - SCM extwinds) +vm_reinstate_partial_continuation (SCM vm, SCM cont, SCM intwinds, + 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); } |