diff --git a/libguile/intrinsics.h b/libguile/intrinsics.h index 434aad3be..aa242416e 100644 --- a/libguile/intrinsics.h +++ b/libguile/intrinsics.h @@ -24,6 +24,8 @@ #error intrinsics.h is private and uninstalled #endif +#include + #include @@ -52,6 +54,7 @@ typedef void (*scm_t_thread_u32_u32_scm_u8_u8_intrinsic) (scm_thread*, uint32_t, typedef SCM (*scm_t_scm_from_scm_scm_scmp_sp_intrinsic) (SCM, SCM, SCM*, const union scm_vm_stack_element*); typedef void (*scm_t_thread_scm_noreturn_intrinsic) (scm_thread*, SCM) SCM_NORETURN; +typedef SCM (*scm_t_scm_from_thread_regs_intrinsic) (scm_thread*, jmp_buf*); #define SCM_FOR_ALL_VM_INTRINSICS(M) \ M(scm_from_scm_scm, add, "add", ADD) \ @@ -103,6 +106,7 @@ typedef void (*scm_t_thread_scm_noreturn_intrinsic) (scm_thread*, SCM) SCM_NORET M(thread, push_interrupt_frame, "push-interrupt-frame", PUSH_INTERRUPT_FRAME) \ M(scm_from_scm_scm_scmp_sp, foreign_call, "foreign-call", FOREIGN_CALL) \ M(thread_scm_noreturn, reinstate_continuation_x, "reinstate-continuation!", REINSTATE_CONTINUATION_X) \ + M(scm_from_thread_regs, capture_continuation, "capture-continuation", CAPTURE_CONTINUATION) \ /* Add new intrinsics here; also update scm_bootstrap_intrinsics. */ enum scm_vm_intrinsic diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c index 920cf1f97..3b46a6f0f 100644 --- a/libguile/vm-engine.c +++ b/libguile/vm-engine.c @@ -756,18 +756,10 @@ VM_NAME (scm_thread *thread, jmp_buf *registers, int resume) */ VM_DEFINE_OP (15, call_cc, "call/cc", OP1 (X32)) { - SCM vm_cont, cont; - scm_t_dynstack *dynstack; + SCM cont; SYNC_IP (); - dynstack = scm_dynstack_capture_all (&thread->dynstack); - vm_cont = scm_i_vm_capture_stack (VP->stack_top, - SCM_FRAME_DYNAMIC_LINK (VP->fp), - SCM_FRAME_PREVIOUS_SP (VP->fp), - SCM_FRAME_RETURN_ADDRESS (VP->fp), - dynstack, - 0); - cont = scm_i_make_continuation (registers, thread, vm_cont); + cont = scm_vm_intrinsics.capture_continuation (thread, registers); RESET_FRAME (2); diff --git a/libguile/vm.c b/libguile/vm.c index 7c301042b..662b3d627 100644 --- a/libguile/vm.c +++ b/libguile/vm.c @@ -1298,6 +1298,20 @@ reinstate_continuation_x (scm_thread *thread, SCM cont) scm_i_reinstate_continuation (cont); } +static SCM +capture_continuation (scm_thread *thread, jmp_buf *registers) +{ + struct scm_vm *vp = &thread->vm; + SCM vm_cont = + scm_i_vm_capture_stack (vp->stack_top, + SCM_FRAME_DYNAMIC_LINK (vp->fp), + SCM_FRAME_PREVIOUS_SP (vp->fp), + SCM_FRAME_RETURN_ADDRESS (vp->fp), + scm_dynstack_capture_all (&thread->dynstack), + 0); + return scm_i_make_continuation (registers, thread, vm_cont); +} + SCM scm_call_n (SCM proc, SCM *argv, size_t nargs) { @@ -1642,6 +1656,7 @@ scm_bootstrap_vm (void) scm_vm_intrinsics.bind_kwargs = bind_kwargs; scm_vm_intrinsics.push_interrupt_frame = push_interrupt_frame; scm_vm_intrinsics.reinstate_continuation_x = reinstate_continuation_x; + scm_vm_intrinsics.capture_continuation = capture_continuation; sym_vm_run = scm_from_latin1_symbol ("vm-run"); sym_vm_error = scm_from_latin1_symbol ("vm-error");