1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-14 15:40:19 +02:00

actually capture partial continuations

* libguile/control.c (cont_objcode): Along with a bunch of boilerplate
  that certainly needs to go in some central place, define this
  continuation-calling trampoline.
  (reify_partial_continuation): New function, returns a procedure that
  when called will reinstate a partial continuation.
  (scm_c_abort): Take an extra arg, the cookie. Actually reify a
  continuation.
  (scm_at_abort): Adapt to scm_c_abort change.

* libguile/control.h: Declare scm_c_abort change.

* libguile/vm-i-system.c (partial_cont_call): New instruction.
  (call/cc, tail-call/cc): Adapt to scm_i_vm_capture_stack change.
  (abort): Pass vm_cookie to abort.

* libguile/vm.h (SCM_F_VM_CONT_PARTIAL, SCM_F_VM_CONT_REWINDABLE): New
  flags.
  (struct scm_vm_cont): Add flags field.
  (SCM_VM_CONT_PARTIAL_P, SCM_VM_CONT_REWINDABLE_P): New predicates.

* libguile/vm.c (scm_i_vm_capture_stack): Rename from
  vm_capture_continuation, and make internal instead of static. Take a
  flags argument.
  (scm_i_vm_capture_continuation): Adapt to scm_i_vm_capture_stack
  change.
  (vm_abort): Plumb cookie to scm_c_abort.
  (vm_reinstate_partial_continuation): New stub.
This commit is contained in:
Andy Wingo 2010-02-22 23:00:19 +01:00
parent 76e3816281
commit cee1d22c3c
5 changed files with 159 additions and 20 deletions

View file

@ -993,6 +993,17 @@ VM_DEFINE_INSTRUCTION (89, continuation_call, "continuation-call", 0, -1, 0)
abort ();
}
VM_DEFINE_INSTRUCTION (94, partial_cont_call, "partial-cont-call", 0, -1, 0)
{
SCM vmcont, intwinds, extwinds;
POP (extwinds);
POP (intwinds);
POP (vmcont);
vm_reinstate_partial_continuation (vm, vmcont, intwinds, extwinds);
NEXT;
}
VM_DEFINE_INSTRUCTION (59, tail_call_nargs, "tail-call/nargs", 0, 0, 1)
{
SCM x;
@ -1099,7 +1110,7 @@ VM_DEFINE_INSTRUCTION (64, call_cc, "call/cc", 0, 1, 1)
SCM proc, vm_cont, cont;
POP (proc);
SYNC_ALL ();
vm_cont = vm_capture_continuation (vp->stack_base, fp, sp, ip, NULL);
vm_cont = scm_i_vm_capture_stack (vp->stack_base, fp, sp, ip, NULL, 0);
cont = scm_i_make_continuation (&first, vm, vm_cont);
if (first)
{
@ -1131,11 +1142,12 @@ VM_DEFINE_INSTRUCTION (65, tail_call_cc, "tail-call/cc", 0, 1, 1)
SYNC_ALL ();
/* In contrast to call/cc, tail-call/cc captures the continuation without the
stack frame. */
vm_cont = vm_capture_continuation (vp->stack_base,
SCM_FRAME_DYNAMIC_LINK (fp),
SCM_FRAME_LOWER_ADDRESS (fp) - 1,
SCM_FRAME_RETURN_ADDRESS (fp),
SCM_FRAME_MV_RETURN_ADDRESS (fp));
vm_cont = scm_i_vm_capture_stack (vp->stack_base,
SCM_FRAME_DYNAMIC_LINK (fp),
SCM_FRAME_LOWER_ADDRESS (fp) - 1,
SCM_FRAME_RETURN_ADDRESS (fp),
SCM_FRAME_MV_RETURN_ADDRESS (fp),
0);
cont = scm_i_make_continuation (&first, vm, vm_cont);
if (first)
{
@ -1511,7 +1523,7 @@ VM_DEFINE_INSTRUCTION (86, abort, "abort", 1, -1, -1)
SYNC_REGISTER ();
if (sp - n - 2 <= SCM_FRAME_UPPER_ADDRESS (fp))
goto vm_error_stack_underflow;
vm_abort (vm, n);
vm_abort (vm, n, vm_cookie);
/* vm_abort should not return */
abort ();
}