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.

diff --git a/libguile/vm.c b/libguile/vm.c
index acb3250..6bbf251 100644 (file)
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -856,15 +856,6 @@ SCM_DEFINE (scm_vm_p, "vm?", 1, 0, 0,
 }
 #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 vm),
            "")

diff --git a/libguile/vm.h b/libguile/vm.h
index bb07454..e461764 100644 (file)
--- a/libguile/vm.h
+++ b/libguile/vm.h
@@ -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_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_call_with_vm (SCM vm, SCM proc, SCM args);
 

diff --git a/module/system/vm/vm.scm b/module/system/vm/vm.scm
index 0d6f5cc..8f830cc 100644 (file)
--- a/module/system/vm/vm.scm
+++ b/module/system/vm/vm.scm
@@ -1,6 +1,6 @@
 ;;; 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
 ;;; modify it under the terms of the GNU Lesser General Public
@@ -20,7 +20,7 @@
 
 (define-module (system vm vm)
   #:export (vm?
-            make-vm the-vm call-with-vm
+            the-vm call-with-vm
             vm:ip vm:sp vm:fp
 
             vm-trace-level set-vm-trace-level!

diff --git a/test-suite/tests/control.test b/test-suite/tests/control.test
index 5b292c4..916eb2c 100644 (file)
--- a/test-suite/tests/control.test
+++ b/test-suite/tests/control.test
@@ -362,20 +362,17 @@
 
 (with-test-prefix/c&e "the-vm"
 
-  (pass-if "unwind changes VMs"
-    (let ((new-vm  (make-vm))
-          (prev-vm (the-vm))
-          (proc    (lambda (x y)
+  (pass-if "unwind through call-with-vm"
+    (let ((proc    (lambda (x y)
                      (expt x y)))
           (call    (lambda (p x y)
                      (p x y))))
       (catch 'foo
         (lambda ()
-          (call-with-vm new-vm (lambda () (throw 'foo (the-vm)))))
+          (call-with-vm (the-vm) (lambda () (throw 'foo (the-vm)))))
         (lambda (key vm)
           (and (eq? key 'foo)
-               (eq? vm new-vm)
-               (eq? (the-vm) prev-vm)))))))
+               (eq? vm (the-vm))))))))
 
 ;; These tests from Oleg Kiselyov's delim-control-n.scm, available at
 ;; http://okmij.org/ftp/Scheme/delim-control-n.scm.  Public domain.

diff --git a/test-suite/tests/coverage.test b/test-suite/tests/coverage.test
index 7a7a6c5..126136a 100644 (file)
--- a/test-suite/tests/coverage.test
+++ b/test-suite/tests/coverage.test
@@ -33,7 +33,7 @@
        (read-enable 'positions)
        (compile (read input))))))
 
-(define %test-vm (make-vm))
+(define %test-vm (the-vm))
 
 (define test-procedure
   (compile '(lambda (x)

diff --git a/test-suite/tests/eval.test b/test-suite/tests/eval.test
index 8930cf2..67e8240 100644 (file)
--- a/test-suite/tests/eval.test
+++ b/test-suite/tests/eval.test
@@ -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 call-with-vm))
+  :use-module ((system vm vm) :select (the-vm call-with-vm))
   :use-module (ice-9 documentation)
   :use-module (ice-9 local-eval))
 
@@ -437,7 +437,7 @@
   ;; FIXME: this test does not test what it is intending to test
   (pass-if-exception "exception raised"
     exception:vm-error
-    (let ((vm    (make-vm))
+    (let ((vm    (the-vm))
           (thunk (let loop () (cons 's (loop)))))
       (call-with-vm vm thunk))))