diff --git a/libguile/intrinsics.h b/libguile/intrinsics.h index 85f4a2eb9..16760e3c8 100644 --- a/libguile/intrinsics.h +++ b/libguile/intrinsics.h @@ -95,7 +95,8 @@ typedef void (*scm_t_thread_u32_u32_scm_u8_u8_intrinsic) (scm_i_thread*, uint32_ M(thread_sp, expand_stack, "expand-stack", EXPAND_STACK) \ M(scm_from_thread_u32, cons_rest, "cons-rest", CONS_REST) \ M(u32_from_thread_u32_u32, compute_kwargs_npositional, "compute-kwargs-npositional", COMPUTE_KWARGS_NPOSITIONAL) \ - M(thread_u32_u32_scm_u8_u8, bind_kwargs, "bind-kwargs", BIND_KWARGS) \ + M(thread_u32_u32_scm_u8_u8, bind_kwargs, "bind-kwargs", BIND_KWARGS) \ + M(thread, push_interrupt_frame, "push-interrupt-frame", PUSH_INTERRUPT_FRAME) \ /* 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 6eb047472..56c5ec177 100644 --- a/libguile/vm-engine.c +++ b/libguile/vm-engine.c @@ -2443,6 +2443,8 @@ VM_NAME (scm_i_thread *thread, jmp_buf *registers, int resume) */ VM_DEFINE_OP (183, handle_interrupts, "handle-interrupts", OP1 (X32)) { + struct scm_vm_intrinsics *i = (void*)intrinsics; + if (SCM_LIKELY (scm_is_null (scm_atomic_ref_scm (&thread->pending_asyncs)))) NEXT (1); @@ -2450,33 +2452,12 @@ VM_NAME (scm_i_thread *thread, jmp_buf *registers, int resume) if (thread->block_asyncs > 0) NEXT (1); - { - union scm_vm_stack_element *old_fp; - size_t old_frame_size = FRAME_LOCALS_COUNT (); - SCM proc = scm_i_async_pop (thread); - - /* No PUSH_CONTINUATION_HOOK, as we can't usefully - POP_CONTINUATION_HOOK because there are no return values. */ - - /* Three slots: two for RA and dynamic link, one for proc. */ - ALLOC_FRAME (old_frame_size + 3); - - /* Set up a frame that will return right back to this - handle-interrupts opcode to handle any additional - interrupts. */ - old_fp = VP->fp; - VP->fp = SCM_FRAME_SLOT (old_fp, old_frame_size + 1); - SCM_FRAME_SET_DYNAMIC_LINK (VP->fp, old_fp); - SCM_FRAME_SET_RETURN_ADDRESS (VP->fp, ip); - - SP_SET (0, proc); - - ip = (uint32_t *) vm_handle_interrupt_code; - - APPLY_HOOK (); - - NEXT (0); - } + SYNC_IP (); + i->push_interrupt_frame (thread); + CACHE_SP (); + ip = (uint32_t *) vm_handle_interrupt_code; + APPLY_HOOK (); + NEXT (0); } /* return-from-interrupt _:24 diff --git a/libguile/vm.c b/libguile/vm.c index 5c13deb0f..1a7308c9c 100644 --- a/libguile/vm.c +++ b/libguile/vm.c @@ -1261,6 +1261,29 @@ cons_rest (scm_i_thread *thread, uint32_t base) return rest; } +static void +push_interrupt_frame (scm_i_thread *thread) +{ + union scm_vm_stack_element *old_fp; + size_t old_frame_size = frame_locals_count (thread); + SCM proc = scm_i_async_pop (thread); + + /* No PUSH_CONTINUATION_HOOK, as we can't usefully + POP_CONTINUATION_HOOK because there are no return values. */ + + /* Three slots: two for RA and dynamic link, one for proc. */ + alloc_frame (thread, old_frame_size + 3); + + old_fp = thread->vm.fp; + thread->vm.fp = SCM_FRAME_SLOT (old_fp, old_frame_size + 1); + SCM_FRAME_SET_DYNAMIC_LINK (thread->vm.fp, old_fp); + /* Arrange to return to the same handle-interrupts opcode to handle + any additional interrupts. */ + SCM_FRAME_SET_RETURN_ADDRESS (thread->vm.fp, thread->vm.ip); + + SCM_FRAME_LOCAL (thread->vm.fp, 0) = proc; +} + SCM scm_call_n (SCM proc, SCM *argv, size_t nargs) { @@ -1603,6 +1626,7 @@ scm_bootstrap_vm (void) scm_vm_intrinsics.cons_rest = cons_rest; scm_vm_intrinsics.compute_kwargs_npositional = compute_kwargs_npositional; scm_vm_intrinsics.bind_kwargs = bind_kwargs; + scm_vm_intrinsics.push_interrupt_frame = push_interrupt_frame; sym_vm_run = scm_from_latin1_symbol ("vm-run"); sym_vm_error = scm_from_latin1_symbol ("vm-error");