VM accessors take VM as implicit argument, not explicit argument

* libguile/vm.h:
* libguile/vm.c:
  (scm_vm_apply_hook, scm_vm_push_continuation_hook,
  scm_vm_pop_continuation_hook, scm_vm_abort_continuation_hook,
  scm_vm_restore_continuation_hook, scm_vm_next_hook,
  scm_vm_trace_level, scm_set_vm_trace_level_x, scm_vm_engine,
  scm_set_vm_engine_x, scm_c_set_vm_engine_x): The VM argument is now
  implicit: the VM for the current thread.

* doc/ref/api-debug.texi (VM Hooks): Try to adapt.

* module/ice-9/command-line.scm:
* module/statprof.scm:
* module/system/vm/coverage.scm:
* module/system/vm/trace.scm:
* module/system/vm/trap-state.scm:
* module/system/vm/traps.scm:
* test-suite/tests/control.test:
* test-suite/tests/eval.test: Adapt users that set hooks or ensure that
  we have a debug engine.

doc/ref/api-debug.texi

@@ -816,28 +816,28 @@ The interface to hooks is provided by the @code{(system vm vm)} module:
 @end example
 
 @noindent
-The result of calling @code{the-vm} is usually passed as the @var{vm}
+All of these functions implicitly act on the VM for the current thread
-argument to all of these procedures.
+only.
 
-@deffn {Scheme Procedure} vm-next-hook vm
+@deffn {Scheme Procedure} vm-next-hook
 The hook that will be fired before an instruction is retired (and
 executed).
 @end deffn
 
-@deffn {Scheme Procedure} vm-push-continuation-hook vm
+@deffn {Scheme Procedure} vm-push-continuation-hook
 The hook that will be fired after preparing a new frame. Fires just
 before applying a procedure in a non-tail context, just before the
 corresponding apply-hook.
 @end deffn
 
-@deffn {Scheme Procedure} vm-pop-continuation-hook vm
+@deffn {Scheme Procedure} vm-pop-continuation-hook
 The hook that will be fired before returning from a frame.
 
 This hook fires with a variable number of arguments, corresponding to
 the values that the frame returns to its continuation.
 @end deffn
 
-@deffn {Scheme Procedure} vm-apply-hook vm
+@deffn {Scheme Procedure} vm-apply-hook
 The hook that will be fired before a procedure is applied. The frame's
 procedure will have already been set to the new procedure.
 
@@ -848,7 +848,7 @@ whereas a tail call will run without having fired a push-continuation
 hook.
 @end deffn
 
-@deffn {Scheme Procedure} vm-abort-continuation-hook vm
+@deffn {Scheme Procedure} vm-abort-continuation-hook
 The hook that will be called after aborting to a
 prompt.  @xref{Prompts}.
 
@@ -857,7 +857,7 @@ of arguments, corresponding to the values that returned to the
 continuation.
 @end deffn
 
-@deffn {Scheme Procedure} vm-restore-continuation-hook vm
+@deffn {Scheme Procedure} vm-restore-continuation-hook
 The hook that will be called after restoring an undelimited
 continuation. Unfortunately it's not currently possible to introspect on
 the values that were given to the continuation.
@@ -875,12 +875,12 @@ level temporarily set to 0.  That way the hooks don't fire while you're
 handling a hook.  The trace level is restored to whatever it was once the hook
 procedure finishes.
 
-@deffn {Scheme Procedure} vm-trace-level vm
+@deffn {Scheme Procedure} vm-trace-level
 Retrieve the ``trace level'' of the VM. If positive, the trace hooks
 associated with @var{vm} will be run. The initial trace level is 0.
 @end deffn
 
-@deffn {Scheme Procedure} set-vm-trace-level! vm level
+@deffn {Scheme Procedure} set-vm-trace-level! level
 Set the ``trace level'' of the VM.
 @end deffn
 

libguile/vm.c

