optional default-value arg to make-fluid

* libguile/fluids.c (grow_dynamic_state, new_fluid): Arrange for the
  default value in the dynamic-state vector to be SCM_UNDEFINED instead
  of SCM_BOOL_F.  If the value in the dynamic-state is #f, default to a
  value attached to the fluid instead.  This allows useful default
  values.
  (scm_make_fluid_with_default): New function, allows the user to
  specify a default value for the fluid.  Defaults to #f.  Bound to
  `make-fluid' on the Scheme side.
  (scm_make_unbound_fluid): Use SCM_UNDEFINED as the default in all
  threads.
  (scm_fluid_unset_x): Also unset the default value.  Not sure if this
  is the right thing.
  (fluid_ref): Update to the new default-value strategy.

* libguile/threads.c (scm_i_reset_fluid): Reset to SCM_UNDEFINED.
* libguile/threads.h: Remove extra arg to scm_i_reset_fluid.
* libguile/vm-i-system.c (fluid-ref): Update to new default-value
  strategy.

* module/ice-9/vlist.scm (block-growth-factor): Default to 2 in all
  threads.  Fixes http://debbugs.gnu.org/10093.

diff --git a/libguile/fluids.c b/libguile/fluids.c
index 67efd9f..f92c5dd 100644 (file)
--- a/libguile/fluids.c
+++ b/libguile/fluids.c
@@ -68,7 +68,7 @@ grow_dynamic_state (SCM state)
   /* Assume the assignment below is atomic.  */
   len = allocated_fluids_len;
 
-  new_fluids = scm_c_make_vector (len, SCM_BOOL_F);
+  new_fluids = scm_c_make_vector (len, SCM_UNDEFINED);
 
   for (i = 0; i < old_len; i++)
     SCM_SIMPLE_VECTOR_SET (new_fluids, i,
@@ -103,14 +103,14 @@ scm_i_with_fluids_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
 \f
 /* Return a new fluid.  */
 static SCM
-new_fluid ()
+new_fluid (SCM init)
 {
   SCM fluid;
   size_t trial, n;
 
-  /* Fluids are pointerless cells: the first word is the type tag; the second
-     word is the fluid number.  */
-  fluid = PTR2SCM (scm_gc_malloc_pointerless (sizeof (scm_t_cell), "fluid"));
+  /* Fluids hold the type tag and the fluid number in the first word,
+     and the default value in the second word.  */
+  fluid = scm_cell (scm_tc7_fluid, SCM_UNPACK (init));
   SCM_SET_CELL_TYPE (fluid, scm_tc7_fluid);
 
   scm_dynwind_begin (0);
@@ -157,7 +157,7 @@ new_fluid ()
     }
 
   allocated_fluids[n] = SCM2PTR (fluid);
-  SCM_SET_CELL_WORD_1 (fluid, (scm_t_bits) n);
+  SCM_SET_CELL_WORD_0 (fluid, (scm_tc7_fluid | (n << 8)));
 
   GC_GENERAL_REGISTER_DISAPPEARING_LINK (&allocated_fluids[n],
                                         SCM2PTR (fluid));
@@ -166,13 +166,19 @@ new_fluid ()
 
   /* Now null out values.  We could (and probably should) do this when
      the fluid is collected instead of now.  */
-  scm_i_reset_fluid (n, SCM_BOOL_F);
+  scm_i_reset_fluid (n);
 
   return fluid;
 }
 
-SCM_DEFINE (scm_make_fluid, "make-fluid", 0, 0, 0, 
-           (),
+SCM
+scm_make_fluid (void)
+{
+  return new_fluid (SCM_BOOL_F);
+}
+
+SCM_DEFINE (scm_make_fluid_with_default, "make-fluid", 0, 1, 0, 
+           (SCM dflt),
            "Return a newly created fluid.\n"
            "Fluids are objects that can hold one\n"
            "value per dynamic state.  That is, modifications to this value are\n"
@@ -180,9 +186,9 @@ SCM_DEFINE (scm_make_fluid, "make-fluid", 0, 0, 0,
            "the modifying code.  When a new dynamic state is constructed, it\n"
            "inherits the values from its parent.  Because each thread normally executes\n"
            "with its own dynamic state, you can use fluids for thread local storage.")
-#define FUNC_NAME s_scm_make_fluid
+#define FUNC_NAME s_scm_make_fluid_with_default
 {
-  return new_fluid ();
+  return new_fluid (SCM_UNBNDP (dflt) ? SCM_BOOL_F : dflt);
 }
 #undef FUNC_NAME
 
@@ -191,9 +197,7 @@ SCM_DEFINE (scm_make_unbound_fluid, "make-unbound-fluid", 0, 0, 0,
             "Make a fluid that is initially unbound.")
 #define FUNC_NAME s_scm_make_unbound_fluid
 {
-  SCM f = new_fluid ();
-  scm_fluid_set_x (f, SCM_UNDEFINED);
-  return f;
+  return new_fluid (SCM_UNDEFINED);
 }
 #undef FUNC_NAME
 
@@ -217,6 +221,7 @@ scm_is_fluid (SCM obj)
 static SCM
 fluid_ref (SCM fluid)
 {
+  SCM ret;
   SCM fluids = DYNAMIC_STATE_FLUIDS (SCM_I_CURRENT_THREAD->dynamic_state);
 
   if (SCM_UNLIKELY (FLUID_NUM (fluid) >= SCM_SIMPLE_VECTOR_LENGTH (fluids)))
@@ -227,7 +232,11 @@ fluid_ref (SCM fluid)
       fluids = DYNAMIC_STATE_FLUIDS (SCM_I_CURRENT_THREAD->dynamic_state);
     }
 
-  return SCM_SIMPLE_VECTOR_REF (fluids, FLUID_NUM (fluid));
+  ret = SCM_SIMPLE_VECTOR_REF (fluids, FLUID_NUM (fluid));
+  if (SCM_UNBNDP (ret))
+    return SCM_I_FLUID_DEFAULT (fluid);
+  else
+    return ret;
 }
 
 SCM_DEFINE (scm_fluid_ref, "fluid-ref", 1, 0, 0, 
@@ -274,6 +283,9 @@ SCM_DEFINE (scm_fluid_unset_x, "fluid-unset!", 1, 0, 0,
             "Unset the value associated with @var{fluid}.")
 #define FUNC_NAME s_scm_fluid_unset_x
 {
+  /* FIXME: really unset the default value, too?  The current test
+     suite demands it, but I would prefer not to.  */
+  SCM_SET_CELL_OBJECT_1 (fluid, SCM_UNDEFINED);
   return scm_fluid_set_x (fluid, SCM_UNDEFINED);
 }
 #undef FUNC_NAME

diff --git a/libguile/fluids.h b/libguile/fluids.h
index 66e3985..2b91ff3 100644 (file)
--- a/libguile/fluids.h
+++ b/libguile/fluids.h
@@ -3,7 +3,7 @@
 #ifndef SCM_FLUIDS_H
 #define SCM_FLUIDS_H
 
-/* Copyright (C) 1996,2000,2001, 2006, 2008, 2009, 2010 Free Software Foundation, Inc.
+/* Copyright (C) 1996,2000,2001, 2006, 2008, 2009, 2010, 2011 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 License
@@ -56,10 +56,12 @@
 
 #define SCM_FLUID_P(x)          (!SCM_IMP (x) && SCM_TYP7 (x) == scm_tc7_fluid)
 #ifdef BUILDING_LIBGUILE
-#define SCM_I_FLUID_NUM(x)        ((size_t)SCM_CELL_WORD_1(x))
+#define SCM_I_FLUID_NUM(x)        ((size_t)(SCM_CELL_WORD_0 (x) >> 8))
+#define SCM_I_FLUID_DEFAULT(x)    (SCM_CELL_OBJECT_1 (x))
 #endif
 
 SCM_API SCM scm_make_fluid (void);
+SCM_API SCM scm_make_fluid_with_default (SCM dflt);
 SCM_API SCM scm_make_unbound_fluid (void);
 SCM_API int scm_is_fluid (SCM obj);
 SCM_API SCM scm_fluid_p (SCM fl);

diff --git a/libguile/threads.c b/libguile/threads.c
index 7523540..e4d3e21 100644 (file)
--- a/libguile/threads.c
+++ b/libguile/threads.c
@@ -478,7 +478,7 @@ static SCM scm_i_default_dynamic_state;
 
 /* Run when a fluid is collected.  */
 void
-scm_i_reset_fluid (size_t n, SCM val)
+scm_i_reset_fluid (size_t n)
 {
   scm_i_thread *t;
 
@@ -489,7 +489,7 @@ scm_i_reset_fluid (size_t n, SCM val)
         SCM v = SCM_I_DYNAMIC_STATE_FLUIDS (t->dynamic_state);
           
         if (n < SCM_SIMPLE_VECTOR_LENGTH (v))
-          SCM_SIMPLE_VECTOR_SET (v, n, val);
+          SCM_SIMPLE_VECTOR_SET (v, n, SCM_UNDEFINED);
       }
   scm_i_pthread_mutex_unlock (&thread_admin_mutex);
 }

diff --git a/libguile/threads.h b/libguile/threads.h
index edecad8..ec129bc 100644 (file)
--- a/libguile/threads.h
+++ b/libguile/threads.h
@@ -136,7 +136,7 @@ SCM_API SCM scm_spawn_thread (scm_t_catch_body body, void *body_data,
 SCM_API void *scm_without_guile (void *(*func)(void *), void *data);
 SCM_API void *scm_with_guile (void *(*func)(void *), void *data);
 
-SCM_INTERNAL void scm_i_reset_fluid (size_t, SCM);
+SCM_INTERNAL void scm_i_reset_fluid (size_t);
 SCM_INTERNAL void scm_threads_prehistory (void *);
 SCM_INTERNAL void scm_init_threads (void);
 SCM_INTERNAL void scm_init_thread_procs (void);

diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index 1b4136f..474fe78 100644 (file)
--- a/libguile/vm-i-system.c
+++ b/libguile/vm-i-system.c
@@ -1660,6 +1660,8 @@ VM_DEFINE_INSTRUCTION (91, fluid_ref, "fluid-ref", 0, 1, 1)
   else
     {
       SCM val = SCM_SIMPLE_VECTOR_REF (fluids, num);
+      if (scm_is_eq (val, SCM_UNDEFINED))
+        val = SCM_I_FLUID_DEFAULT (*sp);
       if (SCM_UNLIKELY (scm_is_eq (val, SCM_UNDEFINED)))
         {
           finish_args = *sp;

diff --git a/module/ice-9/vlist.scm b/module/ice-9/vlist.scm
index 4b40b99..8c7c87b 100644 (file)
--- a/module/ice-9/vlist.scm
+++ b/module/ice-9/vlist.scm
@@ -66,9 +66,7 @@
 ;;;
 
 (define block-growth-factor
-  (let ((f (make-fluid)))
-    (fluid-set! f 2)
-    f))
+  (make-fluid 2))
 
 (define-syntax-rule (define-inline (name formals ...) body ...)
   ;; Work around the lack of an inliner.