diff options
-rw-r--r-- | libguile/async.c | 4 | ||||
-rw-r--r-- | libguile/async.h | 3 | ||||
-rw-r--r-- | libguile/vm-engine.c | 62 | ||||
-rw-r--r-- | libguile/vm.c | 7 |
4 files changed, 60 insertions, 16 deletions
diff --git a/libguile/async.c b/libguile/async.c index 9123ec7c1..b9dc78442 100644 --- a/libguile/async.c +++ b/libguile/async.c @@ -55,7 +55,7 @@ * list in the order they were added to the list. */ -static void +void scm_i_async_push (scm_i_thread *t, SCM proc) { SCM asyncs; @@ -101,7 +101,7 @@ scm_i_async_push (scm_i_thread *t, SCM proc) } /* Precondition: there are pending asyncs. */ -static SCM +SCM scm_i_async_pop (scm_i_thread *t) { while (1) diff --git a/libguile/async.h b/libguile/async.h index 343cc2ae6..1a40a83bd 100644 --- a/libguile/async.h +++ b/libguile/async.h @@ -46,6 +46,9 @@ SCM_API void *scm_c_call_with_unblocked_asyncs (void *(*p) (void *d), void *d); SCM_API void scm_dynwind_block_asyncs (void); SCM_API void scm_dynwind_unblock_asyncs (void); +SCM_INTERNAL void scm_i_async_push (scm_i_thread *t, SCM proc); +SCM_INTERNAL SCM scm_i_async_pop (scm_i_thread *t); + SCM_INTERNAL void scm_init_async (void); #endif /* SCM_ASYNC_H */ diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c index ac8f32e49..cfb60f242 100644 --- a/libguile/vm-engine.c +++ b/libguile/vm-engine.c @@ -3872,22 +3872,56 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, */ VM_DEFINE_OP (183, handle_interrupts, "handle-interrupts", OP1 (X32)) { - /* TODO: Invoke asyncs without trampolining out to C. That will - let us preempt computations via an asynchronous interrupt. */ - if (SCM_LIKELY (thread->block_asyncs == 0)) - { - SCM asyncs = scm_atomic_ref_scm (&thread->pending_asyncs); - if (SCM_UNLIKELY (!scm_is_null (asyncs))) - { - SYNC_IP (); - scm_async_tick (); - CACHE_SP (); - } - } - NEXT (1); + if (SCM_LIKELY (scm_is_null + (scm_atomic_ref_scm (&thread->pending_asyncs)))) + NEXT (1); + + 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 = (scm_t_uint32 *) vm_handle_interrupt_code; + + APPLY_HOOK (); + + NEXT (0); + } + } + + /* return-from-interrupt _:24 + * + * Return from handling an interrupt, discarding any return values and + * stripping away the interrupt frame. + */ + VM_DEFINE_OP (184, return_from_interrupt, "return-from-interrupt", OP1 (X32)) + { + vp->sp = sp = SCM_FRAME_PREVIOUS_SP (vp->fp); + ip = SCM_FRAME_RETURN_ADDRESS (vp->fp); + vp->fp = SCM_FRAME_DYNAMIC_LINK (vp->fp); + + NEXT (0); } - VM_DEFINE_OP (184, unused_184, NULL, NOP) VM_DEFINE_OP (185, unused_185, NULL, NOP) VM_DEFINE_OP (186, unused_186, NULL, NOP) VM_DEFINE_OP (187, unused_187, NULL, NOP) diff --git a/libguile/vm.c b/libguile/vm.c index 86e1a0576..3c616205b 100644 --- a/libguile/vm.c +++ b/libguile/vm.c @@ -666,6 +666,13 @@ static const scm_t_uint32 vm_builtin_call_with_current_continuation_code[] = { SCM_PACK_OP_24 (call_cc, 0) }; +static const scm_t_uint32 vm_handle_interrupt_code[] = { + SCM_PACK_OP_24 (alloc_frame, 3), + SCM_PACK_OP_12_12 (mov, 0, 2), + SCM_PACK_OP_24 (call, 2), SCM_PACK_OP_ARG_8_24 (0, 1), + SCM_PACK_OP_24 (return_from_interrupt, 0) +}; + int scm_i_vm_is_boot_continuation_code (scm_t_uint32 *ip) |