mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-20 11:40:18 +02:00
Remove make-vm; there will be one vm per thread now.
* libguile/vm.h: * libguile/vm.c (scm_make_vm): Remove. * module/system/vm/vm.scm: Remove make-vm export. * test-suite/tests/control.test ("the-vm"): * test-suite/tests/coverage.test (%test-vm): * test-suite/tests/eval.test ("stack overflow"): Adapt tests.
This commit is contained in:
parent
89b235afd3
commit
e08caa5620
6 changed files with 9 additions and 24 deletions
|
@ -856,15 +856,6 @@ SCM_DEFINE (scm_vm_p, "vm?", 1, 0, 0,
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
|
||||||
SCM_DEFINE (scm_make_vm, "make-vm", 0, 0, 0,
|
|
||||||
(void),
|
|
||||||
"")
|
|
||||||
#define FUNC_NAME s_scm_make_vm,
|
|
||||||
{
|
|
||||||
return make_vm ();
|
|
||||||
}
|
|
||||||
#undef FUNC_NAME
|
|
||||||
|
|
||||||
SCM_DEFINE (scm_vm_ip, "vm:ip", 1, 0, 0,
|
SCM_DEFINE (scm_vm_ip, "vm:ip", 1, 0, 0,
|
||||||
(SCM vm),
|
(SCM vm),
|
||||||
"")
|
"")
|
||||||
|
|
|
@ -56,9 +56,6 @@ SCM_API SCM scm_the_vm_fluid;
|
||||||
#define SCM_VM_DATA(vm) ((struct scm_vm *) SCM_CELL_WORD_1 (vm))
|
#define SCM_VM_DATA(vm) ((struct scm_vm *) SCM_CELL_WORD_1 (vm))
|
||||||
#define SCM_VALIDATE_VM(pos,x) SCM_MAKE_VALIDATE (pos, x, VM_P)
|
#define SCM_VALIDATE_VM(pos,x) SCM_MAKE_VALIDATE (pos, x, VM_P)
|
||||||
|
|
||||||
SCM_API SCM scm_the_vm (void);
|
|
||||||
SCM_API SCM scm_make_vm (void);
|
|
||||||
|
|
||||||
SCM_API SCM scm_the_vm (void);
|
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 vm, SCM proc, SCM args);
|
||||||
|
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
;;; Guile VM core
|
;;; Guile VM core
|
||||||
|
|
||||||
;;; Copyright (C) 2001, 2009, 2010 Free Software Foundation, Inc.
|
;;; Copyright (C) 2001, 2009, 2010, 2013 Free Software Foundation, Inc.
|
||||||
;;;
|
;;;
|
||||||
;;; This library is free software; you can redistribute it and/or
|
;;; This library is free software; you can redistribute it and/or
|
||||||
;;; modify it under the terms of the GNU Lesser General Public
|
;;; modify it under the terms of the GNU Lesser General Public
|
||||||
|
@ -20,7 +20,7 @@
|
||||||
|
|
||||||
(define-module (system vm vm)
|
(define-module (system vm vm)
|
||||||
#:export (vm?
|
#:export (vm?
|
||||||
make-vm the-vm call-with-vm
|
the-vm call-with-vm
|
||||||
vm:ip vm:sp vm:fp
|
vm:ip vm:sp vm:fp
|
||||||
|
|
||||||
vm-trace-level set-vm-trace-level!
|
vm-trace-level set-vm-trace-level!
|
||||||
|
|
|
@ -362,20 +362,17 @@
|
||||||
|
|
||||||
(with-test-prefix/c&e "the-vm"
|
(with-test-prefix/c&e "the-vm"
|
||||||
|
|
||||||
(pass-if "unwind changes VMs"
|
(pass-if "unwind through call-with-vm"
|
||||||
(let ((new-vm (make-vm))
|
(let ((proc (lambda (x y)
|
||||||
(prev-vm (the-vm))
|
|
||||||
(proc (lambda (x y)
|
|
||||||
(expt x y)))
|
(expt x y)))
|
||||||
(call (lambda (p x y)
|
(call (lambda (p x y)
|
||||||
(p x y))))
|
(p x y))))
|
||||||
(catch 'foo
|
(catch 'foo
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(call-with-vm new-vm (lambda () (throw 'foo (the-vm)))))
|
(call-with-vm (the-vm) (lambda () (throw 'foo (the-vm)))))
|
||||||
(lambda (key vm)
|
(lambda (key vm)
|
||||||
(and (eq? key 'foo)
|
(and (eq? key 'foo)
|
||||||
(eq? vm new-vm)
|
(eq? vm (the-vm))))))))
|
||||||
(eq? (the-vm) prev-vm)))))))
|
|
||||||
|
|
||||||
;; These tests from Oleg Kiselyov's delim-control-n.scm, available at
|
;; These tests from Oleg Kiselyov's delim-control-n.scm, available at
|
||||||
;; http://okmij.org/ftp/Scheme/delim-control-n.scm. Public domain.
|
;; http://okmij.org/ftp/Scheme/delim-control-n.scm. Public domain.
|
||||||
|
|
|
@ -33,7 +33,7 @@
|
||||||
(read-enable 'positions)
|
(read-enable 'positions)
|
||||||
(compile (read input))))))
|
(compile (read input))))))
|
||||||
|
|
||||||
(define %test-vm (make-vm))
|
(define %test-vm (the-vm))
|
||||||
|
|
||||||
(define test-procedure
|
(define test-procedure
|
||||||
(compile '(lambda (x)
|
(compile '(lambda (x)
|
||||||
|
|
|
@ -18,7 +18,7 @@
|
||||||
(define-module (test-suite test-eval)
|
(define-module (test-suite test-eval)
|
||||||
:use-module (test-suite lib)
|
:use-module (test-suite lib)
|
||||||
:use-module ((srfi srfi-1) :select (unfold count))
|
:use-module ((srfi srfi-1) :select (unfold count))
|
||||||
:use-module ((system vm vm) :select (make-vm call-with-vm))
|
:use-module ((system vm vm) :select (the-vm call-with-vm))
|
||||||
:use-module (ice-9 documentation)
|
:use-module (ice-9 documentation)
|
||||||
:use-module (ice-9 local-eval))
|
:use-module (ice-9 local-eval))
|
||||||
|
|
||||||
|
@ -437,7 +437,7 @@
|
||||||
;; FIXME: this test does not test what it is intending to test
|
;; FIXME: this test does not test what it is intending to test
|
||||||
(pass-if-exception "exception raised"
|
(pass-if-exception "exception raised"
|
||||||
exception:vm-error
|
exception:vm-error
|
||||||
(let ((vm (make-vm))
|
(let ((vm (the-vm))
|
||||||
(thunk (let loop () (cons 's (loop)))))
|
(thunk (let loop () (cons 's (loop)))))
|
||||||
(call-with-vm vm thunk))))
|
(call-with-vm vm thunk))))
|
||||||
|
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue