[Guile-commits] 05/13: Invoke VM hooks through intrinsics

[Andy Wingo]

wingo pushed a commit to branch lightning
in repository guile.

commit 602702772412ffcf2476afa0a41b4e290fb67f59
Author: Andy Wingo <address@hidden>
Date:   Sat Aug 11 11:13:37 2018 +0200

    Invoke VM hooks through intrinsics
    
    * libguile/intrinsics.h (SCM_FOR_ALL_VM_INTRINSICS): Make intrinsics for
      the VM hooks.
    * libguile/vm-engine.c (RUN_HOOK): Run hooks through the intrinsics
      table.
    * libguile/vm.c (invoke_apply_hook, invoke_return_hook):
      (invoke_next_hook, invoke_abort_hook): Rename, remove NOINLINE
      attribute (as we call them through the intrinsics table).
      (scm_bootstrap_vm): Init new intrinsics.
---
 libguile/intrinsics.h |  4 ++++
 libguile/vm-engine.c  |  2 +-
 libguile/vm.c         | 32 ++++++++++++++++++--------------
 3 files changed, 23 insertions(+), 15 deletions(-)

diff --git a/libguile/intrinsics.h b/libguile/intrinsics.h
index 5a26b26..1305623 100644
--- a/libguile/intrinsics.h
+++ b/libguile/intrinsics.h
@@ -134,6 +134,10 @@ typedef uint32_t* (*scm_t_vra_from_thread_intrinsic) 
(scm_thread*);
   M(scm_from_thread, current_module, "current-module", CURRENT_MODULE) \
   M(thread_u8_scm_sp_vra, push_prompt, "push-prompt", PUSH_PROMPT) \
   M(thread_scm, unpack_values_object, "unpack-values-object", 
UNPACK_VALUES_OBJECT) \
+  M(thread, invoke_apply_hook, "invoke-apply-hook", INVOKE_APPLY_HOOK) \
+  M(thread, invoke_return_hook, "invoke-return-hook", INVOKE_RETURN_HOOK) \
+  M(thread, invoke_next_hook, "invoke-next-hook", INVOKE_NEXT_HOOK) \
+  M(thread, invoke_abort_hook, "invoke-abort-hook", INVOKE_ABORT_HOOK) \
   /* 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 7750815..0948956 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -115,7 +115,7 @@
     if (SCM_UNLIKELY (VP->trace_level))                 \
       {                                                 \
         SYNC_IP ();                                     \
-        vm_dispatch_##h##_hook (thread);                \
+        CALL_INTRINSIC (invoke_##h##_hook, (thread));   \
         CACHE_SP ();                                    \
       }                                                 \
   } while (0)
diff --git a/libguile/vm.c b/libguile/vm.c
index 9dc94f8..3159aca 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -195,10 +195,10 @@ scm_i_capture_current_stack (void)
                                  0);
 }
 
-static void vm_dispatch_apply_hook (scm_thread *thread) SCM_NOINLINE;
-static void vm_dispatch_return_hook (scm_thread *thread) SCM_NOINLINE;
-static void vm_dispatch_next_hook (scm_thread *thread) SCM_NOINLINE;
-static void vm_dispatch_abort_hook (scm_thread *thread) SCM_NOINLINE;
+static void invoke_apply_hook (scm_thread *thread);
+static void invoke_return_hook (scm_thread *thread);
+static void invoke_next_hook (scm_thread *thread);
+static void invoke_abort_hook (scm_thread *thread);
 
 /* Return the first integer greater than or equal to LEN such that
    LEN % ALIGN == 0.  Return LEN if ALIGN is zero.  */
@@ -206,7 +206,7 @@ static void vm_dispatch_abort_hook (scm_thread *thread) 
SCM_NOINLINE;
   ((align) ? (((len) - 1UL) | ((align) - 1UL)) + 1UL : (len))
 
 static void
-vm_dispatch_hook (scm_thread *thread, int hook_num)
+invoke_hook (scm_thread *thread, int hook_num)
 {
   struct scm_vm *vp = &thread->vm;
   SCM hook;
@@ -258,24 +258,24 @@ vm_dispatch_hook (scm_thread *thread, int hook_num)
 }
 
 static void
-vm_dispatch_apply_hook (scm_thread *thread)
+invoke_apply_hook (scm_thread *thread)
 {
-  return vm_dispatch_hook (thread, SCM_VM_APPLY_HOOK);
+  return invoke_hook (thread, SCM_VM_APPLY_HOOK);
 }
 static void
-vm_dispatch_return_hook (scm_thread *thread)
+invoke_return_hook (scm_thread *thread)
 {
-  return vm_dispatch_hook (thread, SCM_VM_RETURN_HOOK);
+  return invoke_hook (thread, SCM_VM_RETURN_HOOK);
 }
 static void
-vm_dispatch_next_hook (scm_thread *thread)
+invoke_next_hook (scm_thread *thread)
 {
-  return vm_dispatch_hook (thread, SCM_VM_NEXT_HOOK);
+  return invoke_hook (thread, SCM_VM_NEXT_HOOK);
 }
 static void
-vm_dispatch_abort_hook (scm_thread *thread)
+invoke_abort_hook (scm_thread *thread)
 {
-  return vm_dispatch_hook (thread, SCM_VM_ABORT_CONTINUATION_HOOK);
+  return invoke_hook (thread, SCM_VM_ABORT_CONTINUATION_HOOK);
 }
 
 
@@ -1412,7 +1412,7 @@ scm_call_n (SCM proc, SCM *argv, size_t nargs)
         scm_gc_after_nonlocal_exit ();
         /* Non-local return.  */
         if (vp->trace_level)
-          vm_dispatch_abort_hook (thread);
+          invoke_abort_hook (thread);
       }
     else
       vp->ip = get_callee_vcode (thread);
@@ -1697,6 +1697,10 @@ scm_bootstrap_vm (void)
   scm_vm_intrinsics.abort_to_prompt = abort_to_prompt;
   scm_vm_intrinsics.get_callee_vcode = get_callee_vcode;
   scm_vm_intrinsics.unpack_values_object = unpack_values_object;
+  scm_vm_intrinsics.invoke_apply_hook = invoke_apply_hook;
+  scm_vm_intrinsics.invoke_return_hook = invoke_return_hook;
+  scm_vm_intrinsics.invoke_next_hook = invoke_next_hook;
+  scm_vm_intrinsics.invoke_abort_hook = invoke_abort_hook;
 
   sym_keyword_argument_error = scm_from_latin1_symbol 
("keyword-argument-error");
   sym_regular = scm_from_latin1_symbol ("regular");