X-Git-Url: http://git.hcoop.net/bpt/guile.git/blobdiff_plain/e0c211bb2e80605b4ae3fb121c34136f6e266b70..479fc9a5caca8592da5cc84570fbf2335c632d6c:/libguile/fluids.c

diff --git a/libguile/fluids.c b/libguile/fluids.c
index 8e36acde6..4e0684af8 100644
--- a/libguile/fluids.c
+++ b/libguile/fluids.c
@@ -1,4 +1,5 @@
-/* Copyright (C) 1996,1997,2000,2001, 2004, 2006, 2007, 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
+/* Copyright (C) 1996,1997,2000,2001, 2004, 2006, 2007, 2008, 2009, 2010,
+ *    2011, 2012, 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 License
@@ -115,7 +116,7 @@ new_fluid (SCM init)
 	if (allocated_fluids[n] == NULL)
 	  break;
 
-      if (trial == 0 && n >= allocated_fluids_len)
+      if (trial == 0 && n >= allocated_fluids_len && allocated_fluids_len)
 	/* All fluid numbers are in use.  Run a GC and retry.  Explicitly
 	   running the GC is costly and bad-style.  We only do this because
 	   dynamic state fluid vectors would grow unreasonably if fluid numbers
@@ -301,50 +302,17 @@ apply_thunk (void *thunk)
   return scm_call_0 (SCM_PACK (thunk));
 }
 
-size_t
-scm_prepare_fluids (size_t n, SCM *fluids, SCM *values)
-{
-  size_t j = n;
-
-  /* Ensure that there are no duplicates in the fluids set -- an N^2 operation,
-     but N will usually be small, so perhaps that's OK. */
-  while (j--)
-    {
-      size_t i;
-
-      if (SCM_UNLIKELY (!IS_FLUID (fluids[j])))
-        scm_wrong_type_arg ("with-fluids", 0, fluids[j]);
-
-      for (i = 0; i < j; i++)
-        if (scm_is_eq (fluids[i], fluids[j]))
-          {
-            values[i] = values[j]; /* later bindings win */
-            n--;
-            break;
-          }
-    }
-
-  return n;
-}
-  
 void
