diff options
| -rw-r--r-- | libguile/fluids.c | 42 | ||||
| -rw-r--r-- | libguile/fluids.h | 6 | ||||
| -rw-r--r-- | libguile/threads.c | 4 | ||||
| -rw-r--r-- | libguile/threads.h | 2 | ||||
| -rw-r--r-- | libguile/vm-i-system.c | 2 | ||||
| -rw-r--r-- | module/ice-9/vlist.scm | 4 |
6 files changed, 37 insertions, 23 deletions
diff --git a/libguile/fluids.c b/libguile/fluids.c index 67efd9f6a..f92c5dddc 100644 --- a/libguile/fluids.c +++ b/libguile/fluids.c @@ -68,7 +68,7 @@ grow_dynamic_state (SCM state) /* Assume the assignment below is atomic. */ len = allocated_fluids_len; - new_fluids = scm_c_make_vector (len, SCM_BOOL_F); + new_fluids = scm_c_make_vector (len, SCM_UNDEFINED); for (i = 0; i < old_len; i++) SCM_SIMPLE_VECTOR_SET (new_fluids, i, @@ -103,14 +103,14 @@ scm_i_with_fluids_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED) /* Return a new fluid. */ static SCM -new_fluid () +new_fluid (SCM init) { SCM fluid; size_t trial, n; - /* Fluids are pointerless cells: the first word is the type tag; the second - word is the fluid number. */ - fluid = PTR2SCM (scm_gc_malloc_pointerless (sizeof (scm_t_cell), "fluid")); + /* Fluids hold the type tag and the fluid number in the first word, + and the default value in the second word. */ + fluid = scm_cell (scm_tc7_fluid, SCM_UNPACK (init)); SCM_SET_CELL_TYPE (fluid, scm_tc7_fluid); scm_dynwind_begin (0); @@ -157,7 +157,7 @@ new_fluid () } allocated_fluids[n] = SCM2PTR (fluid); - SCM_SET_CELL_WORD_1 (fluid, (scm_t_bits) n); + SCM_SET_CELL_WORD_0 (fluid, (scm_tc7_fluid | (n << 8))); GC_GENERAL_REGISTER_DISAPPEARING_LINK (&allocated_fluids[n], SCM2PTR (fluid)); @@ -166,13 +166,19 @@ new_fluid () /* Now null out values. We could (and probably should) do this when the fluid is collected instead of now. */ - scm_i_reset_fluid (n, SCM_BOOL_F); + scm_i_reset_fluid (n); return fluid; } -SCM_DEFINE (scm_make_fluid, "make-fluid", 0, 0, 0, - (), +SCM +scm_make_fluid (void) +{ + return new_fluid (SCM_BOOL_F); +} + +SCM_DEFINE (scm_make_fluid_with_default, "make-fluid", 0, 1, 0, + (SCM dflt), "Return a newly created fluid.\n" "Fluids are objects that can hold one\n" "value per dynamic state. That is, modifications to this value are\n" @@ -180,9 +186,9 @@ SCM_DEFINE (scm_make_fluid, "make-fluid", 0, 0, 0, "the modifying code. When a new dynamic state is constructed, it\n" "inherits the values from its parent. Because each thread normally executes\n" "with its own dynamic state, you can use fluids for thread local storage.") -#define FUNC_NAME s_scm_make_fluid +#define FUNC_NAME s_scm_make_fluid_with_default { - return new_fluid (); + return new_fluid (SCM_UNBNDP (dflt) ? SCM_BOOL_F : dflt); } #undef FUNC_NAME @@ -191,9 +197,7 @@ SCM_DEFINE (scm_make_unbound_fluid, "make-unbound-fluid", 0, 0, 0, "Make a fluid that is initially unbound.") #define FUNC_NAME s_scm_make_unbound_fluid { - SCM f = new_fluid (); - scm_fluid_set_x (f, SCM_UNDEFINED); - return f; + return new_fluid (SCM_UNDEFINED); } #undef FUNC_NAME @@ -217,6 +221,7 @@ scm_is_fluid (SCM obj) static SCM fluid_ref (SCM fluid) { + SCM ret; SCM fluids = DYNAMIC_STATE_FLUIDS (SCM_I_CURRENT_THREAD->dynamic_state); if (SCM_UNLIKELY (FLUID_NUM (fluid) >= SCM_SIMPLE_VECTOR_LENGTH (fluids))) @@ -227,7 +232,11 @@ fluid_ref (SCM fluid) fluids = DYNAMIC_STATE_FLUIDS (SCM_I_CURRENT_THREAD->dynamic_state); } - return SCM_SIMPLE_VECTOR_REF (fluids, FLUID_NUM (fluid)); + ret = SCM_SIMPLE_VECTOR_REF (fluids, FLUID_NUM (fluid)); + if (SCM_UNBNDP (ret)) + return SCM_I_FLUID_DEFAULT (fluid); + else + return ret; } SCM_DEFINE (scm_fluid_ref, "fluid-ref", 1, 0, 0, @@ -274,6 +283,9 @@ SCM_DEFINE (scm_fluid_unset_x, "fluid-unset!", 1, 0, 0, "Unset the value associated with @var{fluid}.") #define FUNC_NAME s_scm_fluid_unset_x { + /* FIXME: really unset the default value, too? The current test + suite demands it, but I would prefer not to. */ + SCM_SET_CELL_OBJECT_1 (fluid, SCM_UNDEFINED); return scm_fluid_set_x (fluid, SCM_UNDEFINED); } #undef FUNC_NAME diff --git a/libguile/fluids.h b/libguile/fluids.h index 66e398554..2b91ff3d1 100644 --- a/libguile/fluids.h +++ b/libguile/fluids.h @@ -3,7 +3,7 @@ #ifndef SCM_FLUIDS_H #define SCM_FLUIDS_H -/* Copyright (C) 1996,2000,2001, 2006, 2008, 2009, 2010 Free Software Foundation, Inc. +/* Copyright (C) 1996,2000,2001, 2006, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -56,10 +56,12 @@ #define SCM_FLUID_P(x) (!SCM_IMP (x) && SCM_TYP7 (x) == scm_tc7_fluid) #ifdef BUILDING_LIBGUILE -#define SCM_I_FLUID_NUM(x) ((size_t)SCM_CELL_WORD_1(x)) +#define SCM_I_FLUID_NUM(x) ((size_t)(SCM_CELL_WORD_0 (x) >> 8)) +#define SCM_I_FLUID_DEFAULT(x) (SCM_CELL_OBJECT_1 (x)) #endif SCM_API SCM scm_make_fluid (void); +SCM_API SCM scm_make_fluid_with_default (SCM dflt); SCM_API SCM scm_make_unbound_fluid (void); SCM_API int scm_is_fluid (SCM obj); SCM_API SCM scm_fluid_p (SCM fl); diff --git a/libguile/threads.c b/libguile/threads.c index 752354008..e4d3e2181 100644 --- a/libguile/threads.c +++ b/libguile/threads.c @@ -478,7 +478,7 @@ static SCM scm_i_default_dynamic_state; /* Run when a fluid is collected. */ void -scm_i_reset_fluid (size_t n, SCM val) +scm_i_reset_fluid (size_t n) { scm_i_thread *t; @@ -489,7 +489,7 @@ scm_i_reset_fluid (size_t n, SCM val) SCM v = SCM_I_DYNAMIC_STATE_FLUIDS (t->dynamic_state); if (n < SCM_SIMPLE_VECTOR_LENGTH (v)) - SCM_SIMPLE_VECTOR_SET (v, n, val); + SCM_SIMPLE_VECTOR_SET (v, n, SCM_UNDEFINED); } scm_i_pthread_mutex_unlock (&thread_admin_mutex); } diff --git a/libguile/threads.h b/libguile/threads.h index edecad819..ec129bc72 100644 --- a/libguile/threads.h +++ b/libguile/threads.h @@ -136,7 +136,7 @@ SCM_API SCM scm_spawn_thread (scm_t_catch_body body, void *body_data, SCM_API void *scm_without_guile (void *(*func)(void *), void *data); SCM_API void *scm_with_guile (void *(*func)(void *), void *data); -SCM_INTERNAL void scm_i_reset_fluid (size_t, SCM); +SCM_INTERNAL void scm_i_reset_fluid (size_t); SCM_INTERNAL void scm_threads_prehistory (void *); SCM_INTERNAL void scm_init_threads (void); SCM_INTERNAL void scm_init_thread_procs (void); diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c index 1b4136f3f..474fe7883 100644 --- a/libguile/vm-i-system.c +++ b/libguile/vm-i-system.c @@ -1660,6 +1660,8 @@ VM_DEFINE_INSTRUCTION (91, fluid_ref, "fluid-ref", 0, 1, 1) else { SCM val = SCM_SIMPLE_VECTOR_REF (fluids, num); + if (scm_is_eq (val, SCM_UNDEFINED)) + val = SCM_I_FLUID_DEFAULT (*sp); if (SCM_UNLIKELY (scm_is_eq (val, SCM_UNDEFINED))) { finish_args = *sp; diff --git a/module/ice-9/vlist.scm b/module/ice-9/vlist.scm index 4b40b9932..8c7c87b72 100644 --- a/module/ice-9/vlist.scm +++ b/module/ice-9/vlist.scm @@ -66,9 +66,7 @@ ;;; (define block-growth-factor - (let ((f (make-fluid))) - (fluid-set! f 2) - f)) + (make-fluid 2)) (define-syntax-rule (define-inline (name formals ...) body ...) ;; Work around the lack of an inliner. |