Hook refactors

* libguile/vm.h (SCM_VM_NUM_HOOKS): Remove hook enumeration.
(struct scm_vm): Re-arrange members to be more dense and to use common
cache lines for commonly-used members.  Declare hooks and their enabled
flags by name.
* libguile/vm-engine.c (RUN_HOOK): Refer to hooks by name.
* libguile/vm.c (FOR_EACH_HOOK): New helper.
(vm_hook_compute_enabled, vm_recompute_disable_mcode): New routines to
recompute when hooks are enabled, and whether to disable mcode because
hooks are active.
(set_vm_trace_level): New helper.
(invoke_hook): Take hook to invoke by value.
(DEFINE_INVOKE_HOOK): Refactor to use named hooks.
(scm_i_vm_prepare_stack): Init named hooks.
(VM_ADD_HOOK, VM_REMOVE_HOOK): Refactor to use named hooks, and also
recompute global disable_mcode flag.
(scm_set_vm_trace_level_x, scm_c_set_vm_engine_x): Use internal helper.

libguile/vm-engine.c

@@ -110,9 +110,9 @@
 #endif
 
 #if VM_USE_HOOKS
-#define RUN_HOOK(H, h)                                       \
+#define RUN_HOOK(h)                                          \
   do {                                                       \
-    if (SCM_UNLIKELY (VP->hooks_enabled[SCM_VM_##H##_HOOK])) \
+    if (SCM_UNLIKELY (VP->h##_hook_enabled))                 \
       {                                                      \
         SYNC_IP ();                                          \
         invoke_##h##_hook (thread);                          \
@@ -120,13 +120,13 @@
       }                                                      \
   } while (0)
 #else
-#define RUN_HOOK(H, h)
+#define RUN_HOOK(h)
 #endif
 
-#define APPLY_HOOK()                  RUN_HOOK (APPLY, apply)
+#define APPLY_HOOK()                  RUN_HOOK (apply)
-#define RETURN_HOOK()                 RUN_HOOK (RETURN, return)
+#define RETURN_HOOK()                 RUN_HOOK (return)
-#define NEXT_HOOK()                   RUN_HOOK (NEXT, next)
+#define NEXT_HOOK()                   RUN_HOOK (next)
-#define ABORT_HOOK()                  RUN_HOOK (ABORT, abort)
+#define ABORT_HOOK()                  RUN_HOOK (abort)
 
 
 

libguile/vm.c

@@ -198,34 +198,72 @@ scm_i_capture_current_stack (void)
                         0);
 }
 
+#define FOR_EACH_HOOK(M) \
+  M(apply) \
+  M(return) \
+  M(next) \
+  M(abort)
+
+static void
+vm_hook_compute_enabled (scm_thread *thread, SCM hook, uint8_t *enabled)
+{
+  if (thread->vm.trace_level <= 0
+      || thread->vm.engine == SCM_VM_REGULAR_ENGINE
+      || scm_is_false (hook)
+      || scm_is_true (scm_hook_empty_p (hook)))
+    *enabled = 0;
+  else
+    *enabled = 1;
+}
+
+static void
+vm_recompute_disable_mcode (scm_thread *thread)
+{
+  thread->vm.disable_mcode = 0;
+#define DISABLE_MCODE_IF_HOOK_ENABLED(h) \
+  if (thread->vm.h##_hook_enabled)       \
+    thread->vm.disable_mcode = 1;
+  FOR_EACH_HOOK (DISABLE_MCODE_IF_HOOK_ENABLED)
+#undef DISABLE_MCODE_IF_HOOK_ENABLED
+}
+
+static int
+set_vm_trace_level (scm_thread *thread, int level)
+{
+  int old_level;
+  struct scm_vm *vp = &thread->vm;
+
+  old_level = vp->trace_level;
+  vp->trace_level = level;
+  vp->disable_mcode = 0;
+#define RESET_LEVEL(h) \
+  vm_hook_compute_enabled (thread, vp->h##_hook, &vp->h##_hook_enabled);
+  FOR_EACH_HOOK (RESET_LEVEL);
+#undef RESET_LEVEL
+  vm_recompute_disable_mcode (thread);
+
+  return old_level;
+}
+
 /* Return the first integer greater than or equal to LEN such that
    LEN % ALIGN == 0.  Return LEN if ALIGN is zero.  */
 #define ROUND_UP(len, align)					\
   ((align) ? (((len) - 1UL) | ((align) - 1UL)) + 1UL : (len))
 
 static void
-invoke_hook (scm_thread *thread, int hook_num)
+invoke_hook (scm_thread *thread, SCM hook)
 {
   struct scm_vm *vp = &thread->vm;
-  SCM hook;
   struct scm_frame c_frame;
   scm_t_cell *frame;
   SCM scm_frame;
   int saved_trace_level;
   uint8_t saved_compare_result;
 
-  if (vp->trace_level <= 0 || vp->engine != SCM_VM_DEBUG_ENGINE)
+  if (scm_is_false (hook) || scm_is_null (SCM_HOOK_PROCEDURES (hook)))
     return;
 
-  hook = vp->hooks[hook_num];
+  saved_trace_level = set_vm_trace_level (thread, 0);
-
-  if (SCM_LIKELY (scm_is_false (hook))
-      || scm_is_null (SCM_HOOK_PROCEDURES (hook)))
-    return;
-
-  saved_trace_level = vp->trace_level;
-  vp->trace_level = 0;
-
   saved_compare_result = vp->compare_result;
 
   /* Allocate a frame object on the stack.  This is more efficient than calling
@@ -252,22 +290,22 @@ invoke_hook (scm_thread *thread, int hook_num)
   scm_c_run_hookn (hook, &scm_frame, 1);
 
   vp->compare_result = saved_compare_result;
-  vp->trace_level = saved_trace_level;
+  set_vm_trace_level (thread, saved_trace_level);
 }
 
-#define DEFINE_INVOKE_HOOK(H, h) \
+#define DEFINE_INVOKE_HOOK(h) \
   static void                                             \
   invoke_##h##_hook (scm_thread *thread) SCM_NOINLINE;    \
   static void                                             \
   invoke_##h##_hook (scm_thread *thread)                  \
   {                                                       \
-    return invoke_hook (thread, SCM_VM_##H##_HOOK);       \
+    if (thread->vm.h##_hook_enabled)                      \
+      return invoke_hook (thread, thread->vm.h##_hook);   \
   }
 
-DEFINE_INVOKE_HOOK(APPLY, apply)
+FOR_EACH_HOOK (DEFINE_INVOKE_HOOK)
-DEFINE_INVOKE_HOOK(RETURN, return)
+
-DEFINE_INVOKE_HOOK(NEXT, next)
+#undef DEFINE_INVOKE_HOOK
-DEFINE_INVOKE_HOOK(ABORT, abort)
 
 
 /*
@@ -547,8 +585,6 @@ expand_stack (union scm_vm_stack_element *old_bottom, size_t old_size,
 void
 scm_i_vm_prepare_stack (struct scm_vm *vp)
 {
-  int i;
-
   /* Not racey, as this will be run the first time a thread enters
      Guile.  */
   if (page_size == 0)
@@ -576,8 +612,9 @@ scm_i_vm_prepare_stack (struct scm_vm *vp)
   vp->compare_result = SCM_F_COMPARE_NONE;
   vp->engine = vm_default_engine;
   vp->trace_level = 0;
-  for (i = 0; i < SCM_VM_NUM_HOOKS; i++)
+#define INIT_HOOK(h) vp->h##_hook = SCM_BOOL_F;
-    vp->hooks[i] = SCM_BOOL_F;
+  FOR_EACH_HOOK (INIT_HOOK)
+#undef INIT_HOOK
 }
 
 static void
@@ -1479,42 +1516,35 @@ scm_call_n (SCM proc, SCM *argv, size_t nargs)
 
 /* Scheme interface */
 
-static void
+#define VM_ADD_HOOK(h, f)                                               \
-reset_vm_hook_enabled (scm_thread *thread, int i)
+  {                                                                     \
-{
+    scm_thread *t = SCM_I_CURRENT_THREAD;                               \
-  SCM hook = thread->vm.hooks[i];
+    SCM hook = t->vm.h##_hook;                                          \
-  int empty = scm_is_false (hook) || scm_is_true (scm_hook_empty_p (hook));
+    if (scm_is_false (hook))                                            \
+      hook = t->vm.h##_hook = scm_make_hook (SCM_I_MAKINUM (1));        \
+    scm_add_hook_x (hook, f, SCM_UNDEFINED);                            \
+    vm_hook_compute_enabled (t, hook, &t->vm.h##_hook_enabled);         \
+    vm_recompute_disable_mcode (t);                                     \
+    return SCM_UNSPECIFIED;                                             \
+  }
 
-  if (thread->vm.trace_level > 0)
+#define VM_REMOVE_HOOK(h, f)                                            \
-    thread->vm.hooks_enabled[i] = !empty;
+  {                                                                     \
-  else
+    scm_thread *t = SCM_I_CURRENT_THREAD;                               \
-    thread->vm.hooks_enabled[i] = 0;
+    SCM hook = t->vm.h##_hook;                                          \
-}
+    if (scm_is_true (hook))                                             \
-
+      scm_remove_hook_x (hook, f);                                      \
-#define VM_ADD_HOOK(n, f)                               \
+    vm_hook_compute_enabled (t, hook, &t->vm.h##_hook_enabled);         \
-{							\
+    vm_recompute_disable_mcode (t);                                     \
-  scm_thread *t = SCM_I_CURRENT_THREAD;                 \
+    return SCM_UNSPECIFIED;                                             \
-  if (scm_is_false (t->vm.hooks[n]))			\
+  }
-    t->vm.hooks[n] = scm_make_hook (SCM_I_MAKINUM (1));	\
-  scm_add_hook_x (t->vm.hooks[n], f, SCM_UNDEFINED);    \
-  reset_vm_hook_enabled (t, n);                         \
-  return SCM_UNSPECIFIED;                               \
-}
-
-#define VM_REMOVE_HOOK(n, f)                            \
-{							\
-  scm_thread *t = SCM_I_CURRENT_THREAD;                 \
-  scm_remove_hook_x (t->vm.hooks[n], f);                \
-  reset_vm_hook_enabled (t, n);                         \
-  return SCM_UNSPECIFIED;                               \
-}
 
 SCM_DEFINE (scm_vm_add_apply_hook_x, "vm-add-apply-hook!", 1, 0, 0,
 	    (SCM f),
 	    "")
 #define FUNC_NAME s_scm_vm_add_apply_hook_x
 {
-  VM_ADD_HOOK (SCM_VM_APPLY_HOOK, f);
+  VM_ADD_HOOK (apply, f);
 }
 #undef FUNC_NAME
 
@@ -1523,7 +1553,7 @@ SCM_DEFINE (scm_vm_remove_apply_hook_x, "vm-remove-apply-hook!", 1, 0, 0,
 	    "")
 #define FUNC_NAME s_scm_vm_remove_apply_hook_x
 {
-  VM_REMOVE_HOOK (SCM_VM_APPLY_HOOK, f);
+  VM_REMOVE_HOOK (apply, f);
 }
 #undef FUNC_NAME
 
@@ -1532,7 +1562,7 @@ SCM_DEFINE (scm_vm_add_return_hook_x, "vm-add-return-hook!", 1, 0, 0,
 	    "")
 #define FUNC_NAME s_scm_vm_add_return_hook_x
 {
-  VM_ADD_HOOK (SCM_VM_RETURN_HOOK, f);
+  VM_ADD_HOOK (return, f);
 }
 #undef FUNC_NAME
 
@@ -1541,7 +1571,7 @@ SCM_DEFINE (scm_vm_remove_return_hook_x, "vm-remove-return-hook!", 1, 0, 0,
 	    "")
 #define FUNC_NAME s_scm_vm_remove_return_hook_x
 {
-  VM_REMOVE_HOOK (SCM_VM_RETURN_HOOK, f);
+  VM_REMOVE_HOOK (return, f);
 }
 #undef FUNC_NAME
 
@@ -1550,7 +1580,7 @@ SCM_DEFINE (scm_vm_add_next_hook_x, "vm-add-next-hook!", 1, 0, 0,
 	    "")
 #define FUNC_NAME s_scm_vm_add_next_hook_x
 {
-  VM_ADD_HOOK (SCM_VM_NEXT_HOOK, f);
+  VM_ADD_HOOK (next, f);
 }
 #undef FUNC_NAME
 
@@ -1559,7 +1589,7 @@ SCM_DEFINE (scm_vm_remove_next_hook_x, "vm-remove-next-hook!", 1, 0, 0,
 	    "")
 #define FUNC_NAME s_scm_vm_remove_next_hook_x
 {
-  VM_REMOVE_HOOK (SCM_VM_NEXT_HOOK, f);
+  VM_REMOVE_HOOK (next, f);
 }
 #undef FUNC_NAME
 
@@ -1568,7 +1598,7 @@ SCM_DEFINE (scm_vm_add_abort_hook_x, "vm-add-abort-hook!", 1, 0, 0,
 	    "")
 #define FUNC_NAME s_scm_vm_add_abort_hook_x
 {
-  VM_ADD_HOOK (SCM_VM_ABORT_HOOK, f);
+  VM_ADD_HOOK (abort, f);
 }
 #undef FUNC_NAME
 
@@ -1577,7 +1607,7 @@ SCM_DEFINE (scm_vm_remove_abort_hook_x, "vm-remove-abort-hook!", 1, 0, 0,
 	    "")
 #define FUNC_NAME s_scm_vm_remove_abort_hook_x
 {
-  VM_REMOVE_HOOK (SCM_VM_ABORT_HOOK, f);
+  VM_REMOVE_HOOK (abort, f);
 }
 #undef FUNC_NAME
 
@@ -1596,12 +1626,7 @@ SCM_DEFINE (scm_set_vm_trace_level_x, "set-vm-trace-level!", 1, 0, 0,
 #define FUNC_NAME s_scm_set_vm_trace_level_x
 {
   scm_thread *thread = SCM_I_CURRENT_THREAD;
-  int i;
+  return scm_from_int (set_vm_trace_level (thread, scm_to_int (level)));
-
-  thread->vm.trace_level = scm_to_int (level);
-  for (i = 0; i < SCM_VM_NUM_HOOKS; i++)
-    reset_vm_hook_enabled (thread, i);
-  return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
 
@@ -1650,11 +1675,15 @@ void
 scm_c_set_vm_engine_x (int engine)
 #define FUNC_NAME "set-vm-engine!"
 {
+  scm_thread *thread = SCM_I_CURRENT_THREAD;
+
   if (engine < 0 || engine >= SCM_VM_NUM_ENGINES)
     SCM_MISC_ERROR ("Unknown VM engine: ~a",
                     scm_list_1 (scm_from_int (engine)));
     
-  SCM_I_CURRENT_THREAD->vm.engine = engine;
+  thread->vm.engine = engine;
+  /* Trigger update of the various hook_enabled flags.  */
+  set_vm_trace_level (thread, thread->vm.trace_level);
 }
 #undef FUNC_NAME
 

libguile/vm.h

@@ -25,14 +25,6 @@
 #include <libguile/gc.h>
 #include <libguile/programs.h>
 
-enum {
-  SCM_VM_APPLY_HOOK,
-  SCM_VM_RETURN_HOOK,
-  SCM_VM_NEXT_HOOK,
-  SCM_VM_ABORT_HOOK,
-  SCM_VM_NUM_HOOKS,
-};
-
 #define SCM_VM_REGULAR_ENGINE 0
 #define SCM_VM_DEBUG_ENGINE 1
 #define SCM_VM_NUM_ENGINES 2
@@ -48,19 +40,27 @@ struct scm_vm {
   uint32_t *ip;		/* instruction pointer */
   union scm_vm_stack_element *sp; /* stack pointer */
   union scm_vm_stack_element *fp; /* frame pointer */
-  uint8_t compare_result;   /* flags register: a value from scm_compare */
-  union scm_vm_stack_element *stack_limit; /* stack limit address */
-  int trace_level;              /* traces enabled if trace_level > 0 */
   union scm_vm_stack_element *sp_min_since_gc; /* deepest sp since last gc */
+  union scm_vm_stack_element *stack_limit; /* stack limit address */
+  uint8_t compare_result;       /* flags register: a value from scm_compare */
+  uint8_t apply_hook_enabled;   /* if apply hook is enabled */
+  uint8_t return_hook_enabled;  /* if return hook is enabled */
+  uint8_t next_hook_enabled;    /* if next hook is enabled */
+  uint8_t abort_hook_enabled;   /* if abort hook is enabled */
+  uint8_t disable_mcode;        /* if mcode is disabled (because debugging) */
+  uint8_t engine;               /* which vm engine we're using */
+  uint8_t unused;               /* padding */
   size_t stack_size;		/* stack size */
   union scm_vm_stack_element *stack_bottom; /* lowest address in allocated stack */
+  SCM apply_hook;               /* apply hook */
+  SCM return_hook;              /* return hook */
+  SCM next_hook;                /* next hook */
+  SCM abort_hook;               /* abort hook */
   union scm_vm_stack_element *stack_top; /* highest address in allocated stack */
   SCM overflow_handler_stack;   /* alist of max-stack-size -> thunk */
-  SCM hooks[SCM_VM_NUM_HOOKS];	/* hooks */
-  uint8_t hooks_enabled[SCM_VM_NUM_HOOKS]; /* if corresponding hook is enabled */
   jmp_buf *registers;           /* registers captured at latest vm entry  */
   uint8_t *mra_after_abort;     /* mra to resume after nonlocal exit, or NULL */
-  int engine;                   /* which vm engine we're using */
+  int trace_level;              /* traces enabled if trace_level > 0 */
 };
 
 SCM_API SCM scm_call_with_vm (SCM proc, SCM args);