-scm_swap_fluids (size_t n, SCM *fluids, SCM *values, SCM dynstate)
+scm_swap_fluid (SCM fluid, SCM value_box, SCM dynstate)
 {
-  SCM fluid_vector;
-  size_t i, max = 0;
+  SCM fluid_vector, tmp;
+  size_t fluid_num;
 
-  fluid_vector = DYNAMIC_STATE_FLUIDS (dynstate);
+  fluid_num = FLUID_NUM (fluid);
 
-  /* We could cache the max in the with-fluids, but that would take more mem,
-     and we're touching all the fluids anyway, so this per-swap traversal should
-     be OK. */
-  for (i = 0; i < n; i++)
-    {
-      size_t num = FLUID_NUM (fluids[i]);
-      max = (max > num) ? max : num;
-    }
+  fluid_vector = DYNAMIC_STATE_FLUIDS (dynstate);
 
-  if (SCM_UNLIKELY (max >= SCM_SIMPLE_VECTOR_LENGTH (fluid_vector)))
+  if (SCM_UNLIKELY (fluid_num >= SCM_SIMPLE_VECTOR_LENGTH (fluid_vector)))
     {
       /* Lazily grow the current thread's dynamic state.  */
       grow_dynamic_state (dynstate);
@@ -352,17 +320,9 @@ scm_swap_fluids (size_t n, SCM *fluids, SCM *values, SCM dynstate)
       fluid_vector = DYNAMIC_STATE_FLUIDS (dynstate);
     }
 
-  /* Bind the fluids. Order doesn't matter, as all fluids are distinct. */
-  for (i = 0; i < n; i++)
-    {
-      size_t fluid_num;
-      SCM x;
-      
-      fluid_num = FLUID_NUM (fluids[i]);
-      x = SCM_SIMPLE_VECTOR_REF (fluid_vector, fluid_num);
-      SCM_SIMPLE_VECTOR_SET (fluid_vector, fluid_num, values[i]);
-      values[i] = x;
-    }
+  tmp = SCM_SIMPLE_VECTOR_REF (fluid_vector, fluid_num);
+  SCM_SIMPLE_VECTOR_SET (fluid_vector, fluid_num, SCM_VARIABLE_REF (value_box));
+  SCM_VARIABLE_SET (value_box, tmp);
 }
   
 SCM_DEFINE (scm_with_fluids, "with-fluids*", 3, 0, 0, 
@@ -384,7 +344,6 @@ scm_c_with_fluids (SCM fluids, SCM values, SCM (*cproc) (), void *cdata)
 {
   SCM ans;
   long flen, vlen, i;
-  SCM *fluidsv, *valuesv;
   scm_i_thread *thread = SCM_I_CURRENT_THREAD;
 
   SCM_VALIDATE_LIST_COPYLEN (1, fluids, flen);
@@ -392,39 +351,30 @@ scm_c_with_fluids (SCM fluids, SCM values, SCM (*cproc) (), void *cdata)
   if (flen != vlen)
     scm_out_of_range (s_scm_with_fluids, values);
 
-  if (SCM_UNLIKELY (flen == 0))
-    return cproc (cdata);
-
-  fluidsv = alloca (sizeof(SCM)*flen);
-  valuesv = alloca (sizeof(SCM)*flen);
-  
   for (i = 0; i < flen; i++)
     {
-      fluidsv[i] = SCM_CAR (fluids);
+      scm_dynstack_push_fluid (&thread->dynstack,
+                               SCM_CAR (fluids), SCM_CAR (values),
+                               thread->dynamic_state);
       fluids = SCM_CDR (fluids);
-      valuesv[i] = SCM_CAR (values);
       values = SCM_CDR (values);
     }
 
-  scm_dynstack_push_fluids (&thread->dynstack, flen, fluidsv, valuesv,
-                            thread->dynamic_state);
   ans = cproc (cdata);
-  scm_dynstack_unwind_fluids (&thread->dynstack, thread->dynamic_state);
+
+  for (i = 0; i < flen; i++)
+    scm_dynstack_unwind_fluid (&thread->dynstack, thread->dynamic_state);
 
   return ans;
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_with_fluid, "with-fluid*", 3, 0, 0, 
-	    (SCM fluid, SCM value, SCM thunk),
-	    "Set @var{fluid} to @var{value} temporarily, and call @var{thunk}.\n"
-	    "@var{thunk} must be a procedure with no argument.")
-#define FUNC_NAME s_scm_with_fluid
+SCM
+scm_with_fluid (SCM fluid, SCM value, SCM thunk)
 {
   return scm_c_with_fluid (fluid, value,
 			   apply_thunk, (void *) SCM_UNPACK (thunk));
 }
-#undef FUNC_NAME
 
 SCM
 scm_c_with_fluid (SCM fluid, SCM value, SCM (*cproc) (), void *cdata)
@@ -433,10 +383,10 @@ scm_c_with_fluid (SCM fluid, SCM value, SCM (*cproc) (), void *cdata)
   SCM ans;
   scm_i_thread *thread = SCM_I_CURRENT_THREAD;
 
-  scm_dynstack_push_fluids (&thread->dynstack, 1, &fluid, &value,
-                            thread->dynamic_state);
+  scm_dynstack_push_fluid (&thread->dynstack, fluid, value,
+                           thread->dynamic_state);
   ans = cproc (cdata);
-  scm_dynstack_unwind_fluids (&thread->dynstack, thread->dynamic_state);
+  scm_dynstack_unwind_fluid (&thread->dynstack, thread->dynamic_state);
 
   return ans;
 }