VM manages hook sets itself

* libguile/vm.h (SCM_VM_ABORT_HOOK): Rename from
  SCM_VM_ABORT_CONTINUATION_HOOK.
* libguile/vm-engine.c (ABORT_HOOK):
* libguile/vm.c (invoke_abort_hook): Adapt to SCM_VM_ABORT_HOOK name
change.
(reset_vm_hook_enabled): New helper.
(VM_ADD_HOOK, VM_REMOVE_HOOK): New helper macros, replacing
VM_DEFINE_HOOK.
(scm_vm_add_abort_hook_x, scm_vm_remove_abort_hook_x)
(scm_vm_add_apply_hook_x, scm_vm_remove_apply_hook_x)
(scm_vm_add_return_hook_x, scm_vm_remove_return_hook_x)
(scm_vm_add_next_hook_x, scm_vm_remove_next_hook_x): New functions,
replacing direct access to the hooks.  Allows us to know in a more
fine-grained way when to enable hooks.
(scm_set_vm_trace_level_x): Use reset_vm_hook_enabled to update the
individual hook_enabled flags.
* module/statprof.scm:
* module/system/vm/coverage.scm:
* module/system/vm/traps.scm:
* module/system/vm/vm.scm: Adapt VM hook users to the new API.

1 files changed, 83 insertions, 20 deletions

diff --git a/libguile/vm.c b/libguile/vm.c
index 76c3e90a6..c59c91b8f 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -278,7 +278,7 @@ invoke_next_hook (scm_thread *thread)
 static void
 invoke_abort_hook (scm_thread *thread)
 {
-  return invoke_hook (thread, SCM_VM_ABORT_CONTINUATION_HOOK);
+  return invoke_hook (thread, SCM_VM_ABORT_HOOK);
 }
 
 
@@ -1491,47 +1491,105 @@ scm_call_n (SCM proc, SCM *argv, size_t nargs)
 
 /* Scheme interface */
 
-#define VM_DEFINE_HOOK(n)				\
+static void
+reset_vm_hook_enabled (scm_thread *thread, int i)
+{
+  SCM hook = thread->vm.hooks[i];
+  int empty = scm_is_false (hook) || scm_is_true (scm_hook_empty_p (hook));
+
+  if (thread->vm.trace_level > 0)
+    thread->vm.hooks_enabled[i] = !empty;
+  else
+    thread->vm.hooks_enabled[i] = 0;
+}
+
+#define VM_ADD_HOOK(n, f)                               \
 {							\
   scm_thread *t = SCM_I_CURRENT_THREAD;                 \
   if (scm_is_false (t->vm.hooks[n]))			\
     t->vm.hooks[n] = scm_make_hook (SCM_I_MAKINUM (1));	\
-  return t->vm.hooks[n];				\
+  scm_add_hook_x (t->vm.hooks[n], f, SCM_UNDEFINED);    \
+  reset_vm_hook_enabled (t, n);                         \
+  return SCM_UNSPECIFIED;                               \
 }
 
-SCM_DEFINE (scm_vm_apply_hook, "vm-apply-hook", 0, 0, 0,
-	    (void),
+#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_apply_hook
+#define FUNC_NAME s_scm_vm_add_apply_hook_x
 {
-  VM_DEFINE_HOOK (SCM_VM_APPLY_HOOK);
+  VM_ADD_HOOK (SCM_VM_APPLY_HOOK, f);
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_vm_return_hook, "vm-return-hook", 0, 0, 0,
-	    (void),
+SCM_DEFINE (scm_vm_remove_apply_hook_x, "vm-remove-apply-hook!", 1, 0, 0,
+	    (SCM f),
 	    "")
-#define FUNC_NAME s_scm_vm_return_hook
+#define FUNC_NAME s_scm_vm_remove_apply_hook_x
 {
-  VM_DEFINE_HOOK (SCM_VM_RETURN_HOOK);
+  VM_REMOVE_HOOK (SCM_VM_APPLY_HOOK, f);
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_vm_next_hook, "vm-next-hook", 0, 0, 0,
-	    (void),
+SCM_DEFINE (scm_vm_add_return_hook_x, "vm-add-return-hook!", 1, 0, 0,
+	    (SCM f),
 	    "")
-#define FUNC_NAME s_scm_vm_next_hook
+#define FUNC_NAME s_scm_vm_add_return_hook_x
 {
-  VM_DEFINE_HOOK (SCM_VM_NEXT_HOOK);
+  VM_ADD_HOOK (SCM_VM_RETURN_HOOK, f);
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_vm_abort_continuation_hook, "vm-abort-continuation-hook", 0, 0, 0,
-	    (void),
+SCM_DEFINE (scm_vm_remove_return_hook_x, "vm-remove-return-hook!", 1, 0, 0,
+	    (SCM f),
+	    "")
+#define FUNC_NAME s_scm_vm_remove_return_hook_x
+{
+  VM_REMOVE_HOOK (SCM_VM_RETURN_HOOK, f);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_vm_add_next_hook_x, "vm-add-next-hook!", 1, 0, 0,
+	    (SCM f),
 	    "")
-#define FUNC_NAME s_scm_vm_abort_continuation_hook
+#define FUNC_NAME s_scm_vm_add_next_hook_x
 {
-  VM_DEFINE_HOOK (SCM_VM_ABORT_CONTINUATION_HOOK);
+  VM_ADD_HOOK (SCM_VM_NEXT_HOOK, f);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_vm_remove_next_hook_x, "vm-remove-next-hook!", 1, 0, 0,
+	    (SCM f),
+	    "")
+#define FUNC_NAME s_scm_vm_remove_next_hook_x
+{
+  VM_REMOVE_HOOK (SCM_VM_NEXT_HOOK, f);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_vm_add_abort_hook_x, "vm-add-abort-hook!", 1, 0, 0,
+	    (SCM f),
+	    "")
+#define FUNC_NAME s_scm_vm_add_abort_hook_x
+{
+  VM_ADD_HOOK (SCM_VM_ABORT_HOOK, f);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_vm_remove_abort_hook_x, "vm-remove-abort-hook!", 1, 0, 0,
+            (SCM f),
+	    "")
+#define FUNC_NAME s_scm_vm_remove_abort_hook_x
+{
+  VM_REMOVE_HOOK (SCM_VM_ABORT_HOOK, f);
 }
 #undef FUNC_NAME
 
@@ -1549,7 +1607,12 @@ 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_I_CURRENT_THREAD->vm.trace_level = scm_to_int (level);
+  scm_thread *thread = SCM_I_CURRENT_THREAD;
+  int i;
+
+  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