@@ -859,15 +859,14 @@ SCM_DEFINE (scm_vm_p, "vm?", 1, 0, 0,
 #define VM_DEFINE_HOOK(n)				\
 {							\
   struct scm_vm *vp;					\
-  SCM_VALIDATE_VM (1, vm);				\
+  vp = SCM_VM_DATA (scm_the_vm ());                     \
-  vp = SCM_VM_DATA (vm);				\
   if (scm_is_false (vp->hooks[n]))			\
     vp->hooks[n] = scm_make_hook (SCM_I_MAKINUM (1));	\
   return vp->hooks[n];					\
 }
 
-SCM_DEFINE (scm_vm_apply_hook, "vm-apply-hook", 1, 0, 0,
+SCM_DEFINE (scm_vm_apply_hook, "vm-apply-hook", 0, 0, 0,
-	    (SCM vm),
+	    (void),
 	    "")
 #define FUNC_NAME s_scm_vm_apply_hook
 {
@@ -875,8 +874,8 @@ SCM_DEFINE (scm_vm_apply_hook, "vm-apply-hook", 1, 0, 0,
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_vm_push_continuation_hook, "vm-push-continuation-hook", 1, 0, 0,
+SCM_DEFINE (scm_vm_push_continuation_hook, "vm-push-continuation-hook", 0, 0, 0,
-	    (SCM vm),
+	    (void),
 	    "")
 #define FUNC_NAME s_scm_vm_push_continuation_hook
 {
@@ -884,8 +883,8 @@ SCM_DEFINE (scm_vm_push_continuation_hook, "vm-push-continuation-hook", 1, 0, 0,
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_vm_pop_continuation_hook, "vm-pop-continuation-hook", 1, 0, 0,
+SCM_DEFINE (scm_vm_pop_continuation_hook, "vm-pop-continuation-hook", 0, 0, 0,
-	    (SCM vm),
+	    (void),
 	    "")
 #define FUNC_NAME s_scm_vm_pop_continuation_hook
 {
@@ -893,8 +892,8 @@ SCM_DEFINE (scm_vm_pop_continuation_hook, "vm-pop-continuation-hook", 1, 0, 0,
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_vm_next_hook, "vm-next-hook", 1, 0, 0,
+SCM_DEFINE (scm_vm_next_hook, "vm-next-hook", 0, 0, 0,
-	    (SCM vm),
+	    (void),
 	    "")
 #define FUNC_NAME s_scm_vm_next_hook
 {
@@ -902,8 +901,8 @@ SCM_DEFINE (scm_vm_next_hook, "vm-next-hook", 1, 0, 0,
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_vm_abort_continuation_hook, "vm-abort-continuation-hook", 1, 0, 0,
+SCM_DEFINE (scm_vm_abort_continuation_hook, "vm-abort-continuation-hook", 0, 0, 0,
-	    (SCM vm),
+	    (void),
 	    "")
 #define FUNC_NAME s_scm_vm_abort_continuation_hook
 {
@@ -911,8 +910,8 @@ SCM_DEFINE (scm_vm_abort_continuation_hook, "vm-abort-continuation-hook", 1, 0,
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_vm_restore_continuation_hook, "vm-restore-continuation-hook", 1, 0, 0,
+SCM_DEFINE (scm_vm_restore_continuation_hook, "vm-restore-continuation-hook", 0, 0, 0,
-	    (SCM vm),
+	    (void),
 	    "")
 #define FUNC_NAME s_scm_vm_restore_continuation_hook
 {
@@ -920,23 +919,21 @@ SCM_DEFINE (scm_vm_restore_continuation_hook, "vm-restore-continuation-hook", 1,
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_vm_trace_level, "vm-trace-level", 1, 0, 0,
+SCM_DEFINE (scm_vm_trace_level, "vm-trace-level", 0, 0, 0,
-	    (SCM vm),
+	    (void),
 	    "")
 #define FUNC_NAME s_scm_vm_trace_level
 {
-  SCM_VALIDATE_VM (1, vm);
+  return scm_from_int (SCM_VM_DATA (scm_the_vm ())->trace_level);
-  return scm_from_int (SCM_VM_DATA (vm)->trace_level);
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_set_vm_trace_level_x, "set-vm-trace-level!", 2, 0, 0,
+SCM_DEFINE (scm_set_vm_trace_level_x, "set-vm-trace-level!", 1, 0, 0,
-	    (SCM vm, SCM level),
+	    (SCM level),
 	    "")
 #define FUNC_NAME s_scm_set_vm_trace_level_x
 {
-  SCM_VALIDATE_VM (1, vm);
+  SCM_VM_DATA (scm_the_vm ())->trace_level = scm_to_int (level);
-  SCM_VM_DATA (vm)->trace_level = scm_to_int (level);
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
@@ -973,36 +970,33 @@ vm_engine_to_symbol (int engine, const char *FUNC_NAME)
     }
 }
   
-SCM_DEFINE (scm_vm_engine, "vm-engine", 1, 0, 0,
+SCM_DEFINE (scm_vm_engine, "vm-engine", 0, 0, 0,
-	    (SCM vm),
+	    (void),
 	    "")
 #define FUNC_NAME s_scm_vm_engine
 {
-  SCM_VALIDATE_VM (1, vm);
+  return vm_engine_to_symbol (SCM_VM_DATA (scm_the_vm ())->engine, FUNC_NAME);
-  return vm_engine_to_symbol (SCM_VM_DATA (vm)->engine, FUNC_NAME);
 }
 #undef FUNC_NAME
 
 void
-scm_c_set_vm_engine_x (SCM vm, int engine)
+scm_c_set_vm_engine_x (int engine)
 #define FUNC_NAME "set-vm-engine!"
 {
-  SCM_VALIDATE_VM (1, vm);
-
   if (engine < 0 || engine >= SCM_VM_NUM_ENGINES)
     SCM_MISC_ERROR ("Unknown VM engine: ~a",
                     scm_list_1 (scm_from_int (engine)));
     
-  SCM_VM_DATA (vm)->engine = engine;
+  SCM_VM_DATA (scm_the_vm ())->engine = engine;
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_set_vm_engine_x, "set-vm-engine!", 2, 0, 0,
+SCM_DEFINE (scm_set_vm_engine_x, "set-vm-engine!", 1, 0, 0,
-	    (SCM vm, SCM engine),
+	    (SCM engine),
 	    "")
 #define FUNC_NAME s_scm_set_vm_engine_x
 {
-  scm_c_set_vm_engine_x (vm, symbol_to_vm_engine (engine, FUNC_NAME));
+  scm_c_set_vm_engine_x (symbol_to_vm_engine (engine, FUNC_NAME));
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
@@ -1029,63 +1023,15 @@ SCM_DEFINE (scm_set_default_vm_engine_x, "set-default-vm-engine!", 1, 0, 0,
 }
 #undef FUNC_NAME
 
-static void reinstate_vm (SCM vm)
+/* FIXME: This function makes no sense, but we keep it to make sure we
-{
+   have a way of switching to the debug or regular VM.  */
-  scm_i_thread *t = SCM_I_CURRENT_THREAD;
+SCM_DEFINE (scm_call_with_vm, "call-with-vm", 1, 0, 1,
-  t->vm = vm;
+	    (SCM proc, SCM args),
-}
-
-SCM_DEFINE (scm_call_with_vm, "call-with-vm", 2, 0, 1,
-	    (SCM vm, SCM proc, SCM args),
 	    "Apply @var{proc} to @var{args} in a dynamic extent in which\n"
-            "@var{vm} is the current VM.\n\n"
+            "@var{vm} is the current VM.")
-            "As an implementation restriction, if @var{vm} is not the same\n"
-            "as the current thread's VM, continuations captured within the\n"
-            "call to @var{proc} may not be reinstated once control leaves\n"
-            "@var{proc}.")
 #define FUNC_NAME s_scm_call_with_vm
 {
-  SCM prev_vm, ret;
+  return scm_apply_0 (proc, args);
-  SCM *argv;
-  int i, nargs;
-  scm_t_wind_flags flags;
-  scm_i_thread *t = SCM_I_CURRENT_THREAD;
-
-  SCM_VALIDATE_VM (1, vm);
-  SCM_VALIDATE_PROC (2, proc);
-
-  nargs = scm_ilength (args);
-  if (SCM_UNLIKELY (nargs < 0))
-    scm_wrong_type_arg_msg (FUNC_NAME, 3, args, "list");
-  
-  argv = alloca (nargs * sizeof(SCM));
-  for (i = 0; i < nargs; i++)
-    {
-      argv[i] = SCM_CAR (args);
-      args = SCM_CDR (args);
-    }
-
-  prev_vm = t->vm;
-
-  /* Reentry can happen via invokation of a saved continuation, but
-     continuations only save the state of the VM that they are in at
-     capture-time, which might be different from this one.  So, in the
-     case that the VMs are different, set up a non-rewindable frame to
-     prevent reinstating an incomplete continuation.  */
-  flags = scm_is_eq (prev_vm, vm) ? 0 : SCM_F_WIND_EXPLICITLY;
-  if (flags)
-    {
-      scm_dynwind_begin (0);
-      scm_dynwind_unwind_handler_with_scm (reinstate_vm, prev_vm, flags);
-      t->vm = vm;
-    }
-
-  ret = scm_c_vm_run (vm, proc, argv, nargs);
-
-  if (flags)
-    scm_dynwind_end ();
-  
-  return ret;
 }
 #undef FUNC_NAME
 

libguile/vm.h

@@ -57,21 +57,21 @@ SCM_API SCM scm_the_vm_fluid;
 #define SCM_VALIDATE_VM(pos,x)	SCM_MAKE_VALIDATE (pos, x, VM_P)
 
 SCM_API SCM scm_the_vm (void);
-SCM_API SCM scm_call_with_vm (SCM vm, SCM proc, SCM args);
+SCM_API SCM scm_call_with_vm (SCM proc, SCM args);
 
 SCM_API SCM scm_vm_p (SCM obj);
-SCM_API SCM scm_vm_apply_hook (SCM vm);
+SCM_API SCM scm_vm_apply_hook (void);
-SCM_API SCM scm_vm_push_continuation_hook (SCM vm);
+SCM_API SCM scm_vm_push_continuation_hook (void);
-SCM_API SCM scm_vm_pop_continuation_hook (SCM vm);
+SCM_API SCM scm_vm_pop_continuation_hook (void);
-SCM_API SCM scm_vm_abort_continuation_hook (SCM vm);
+SCM_API SCM scm_vm_abort_continuation_hook (void);
-SCM_API SCM scm_vm_restore_continuation_hook (SCM vm);
+SCM_API SCM scm_vm_restore_continuation_hook (void);
-SCM_API SCM scm_vm_next_hook (SCM vm);
+SCM_API SCM scm_vm_next_hook (void);
-SCM_API SCM scm_vm_trace_level (SCM vm);
+SCM_API SCM scm_vm_trace_level (void);
-SCM_API SCM scm_set_vm_trace_level_x (SCM vm, SCM level);
+SCM_API SCM scm_set_vm_trace_level_x (SCM level);
-SCM_API SCM scm_vm_engine (SCM vm);
+SCM_API SCM scm_vm_engine (void);
-SCM_API SCM scm_set_vm_engine_x (SCM vm, SCM engine);
+SCM_API SCM scm_set_vm_engine_x (SCM engine);
 SCM_API SCM scm_set_default_vm_engine_x (SCM engine);
-SCM_API void scm_c_set_vm_engine_x (SCM vm, int engine);
+SCM_API void scm_c_set_vm_engine_x (int engine);
 SCM_API void scm_c_set_default_vm_engine_x (int engine);
 
 #define SCM_F_VM_CONT_PARTIAL 0x1

module/ice-9/command-line.scm

@@ -422,7 +422,7 @@ If FILE begins with `-' the -s switch is mandatory.
               (and interactive? (not turn-off-debugging?)))
           (begin
             (set-default-vm-engine! 'debug)
-            (set-vm-engine! (the-vm) 'debug)))
+            (set-vm-engine! 'debug)))
       
       ;; Return this value.
       `(;; It would be nice not to load up (ice-9 control), but the

module/statprof.scm

@@ -295,8 +295,7 @@
               ;; confuse guile wrt re-enabling the trap when
               ;; count-call finishes.
               (if %count-calls?
-                  (set-vm-trace-level! (the-vm)
+                  (set-vm-trace-level! (1- (vm-trace-level))))
-                                       (1- (vm-trace-level (the-vm)))))
               (accumulate-time stop-time)))
         
         (setitimer ITIMER_PROF
@@ -308,8 +307,7 @@
             (begin
               (set! last-start-time (get-internal-run-time))
               (if %count-calls?
-                  (set-vm-trace-level! (the-vm)
+                  (set-vm-trace-level! (1+ (vm-trace-level))))))))
-                                       (1+ (vm-trace-level (the-vm)))))))))
   
   (set! inside-profiler? #f))
 
@@ -357,8 +355,8 @@ than @code{statprof-stop}, @code{#f} otherwise."
                        (car sampling-frequency)
                        (cdr sampling-frequency)))
         (if %count-calls?
-            (add-hook! (vm-apply-hook (the-vm)) count-call))
+            (add-hook! (vm-apply-hook) count-call))
-        (set-vm-trace-level! (the-vm) (1+ (vm-trace-level (the-vm))))
+        (set-vm-trace-level! (1+ (vm-trace-level)))
         #t)))
   
 ;; Do not call this from statprof internal functions -- user only.
@@ -371,9 +369,9 @@ than @code{statprof-stop}, @code{#f} otherwise."
       (begin
         (set! gc-time-taken
               (- (cdr (assq 'gc-time-taken (gc-stats))) gc-time-taken))
-        (set-vm-trace-level! (the-vm) (1- (vm-trace-level (the-vm))))
+        (set-vm-trace-level! (1- (vm-trace-level)))
         (if %count-calls?
-            (remove-hook! (vm-apply-hook (the-vm)) count-call))
+            (remove-hook! (vm-apply-hook) count-call))
         ;; I believe that we need to do this before getting the time
         ;; (unless we want to make things even more complicated).
         (set! remaining-prof-time (setitimer ITIMER_PROF 0 0 0 0))
@@ -754,7 +752,7 @@ whole call tree, for later analysis. Use @code{statprof-fetch-stacks} or
           (set! last-start-time (get-internal-run-time))
           (set! gc-time-taken (cdr (assq 'gc-time-taken (gc-stats))))
           (add-hook! after-gc-hook gc-callback)
-          (set-vm-trace-level! (the-vm) (1+ (vm-trace-level (the-vm))))
+          (set-vm-trace-level! (1+ (vm-trace-level)))
           #t)))
 
   (define (stop)

module/system/vm/coverage.scm

@@ -69,16 +69,16 @@ coverage data.  Return code coverage data and the values returned by THUNK."
   ;; VM is different from the current one, continuations will not be
   ;; resumable.
   (call-with-values (lambda ()
-                      (let ((level   (vm-trace-level vm))
+                      (let ((level   (vm-trace-level))
-                            (hook    (vm-next-hook vm)))
+                            (hook    (vm-next-hook)))
                         (dynamic-wind
                           (lambda ()
-                            (set-vm-trace-level! vm (+ level 1))
+                            (set-vm-trace-level! (+ level 1))
                             (add-hook! hook collect!))
                           (lambda ()
-                            (call-with-vm vm thunk))
+                            (call-with-vm thunk))
                           (lambda ()
-                            (set-vm-trace-level! vm level)
+                            (set-vm-trace-level! level)
                             (remove-hook! hook collect!)))))
     (lambda args
       (apply values (make-coverage-data ip-counts) args))))

module/system/vm/trace.scm

@@ -114,10 +114,10 @@
             (set! inst-trap
                   (trace-instructions-in-procedure thunk #:vm vm #:width width 
                                                    #:max-indent max-indent)))
-        (set-vm-trace-level! vm (1+ (vm-trace-level vm))))
+        (set-vm-trace-level! (1+ (vm-trace-level))))
       thunk
       (lambda ()
-        (set-vm-trace-level! vm (1- (vm-trace-level vm)))
+        (set-vm-trace-level! (1- (vm-trace-level)))
         (if call-trap (call-trap))
         (if inst-trap (inst-trap))
         (set! call-trap #f)

module/system/vm/trap-state.scm

@@ -173,11 +173,11 @@
       (lambda ()
         ;; Don't enable hooks if the handler is #f.
         (if handler
-            (set-vm-trace-level! (the-vm) (trap-state->trace-level trap-state))))
+            (set-vm-trace-level! (trap-state->trace-level trap-state))))
       thunk
       (lambda ()
         (if handler
-            (set-vm-trace-level! (the-vm) 0))))))
+            (set-vm-trace-level! 0))))))
 
 (define* (list-traps #:optional (trap-state (the-trap-state)))
   (map trap-wrapper-index (trap-state-wrappers trap-state)))

module/system/vm/traps.scm

@@ -139,9 +139,9 @@
     (new-enabled-trap
      vm #f
      (lambda (frame)
-       (add-hook! (vm-apply-hook vm) apply-hook))
+       (add-hook! (vm-apply-hook) apply-hook))
      (lambda (frame)
-       (remove-hook! (vm-apply-hook vm) apply-hook)))))
+       (remove-hook! (vm-apply-hook) apply-hook)))))
 
 ;; A more complicated trap, traps when control enters a procedure.
 ;;
