From 7bbed5181c562f771276e93480358d6512260dbf Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@pobox.com>
Date: Wed, 24 Sep 2008 11:47:25 +0200
Subject: [PATCH] the vm is a fluid

* module/system/vm/vm.scm:
* libguile/vm.h:
* libguile/vm.c: Make the `the-vm' procedure access a fluid, `*the-vm*'.
  Export that fluid from vm.h and vm.scm.
---
 libguile/vm.c           | 10 ++++++----
 libguile/vm.h           |  2 ++
 module/system/vm/vm.scm |  2 +-
 3 files changed, 9 insertions(+), 5 deletions(-)

diff --git a/libguile/vm.c b/libguile/vm.c
index 3933894af..5b3f90e3a 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -259,7 +259,7 @@ vm_heapify_frames (SCM vm)
 
 scm_t_bits scm_tc16_vm;
 
-static SCM the_vm;
+SCM scm_the_vm_fluid;
 
 static SCM
 make_vm (void)
@@ -342,7 +342,7 @@ SCM_DEFINE (scm_the_vm, "the-vm", 0, 0, 0,
 	    "")
 #define FUNC_NAME s_scm_the_vm
 {
-  return the_vm;
+  return scm_fluid_ref (scm_the_vm_fluid);
 }
 #undef FUNC_NAME
 
@@ -628,7 +628,7 @@ SCM scm_load_compiled_with_vm (SCM file)
 {
   SCM program = scm_objcode_to_program (scm_load_objcode (file));
   
-  return vm_run (the_vm, program, SCM_EOL);
+  return vm_run (scm_the_vm (), program, SCM_EOL);
 }
 
 void
@@ -653,7 +653,9 @@ scm_bootstrap_vm (void)
   scm_set_smob_free (scm_tc16_vm, vm_free);
   scm_set_smob_apply (scm_tc16_vm, scm_vm_apply, 1, 0, 1);
 
-  the_vm = scm_permanent_object (make_vm ());
+  scm_the_vm_fluid = scm_permanent_object (scm_make_fluid ());
+  scm_fluid_set_x (scm_the_vm_fluid, make_vm ());
+  scm_c_define ("*the-vm*", scm_the_vm_fluid);
 
   scm_c_define ("load-compiled",
                 scm_c_make_gsubr ("load-compiled/vm", 1, 0, 0,
diff --git a/libguile/vm.h b/libguile/vm.h
index b3afbfdf6..398013575 100644
--- a/libguile/vm.h
+++ b/libguile/vm.h
@@ -71,6 +71,8 @@ struct scm_vm {
   unsigned long clock;		/* bogos clock */
 };
 
+extern SCM scm_the_vm_fluid;
+
 #define SCM_VM_P(x)		SCM_SMOB_PREDICATE (scm_tc16_vm, x)
 #define SCM_VM_DATA(vm)		((struct scm_vm *) SCM_SMOB_DATA (vm))
 #define SCM_VALIDATE_VM(pos,x)	SCM_MAKE_VALIDATE (pos, x, VM_P)
diff --git a/module/system/vm/vm.scm b/module/system/vm/vm.scm
index 725c1a281..e4f5e98a3 100644
--- a/module/system/vm/vm.scm
+++ b/module/system/vm/vm.scm
@@ -22,7 +22,7 @@
 (define-module (system vm vm)
   #:use-module (system vm frame)
   #:use-module (system vm objcode)
-  #:export (vm? the-vm make-vm vm-version
+  #:export (vm? the-vm *the-vm* make-vm vm-version
            vm:ip vm:sp vm:fp vm:last-ip
 
            vm-load vm-return-value