-/* Copyright (C) 1996,1997,2000,2001, 2004, 2006, 2007, 2008 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
#include "libguile/_scm.h"
#include "libguile/print.h"
-#include "libguile/smob.h"
#include "libguile/dynwind.h"
#include "libguile/fluids.h"
#include "libguile/alist.h"
#include "libguile/eval.h"
#include "libguile/ports.h"
#include "libguile/deprecation.h"
-#include "libguile/lang.h"
#include "libguile/validate.h"
+#include "libguile/bdw-gc.h"
-#define FLUID_GROW 20
-
-/* A lot of the complexity below stems from the desire to reuse fluid
- slots. Normally, fluids should be pretty global and long-lived
- things, so that reusing their slots should not be overly critical,
- but it is the right thing to do nevertheless. The code therefore
- puts the burdon on allocating and collection fluids and keeps
- accessing fluids lock free. This is achieved by manipulating the
- global state of the fluid machinery mostly in single threaded
- sections.
-
- Reusing a fluid slot means that it must be reset to #f in all
- dynamic states. We do this by maintaining a weak list of all
- dynamic states, which is used after a GC to do the resetting.
-
- Also, the fluid vectors in the dynamic states need to grow from
- time to time when more fluids are created. We do this in a single
- threaded section so that threads do not need to lock when accessing
- a fluid in the normal way.
-*/
-
-static scm_i_pthread_mutex_t fluid_admin_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER;
+/* Number of additional slots to allocate when ALLOCATED_FLUIDS is full. */
+#define FLUID_GROW 128
-/* Protected by fluid_admin_mutex, but also accessed during GC. See
- next_fluid_num for a discussion of this.
- */
+/* Vector of allocated fluids indexed by fluid numbers. Access is protected by
+ FLUID_ADMIN_MUTEX. */
+static void **allocated_fluids = NULL;
static size_t allocated_fluids_len = 0;
-static size_t allocated_fluids_num = 0;
-static char *allocated_fluids = NULL;
-
-static scm_t_bits tc16_fluid;
-#define IS_FLUID(x) SCM_SMOB_PREDICATE(tc16_fluid, (x))
-#define FLUID_NUM(x) ((size_t)SCM_SMOB_DATA(x))
-#define FLUID_NEXT(x) SCM_SMOB_OBJECT_2(x)
-#define FLUID_NEXT_LOC(x) SCM_SMOB_OBJECT_2_LOC(x)
-#define SET_FLUID_NEXT(x,y) SCM_SET_SMOB_OBJECT_2((x), (y))
+static scm_i_pthread_mutex_t fluid_admin_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER;
-static scm_t_bits tc16_dynamic_state;
+#define IS_FLUID(x) SCM_FLUID_P (x)
+#define FLUID_NUM(x) SCM_I_FLUID_NUM (x)
-#define IS_DYNAMIC_STATE(x) SCM_SMOB_PREDICATE(tc16_dynamic_state, (x))
-#define DYNAMIC_STATE_FLUIDS(x) SCM_SMOB_OBJECT(x)
-#define SET_DYNAMIC_STATE_FLUIDS(x, y) SCM_SET_SMOB_OBJECT((x), (y))
-#define DYNAMIC_STATE_NEXT(x) SCM_SMOB_OBJECT_2(x)
-#define DYNAMIC_STATE_NEXT_LOC(x) SCM_SMOB_OBJECT_2_LOC(x)
-#define SET_DYNAMIC_STATE_NEXT(x, y) SCM_SET_SMOB_OBJECT_2((x), (y))
+#define IS_DYNAMIC_STATE(x) SCM_I_DYNAMIC_STATE_P (x)
+#define DYNAMIC_STATE_FLUIDS(x) SCM_I_DYNAMIC_STATE_FLUIDS (x)
+#define SET_DYNAMIC_STATE_FLUIDS(x, y) SCM_SET_CELL_WORD_1 ((x), (SCM_UNPACK (y)))
-/* Weak lists of all dynamic states and all fluids.
- */
-static SCM all_dynamic_states = SCM_EOL;
-static SCM all_fluids = SCM_EOL;
-/* Make sure that all states have the right size. This must be called
- while fluid_admin_mutex is held.
-*/
+\f
+/* Grow STATE so that it can hold up to ALLOCATED_FLUIDS_LEN fluids. This may
+ be more than necessary since ALLOCATED_FLUIDS is sparse and the current
+ thread may not access all the fluids anyway. Memory usage could be improved
+ by using a 2-level array as is done in glibc for pthread keys (TODO). */
static void
-resize_all_states ()
-{
- SCM new_vectors, state;
-
- /* Replacing the vector of a dynamic state must be done atomically:
- the old values must be copied into the new vector and the new
- vector must be installed without someone modifying the old vector
- concurrently. Since accessing a fluid should be lock-free, we
- need to put all threads to sleep when replacing a vector.
- However, when being single threaded, it is best not to do much.
- Therefore, we allocate the new vectors before going single
- threaded.
- */
-
- new_vectors = SCM_EOL;
- for (state = all_dynamic_states; !scm_is_null (state);
- state = DYNAMIC_STATE_NEXT (state))
- new_vectors = scm_cons (scm_c_make_vector (allocated_fluids_len,
- SCM_BOOL_F),
- new_vectors);
-
- scm_i_thread_put_to_sleep ();
- for (state = all_dynamic_states; !scm_is_null (state);
- state = DYNAMIC_STATE_NEXT (state))
- {
- SCM old_fluids = DYNAMIC_STATE_FLUIDS (state);
- SCM new_fluids = SCM_CAR (new_vectors);
- size_t i, old_len = SCM_SIMPLE_VECTOR_LENGTH (old_fluids);
-
- for (i = 0; i < old_len; i++)
- SCM_SIMPLE_VECTOR_SET (new_fluids, i,
- SCM_SIMPLE_VECTOR_REF (old_fluids, i));
- SET_DYNAMIC_STATE_FLUIDS (state, new_fluids);
- new_vectors = SCM_CDR (new_vectors);
- }
- scm_i_thread_wake_up ();
-}
-
-/* This is called during GC, that is, while being single threaded.
- See next_fluid_num for a discussion why it is safe to access
- allocated_fluids here.
- */
-static void *
-scan_dynamic_states_and_fluids (void *dummy1 SCM_UNUSED,
- void *dummy2 SCM_UNUSED,
- void *dummy3 SCM_UNUSED)
+grow_dynamic_state (SCM state)
{
- SCM *statep, *fluidp;
+ SCM new_fluids;
+ SCM old_fluids = DYNAMIC_STATE_FLUIDS (state);
+ size_t i, len, old_len = SCM_SIMPLE_VECTOR_LENGTH (old_fluids);
- /* Scan all fluids and deallocate the unmarked ones.
- */
- fluidp = &all_fluids;
- while (!scm_is_null (*fluidp))
- {
- if (!SCM_GC_MARK_P (*fluidp))
- {
- allocated_fluids_num -= 1;
- allocated_fluids[FLUID_NUM (*fluidp)] = 0;
- *fluidp = FLUID_NEXT (*fluidp);
- }
- else
- fluidp = FLUID_NEXT_LOC (*fluidp);
- }
+ /* Assume the assignment below is atomic. */
+ len = allocated_fluids_len;
- /* Scan all dynamic states and remove the unmarked ones. The live
- ones are updated for unallocated fluids.
- */
- statep = &all_dynamic_states;
- while (!scm_is_null (*statep))
- {
- if (!SCM_GC_MARK_P (*statep))
- *statep = DYNAMIC_STATE_NEXT (*statep);
- else
- {
- SCM fluids = DYNAMIC_STATE_FLUIDS (*statep);
- size_t len, i;
-
- len = SCM_SIMPLE_VECTOR_LENGTH (fluids);
- for (i = 0; i < len && i < allocated_fluids_len; i++)
- if (allocated_fluids[i] == 0)
- SCM_SIMPLE_VECTOR_SET (fluids, i, SCM_BOOL_F);
-
- statep = DYNAMIC_STATE_NEXT_LOC (*statep);
- }
- }
+ new_fluids = scm_c_make_vector (len, SCM_UNDEFINED);
- return NULL;
+ for (i = 0; i < old_len; i++)
+ SCM_SIMPLE_VECTOR_SET (new_fluids, i,
+ SCM_SIMPLE_VECTOR_REF (old_fluids, i));
+ SET_DYNAMIC_STATE_FLUIDS (state, new_fluids);
}
-static size_t
-fluid_free (SCM fluid)
+void
+scm_i_fluid_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
{
- /* The real work is done in scan_dynamic_states_and_fluids. We can
- not touch allocated_fluids etc here since a smob free routine can
- be run at any time, in any thread.
- */
- return 0;
+ scm_puts_unlocked ("#<fluid ", port);
+ scm_intprint ((int) FLUID_NUM (exp), 10, port);
+ scm_putc_unlocked ('>', port);
}
-static int
-fluid_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
+void
+scm_i_dynamic_state_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
{
- scm_puts ("#<fluid ", port);
- scm_intprint ((int) FLUID_NUM (exp), 10, port);
- scm_putc ('>', port);
- return 1;
+ scm_puts_unlocked ("#<dynamic-state ", port);
+ scm_intprint (SCM_UNPACK (exp), 16, port);
+ scm_putc_unlocked ('>', port);
}
-static size_t
-next_fluid_num ()
+\f
+/* Return a new fluid. */
+static SCM
+new_fluid (SCM init)
{
- size_t n;
+ SCM fluid;
+ size_t trial, n;
+
+ /* 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);
scm_i_dynwind_pthread_mutex_lock (&fluid_admin_mutex);
- if ((allocated_fluids_len > 0) &&
- (allocated_fluids_num == allocated_fluids_len))
- {
- /* All fluid numbers are in use. Run a GC to try to free some
- up.
- */
- scm_gc ();
- }
-
- if (allocated_fluids_num < allocated_fluids_len)
+ for (trial = 0; trial < 2; trial++)
{
+ /* Look for a free fluid number. */
for (n = 0; n < allocated_fluids_len; n++)
- if (allocated_fluids[n] == 0)
+ /* TODO: Use `__sync_bool_compare_and_swap' where available. */
+ if (allocated_fluids[n] == NULL)
break;
+
+ if (trial == 0 && n >= 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
+ weren't reused. */
+ scm_i_gc ("fluids");
}
- else
- {
- /* During the following call, the GC might run and elements of
- allocated_fluids might bet set to zero. Also,
- allocated_fluids and allocated_fluids_len are used to scan
- all dynamic states during GC. Thus we need to make sure that
- no GC can run while updating these two variables.
- */
- char *prev_allocated_fluids;
- char *new_allocated_fluids =
- scm_malloc (allocated_fluids_len + FLUID_GROW);
+ if (n >= allocated_fluids_len)
+ {
+ /* Grow the vector of allocated fluids. */
+ void **new_allocated_fluids =
+ scm_gc_malloc_pointerless ((allocated_fluids_len + FLUID_GROW)
+ * sizeof (*allocated_fluids),
+ "allocated fluids");
/* Copy over old values and initialize rest. GC can not run
during these two operations since there is no safe point in
- them.
- */
- memcpy (new_allocated_fluids, allocated_fluids, allocated_fluids_len);
- memset (new_allocated_fluids + allocated_fluids_len, 0, FLUID_GROW);
+ them. */
+ memcpy (new_allocated_fluids, allocated_fluids,
+ allocated_fluids_len * sizeof (*allocated_fluids));
+ memset (new_allocated_fluids + allocated_fluids_len, 0,
+ FLUID_GROW * sizeof (*allocated_fluids));
n = allocated_fluids_len;
- prev_allocated_fluids = allocated_fluids;
+ /* Update the vector of allocated fluids. Dynamic states will
+ eventually be lazily grown to accomodate the new value of
+ ALLOCATED_FLUIDS_LEN in `fluid-ref' and `fluid-set!'. */
allocated_fluids = new_allocated_fluids;
allocated_fluids_len += FLUID_GROW;
+ }
- if (prev_allocated_fluids != NULL)
- free (prev_allocated_fluids);
+ allocated_fluids[n] = SCM_UNPACK_POINTER (fluid);
+ SCM_SET_CELL_WORD_0 (fluid, (scm_tc7_fluid | (n << 8)));
+
+ GC_GENERAL_REGISTER_DISAPPEARING_LINK (&allocated_fluids[n],
+ SCM2PTR (fluid));
- /* Now allocated_fluids and allocated_fluids_len are valid again
- and we can allow GCs to occur.
- */
- resize_all_states ();
- }
-
- allocated_fluids_num += 1;
- allocated_fluids[n] = 1;
-
scm_dynwind_end ();
- return n;
+
+ /* Now null out values. We could (and probably should) do this when
+ the fluid is collected instead of now. */
+ scm_i_reset_fluid (n);
+
+ return fluid;
}
-SCM_DEFINE (scm_make_fluid, "make-fluid", 0, 0, 0,
- (),
- "Return a newly created fluid.\n"
+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, whose initial value is @var{dflt},\n"
+ "or @code{#f} if @var{dflt} is not given.\n"
"Fluids are objects that can hold one\n"
"value per dynamic state. That is, modifications to this value are\n"
"only visible to code that executes with the same dynamic state as\n"
"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
{
- SCM fluid;
-
- SCM_NEWSMOB2 (fluid, tc16_fluid,
- (scm_t_bits) next_fluid_num (), SCM_UNPACK (SCM_EOL));
-
- /* The GC must not run until the fluid is properly entered into the
- list.
- */
- scm_i_scm_pthread_mutex_lock (&fluid_admin_mutex);
- SET_FLUID_NEXT (fluid, all_fluids);
- all_fluids = fluid;
- scm_i_pthread_mutex_unlock (&fluid_admin_mutex);
+ return new_fluid (SCM_UNBNDP (dflt) ? SCM_BOOL_F : dflt);
+}
+#undef FUNC_NAME
- return fluid;
+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
+{
+ return new_fluid (SCM_UNDEFINED);
}
#undef FUNC_NAME
return IS_FLUID (obj);
}
-size_t
-scm_i_fluid_num (SCM fluid)
+/* Does not check type of `fluid'! */
+static SCM
+fluid_ref (SCM fluid)
{
- return FLUID_NUM (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)))
+ {
+ /* Lazily grow the current thread's dynamic state. */
+ grow_dynamic_state (SCM_I_CURRENT_THREAD->dynamic_state);
+
+ fluids = DYNAMIC_STATE_FLUIDS (SCM_I_CURRENT_THREAD->dynamic_state);
+ }
+
+ 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,
"@code{#f}.")
#define FUNC_NAME s_scm_fluid_ref
{
- SCM fluids = DYNAMIC_STATE_FLUIDS (SCM_I_CURRENT_THREAD->dynamic_state);
-
+ SCM val;
SCM_VALIDATE_FLUID (1, fluid);
- return SCM_SIMPLE_VECTOR_REF (fluids, FLUID_NUM (fluid));
+ val = fluid_ref (fluid);
+ if (SCM_UNBNDP (val))
+ SCM_MISC_ERROR ("unbound fluid: ~S",
+ scm_list_1 (fluid));
+ return val;
}
#undef FUNC_NAME
-SCM
-scm_i_fast_fluid_ref (size_t n)
-{
- SCM fluids = DYNAMIC_STATE_FLUIDS (SCM_I_CURRENT_THREAD->dynamic_state);
- return SCM_SIMPLE_VECTOR_REF (fluids, n);
-}
-
SCM_DEFINE (scm_fluid_set_x, "fluid-set!", 2, 0, 0,
(SCM fluid, SCM value),
"Set the value associated with @var{fluid} in the current dynamic root.")
SCM fluids = DYNAMIC_STATE_FLUIDS (SCM_I_CURRENT_THREAD->dynamic_state);
SCM_VALIDATE_FLUID (1, fluid);
+
+ if (SCM_UNLIKELY (FLUID_NUM (fluid) >= SCM_SIMPLE_VECTOR_LENGTH (fluids)))
+ {
+ /* Lazily grow the current thread's dynamic state. */
+ grow_dynamic_state (SCM_I_CURRENT_THREAD->dynamic_state);
+
+ fluids = DYNAMIC_STATE_FLUIDS (SCM_I_CURRENT_THREAD->dynamic_state);
+ }
+
SCM_SIMPLE_VECTOR_SET (fluids, FLUID_NUM (fluid), value);
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
-void
-scm_i_fast_fluid_set_x (size_t n, SCM value)
+SCM_DEFINE (scm_fluid_unset_x, "fluid-unset!", 1, 0, 0,
+ (SCM fluid),
+ "Unset the value associated with @var{fluid}.")
+#define FUNC_NAME s_scm_fluid_unset_x
{
- SCM fluids = DYNAMIC_STATE_FLUIDS (SCM_I_CURRENT_THREAD->dynamic_state);
- SCM_SIMPLE_VECTOR_SET (fluids, n, value);
+ /* 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
-static void
-swap_fluids (SCM data)
+SCM_DEFINE (scm_fluid_bound_p, "fluid-bound?", 1, 0, 0,
+ (SCM fluid),
+ "Return @code{#t} iff @var{fluid} is bound to a value.\n"
+ "Throw an error if @var{fluid} is not a fluid.")
+#define FUNC_NAME s_scm_fluid_bound_p
{
- SCM fluids = SCM_CAR (data), vals = SCM_CDR (data);
-
- while (!SCM_NULL_OR_NIL_P (fluids))
- {
- SCM fl = SCM_CAR (fluids);
- SCM old_val = scm_fluid_ref (fl);
- scm_fluid_set_x (fl, SCM_CAR (vals));
- SCM_SETCAR (vals, old_val);
- fluids = SCM_CDR (fluids);
- vals = SCM_CDR (vals);
- }
+ SCM val;
+ SCM_VALIDATE_FLUID (1, fluid);
+ val = fluid_ref (fluid);
+ return scm_from_bool (! (SCM_UNBNDP (val)));
}
+#undef FUNC_NAME
-/* Swap the fluid values in reverse order. This is important when the
- same fluid appears multiple times in the fluids list.
-*/
+static SCM
+apply_thunk (void *thunk)
+{
+ return scm_call_0 (SCM_PACK (thunk));
+}
-static void
-swap_fluids_reverse_aux (SCM fluids, SCM vals)
+size_t
+scm_prepare_fluids (size_t n, SCM *fluids, SCM *values)
{
- if (!SCM_NULL_OR_NIL_P (fluids))
- {
- SCM fl, old_val;
+ size_t j;
- swap_fluids_reverse_aux (SCM_CDR (fluids), SCM_CDR (vals));
- fl = SCM_CAR (fluids);
- old_val = scm_fluid_ref (fl);
- scm_fluid_set_x (fl, SCM_CAR (vals));
- SCM_SETCAR (vals, old_val);
+ /* 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. */
+ for (j = n; j--;)
+ {
+ size_t i;
+
+ if (SCM_UNLIKELY (!IS_FLUID (fluids[j])))
+ scm_wrong_type_arg ("with-fluids", 0, fluids[j]);
+
+ for (i = j; i--;)
+ if (scm_is_eq (fluids[i], fluids[j]))
+ {
+ values[i] = values[j]; /* later bindings win */
+ n--;
+ fluids[j] = fluids[n];
+ values[j] = values[n];
+ break;
+ }
}
-}
-static void
-swap_fluids_reverse (SCM data)
-{
- swap_fluids_reverse_aux (SCM_CAR (data), SCM_CDR (data));
+ return n;
}
-
-static SCM
-apply_thunk (void *thunk)
+
+void
+scm_swap_fluids (size_t n, SCM *fluids, SCM *values, SCM dynstate)
{
- return scm_call_0 (SCM_PACK (thunk));
-}
+ SCM fluid_vector;
+ size_t i, max = 0;
+
+ fluid_vector = DYNAMIC_STATE_FLUIDS (dynstate);
+
+ /* 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;
+ }
+
+ if (SCM_UNLIKELY (max >= SCM_SIMPLE_VECTOR_LENGTH (fluid_vector)))
+ {
+ /* Lazily grow the current thread's dynamic state. */
+ grow_dynamic_state (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;
+ }
+}
+
SCM_DEFINE (scm_with_fluids, "with-fluids*", 3, 0, 0,
(SCM fluids, SCM values, SCM thunk),
"Set @var{fluids} to @var{values} temporary, and call @var{thunk}.\n"
scm_c_with_fluids (SCM fluids, SCM values, SCM (*cproc) (), void *cdata)
#define FUNC_NAME "scm_c_with_fluids"
{
- SCM ans, data;
- long flen, vlen;
+ SCM ans;
+ long flen, vlen, i;
+ SCM *fluidsv, *valuesv;
+ scm_i_thread *thread = SCM_I_CURRENT_THREAD;
SCM_VALIDATE_LIST_COPYLEN (1, fluids, flen);
SCM_VALIDATE_LIST_COPYLEN (2, values, vlen);
if (flen != vlen)
scm_out_of_range (s_scm_with_fluids, values);
- if (flen == 1)
- return scm_c_with_fluid (SCM_CAR (fluids), SCM_CAR (values),
- cproc, cdata);
+ if (SCM_UNLIKELY (flen == 0))
+ return cproc (cdata);
+
+ fluidsv = alloca (sizeof(SCM)*flen);
+ valuesv = alloca (sizeof(SCM)*flen);
- data = scm_cons (fluids, values);
- scm_dynwind_begin (SCM_F_DYNWIND_REWINDABLE);
- scm_dynwind_rewind_handler_with_scm (swap_fluids, data,
- SCM_F_WIND_EXPLICITLY);
- scm_dynwind_unwind_handler_with_scm (swap_fluids_reverse, data,
- SCM_F_WIND_EXPLICITLY);
+ for (i = 0; i < flen; i++)
+ {
+ fluidsv[i] = SCM_CAR (fluids);
+ 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_dynwind_end ();
+ scm_dynstack_unwind_fluids (&thread->dynstack, thread->dynamic_state);
+
return ans;
}
#undef FUNC_NAME
#define FUNC_NAME "scm_c_with_fluid"
{
SCM ans;
+ scm_i_thread *thread = SCM_I_CURRENT_THREAD;
- scm_dynwind_begin (SCM_F_DYNWIND_REWINDABLE);
- scm_dynwind_fluid (fluid, value);
+ scm_dynstack_push_fluids (&thread->dynstack, 1, &fluid, &value,
+ thread->dynamic_state);
ans = cproc (cdata);
- scm_dynwind_end ();
+ scm_dynstack_unwind_fluids (&thread->dynstack, thread->dynamic_state);
+
return ans;
}
#undef FUNC_NAME
swap_fluid (SCM data)
{
SCM f = SCM_CAR (data);
- SCM t = scm_fluid_ref (f);
+ SCM t = fluid_ref (f);
scm_fluid_set_x (f, SCM_CDR (data));
SCM_SETCDR (data, t);
}
scm_i_make_initial_dynamic_state ()
{
SCM fluids = scm_c_make_vector (allocated_fluids_len, SCM_BOOL_F);
- SCM state;
- SCM_NEWSMOB2 (state, tc16_dynamic_state,
- SCM_UNPACK (fluids), SCM_UNPACK (SCM_EOL));
- all_dynamic_states = state;
- return state;
+ return scm_cell (scm_tc7_dynamic_state, SCM_UNPACK (fluids));
}
SCM_DEFINE (scm_make_dynamic_state, "make-dynamic-state", 0, 1, 0,
"or of the current dynamic state when @var{parent} is omitted.")
#define FUNC_NAME s_scm_make_dynamic_state
{
- SCM fluids, state;
+ SCM fluids;
if (SCM_UNBNDP (parent))
parent = scm_current_dynamic_state ();
- scm_assert_smob_type (tc16_dynamic_state, parent);
+ SCM_ASSERT (IS_DYNAMIC_STATE (parent), parent, SCM_ARG1, FUNC_NAME);
fluids = scm_vector_copy (DYNAMIC_STATE_FLUIDS (parent));
- SCM_NEWSMOB2 (state, tc16_dynamic_state,
- SCM_UNPACK (fluids), SCM_UNPACK (SCM_EOL));
-
- /* The GC must not run until the state is properly entered into the
- list.
- */
- scm_i_scm_pthread_mutex_lock (&fluid_admin_mutex);
- SET_DYNAMIC_STATE_NEXT (state, all_dynamic_states);
- all_dynamic_states = state;
- scm_i_pthread_mutex_unlock (&fluid_admin_mutex);
-
- return state;
+ return scm_cell (scm_tc7_dynamic_state, SCM_UNPACK (fluids));
}
#undef FUNC_NAME
{
scm_i_thread *t = SCM_I_CURRENT_THREAD;
SCM old = t->dynamic_state;
- scm_assert_smob_type (tc16_dynamic_state, state);
+ SCM_ASSERT (IS_DYNAMIC_STATE (state), state, SCM_ARG1, FUNC_NAME);
t->dynamic_state = state;
return old;
}
scm_dynwind_current_dynamic_state (SCM state)
{
SCM loc = scm_cons (state, SCM_EOL);
- scm_assert_smob_type (tc16_dynamic_state, state);
+ SCM_ASSERT (IS_DYNAMIC_STATE (state), state, SCM_ARG1, NULL);
scm_dynwind_rewind_handler_with_scm (swap_dynamic_state, loc,
SCM_F_WIND_EXPLICITLY);
scm_dynwind_unwind_handler_with_scm (swap_dynamic_state, loc,
}
#undef FUNC_NAME
-void
-scm_fluids_prehistory ()
-{
- tc16_fluid = scm_make_smob_type ("fluid", 0);
- scm_set_smob_free (tc16_fluid, fluid_free);
- scm_set_smob_print (tc16_fluid, fluid_print);
-
- tc16_dynamic_state = scm_make_smob_type ("dynamic-state", 0);
- scm_set_smob_mark (tc16_dynamic_state, scm_markcdr);
-
- scm_c_hook_add (&scm_after_sweep_c_hook, scan_dynamic_states_and_fluids,
- 0, 0);
-}
void
scm_init_fluids ()
HCoop / bpt / guile.git / blobdiff