Add push-interrupt-frame VM intrinsic

* libguile/intrinsics.h (SCM_FOR_ALL_VM_INTRINSICS): Add
  push-interrupt-frame.
* libguile/vm.c (push_interrupt_frame): New intrinsic.  Goal is to
  reduce the amount of inline code the JIT will generate for handling
  interrupts.
* libguile/vm-engine.c (handle-interrupts): Call out to the
  push_interrupt_frame intrinsic in the slow case.

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

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);
 
-      {
+      SYNC_IP ();
-        union scm_vm_stack_element *old_fp;
+      i->push_interrupt_frame (thread);
-        size_t old_frame_size = FRAME_LOCALS_COUNT ();
+      CACHE_SP ();
-        SCM proc = scm_i_async_pop (thread);
+      ip = (uint32_t *) vm_handle_interrupt_code;
-
+      APPLY_HOOK ();
-        /* No PUSH_CONTINUATION_HOOK, as we can't usefully
+      NEXT (0);
-           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);
-      }
     }
 
   /* return-from-interrupt _:24

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");