From: Andy Wingo Date: Thu, 21 Nov 2013 15:10:41 +0000 (+0100) Subject: VM accessors take VM as implicit argument, not explicit argument X-Git-Url: https://git.hcoop.net/bpt/guile.git/commitdiff_plain/972275eee5326b4628f207996e14e0040fb94256 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. --- diff --git a/doc/ref/api-debug.texi b/doc/ref/api-debug.texi index 4e1b82295..ee32cc038 100644 --- a/doc/ref/api-debug.texi +++ b/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} -argument to all of these procedures. +All of these functions implicitly act on the VM for the current thread +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 diff --git a/libguile/vm.c b/libguile/vm.c index f7fac9559..21180d8d0 100644 --- a/libguile/vm.c +++ b/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 (vm); \ + vp = SCM_VM_DATA (scm_the_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 vm), +SCM_DEFINE (scm_vm_apply_hook, "vm-apply-hook", 0, 0, 0, + (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 vm), +SCM_DEFINE (scm_vm_push_continuation_hook, "vm-push-continuation-hook", 0, 0, 0, + (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 vm), +SCM_DEFINE (scm_vm_pop_continuation_hook, "vm-pop-continuation-hook", 0, 0, 0, + (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 vm), +SCM_DEFINE (scm_vm_next_hook, "vm-next-hook", 0, 0, 0, + (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 vm), +SCM_DEFINE (scm_vm_abort_continuation_hook, "vm-abort-continuation-hook", 0, 0, 0, + (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 vm), +SCM_DEFINE (scm_vm_restore_continuation_hook, "vm-restore-continuation-hook", 0, 0, 0, + (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 vm), +SCM_DEFINE (scm_vm_trace_level, "vm-trace-level", 0, 0, 0, + (void), "") #define FUNC_NAME s_scm_vm_trace_level { - SCM_VALIDATE_VM (1, vm); - return scm_from_int (SCM_VM_DATA (vm)->trace_level); + return scm_from_int (SCM_VM_DATA (scm_the_vm ())->trace_level); } #undef FUNC_NAME -SCM_DEFINE (scm_set_vm_trace_level_x, "set-vm-trace-level!", 2, 0, 0, - (SCM vm, SCM level), +SCM_DEFINE (scm_set_vm_trace_level_x, "set-vm-trace-level!", 1, 0, 0, + (SCM level), "") #define FUNC_NAME s_scm_set_vm_trace_level_x { - SCM_VALIDATE_VM (1, vm); - SCM_VM_DATA (vm)->trace_level = scm_to_int (level); + SCM_VM_DATA (scm_the_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 vm), +SCM_DEFINE (scm_vm_engine, "vm-engine", 0, 0, 0, + (void), "") #define FUNC_NAME s_scm_vm_engine { - SCM_VALIDATE_VM (1, vm); - return vm_engine_to_symbol (SCM_VM_DATA (vm)->engine, FUNC_NAME); + return vm_engine_to_symbol (SCM_VM_DATA (scm_the_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 vm, SCM engine), +SCM_DEFINE (scm_set_vm_engine_x, "set-vm-engine!", 1, 0, 0, + (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) -{ - scm_i_thread *t = SCM_I_CURRENT_THREAD; - t->vm = vm; -} - -SCM_DEFINE (scm_call_with_vm, "call-with-vm", 2, 0, 1, - (SCM vm, SCM proc, SCM args), +/* 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_DEFINE (scm_call_with_vm, "call-with-vm", 1, 0, 1, + (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" - "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}.") + "@var{vm} is the current VM.") #define FUNC_NAME s_scm_call_with_vm { - SCM prev_vm, ret; - 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; + return scm_apply_0 (proc, args); } #undef FUNC_NAME diff --git a/libguile/vm.h b/libguile/vm.h index a71fd0f70..214fd0ba1 100644 --- a/libguile/vm.h +++ b/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_push_continuation_hook (SCM vm); -SCM_API SCM scm_vm_pop_continuation_hook (SCM vm); -SCM_API SCM scm_vm_abort_continuation_hook (SCM vm); -SCM_API SCM scm_vm_restore_continuation_hook (SCM vm); -SCM_API SCM scm_vm_next_hook (SCM vm); -SCM_API SCM scm_vm_trace_level (SCM vm); -SCM_API SCM scm_set_vm_trace_level_x (SCM vm, SCM level); -SCM_API SCM scm_vm_engine (SCM vm); -SCM_API SCM scm_set_vm_engine_x (SCM vm, SCM engine); +SCM_API SCM scm_vm_apply_hook (void); +SCM_API SCM scm_vm_push_continuation_hook (void); +SCM_API SCM scm_vm_pop_continuation_hook (void); +SCM_API SCM scm_vm_abort_continuation_hook (void); +SCM_API SCM scm_vm_restore_continuation_hook (void); +SCM_API SCM scm_vm_next_hook (void); +SCM_API SCM scm_vm_trace_level (void); +SCM_API SCM scm_set_vm_trace_level_x (SCM level); +SCM_API SCM scm_vm_engine (void); +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 diff --git a/module/ice-9/command-line.scm b/module/ice-9/command-line.scm index bd1931692..6633e1810 100644 --- a/module/ice-9/command-line.scm +++ b/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 diff --git a/module/statprof.scm b/module/statprof.scm index 7ef44304d..7c3a339bb 100644 --- a/module/statprof.scm +++ b/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) - (1- (vm-trace-level (the-vm))))) + (set-vm-trace-level! (1- (vm-trace-level)))) (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) - (1+ (vm-trace-level (the-vm))))))))) + (set-vm-trace-level! (1+ (vm-trace-level)))))))) (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)) - (set-vm-trace-level! (the-vm) (1+ (vm-trace-level (the-vm)))) + (add-hook! (vm-apply-hook) count-call)) + (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) diff --git a/module/system/vm/coverage.scm b/module/system/vm/coverage.scm index ea66ce1f6..311a23b7c 100644 --- a/module/system/vm/coverage.scm +++ b/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)) - (hook (vm-next-hook vm))) + (let ((level (vm-trace-level)) + (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)))) diff --git a/module/system/vm/trace.scm b/module/system/vm/trace.scm index 0135b39f3..084c65a9a 100644 --- a/module/system/vm/trace.scm +++ b/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) diff --git a/module/system/vm/trap-state.scm b/module/system/vm/trap-state.scm index e334c018c..78ccb8d89 100644 --- a/module/system/vm/trap-state.scm +++ b/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))) diff --git a/module/system/vm/traps.scm b/module/system/vm/traps.scm index 2d1a09aae..1d42f1cc1 100644 --- a/module/system/vm/traps.scm +++ b/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-push-continuation-hook vm) push-cont-hook) - (add-hook! (vm-pop-continuation-hook vm) pop-cont-hook) - (add-hook! (vm-abort-continuation-hook vm) abort-hook) - (add-hook! (vm-restore-continuation-hook vm) restore-hook) + (add-hook! (vm-apply-hook) apply-hook) + (add-hook! (vm-push-continuation-hook) push-cont-hook) + (add-hook! (vm-pop-continuation-hook) pop-cont-hook) + (add-hook! (vm-abort-continuation-hook) abort-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-push-continuation-hook vm) push-cont-hook) - (remove-hook! (vm-pop-continuation-hook vm) pop-cont-hook) - (remove-hook! (vm-abort-continuation-hook vm) abort-hook) - (remove-hook! (vm-restore-continuation-hook vm) restore-hook))))) + (remove-hook! (vm-apply-hook) apply-hook) + (remove-hook! (vm-push-continuation-hook) push-cont-hook) + (remove-hook! (vm-pop-continuation-hook) pop-cont-hook) + (remove-hook! (vm-abort-continuation-hook) abort-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-abort-continuation-hook vm) abort-hook) - (add-hook! (vm-restore-continuation-hook vm) abort-hook)) + (add-hook! (vm-pop-continuation-hook) pop-cont-hook) + (add-hook! (vm-abort-continuation-hook) 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-abort-continuation-hook vm) abort-hook) - (remove-hook! (vm-restore-continuation-hook vm) abort-hook))))) + (remove-hook! (vm-pop-continuation-hook) pop-cont-hook) + (remove-hook! (vm-abort-continuation-hook) 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-pop-continuation-hook vm) trace-pop) - (add-hook! (vm-apply-hook vm) trace-apply)) + (add-hook! (vm-push-continuation-hook) trace-push) + (add-hook! (vm-pop-continuation-hook) trace-pop) + (add-hook! (vm-apply-hook) trace-apply)) (define (leave frame) - (remove-hook! (vm-push-continuation-hook vm) trace-push) - (remove-hook! (vm-pop-continuation-hook vm) trace-pop) - (remove-hook! (vm-apply-hook vm) trace-apply)) + (remove-hook! (vm-push-continuation-hook) trace-push) + (remove-hook! (vm-pop-continuation-hook) trace-pop) + (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))))) diff --git a/test-suite/tests/control.test b/test-suite/tests/control.test index 916eb2c4b..f3aad3d13 100644 --- a/test-suite/tests/control.test +++ b/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)))))))) diff --git a/test-suite/tests/eval.test b/test-suite/tests/eval.test index 67e8240e4..c8e68a506 100644 --- a/test-suite/tests/eval.test +++ b/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)) - (thunk (let loop () (cons 's (loop))))) - (call-with-vm vm thunk)))) + (let ((thunk (let loop () (cons 's (loop))))) + (call-with-vm thunk)))) ;;; ;;; docstrings