VM hooks take no values

* libguile/vm-engine.c (RUN_HOOK0, RUN_HOOK1): Remove.
  (RUN_HOOK): Take hook name.
  (APPLY_HOOK, RETURN_HOOK, NEXT_HOOK, ABORT_CONTINUATION_HOOK): Use
  RUN_HOOK.
* libguile/vm.c (vm_dispatch_hook): Remove value count arg; hooks no
  longer receive values (e.g. the return hook now uses
  frame-return-values).
  (vm_dispatch_abort_hook): Remove value count, which was bogus because
  the active frame was the continuation which might contain other
  locals, potentially unboxed, not the implicit return-values frame.  In
  the future we could push on an implicit return-values frame instead.
* module/system/vm/traps.scm (trap-in-procedure, trap-frame-finish):
  (trap-in-dynamic-extent, trap-calls-to-procedure): Adapt abort hooks
  to not take values.  They weren't being used anyway!

libguile/vm-engine.c

@@ -110,25 +110,23 @@
 #endif
 
 #if VM_USE_HOOKS
-#define RUN_HOOK(exp)                                   \
+#define RUN_HOOK(h)                                     \
   do {                                                  \
     if (SCM_UNLIKELY (VP->trace_level))                 \
       {                                                 \
         SYNC_IP ();                                     \
-        exp;                                            \
+        vm_dispatch_##h##_hook (thread);                \
         CACHE_SP ();                                    \
       }                                                 \
   } while (0)
 #else
-#define RUN_HOOK(exp)
+#define RUN_HOOK(h)
 #endif
-#define RUN_HOOK0(h)      RUN_HOOK (vm_dispatch_##h##_hook (thread))
-#define RUN_HOOK1(h, arg) RUN_HOOK (vm_dispatch_##h##_hook (thread, arg))
 
-#define APPLY_HOOK()                  RUN_HOOK0 (apply)
-#define RETURN_HOOK()                 RUN_HOOK0 (return)
-#define NEXT_HOOK()                   RUN_HOOK0 (next)
-#define ABORT_CONTINUATION_HOOK()     RUN_HOOK0 (abort)
+#define APPLY_HOOK()                  RUN_HOOK (apply)
+#define RETURN_HOOK()                 RUN_HOOK (return)
+#define NEXT_HOOK()                   RUN_HOOK (next)
+#define ABORT_CONTINUATION_HOOK()     RUN_HOOK (abort)
 
 
 
@@ -3011,8 +3009,6 @@ VM_NAME (scm_thread *thread)
 #undef NEXT_HOOK
 #undef RETURN_HOOK
 #undef RUN_HOOK
-#undef RUN_HOOK0
-#undef RUN_HOOK1
 #undef SYNC_IP
 #undef UNPACK_8_8_8
 #undef UNPACK_8_16

libguile/vm.c

@@ -206,12 +206,13 @@ 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, int n)
+vm_dispatch_hook (scm_thread *thread, int hook_num)
 {
   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;
 
@@ -249,30 +250,8 @@ vm_dispatch_hook (scm_thread *thread, int hook_num, int n)
   frame->word_0 = SCM_PACK (scm_tc7_frame | (SCM_VM_FRAME_KIND_VM << 8));
   frame->word_1 = SCM_PACK_POINTER (&c_frame);
 
-  if (n == 0)
-    {
-      SCM args[1];
-
-      args[0] = SCM_PACK_POINTER (frame);
-      scm_c_run_hookn (hook, args, 1);
-    }
-  else if (n == 1)
-    {
-      SCM args[2];
-
-      args[0] = SCM_PACK_POINTER (frame);
-      args[1] = vp->sp[0].as_scm;
-      scm_c_run_hookn (hook, args, 2);
-    }
-  else
-    {
-      SCM args = SCM_EOL;
-      int i;
-
-      for (i = 0; i < n; i++)
-        args = scm_cons (vp->sp[i].as_scm, args);
-      scm_c_run_hook (hook, scm_cons (SCM_PACK_POINTER (frame), args));
-    }
+  scm_frame = SCM_PACK_POINTER (frame);
+  scm_c_run_hookn (hook, &scm_frame, 1);
 
   vp->compare_result = saved_compare_result;
   vp->trace_level = saved_trace_level;
@@ -281,23 +260,22 @@ vm_dispatch_hook (scm_thread *thread, int hook_num, int n)
 static void
 vm_dispatch_apply_hook (scm_thread *thread)
 {
-  return vm_dispatch_hook (thread, SCM_VM_APPLY_HOOK, 0);
+  return vm_dispatch_hook (thread, SCM_VM_APPLY_HOOK);
 }
 static void
 vm_dispatch_return_hook (scm_thread *thread)
 {
-  return vm_dispatch_hook (thread, SCM_VM_RETURN_HOOK, 0);
+  return vm_dispatch_hook (thread, SCM_VM_RETURN_HOOK);
 }
 static void
 vm_dispatch_next_hook (scm_thread *thread)
 {
-  return vm_dispatch_hook (thread, SCM_VM_NEXT_HOOK, 0);
+  return vm_dispatch_hook (thread, SCM_VM_NEXT_HOOK);
 }
 static void
 vm_dispatch_abort_hook (scm_thread *thread)
 {
-  return vm_dispatch_hook (thread, SCM_VM_ABORT_CONTINUATION_HOOK,
-                           SCM_FRAME_NUM_LOCALS (thread->vm.fp, thread->vm.sp));
+  return vm_dispatch_hook (thread, SCM_VM_ABORT_CONTINUATION_HOOK);
 }
 
 

module/system/vm/traps.scm

@@ -197,7 +197,7 @@
         (if (our-frame? prev)
             (enter-proc prev))))
 
-    (define (abort-hook frame . values)
+    (define (abort-hook frame)
       (if in-proc?
           (exit-proc frame))
       (if (our-frame? frame)
@@ -402,11 +402,11 @@
             (set! fp #f)
             (return-handler frame))))
     
-    (define (abort-hook frame . values)
+    (define (abort-hook frame)
       (if (and fp (<= (frame-address frame) fp))
           (begin
             (set! fp #f)
-            (apply abort-handler frame values))))
+            (abort-handler frame))))
     
     (new-enabled-trap
      frame
@@ -436,7 +436,7 @@
       (set! exit-trap #f)
       (return-handler frame))
     
-    (define (abort-hook frame . values)
+    (define (abort-hook frame)
       (exit-trap frame) ; disable the return/abort trap.
       (set! exit-trap #f)
       (abort-handler frame))
@@ -570,7 +570,7 @@
                 (return-handler frame depth))
         
               ;; FIXME: abort handler?
-              (define (abort-hook frame . values)
+              (define (abort-hook frame)
                 (frame-finished frame))
         
               (set! finish-trap