Rework hook dispatch mechanism

* libguile/vm-engine.c (RUN_HOOK, RUN_HOOK0, RUN_HOOK1): Rework to
  dispatch through specific per-hook procedures.  Might reduce register
  pressure in the VM.

* libguile/vm.c (vm_dispatch_apply_hook):
  (vm_dispatch_push_continuation_hook):
  (vm_dispatch_pop_continuation_hook):
  (vm_dispatch_next_hook):
  (vm_dispatch_abort_hook):
  (vm_dispatch_restore_continuation_hook): New internal helpers.

diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index 85674c0..065b7fe 100644 (file)
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -100,35 +100,32 @@
 #endif
 
 #if VM_USE_HOOKS
-#define RUN_HOOK(h, args, n)                            \
+#define RUN_HOOK(exp)                                   \
   do {                                                  \
     if (SCM_UNLIKELY (vp->trace_level > 0))             \
       {                                                 \
         SYNC_REGISTER ();                              \
-        vm_dispatch_hook (vm, h, args, n);              \
+        exp;                                            \
       }                                                 \
   } while (0)
 #else
-#define RUN_HOOK(h, args, n)
+#define RUN_HOOK(exp)
 #endif
-#define RUN_HOOK0(h) RUN_HOOK(h, NULL, 0)
+#define RUN_HOOK0(h)      RUN_HOOK (vm_dispatch_##h##_hook (vm))
+#define RUN_HOOK1(h, arg) RUN_HOOK (vm_dispatch_##h##_hook (vm, arg))
 
 #define APPLY_HOOK()                            \
-  RUN_HOOK0 (SCM_VM_APPLY_HOOK)
+  RUN_HOOK0 (apply)
 #define PUSH_CONTINUATION_HOOK()                \
-  RUN_HOOK0 (SCM_VM_PUSH_CONTINUATION_HOOK)
+  RUN_HOOK0 (push_continuation)
 #define POP_CONTINUATION_HOOK(old_fp)           \
-  RUN_HOOK (SCM_VM_POP_CONTINUATION_HOOK,       \
-            &SCM_FRAME_LOCAL (old_fp, 1),       \
-            SCM_FRAME_NUM_LOCALS (old_fp, vp->sp) - 1)
+  RUN_HOOK1 (pop_continuation, old_fp)
 #define NEXT_HOOK()                             \
-  RUN_HOOK0 (SCM_VM_NEXT_HOOK)
+  RUN_HOOK0 (next)
 #define ABORT_CONTINUATION_HOOK()               \
-  RUN_HOOK (SCM_VM_ABORT_CONTINUATION_HOOK,     \
-            LOCAL_ADDRESS (1),                  \
-            FRAME_LOCALS_COUNT () - 1)
-#define RESTORE_CONTINUATION_HOOK()            \
-  RUN_HOOK0 (SCM_VM_RESTORE_CONTINUATION_HOOK)
+  RUN_HOOK0 (abort)
+#define RESTORE_CONTINUATION_HOOK()             \
+  RUN_HOOK0 (restore_continuation)
 
 #define VM_HANDLE_INTERRUPTS                     \
   SCM_ASYNC_TICK_WITH_CODE (current_thread, SYNC_REGISTER ())
@@ -3156,6 +3153,7 @@ VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
 #undef RETURN_VALUE_LIST
 #undef RUN_HOOK
 #undef RUN_HOOK0
+#undef RUN_HOOK1
 #undef SYNC_ALL
 #undef SYNC_BEFORE_GC
 #undef SYNC_IP

diff --git a/libguile/vm.c b/libguile/vm.c
index 5aaf624..125501e 100644 (file)
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -168,8 +168,12 @@ scm_i_capture_current_stack (void)
                                  0);
 }
 
-static void vm_dispatch_hook (SCM vm, int hook_num,
-                              SCM *argv, int n) SCM_NOINLINE;
+static void vm_dispatch_apply_hook (SCM vm) SCM_NOINLINE;
+static void vm_dispatch_push_continuation_hook (SCM vm) SCM_NOINLINE;
+static void vm_dispatch_pop_continuation_hook (SCM vm, SCM *old_fp) SCM_NOINLINE;
+static void vm_dispatch_next_hook (SCM vm) SCM_NOINLINE;
+static void vm_dispatch_abort_hook (SCM vm) SCM_NOINLINE;
+static void vm_dispatch_restore_continuation_hook (SCM vm) SCM_NOINLINE;
 
 static void
 vm_dispatch_hook (SCM vm, int hook_num, SCM *argv, int n)
@@ -238,6 +242,38 @@ vm_dispatch_hook (SCM vm, int hook_num, SCM *argv, int n)
   vp->trace_level = saved_trace_level;
 }
 
+static void
+vm_dispatch_apply_hook (SCM vm)
+{
+  return vm_dispatch_hook (vm, SCM_VM_APPLY_HOOK, NULL, 0);
+}
+static void vm_dispatch_push_continuation_hook (SCM vm)
+{
+  return vm_dispatch_hook (vm, SCM_VM_PUSH_CONTINUATION_HOOK, NULL, 0);
+}
+static void vm_dispatch_pop_continuation_hook (SCM vm, SCM *old_fp)
+{
+  struct scm_vm *vp = SCM_VM_DATA (vm);
+  return vm_dispatch_hook (vm, SCM_VM_POP_CONTINUATION_HOOK,
+                           &SCM_FRAME_LOCAL (old_fp, 1),
+                           SCM_FRAME_NUM_LOCALS (old_fp, vp->sp) - 1);
+}
+static void vm_dispatch_next_hook (SCM vm)
+{
+  return vm_dispatch_hook (vm, SCM_VM_NEXT_HOOK, NULL, 0);
+}
+static void vm_dispatch_abort_hook (SCM vm)
+{
+  struct scm_vm *vp = SCM_VM_DATA (vm);
+  return vm_dispatch_hook (vm, SCM_VM_ABORT_CONTINUATION_HOOK,
+                           &SCM_FRAME_LOCAL (vp->fp, 1),
+                           SCM_FRAME_NUM_LOCALS (vp->fp, vp->sp) - 1);
+}
+static void vm_dispatch_restore_continuation_hook (SCM vm)
+{
+  return vm_dispatch_hook (vm, SCM_VM_RESTORE_CONTINUATION_HOOK, NULL, 0);
+}
+
 static void
 vm_abort (SCM vm, SCM tag, size_t nstack, SCM *stack_args, SCM tail, SCM *sp,
           scm_i_jmp_buf *current_registers) SCM_NORETURN;