[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 01/02: Reimplement dynamic states
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] 01/02: Reimplement dynamic states |
|
Date: |
Mon, 5 Dec 2016 21:57:48 +0000 (UTC) |
wingo pushed a commit to branch master
in repository guile.
commit aa84489d18320df086e08554554d6f3b92c45893
Author: Andy Wingo <address@hidden>
Date: Sun Nov 27 21:33:30 2016 +0100
Reimplement dynamic states
There are two goals: one, to use less memory per dynamic state in order
to allow millions of dynamic states to be allocated in light-weight
threading scenarios. The second goal is to prevent dynamic states from
being actively mutated in two threads at once. This second goal does
mean that dynamic states object that escape into scheme are now copies
that won't receive further updates; an incompatible change, but one
which we hope doesn't affect anyone.
* libguile/cache-internal.h: New file.
* libguile/fluids.c (is_dynamic_state, get_dynamic_state)
(save_dynamic_state, restore_dynamic_state, add_entry)
(copy_value_table): New functions.
(scm_i_fluid_print, scm_i_dynamic_state_print): Move up.
(new_fluid): No need for a number.
(scm_fluid_p: scm_is_fluid): Inline IS_FLUID uses.
(fluid_set_x, fluid_ref): Adapt to dynamic state changes.
(scm_fluid_set_x, scm_fluid_unset_x): Call fluid_set_x.
(scm_swap_fluid): Rewrite in terms of fluid_ref and fluid_set.
(swap_fluid): Use internal fluid_set_x.
(scm_i_make_initial_dynamic_state): Adapt to dynamic state
representation change.
(scm_dynamic_state_p, scm_is_dynamic_state): Use new accessors.
(scm_current_dynamic_state): Use make_dynamic_state.
(scm_dynwind_current_dynamic_state): Use new accessor.
* libguile/fluids.h: Remove internal definitions. Add new struct
definition.
* libguile/threads.h (scm_i_thread): Use scm_t_dynamic_state for dynamic
state.
* libguile/threads.c (guilify_self_1, guilify_self_2):
(scm_i_init_thread_for_guile, scm_init_guile):
(scm_call_with_new_thread):
(scm_init_threads, scm_init_threads_default_dynamic_state): Adapt to
scm_i_thread change.
(scm_i_with_guile, with_guile): Remove "and parent" suffix.
(scm_i_reset_fluid): Remove unneeded function.
* doc/ref/api-scheduling.texi (Fluids and Dynamic States): Remove
scm_make_dynamic_state docs. Update current-dynamic-state docs.
* libguile/vm-engine.c (vm_engine): Update fluid-ref and fluid-set!
inlined fast paths for dynamic state changes.
* libguile/vm.c (vm_error_unbound_fluid): Remove now-unused function.
* NEWS: Update.
* module/ice-9/deprecated.scm (make-dynamic-state): New definition.
* libguile/deprecated.h:
* libguile/deprecated.c (scm_make_dynamic_state): Move here.
* libguile/__scm.h (scm_t_dynamic_state): New typedef.
* libguile/dynstack.h:
* libguile/dynstack.c (scm_dynstack_push_fluid):
(scm_dynstack_unwind_fluid): Take raw dynstate in these internal
functions.
* libguile/throw.c (catch): Adapt to dynstack changes.
---
NEWS | 17 ++
doc/ref/api-scheduling.texi | 36 ++--
libguile/Makefile.am | 1 +
libguile/__scm.h | 4 +
libguile/cache-internal.h | 111 ++++++++++++
libguile/deprecated.c | 14 +-
libguile/deprecated.h | 4 +
libguile/dynstack.c | 5 +-
libguile/dynstack.h | 10 +-
libguile/fluids.c | 395 +++++++++++++++++++++++--------------------
libguile/fluids.h | 25 ++-
libguile/threads.c | 69 +++-----
libguile/threads.h | 3 +-
libguile/throw.c | 2 +-
libguile/vm-engine.c | 55 +++---
libguile/vm.c | 11 +-
module/ice-9/deprecated.scm | 13 ++
17 files changed, 464 insertions(+), 311 deletions(-)
diff --git a/NEWS b/NEWS
index 66fd2b0..809f5ac 100644
--- a/NEWS
+++ b/NEWS
@@ -87,6 +87,18 @@ Guile itself, though their join value was always `#f'. This
is no
longer the case; attempting to join a foreign thread will throw an
error.
+** Dynamic states capture values, not locations
+
+Dynamic states used to capture the locations of fluid-value
+associations. Capturing the current dynamic state then setting a fluid
+would result in a mutation of that captured state. Now capturing a
+dynamic state simply captures the current values, and calling
+`with-dynamic-state' copies those values into the Guile virtual machine
+instead of aliasing them in a way that could allow them to be mutated in
+place. This change allows Guile's fluid variables to be thread-safe.
+To capture the locations of a dynamic state, use partial continuations
+instead.
+
* New deprecations
** Arbiters deprecated
@@ -122,6 +134,11 @@ This was a facility that predated threads, was unused as
far as we can
tell, and was never documented. Still, a grep of your code for
dynamic-root or dynamic_root would not be amiss.
+** `make-dynamic-state' deprecated
+
+Use `current-dynamic-state' to get an immutable copy of the current
+fluid-value associations.
+
* Bug fixes
** cancel-thread uses asynchronous interrupts, not pthread_cancel
diff --git a/doc/ref/api-scheduling.texi b/doc/ref/api-scheduling.texi
index 1087bfe..615e8b6 100644
--- a/doc/ref/api-scheduling.texi
+++ b/doc/ref/api-scheduling.texi
@@ -673,17 +673,22 @@ delivery of an async causes this function to be
interrupted.
A @emph{fluid} is an object that can store one value per @emph{dynamic
state}. Each thread has a current dynamic state, and when accessing a
fluid, this current dynamic state is used to provide the actual value.
-In this way, fluids can be used for thread local storage, but they are
-in fact more flexible: dynamic states are objects of their own and can
-be made current for more than one thread at the same time, or only be
-made current temporarily, for example.
-
-Fluids can also be used to simulate the desirable effects of
-dynamically scoped variables. Dynamically scoped variables are useful
-when you want to set a variable to a value during some dynamic extent
-in the execution of your program and have them revert to their
-original value when the control flow is outside of this dynamic
-extent. See the description of @code{with-fluids} below for details.
+In this way, fluids can be used for thread local storage. Additionally,
+the set of current fluid values can be captured by a dynamic state and
+reinstated in some other dynamic extent, possibly in another thread
+even.
+
+Fluids are a building block for implementing dynamically scoped
+variables. Dynamically scoped variables are useful when you want to set
+a variable to a value during some dynamic extent in the execution of
+your program and have them revert to their original value when the
+control flow is outside of this dynamic extent. See the description of
address@hidden below for details.
+
+Guile uses fluids to implement parameters (@pxref{Parameters}). Usually
+you just want to use parameters directly. However it can be useful to
+know what a fluid is and how it works, so that's what this section is
+about.
New fluids are created with @code{make-fluid} and @code{fluid?} is
used for testing whether an object is actually a fluid. The values
@@ -788,12 +793,6 @@ value whenever the dynwind context is entered or left.
The backup
value is initialized with the @var{val} argument.
@end deftypefn
address@hidden {Scheme Procedure} make-dynamic-state [parent]
address@hidden {C Function} scm_make_dynamic_state (parent)
-Return a copy of the dynamic state object @var{parent}
-or of the current dynamic state when @var{parent} is omitted.
address@hidden deffn
-
@deffn {Scheme Procedure} dynamic-state? obj
@deffnx {C Function} scm_dynamic_state_p (obj)
Return @code{#t} if @var{obj} is a dynamic state object;
@@ -807,7 +806,8 @@ return zero otherwise.
@deffn {Scheme Procedure} current-dynamic-state
@deffnx {C Function} scm_current_dynamic_state ()
-Return the current dynamic state object.
+Return a snapshot of the current fluid-value associations as a fresh
+dynamic state object.
@end deffn
@deffn {Scheme Procedure} set-current-dynamic-state state
diff --git a/libguile/Makefile.am b/libguile/Makefile.am
index 8bf9ddf..c36a7e5 100644
--- a/libguile/Makefile.am
+++ b/libguile/Makefile.am
@@ -505,6 +505,7 @@ noinst_HEADERS = conv-integer.i.c conv-uinteger.i.c
\
srfi-14.i.c \
quicksort.i.c \
atomics-internal.h \
+ cache-internal.h \
posix-w32.h \
private-options.h ports-internal.h
diff --git a/libguile/__scm.h b/libguile/__scm.h
index dde26be..62ceeeb 100644
--- a/libguile/__scm.h
+++ b/libguile/__scm.h
@@ -412,6 +412,10 @@ typedef void *scm_t_subr;
+typedef struct scm_dynamic_state scm_t_dynamic_state;
+
+
+
/* scm_i_jmp_buf
*
* The corresponding SCM_I_SETJMP and SCM_I_LONGJMP are defined in the
diff --git a/libguile/cache-internal.h b/libguile/cache-internal.h
new file mode 100644
index 0000000..fc1e3c1
--- /dev/null
+++ b/libguile/cache-internal.h
@@ -0,0 +1,111 @@
+#ifndef SCM_CACHE_INTERNAL_H
+#define SCM_CACHE_INTERNAL_H
+
+/* Copyright (C) 2016
+ * 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
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
+ */
+
+
+
+
+#include <string.h>
+
+#include "libguile/__scm.h"
+#include "libguile/gc.h"
+#include "libguile/hash.h"
+#include "libguile/threads.h"
+
+
+/* A simple cache with 8 entries. The cache entries are stored in a
+ sorted vector. */
+struct scm_cache_entry
+{
+ scm_t_bits key;
+ scm_t_bits value;
+};
+
+#define SCM_CACHE_SIZE 8
+
+struct scm_cache
+{
+ scm_t_bits eviction_cookie;
+ struct scm_cache_entry entries[SCM_CACHE_SIZE];
+};
+
+static inline struct scm_cache*
+scm_make_cache (void)
+{
+ struct scm_cache *ret = scm_gc_typed_calloc (struct scm_cache);
+ ret->eviction_cookie = (scm_t_bits) ret;
+ return ret;
+}
+
+static inline int
+scm_cache_full_p (struct scm_cache *cache)
+{
+ return cache->entries[0].key != 0;
+}
+
+static inline void
+scm_cache_evict_1 (struct scm_cache *cache, struct scm_cache_entry *evicted)
+{
+ size_t idx;
+ cache->eviction_cookie = scm_ihashq (SCM_PACK (cache->eviction_cookie), -1);
+ idx = cache->eviction_cookie & (SCM_CACHE_SIZE - 1);
+ memcpy (evicted, cache->entries + idx, sizeof (*evicted));
+ memmove (cache->entries + 1,
+ cache->entries,
+ sizeof (cache->entries[0]) * idx);
+ cache->entries[0].key = 0;
+ cache->entries[0].value = 0;
+}
+
+static inline struct scm_cache_entry*
+scm_cache_lookup (struct scm_cache *cache, SCM k)
+{
+ scm_t_bits k_bits = SCM_UNPACK (k);
+ struct scm_cache_entry *entry = cache->entries;
+ /* Unrolled binary search, compiled to branchless cmp + cmov chain. */
+ if (entry[4].key <= k_bits) entry += 4;
+ if (entry[2].key <= k_bits) entry += 2;
+ if (entry[1].key <= k_bits) entry += 1;
+ return entry;
+}
+
+static inline void
+scm_cache_insert (struct scm_cache *cache, SCM k, SCM v,
+ struct scm_cache_entry *evicted)
+{
+ struct scm_cache_entry *entry;
+
+ if (scm_cache_full_p (cache))
+ scm_cache_evict_1 (cache, evicted);
+ entry = scm_cache_lookup (cache, k);
+ if (entry->key == SCM_UNPACK (k))
+ {
+ entry->value = SCM_UNPACK (v);
+ return;
+ }
+ memmove (cache->entries,
+ cache->entries + 1,
+ (entry - cache->entries) * sizeof (*entry));
+ entry->key = SCM_UNPACK (k);
+ entry->value = SCM_UNPACK (v);
+}
+
+#endif /* SCM_CACHE_INTERNAL_H */
diff --git a/libguile/deprecated.c b/libguile/deprecated.c
index 0ea4b5e..c3d4935 100644
--- a/libguile/deprecated.c
+++ b/libguile/deprecated.c
@@ -853,7 +853,7 @@ scm_internal_cwdr (scm_t_catch_body body, void *body_data,
scm_dynstack_unwind (dynstack, SCM_DYNSTACK_FIRST (dynstack));
scm_dynwind_begin (SCM_F_DYNWIND_REWINDABLE);
- scm_dynwind_current_dynamic_state (scm_make_dynamic_state (SCM_UNDEFINED));
+ scm_dynwind_current_dynamic_state (scm_current_dynamic_state ());
my_handler_data.run_handler = 0;
answer = scm_i_with_continuation_barrier (body, body_data,
@@ -928,6 +928,18 @@ scm_apply_with_dynamic_root (SCM proc, SCM a1, SCM args,
SCM handler)
+SCM
+scm_make_dynamic_state (SCM parent)
+{
+ scm_c_issue_deprecation_warning
+ ("scm_make_dynamic_state is deprecated. Dynamic states are "
+ "now immutable; just use the parent directly.");
+ return SCM_UNBNDP (parent) ? scm_current_dynamic_state () : parent;
+}
+
+
+
+
void
scm_i_init_deprecated ()
{
diff --git a/libguile/deprecated.h b/libguile/deprecated.h
index 69f9e1e..b1e455a 100644
--- a/libguile/deprecated.h
+++ b/libguile/deprecated.h
@@ -256,6 +256,10 @@ SCM_DEPRECATED SCM scm_apply_with_dynamic_root (SCM proc,
SCM a1,
+SCM_DEPRECATED SCM scm_make_dynamic_state (SCM parent);
+
+
+
/* Deprecated 2016-11-18. Never documented. Unnecessary, since
array-copy! already unrolls and does it in more general cases. */
/* With this also remove SCM_I_ARRAY_FLAG_CONTIGUOUS,
diff --git a/libguile/dynstack.c b/libguile/dynstack.c
index bda1a16..7fb8583 100644
--- a/libguile/dynstack.c
+++ b/libguile/dynstack.c
@@ -163,7 +163,7 @@ scm_dynstack_push_unwinder (scm_t_dynstack *dynstack,
binding. */
void
scm_dynstack_push_fluid (scm_t_dynstack *dynstack, SCM fluid, SCM value,
- SCM dynamic_state)
+ scm_t_dynamic_state *dynamic_state)
{
scm_t_bits *words;
SCM value_box;
@@ -525,7 +525,8 @@ scm_dynstack_unwind_frame (scm_t_dynstack *dynstack)
/* This function must not allocate. */
void
-scm_dynstack_unwind_fluid (scm_t_dynstack *dynstack, SCM dynamic_state)
+scm_dynstack_unwind_fluid (scm_t_dynstack *dynstack,
+ scm_t_dynamic_state *dynamic_state)
{
scm_t_bits tag, *words;
size_t len;
diff --git a/libguile/dynstack.h b/libguile/dynstack.h
index 853f068..592e7c8 100644
--- a/libguile/dynstack.h
+++ b/libguile/dynstack.h
@@ -147,9 +147,9 @@ SCM_INTERNAL void scm_dynstack_push_rewinder
(scm_t_dynstack *,
SCM_INTERNAL void scm_dynstack_push_unwinder (scm_t_dynstack *,
scm_t_dynstack_winder_flags,
scm_t_guard, void *);
-SCM_INTERNAL void scm_dynstack_push_fluid (scm_t_dynstack *,
- SCM fluid, SCM value,
- SCM dynamic_state);
+SCM_INTERNAL void scm_dynstack_push_fluid (
+ scm_t_dynstack *, SCM fluid, SCM value,
+ scm_t_dynamic_state *dynamic_state);
SCM_INTERNAL void scm_dynstack_push_prompt (scm_t_dynstack *,
scm_t_dynstack_prompt_flags,
SCM key,
@@ -186,8 +186,8 @@ SCM_INTERNAL scm_t_bits* scm_dynstack_unwind_fork
(scm_t_dynstack *,
scm_t_dynstack *);
SCM_INTERNAL void scm_dynstack_unwind_frame (scm_t_dynstack *);
-SCM_INTERNAL void scm_dynstack_unwind_fluid (scm_t_dynstack *dynstack,
- SCM dynamic_state);
+SCM_INTERNAL void scm_dynstack_unwind_fluid
+ (scm_t_dynstack *dynstack, scm_t_dynamic_state *dynamic_state);
SCM_INTERNAL scm_t_bits* scm_dynstack_find_prompt (scm_t_dynstack *, SCM,
scm_t_dynstack_prompt_flags
*,
diff --git a/libguile/fluids.c b/libguile/fluids.c
index 5ff92a8..72c7595 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,
diff --git a/libguile/fluids.h b/libguile/fluids.h
index 2292e40..8031c0d 100644
--- a/libguile/fluids.h
+++ b/libguile/fluids.h
@@ -35,17 +35,19 @@
code. When a new dynamic state is constructed, it inherits the
values from its parent. Because each thread executes with its own
dynamic state, you can use fluids for thread local storage.
-
- Each fluid is identified by a small integer. This integer is used to
- index a vector that holds the values of all fluids. A dynamic state
- consists of this vector, wrapped in an object so that the vector can
- grow.
*/
#define SCM_FLUID_P(x) (SCM_HAS_TYP7 (x, scm_tc7_fluid))
+
#ifdef BUILDING_LIBGUILE
-#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))
+# include <libguile/cache-internal.h>
+
+struct scm_dynamic_state
+{
+ SCM values;
+ uint8_t has_aliased_values;
+ struct scm_cache cache;
+};
#endif
SCM_API SCM scm_make_fluid (void);
@@ -58,7 +60,8 @@ SCM_API SCM scm_fluid_set_x (SCM fluid, SCM value);
SCM_API SCM scm_fluid_unset_x (SCM fluid);
SCM_API SCM scm_fluid_bound_p (SCM fluid);
-SCM_INTERNAL void scm_swap_fluid (SCM fluid, SCM value_box, SCM dynamic_state);
+SCM_INTERNAL void scm_swap_fluid (SCM fluid, SCM value_box,
+ scm_t_dynamic_state *dynamic_state);
SCM_API SCM scm_c_with_fluids (SCM fluids, SCM vals,
SCM (*cproc)(void *), void *cdata);
@@ -69,12 +72,6 @@ SCM_API SCM scm_with_fluid (SCM fluid, SCM val, SCM thunk);
SCM_API void scm_dynwind_fluid (SCM fluid, SCM value);
-#ifdef BUILDING_LIBGUILE
-#define SCM_I_DYNAMIC_STATE_P(x) (SCM_HAS_TYP7 (x, scm_tc7_dynamic_state))
-#define SCM_I_DYNAMIC_STATE_FLUIDS(x) SCM_PACK (SCM_CELL_WORD_1 (x))
-#endif
-
-SCM_API SCM scm_make_dynamic_state (SCM parent);
SCM_API SCM scm_dynamic_state_p (SCM obj);
SCM_API int scm_is_dynamic_state (SCM obj);
SCM_API SCM scm_current_dynamic_state (void);
diff --git a/libguile/threads.c b/libguile/threads.c
index 28f6cf4..91b18b4 100644
--- a/libguile/threads.c
+++ b/libguile/threads.c
@@ -372,25 +372,7 @@ static scm_i_pthread_mutex_t thread_admin_mutex =
SCM_I_PTHREAD_MUTEX_INITIALIZE
static scm_i_thread *all_threads = NULL;
static int thread_count;
-static SCM scm_i_default_dynamic_state;
-
-/* Run when a fluid is collected. */
-void
-scm_i_reset_fluid (size_t n)
-{
- scm_i_thread *t;
-
- scm_i_pthread_mutex_lock (&thread_admin_mutex);
- for (t = all_threads; t; t = t->next_thread)
- if (SCM_I_DYNAMIC_STATE_P (t->dynamic_state))
- {
- SCM v = SCM_I_DYNAMIC_STATE_FLUIDS (t->dynamic_state);
-
- if (n < SCM_SIMPLE_VECTOR_LENGTH (v))
- SCM_SIMPLE_VECTOR_SET (v, n, SCM_UNDEFINED);
- }
- scm_i_pthread_mutex_unlock (&thread_admin_mutex);
-}
+static SCM default_dynamic_state;
/* Perform first stage of thread initialisation, in non-guile mode.
*/
@@ -409,7 +391,7 @@ guilify_self_1 (struct GC_stack_base *base)
t.result = SCM_BOOL_F;
t.freelists = NULL;
t.pointerless_freelists = NULL;
- t.dynamic_state = SCM_BOOL_F;
+ t.dynamic_state = NULL;
t.dynstack.base = NULL;
t.dynstack.top = NULL;
t.dynstack.limit = NULL;
@@ -463,7 +445,7 @@ guilify_self_1 (struct GC_stack_base *base)
/* Perform second stage of thread initialisation, in guile mode.
*/
static void
-guilify_self_2 (SCM parent)
+guilify_self_2 (SCM dynamic_state)
{
scm_i_thread *t = SCM_I_CURRENT_THREAD;
@@ -480,10 +462,8 @@ guilify_self_2 (SCM parent)
t->pointerless_freelists = scm_gc_malloc (size, "atomic freelists");
}
- if (scm_is_true (parent))
- t->dynamic_state = scm_make_dynamic_state (parent);
- else
- t->dynamic_state = scm_i_make_initial_dynamic_state ();
+ t->dynamic_state = scm_gc_typed_calloc (scm_t_dynamic_state);
+ scm_set_current_dynamic_state (dynamic_state);
t->dynstack.base = scm_gc_malloc (16 * sizeof (scm_t_bits), "dynstack");
t->dynstack.limit = t->dynstack.base + 16;
@@ -557,8 +537,7 @@ init_thread_key (void)
BASE is the stack base to use with GC.
- PARENT is the dynamic state to use as the parent, ot SCM_BOOL_F in
- which case the default dynamic state is used.
+ DYNAMIC_STATE is the set of fluid values to start with.
Returns zero when the thread was known to guile already; otherwise
return 1.
@@ -569,7 +548,8 @@ init_thread_key (void)
be sure. New threads are put into guile mode implicitly. */
static int
-scm_i_init_thread_for_guile (struct GC_stack_base *base, SCM parent)
+scm_i_init_thread_for_guile (struct GC_stack_base *base,
+ SCM dynamic_state)
{
scm_i_pthread_once (&init_thread_key_once, init_thread_key);
@@ -612,7 +592,7 @@ scm_i_init_thread_for_guile (struct GC_stack_base *base,
SCM parent)
#endif
guilify_self_1 (base);
- guilify_self_2 (parent);
+ guilify_self_2 (dynamic_state);
}
return 1;
}
@@ -624,8 +604,7 @@ scm_init_guile ()
struct GC_stack_base stack_base;
if (GC_get_stack_base (&stack_base) == GC_SUCCESS)
- scm_i_init_thread_for_guile (&stack_base,
- scm_i_default_dynamic_state);
+ scm_i_init_thread_for_guile (&stack_base, default_dynamic_state);
else
{
fprintf (stderr, "Failed to get stack base for current thread.\n");
@@ -637,7 +616,7 @@ struct with_guile_args
{
GC_fn_type func;
void *data;
- SCM parent;
+ SCM dynamic_state;
};
static void *
@@ -649,14 +628,14 @@ with_guile_trampoline (void *data)
}
static void *
-with_guile_and_parent (struct GC_stack_base *base, void *data)
+with_guile (struct GC_stack_base *base, void *data)
{
void *res;
int new_thread;
scm_i_thread *t;
struct with_guile_args *args = data;
- new_thread = scm_i_init_thread_for_guile (base, args->parent);
+ new_thread = scm_i_init_thread_for_guile (base, args->dynamic_state);
t = SCM_I_CURRENT_THREAD;
if (new_thread)
{
@@ -698,22 +677,21 @@ with_guile_and_parent (struct GC_stack_base *base, void
*data)
}
static void *
-scm_i_with_guile_and_parent (void *(*func)(void *), void *data, SCM parent)
+scm_i_with_guile (void *(*func)(void *), void *data, SCM dynamic_state)
{
struct with_guile_args args;
args.func = func;
args.data = data;
- args.parent = parent;
+ args.dynamic_state = dynamic_state;
- return GC_call_with_stack_base (with_guile_and_parent, &args);
+ return GC_call_with_stack_base (with_guile, &args);
}
void *
scm_with_guile (void *(*func)(void *), void *data)
{
- return scm_i_with_guile_and_parent (func, data,
- scm_i_default_dynamic_state);
+ return scm_i_with_guile (func, data, default_dynamic_state);
}
void *
@@ -753,7 +731,7 @@ scm_call_with_new_thread (SCM thunk, SCM handler)
}
typedef struct {
- SCM parent;
+ SCM dynamic_state;
SCM thunk;
} launch_data;
@@ -769,7 +747,7 @@ launch_thread (void *d)
{
launch_data *data = (launch_data *)d;
scm_i_pthread_detach (scm_i_pthread_self ());
- scm_i_with_guile_and_parent (really_launch, d, data->parent);
+ scm_i_with_guile (really_launch, d, data->dynamic_state);
return NULL;
}
@@ -786,7 +764,7 @@ SCM_DEFINE (scm_sys_call_with_new_thread,
"%call-with-new-thread", 1, 0, 0,
GC_collect_a_little ();
data = scm_gc_typed_calloc (launch_data);
- data->parent = scm_current_dynamic_state ();
+ data->dynamic_state = scm_current_dynamic_state ();
data->thunk = thunk;
err = scm_i_pthread_create (&id, NULL, launch_thread, data);
if (err)
@@ -1792,8 +1770,8 @@ scm_init_threads ()
sizeof (struct scm_cond));
scm_set_smob_print (scm_tc16_condvar, scm_cond_print);
- scm_i_default_dynamic_state = SCM_BOOL_F;
- guilify_self_2 (SCM_BOOL_F);
+ default_dynamic_state = SCM_BOOL_F;
+ guilify_self_2 (scm_i_make_initial_dynamic_state ());
threads_initialized_p = 1;
scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
@@ -1804,8 +1782,7 @@ scm_init_threads ()
void
scm_init_threads_default_dynamic_state ()
{
- SCM state = scm_make_dynamic_state (scm_current_dynamic_state ());
- scm_i_default_dynamic_state = state;
+ default_dynamic_state = scm_current_dynamic_state ();
}
diff --git a/libguile/threads.h b/libguile/threads.h
index e8e56e7..e09a2ef 100644
--- a/libguile/threads.h
+++ b/libguile/threads.h
@@ -72,7 +72,7 @@ typedef struct scm_i_thread {
/* Other thread local things.
*/
- SCM dynamic_state;
+ scm_t_dynamic_state *dynamic_state;
/* The dynamic stack. */
scm_t_dynstack dynstack;
@@ -126,7 +126,6 @@ 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_INTERNAL void scm_threads_prehistory (void *);
SCM_INTERNAL void scm_init_threads (void);
SCM_INTERNAL void scm_init_threads_default_dynamic_state (void);
diff --git a/libguile/throw.c b/libguile/throw.c
index 45bab7a..a6a95ba 100644
--- a/libguile/throw.c
+++ b/libguile/throw.c
@@ -76,7 +76,7 @@ catch (SCM tag, SCM thunk, SCM handler, SCM
pre_unwind_handler)
SCM eh, prompt_tag;
SCM res;
scm_t_dynstack *dynstack = &SCM_I_CURRENT_THREAD->dynstack;
- SCM dynamic_state = SCM_I_CURRENT_THREAD->dynamic_state;
+ scm_t_dynamic_state *dynamic_state = SCM_I_CURRENT_THREAD->dynamic_state;
scm_i_jmp_buf registers;
scm_t_ptrdiff saved_stack_depth;
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index 03cca8d..1ee2164 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -403,7 +403,7 @@
#define VM_VALIDATE_BYTEVECTOR(x, proc) \
VM_VALIDATE (x, SCM_BYTEVECTOR_P, proc, bytevector)
#define VM_VALIDATE_CHAR(x, proc) \
- VM_VALIDATE (x, SCM_CHARP, proc, char);
+ VM_VALIDATE (x, SCM_CHARP, proc, char)
#define VM_VALIDATE_PAIR(x, proc) \
VM_VALIDATE (x, scm_is_pair, proc, pair)
#define VM_VALIDATE_STRING(obj, proc) \
@@ -2166,30 +2166,26 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
VM_DEFINE_OP (74, fluid_ref, "fluid-ref", OP1 (X8_S12_S12) | OP_DST)
{
scm_t_uint16 dst, src;
- size_t num;
- SCM fluid, fluids;
+ SCM fluid;
+ struct scm_cache_entry *entry;
UNPACK_12_12 (op, dst, src);
fluid = SP_REF (src);
- fluids = SCM_I_DYNAMIC_STATE_FLUIDS (thread->dynamic_state);
- if (SCM_UNLIKELY (!SCM_FLUID_P (fluid))
- || ((num = SCM_I_FLUID_NUM (fluid)) >= SCM_SIMPLE_VECTOR_LENGTH
(fluids)))
+
+ /* If we find FLUID in the cache, then it is indeed a fluid. */
+ entry = scm_cache_lookup (&thread->dynamic_state->cache, fluid);
+ if (SCM_LIKELY (scm_is_eq (SCM_PACK (entry->key), fluid)
+ && !SCM_UNBNDP (SCM_PACK (entry->value))))
{
- /* Punt dynstate expansion and error handling to the C proc. */
- SYNC_IP ();
- SP_SET (dst, scm_fluid_ref (fluid));
+ SP_SET (dst, SCM_PACK (entry->value));
+ NEXT (1);
}
else
{
- SCM val = SCM_SIMPLE_VECTOR_REF (fluids, num);
- if (scm_is_eq (val, SCM_UNDEFINED))
- val = SCM_I_FLUID_DEFAULT (fluid);
- VM_ASSERT (!scm_is_eq (val, SCM_UNDEFINED),
- vm_error_unbound_fluid (fluid));
- SP_SET (dst, val);
+ SYNC_IP ();
+ SP_SET (dst, scm_fluid_ref (fluid));
+ NEXT (1);
}
-
- NEXT (1);
}
/* fluid-set fluid:12 val:12
@@ -2199,23 +2195,26 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
VM_DEFINE_OP (75, fluid_set, "fluid-set!", OP1 (X8_S12_S12))
{
scm_t_uint16 a, b;
- size_t num;
- SCM fluid, fluids;
+ SCM fluid, value;
+ struct scm_cache_entry *entry;
UNPACK_12_12 (op, a, b);
fluid = SP_REF (a);
- fluids = SCM_I_DYNAMIC_STATE_FLUIDS (thread->dynamic_state);
- if (SCM_UNLIKELY (!SCM_FLUID_P (fluid))
- || ((num = SCM_I_FLUID_NUM (fluid)) >= SCM_SIMPLE_VECTOR_LENGTH
(fluids)))
+ value = SP_REF (b);
+
+ /* If we find FLUID in the cache, then it is indeed a fluid. */
+ entry = scm_cache_lookup (&thread->dynamic_state->cache, fluid);
+ if (SCM_LIKELY (scm_is_eq (SCM_PACK (entry->key), fluid)))
{
- /* Punt dynstate expansion and error handling to the C proc. */
- SYNC_IP ();
- scm_fluid_set_x (fluid, SP_REF (b));
+ entry->value = SCM_UNPACK (value);
+ NEXT (1);
}
else
- SCM_SIMPLE_VECTOR_SET (fluids, num, SP_REF (b));
-
- NEXT (1);
+ {
+ SYNC_IP ();
+ scm_fluid_set_x (fluid, value);
+ NEXT (1);
+ }
}
diff --git a/libguile/vm.c b/libguile/vm.c
index 3c61620..cc7bbf1 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -37,7 +37,7 @@
#include "libguile/_scm.h"
#include "libguile/atomic.h"
#include "libguile/atomics-internal.h"
-#include "libguile/control.h"
+#include "libguile/cache-internal.h"
#include "libguile/control.h"
#include "libguile/frames.h"
#include "libguile/gc-inline.h"
@@ -434,7 +434,6 @@ vm_reinstate_partial_continuation (struct scm_vm *vp, SCM
cont, size_t nargs,
static void vm_error (const char *msg, SCM arg) SCM_NORETURN;
static void vm_error_bad_instruction (scm_t_uint32 inst) SCM_NORETURN
SCM_NOINLINE;
static void vm_error_unbound (SCM sym) SCM_NORETURN SCM_NOINLINE;
-static void vm_error_unbound_fluid (SCM fluid) SCM_NORETURN SCM_NOINLINE;
static void vm_error_not_a_variable (const char *func_name, SCM x)
SCM_NORETURN SCM_NOINLINE;
static void vm_error_apply_to_non_list (SCM x) SCM_NORETURN SCM_NOINLINE;
static void vm_error_kwargs_length_not_even (SCM proc) SCM_NORETURN
SCM_NOINLINE;
@@ -480,14 +479,6 @@ vm_error_unbound (SCM sym)
}
static void
-vm_error_unbound_fluid (SCM fluid)
-{
- scm_error_scm (scm_misc_error_key, SCM_BOOL_F,
- scm_from_latin1_string ("Unbound fluid: ~s"),
- scm_list_1 (fluid), SCM_BOOL_F);
-}
-
-static void
vm_error_not_a_variable (const char *func_name, SCM x)
{
scm_error (scm_arg_type_key, func_name, "Not a variable: ~S",
diff --git a/module/ice-9/deprecated.scm b/module/ice-9/deprecated.scm
index 52b3d63..2f41686 100644
--- a/module/ice-9/deprecated.scm
+++ b/module/ice-9/deprecated.scm
@@ -78,3 +78,16 @@
thread-exited?
total-processor-count
current-processor-count)
+
+(define-public make-dynamic-state
+ (case-lambda
+ (()
+ (issue-deprecation-warning
+ "`(make-dynamic-state)' is deprecated; use `(current-dynamic-state)'
+instead.")
+ (current-dynamic-state))
+ ((parent)
+ (issue-deprecation-warning
+ "`(make-dynamic-state PARENT)' is deprecated; now that reified
+dynamic state objects are themselves copies, just use PARENT directly.")
+ parent)))