Inline interrupts

* libguile/async.c:
* libguile/async.h (scm_i_async_push, scm_i_async_pop): Make internally
  available.
* libguile/vm-engine.c (vm_engine): Invoke interrupts inline.  Add
  return-from-interrupt instruction.
* libguile/vm.c (vm_handle_interrupt_code): New "builtin".

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)

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 */

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
+      if (SCM_LIKELY (scm_is_null
-         let us preempt computations via an asynchronous interrupt.  */
+                      (scm_atomic_ref_scm (&thread->pending_asyncs))))
-      if (SCM_LIKELY (thread->block_asyncs == 0))
+        NEXT (1);
-        {
+
-          SCM asyncs = scm_atomic_ref_scm (&thread->pending_asyncs);
+      if (thread->block_asyncs > 0)
-          if (SCM_UNLIKELY (!scm_is_null (asyncs)))
+        NEXT (1);
-            {
+
-              SYNC_IP ();
+      {
-              scm_async_tick ();
+        union scm_vm_stack_element *old_fp;
-              CACHE_SP ();
+        size_t old_frame_size = FRAME_LOCALS_COUNT ();
-            }
+        SCM proc = scm_i_async_pop (thread);
-        }
+
-      NEXT (1);
+        /* 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)

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)