@@ -210,21 +210,21 @@
     (new-enabled-trap
      vm current-frame
      (lambda (frame)
-       (add-hook! (vm-apply-hook vm) apply-hook)
+       (add-hook! (vm-apply-hook) apply-hook)
-       (add-hook! (vm-push-continuation-hook vm) push-cont-hook)
+       (add-hook! (vm-push-continuation-hook) push-cont-hook)
-       (add-hook! (vm-pop-continuation-hook vm) pop-cont-hook)
+       (add-hook! (vm-pop-continuation-hook) pop-cont-hook)
-       (add-hook! (vm-abort-continuation-hook vm) abort-hook)
+       (add-hook! (vm-abort-continuation-hook) abort-hook)
-       (add-hook! (vm-restore-continuation-hook vm) restore-hook)
+       (add-hook! (vm-restore-continuation-hook) restore-hook)
        (if (and frame (our-frame? frame))
            (enter-proc frame)))
      (lambda (frame)
        (if in-proc?
            (exit-proc frame))
-       (remove-hook! (vm-apply-hook vm) apply-hook)
+       (remove-hook! (vm-apply-hook) apply-hook)
-       (remove-hook! (vm-push-continuation-hook vm) push-cont-hook)
+       (remove-hook! (vm-push-continuation-hook) push-cont-hook)
-       (remove-hook! (vm-pop-continuation-hook vm) pop-cont-hook)
+       (remove-hook! (vm-pop-continuation-hook) pop-cont-hook)
-       (remove-hook! (vm-abort-continuation-hook vm) abort-hook)
+       (remove-hook! (vm-abort-continuation-hook) abort-hook)
-       (remove-hook! (vm-restore-continuation-hook vm) restore-hook)))))
+       (remove-hook! (vm-restore-continuation-hook) restore-hook)))))
 
 ;; Building on trap-in-procedure, we have trap-instructions-in-procedure
 ;;
