add call-with-vm; remove thread-vm bits; remove vm-apply; engines settable.
* libguile/vm.h (scm_c_vm_run): Make internal.
* libguile/vm.c (vm_default_engine): New static global variable.
(make_vm): Set vp->engine based on
(scm_vm_apply): Remove in favor of call-with-vm.
(scm_thread_vm, scm_set_thread_vm_x): Remove these, as they did not
have a well-defined meaning, and were dangerous to call on other
threads.
(scm_the_vm): Reinstate previous definition.
(symbol_to_vm_engine, vm_engine_to_symbol)
(vm_has_pending_computation): New helpers.
(scm_vm_engine, scm_set_vm_engine_x, scm_c_set_vm_engine_x): New
accessors for VM engines.
(scm_c_set_default_vm_engine_x, scm_set_default_vm_engine_x): New
setters for the default VM engine.
(scm_call_with_vm): New function, applies a procedure to arguments in
a context in which a given VM is current.
* libguile/eval.c (eval, scm_apply): VM dispatch goes through
scm_call_with_vm.
* test-suite/tests/control.test ("the-vm"):
* module/system/vm/coverage.scm (with-code-coverage): Use call-with-vm.
* module/system/vm/vm.scm: Update exports.
* test-suite/vm/run-vm-tests.scm (run-vm-program):
* test-suite/tests/compiler.test ("current-reader"): Just rely on the
result of make-program being an applicable.
* test-suite/tests/eval.test ("stack overflow"): Add a note that this
test does not test what it should.
This commit is contained in:
parent
864e7d424e
commit
ea9f4f4b15
9 changed files with 205 additions and 110 deletions
|
|
@ -19,7 +19,6 @@
|
|||
#:use-module (test-suite lib)
|
||||
#:use-module (test-suite guile-test)
|
||||
#:use-module (system base compile)
|
||||
#:use-module ((system vm vm) #:select (the-vm vm-apply))
|
||||
#:use-module ((system vm program) #:select (make-program
|
||||
program-sources source:addr)))
|
||||
|
||||
|
|
@ -98,7 +97,7 @@
|
|||
#f)
|
||||
(install-reader!)
|
||||
this-should-be-ignored")))
|
||||
(and (eq? (vm-apply (the-vm) (make-program (read-and-compile input)) '())
|
||||
(and (eq? ((make-program (read-and-compile input)))
|
||||
'ok)
|
||||
(eq? r (fluid-ref current-reader)))))
|
||||
|
||||
|
|
|
|||
|
|
@ -238,15 +238,7 @@
|
|||
(p x y))))
|
||||
(catch 'foo
|
||||
(lambda ()
|
||||
(dynamic-wind
|
||||
(lambda ()
|
||||
(set-thread-vm! (current-thread) new-vm))
|
||||
(lambda ()
|
||||
(vm-apply new-vm
|
||||
(lambda () (throw 'foo (the-vm)))
|
||||
'()))
|
||||
(lambda ()
|
||||
(set-thread-vm! (current-thread) prev-vm))))
|
||||
(call-with-vm new-vm (lambda () (throw 'foo (the-vm)))))
|
||||
(lambda (key vm)
|
||||
(and (eq? key 'foo)
|
||||
(eq? vm new-vm)
|
||||
|
|
|
|||
|
|
@ -18,7 +18,7 @@
|
|||
(define-module (test-suite test-eval)
|
||||
:use-module (test-suite lib)
|
||||
:use-module ((srfi srfi-1) :select (unfold count))
|
||||
:use-module ((system vm vm) :select (make-vm vm-apply))
|
||||
:use-module ((system vm vm) :select (make-vm call-with-vm))
|
||||
:use-module (ice-9 documentation))
|
||||
|
||||
|
||||
|
|
@ -439,10 +439,11 @@
|
|||
|
||||
(with-test-prefix "stack overflow"
|
||||
|
||||
;; FIXME: this test does not test what it is intending to test
|
||||
(pass-if-exception "exception raised"
|
||||
exception:vm-error
|
||||
(let ((vm (make-vm))
|
||||
(thunk (let loop () (cons 's (loop)))))
|
||||
(vm-apply vm thunk))))
|
||||
(call-with-vm vm thunk))))
|
||||
|
||||
;;; eval.test ends here
|
||||
|
|
|
|||
|
|
@ -42,7 +42,7 @@
|
|||
|
||||
(define (run-vm-program objcode)
|
||||
"Run VM program contained into @var{objcode}."
|
||||
(vm-apply (the-vm) (make-program objcode) '()))
|
||||
((make-program objcode)))
|
||||
|
||||
(define (compile/run-test-from-file file)
|
||||
"Run test from source file @var{file} and return a value indicating whether
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue