[Guile-commits] 12/26: Add push-interrupt-frame VM intrinsic

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit 08bf4aba30d6365d5fc73fe5ced5f83ff819205c
Author: Andy Wingo <address@hidden>
Date:   Mon Jun 25 10:52:16 2018 +0200

    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 |  3 ++-
 libguile/vm-engine.c  | 35 ++++++++---------------------------
 libguile/vm.c         | 24 ++++++++++++++++++++++++
 3 files changed, 34 insertions(+), 28 deletions(-)

diff --git a/libguile/intrinsics.h b/libguile/intrinsics.h
index 85f4a2e..16760e3 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 6eb0474..56c5ec1 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 5c13deb..1a7308c 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");