@@ -242,12 +242,12 @@
           (next-handler frame)))
     
     (define (enter frame)
-      (add-hook! (vm-next-hook vm) next-hook)
+      (add-hook! (vm-next-hook) next-hook)
       (if frame (next-hook frame)))
 
     (define (exit frame)
       (exit-handler frame)
-      (remove-hook! (vm-next-hook vm) next-hook))
+      (remove-hook! (vm-next-hook) next-hook))
 
     (trap-in-procedure proc enter exit
                        #:current-frame current-frame #:vm vm
@@ -431,14 +431,14 @@
      (lambda (frame)
        (if (not fp)
            (error "return-or-abort traps may only be enabled once"))
-       (add-hook! (vm-pop-continuation-hook vm) pop-cont-hook)
+       (add-hook! (vm-pop-continuation-hook) pop-cont-hook)
-       (add-hook! (vm-abort-continuation-hook vm) abort-hook)
+       (add-hook! (vm-abort-continuation-hook) abort-hook)
-       (add-hook! (vm-restore-continuation-hook vm) abort-hook))
+       (add-hook! (vm-restore-continuation-hook) abort-hook))
      (lambda (frame)
        (set! fp #f)
-       (remove-hook! (vm-pop-continuation-hook vm) pop-cont-hook)
+       (remove-hook! (vm-pop-continuation-hook) pop-cont-hook)
-       (remove-hook! (vm-abort-continuation-hook vm) abort-hook)
+       (remove-hook! (vm-abort-continuation-hook) abort-hook)
-       (remove-hook! (vm-restore-continuation-hook vm) abort-hook)))))
+       (remove-hook! (vm-restore-continuation-hook) abort-hook)))))
 
 ;; A more traditional dynamic-wind trap. Perhaps this should not be
 ;; based on the above trap-frame-finish?
