summaryrefslogtreecommitdiff
path: root/libguile/fluids.c
diff options
context:
space:
mode:
Diffstat (limited to 'libguile/fluids.c')
-rw-r--r--libguile/fluids.c395
1 files changed, 211 insertions, 184 deletions
diff --git a/libguile/fluids.c b/libguile/fluids.c
index 5ff92a884..72c75952d 100644
--- a/libguile/fluids.c
+++ b/libguile/fluids.c
@@ -25,6 +25,8 @@
#include <string.h>
#include "libguile/_scm.h"
+#include "libguile/atomics-internal.h"
+#include "libguile/cache-internal.h"
#include "libguile/print.h"
#include "libguile/dynwind.h"
#include "libguile/fluids.h"
@@ -35,52 +37,138 @@
#include "libguile/validate.h"
#include "libguile/bdw-gc.h"
-/* Number of additional slots to allocate when ALLOCATED_FLUIDS is full. */
-#define FLUID_GROW 128
-
-/* 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 scm_i_pthread_mutex_t fluid_admin_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER;
-
-#define IS_FLUID(x) SCM_FLUID_P (x)
-#define FLUID_NUM(x) SCM_I_FLUID_NUM (x)
-
-#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)))
+/* A dynamic state associates fluids with values. There are two
+ representations of a dynamic state in Guile: the active
+ representation that is part of each thread, and a frozen
+ representation that can live in Scheme land as a value.
+
+ The active dynamic state has two parts: a locals cache, and a values
+ table. The locals cache stores fluid values that have been recently
+ referenced or set. If a value isn't in the locals cache, Guile then
+ looks for it in the values table, which is a weak-key hash table.
+ Otherwise Guile falls back to the default value of the fluid. In any
+ case, the value is recorded in the locals cache. Likewise setting a
+ fluid's value simply inserts that association into the locals cache.
+
+ The locals cache is not large, so adding an entry to it might evict
+ some other entry. In that case the entry gets flushed to the values
+ table.
+
+ The values table begins as being inherited from the parent dynamic
+ state, and represents a capture of the fluid values at a point in
+ time. A dynamic state records when its values table might be
+ referenced by other dynamic states. If it is aliased, then any
+ update to that table has to start by making a fresh local copy to
+ work on.
+
+ There are two interesting constraints on dynamic states, besides
+ speed. One is that they should hold onto their fluid-value
+ associations weakly: they shouldn't keep fluids alive indefinitely,
+ and if a fluid goes away, its value should become collectible too.
+ This is why the values table is a weak table; it makes access
+ somewhat slower, but this is mitigated by the cache. The cache
+ itself holds onto fluids and values strongly, but if there are more
+ than 8 fluids in use by a dynamic state, this won't be a problem.
+
+ The other interesting constraint is memory usage: you don't want a
+ program with M fluids and N dynamic states to consume N*M memory.
+ Guile associates each thread with a dynamic state, which itself isn't
+ that bad as there are relatively few threads in a program. The
+ problem comes in with "fibers", lightweight user-space threads that
+ can be allocated in the millions. Here you want new fibers to
+ inherit the dynamic state from the fiber that created them, but you
+ really need to limit memory overheads. For reference, in late 2016,
+ non-dynamic-state memory overhead per fiber in one user-space library
+ is around 500 bytes, in a simple "all fibers try to send a message on
+ one channel" test case.
+
+ For this reason the frozen representation of dynamic states is the
+ probably-shared values table at the end of a list of fluid-value
+ pairs, representing entries from the locals cache that differ from
+ the values table. This keeps per-dynamic-state memory usage in
+ check. A family of fibers that uses the same 3 or 4 fluids probably
+ won't ever have to allocate a new values table. Ideally the values
+ table could share more state, as in an immutable weak array-mapped
+ hash trie or something, but we don't have such a data structure. */
+
+static inline int
+is_dynamic_state (SCM x)
+{
+ return SCM_HAS_TYP7 (x, scm_tc7_dynamic_state);
+}
+
+static inline SCM
+get_dynamic_state (SCM dynamic_state)
+{
+ return SCM_CELL_OBJECT_1 (dynamic_state);
+}
+
+static inline void
+restore_dynamic_state (SCM saved, scm_t_dynamic_state *state)
+{
+ int slot;
+ for (slot = SCM_CACHE_SIZE - 1; slot >= 0; slot--)
+ {
+ struct scm_cache_entry *entry = &state->cache.entries[slot];
+ if (scm_is_pair (saved))
+ {
+ entry->key = SCM_UNPACK (SCM_CAAR (saved));
+ entry->value = SCM_UNPACK (SCM_CDAR (saved));
+ saved = scm_cdr (saved);
+ }
+ else
+ entry->key = entry->value = 0;
+ }
+ state->values = saved;
+ state->has_aliased_values = 1;
+}
+static inline SCM
+save_dynamic_state (scm_t_dynamic_state *state)
+{
+ int slot;
+ SCM saved = state->values;
+ for (slot = 0; slot < SCM_CACHE_SIZE; slot++)
+ {
+ struct scm_cache_entry *entry = &state->cache.entries[slot];
+ SCM key = SCM_PACK (entry->key);
+ SCM value = SCM_PACK (entry->value);
+ if (entry->key &&
+ !scm_is_eq (scm_weak_table_refq (state->values, key, SCM_UNDEFINED),
+ value))
+ {
+ if (state->has_aliased_values)
+ saved = scm_acons (key, value, saved);
+ else
+ scm_weak_table_putq_x (state->values, key, value);
+ }
+ }
+ state->has_aliased_values = 1;
+ return saved;
+}
-
-/* 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
-grow_dynamic_state (SCM state)
+static SCM
+add_entry (void *data, SCM k, SCM v, SCM result)
{
- SCM new_fluids;
- SCM old_fluids = DYNAMIC_STATE_FLUIDS (state);
- size_t i, len, old_len = SCM_SIMPLE_VECTOR_LENGTH (old_fluids);
+ scm_weak_table_putq_x (result, k, v);
+ return result;
+}
- /* Assume the assignment below is atomic. */
- len = allocated_fluids_len;
+static SCM
+copy_value_table (SCM tab)
+{
+ SCM ret = scm_c_make_weak_table (0, SCM_WEAK_TABLE_KIND_KEY);
+ return scm_c_weak_table_fold (add_entry, NULL, ret, tab);
+}
- new_fluids = scm_c_make_vector (len, SCM_UNDEFINED);
- 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);
-}
+
void
scm_i_fluid_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
{
scm_puts ("#<fluid ", port);
- scm_intprint ((int) FLUID_NUM (exp), 10, port);
+ scm_intprint (SCM_UNPACK (exp), 16, port);
scm_putc ('>', port);
}
@@ -92,75 +180,15 @@ scm_i_dynamic_state_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED
scm_putc ('>', port);
}
+
-/* Return a new fluid. */
+
+#define SCM_I_FLUID_DEFAULT(x) (SCM_CELL_OBJECT_1 (x))
+
static SCM
new_fluid (SCM init)
{
- 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);
-
- for (trial = 0; trial < 2; trial++)
- {
- /* Look for a free fluid number. */
- for (n = 0; n < allocated_fluids_len; n++)
- /* TODO: Use `__sync_bool_compare_and_swap' where available. */
- if (allocated_fluids[n] == NULL)
- break;
-
- 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
- weren't reused. */
- scm_i_gc ("fluids");
- }
-
- 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 * sizeof (*allocated_fluids));
- memset (new_allocated_fluids + allocated_fluids_len, 0,
- FLUID_GROW * sizeof (*allocated_fluids));
- n = allocated_fluids_len;
-
- /* 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;
- }
-
- 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));
-
- scm_dynwind_end ();
-
- /* 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;
+ return scm_cell (scm_tc7_fluid, SCM_UNPACK (init));
}
SCM
@@ -200,36 +228,72 @@ SCM_DEFINE (scm_fluid_p, "fluid?", 1, 0, 0,
"@code{#f}.")
#define FUNC_NAME s_scm_fluid_p
{
- return scm_from_bool (IS_FLUID (obj));
+ return scm_from_bool (SCM_FLUID_P (obj));
}
#undef FUNC_NAME
int
scm_is_fluid (SCM obj)
{
- return IS_FLUID (obj);
+ return SCM_FLUID_P (obj);
}
-/* Does not check type of `fluid'! */
-static SCM
-fluid_ref (SCM fluid)
+static void
+fluid_set_x (scm_t_dynamic_state *dynamic_state, SCM fluid, SCM value)
{
- SCM ret;
- SCM fluids = DYNAMIC_STATE_FLUIDS (SCM_I_CURRENT_THREAD->dynamic_state);
+ struct scm_cache_entry *entry;
+ struct scm_cache_entry evicted = { 0, 0 };
- if (SCM_UNLIKELY (FLUID_NUM (fluid) >= SCM_SIMPLE_VECTOR_LENGTH (fluids)))
+ entry = scm_cache_lookup (&dynamic_state->cache, fluid);
+ if (scm_is_eq (SCM_PACK (entry->key), fluid))
{
- /* Lazily grow the current thread's dynamic state. */
- grow_dynamic_state (SCM_I_CURRENT_THREAD->dynamic_state);
+ entry->value = SCM_UNPACK (value);
+ return;
+ }
+
+ scm_cache_insert (&dynamic_state->cache, fluid, value, &evicted);
- fluids = DYNAMIC_STATE_FLUIDS (SCM_I_CURRENT_THREAD->dynamic_state);
+ if (evicted.key != 0)
+ {
+ fluid = SCM_PACK (evicted.key);
+ value = SCM_PACK (evicted.value);
+
+ if (dynamic_state->has_aliased_values)
+ {
+ if (scm_is_eq (scm_weak_table_refq (dynamic_state->values,
+ fluid, SCM_UNDEFINED),
+ value))
+ return;
+ dynamic_state->values = copy_value_table (dynamic_state->values);
+ dynamic_state->has_aliased_values = 0;
+ }
+
+ scm_weak_table_putq_x (dynamic_state->values, fluid, value);
}
+}
- ret = SCM_SIMPLE_VECTOR_REF (fluids, FLUID_NUM (fluid));
- if (SCM_UNBNDP (ret))
- return SCM_I_FLUID_DEFAULT (fluid);
+/* Return value can be SCM_UNDEFINED; caller checks. */
+static SCM
+fluid_ref (scm_t_dynamic_state *dynamic_state, SCM fluid)
+{
+ SCM val;
+ struct scm_cache_entry *entry;
+
+ entry = scm_cache_lookup (&dynamic_state->cache, fluid);
+ if (scm_is_eq (SCM_PACK (entry->key), fluid))
+ val = SCM_PACK (entry->value);
else
- return ret;
+ {
+ val = scm_weak_table_refq (dynamic_state->values, fluid, SCM_UNDEFINED);
+
+ if (SCM_UNBNDP (val))
+ val = SCM_I_FLUID_DEFAULT (fluid);
+
+ /* Cache this lookup. */
+ fluid_set_x (dynamic_state, fluid, val);
+ }
+
+ return val;
}
SCM_DEFINE (scm_fluid_ref, "fluid-ref", 1, 0, 0,
@@ -239,13 +303,12 @@ SCM_DEFINE (scm_fluid_ref, "fluid-ref", 1, 0, 0,
"@code{#f}.")
#define FUNC_NAME s_scm_fluid_ref
{
- SCM val;
+ SCM ret;
SCM_VALIDATE_FLUID (1, fluid);
- val = fluid_ref (fluid);
- if (SCM_UNBNDP (val))
- SCM_MISC_ERROR ("unbound fluid: ~S",
- scm_list_1 (fluid));
- return val;
+ ret = fluid_ref (SCM_I_CURRENT_THREAD->dynamic_state, fluid);
+ if (SCM_UNBNDP (ret))
+ scm_misc_error ("fluid-ref", "unbound fluid: ~S", scm_list_1 (fluid));
+ return ret;
}
#undef FUNC_NAME
@@ -254,19 +317,8 @@ SCM_DEFINE (scm_fluid_set_x, "fluid-set!", 2, 0, 0,
"Set the value associated with @var{fluid} in the current dynamic root.")
#define FUNC_NAME s_scm_fluid_set_x
{
- 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);
+ fluid_set_x (SCM_I_CURRENT_THREAD->dynamic_state, fluid, value);
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
@@ -278,8 +330,10 @@ SCM_DEFINE (scm_fluid_unset_x, "fluid-unset!", 1, 0, 0,
{
/* FIXME: really unset the default value, too? The current test
suite demands it, but I would prefer not to. */
+ SCM_VALIDATE_FLUID (1, fluid);
SCM_SET_CELL_OBJECT_1 (fluid, SCM_UNDEFINED);
- return scm_fluid_set_x (fluid, SCM_UNDEFINED);
+ fluid_set_x (SCM_I_CURRENT_THREAD->dynamic_state, fluid, SCM_UNDEFINED);
+ return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
@@ -291,7 +345,7 @@ SCM_DEFINE (scm_fluid_bound_p, "fluid-bound?", 1, 0, 0,
{
SCM val;
SCM_VALIDATE_FLUID (1, fluid);
- val = fluid_ref (fluid);
+ val = fluid_ref (SCM_I_CURRENT_THREAD->dynamic_state, fluid);
return scm_from_bool (! (SCM_UNBNDP (val)));
}
#undef FUNC_NAME
@@ -303,26 +357,11 @@ apply_thunk (void *thunk)
}
void
-scm_swap_fluid (SCM fluid, SCM value_box, SCM dynstate)
+scm_swap_fluid (SCM fluid, SCM value_box, scm_t_dynamic_state *dynstate)
{
- SCM fluid_vector, tmp;
- size_t fluid_num;
-
- fluid_num = FLUID_NUM (fluid);
-
- fluid_vector = DYNAMIC_STATE_FLUIDS (dynstate);
-
- if (SCM_UNLIKELY (fluid_num >= SCM_SIMPLE_VECTOR_LENGTH (fluid_vector)))
- {
- /* Lazily grow the current thread's dynamic state. */
- grow_dynamic_state (dynstate);
-
- fluid_vector = DYNAMIC_STATE_FLUIDS (dynstate);
- }
-
- 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 val = fluid_ref (dynstate, fluid);
+ fluid_set_x (dynstate, fluid, SCM_VARIABLE_REF (value_box));
+ SCM_VARIABLE_SET (value_box, val);
}
SCM_DEFINE (scm_with_fluids, "with-fluids*", 3, 0, 0,
@@ -395,9 +434,10 @@ scm_c_with_fluid (SCM fluid, SCM value, SCM (*cproc) (), void *cdata)
static void
swap_fluid (SCM data)
{
+ scm_t_dynamic_state *dynstate = SCM_I_CURRENT_THREAD->dynamic_state;
SCM f = SCM_CAR (data);
- SCM t = fluid_ref (f);
- scm_fluid_set_x (f, SCM_CDR (data));
+ SCM t = fluid_ref (dynstate, f);
+ fluid_set_x (dynstate, f, SCM_CDR (data));
SCM_SETCDR (data, t);
}
@@ -410,28 +450,12 @@ scm_dynwind_fluid (SCM fluid, SCM value)
}
SCM
-scm_i_make_initial_dynamic_state ()
-{
- SCM fluids = scm_c_make_vector (allocated_fluids_len, SCM_BOOL_F);
- return scm_cell (scm_tc7_dynamic_state, SCM_UNPACK (fluids));
-}
-
-SCM_DEFINE (scm_make_dynamic_state, "make-dynamic-state", 0, 1, 0,
- (SCM parent),
- "Return a copy of the dynamic state object @var{parent}\n"
- "or of the current dynamic state when @var{parent} is omitted.")
-#define FUNC_NAME s_scm_make_dynamic_state
+scm_i_make_initial_dynamic_state (void)
{
- SCM fluids;
-
- if (SCM_UNBNDP (parent))
- parent = scm_current_dynamic_state ();
-
- SCM_ASSERT (IS_DYNAMIC_STATE (parent), parent, SCM_ARG1, FUNC_NAME);
- fluids = scm_vector_copy (DYNAMIC_STATE_FLUIDS (parent));
- return scm_cell (scm_tc7_dynamic_state, SCM_UNPACK (fluids));
+ return scm_cell (scm_tc7_dynamic_state,
+ SCM_UNPACK (scm_c_make_weak_table
+ (0, SCM_WEAK_TABLE_KIND_KEY)));
}
-#undef FUNC_NAME
SCM_DEFINE (scm_dynamic_state_p, "dynamic-state?", 1, 0, 0,
(SCM obj),
@@ -439,22 +463,25 @@ SCM_DEFINE (scm_dynamic_state_p, "dynamic-state?", 1, 0, 0,
"return @code{#f} otherwise")
#define FUNC_NAME s_scm_dynamic_state_p
{
- return scm_from_bool (IS_DYNAMIC_STATE (obj));
+ return scm_from_bool (is_dynamic_state (obj));
}
#undef FUNC_NAME
int
scm_is_dynamic_state (SCM obj)
{
- return IS_DYNAMIC_STATE (obj);
+ return is_dynamic_state (obj);
}
SCM_DEFINE (scm_current_dynamic_state, "current-dynamic-state", 0, 0, 0,
(),
- "Return the current dynamic state object.")
+ "Return a snapshot of the current fluid-value associations\n"
+ "as a fresh dynamic state object.")
#define FUNC_NAME s_scm_current_dynamic_state
{
- return SCM_I_CURRENT_THREAD->dynamic_state;
+ struct scm_dynamic_state *state = SCM_I_CURRENT_THREAD->dynamic_state;
+ return scm_cell (scm_tc7_dynamic_state,
+ SCM_UNPACK (save_dynamic_state (state)));
}
#undef FUNC_NAME
@@ -465,9 +492,9 @@ SCM_DEFINE (scm_set_current_dynamic_state, "set-current-dynamic-state", 1,0,0,
#define FUNC_NAME s_scm_set_current_dynamic_state
{
scm_i_thread *t = SCM_I_CURRENT_THREAD;
- SCM old = t->dynamic_state;
- SCM_ASSERT (IS_DYNAMIC_STATE (state), state, SCM_ARG1, FUNC_NAME);
- t->dynamic_state = state;
+ SCM old = scm_current_dynamic_state ();
+ SCM_ASSERT (is_dynamic_state (state), state, SCM_ARG1, FUNC_NAME);
+ restore_dynamic_state (get_dynamic_state (state), t->dynamic_state);
return old;
}
#undef FUNC_NAME
@@ -482,7 +509,7 @@ void
scm_dynwind_current_dynamic_state (SCM state)
{
SCM loc = scm_cons (state, SCM_EOL);
- SCM_ASSERT (IS_DYNAMIC_STATE (state), state, SCM_ARG1, NULL);
+ 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,