@@ -473,12 +473,12 @@
     (new-enabled-trap
      vm current-frame
      (lambda (frame)
-       (add-hook! (vm-apply-hook vm) apply-hook))
+       (add-hook! (vm-apply-hook) apply-hook))
      (lambda (frame)
        (if exit-trap
            (abort-hook frame))
        (set! exit-trap #f)
-       (remove-hook! (vm-apply-hook vm) apply-hook)))))
+       (remove-hook! (vm-apply-hook) apply-hook)))))
 
 ;; Trapping all procedure calls within a dynamic extent, recording the
 ;; depth of the call stack relative to the original procedure.
@@ -505,14 +505,14 @@
     ;; FIXME: recalc depth on abort
 
     (define (enter frame)
-      (add-hook! (vm-push-continuation-hook vm) trace-push)
+      (add-hook! (vm-push-continuation-hook) trace-push)
-      (add-hook! (vm-pop-continuation-hook vm) trace-pop)
+      (add-hook! (vm-pop-continuation-hook) trace-pop)
-      (add-hook! (vm-apply-hook vm) trace-apply))
+      (add-hook! (vm-apply-hook) trace-apply))
   
     (define (leave frame)
-      (remove-hook! (vm-push-continuation-hook vm) trace-push)
+      (remove-hook! (vm-push-continuation-hook) trace-push)
-      (remove-hook! (vm-pop-continuation-hook vm) trace-pop)
+      (remove-hook! (vm-pop-continuation-hook) trace-pop)
-      (remove-hook! (vm-apply-hook vm) trace-apply))
+      (remove-hook! (vm-apply-hook) trace-apply))
   
     (define (return frame)
       (leave frame))
@@ -538,10 +538,10 @@
       (next-handler frame))
   
     (define (enter frame)
-      (add-hook! (vm-next-hook vm) trace-next))
+      (add-hook! (vm-next-hook) trace-next))
   
     (define (leave frame)
-      (remove-hook! (vm-next-hook vm) trace-next))
+      (remove-hook! (vm-next-hook) trace-next))
   
     (define (return frame)
       (leave frame))
@@ -629,6 +629,6 @@
     (new-enabled-trap
      vm #f
      (lambda (frame)
-       (add-hook! (vm-next-hook vm) next-hook))
+       (add-hook! (vm-next-hook) next-hook))
      (lambda (frame)
-       (remove-hook! (vm-next-hook vm) next-hook)))))
+       (remove-hook! (vm-next-hook) next-hook)))))

test-suite/tests/control.test

@@ -369,7 +369,7 @@
                      (p x y))))
       (catch 'foo
         (lambda ()
-          (call-with-vm (the-vm) (lambda () (throw 'foo (the-vm)))))
+          (call-with-vm (lambda () (throw 'foo (the-vm)))))
         (lambda (key vm)
           (and (eq? key 'foo)
                (eq? vm (the-vm))))))))

test-suite/tests/eval.test

@@ -437,9 +437,8 @@
   ;; FIXME: this test does not test what it is intending to test
   (pass-if-exception "exception raised"
     exception:vm-error
-    (let ((vm    (the-vm))
+    (let ((thunk (let loop () (cons 's (loop)))))
-          (thunk (let loop () (cons 's (loop)))))
+      (call-with-vm thunk))))
-      (call-with-vm vm thunk))))
 
 ;;;
 ;;; docstrings