diff options
Diffstat (limited to 'libguile/fluids.c')
-rw-r--r-- | libguile/fluids.c | 135 |
1 files changed, 31 insertions, 104 deletions
diff --git a/libguile/fluids.c b/libguile/fluids.c index 327d12f4c..4e0684af8 100644 --- a/libguile/fluids.c +++ b/libguile/fluids.c @@ -21,7 +21,6 @@ # include <config.h> #endif -#include <alloca.h> #include <stdio.h> #include <string.h> @@ -80,25 +79,17 @@ grow_dynamic_state (SCM state) void scm_i_fluid_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED) { - scm_puts ("#<fluid ", port); + scm_puts_unlocked ("#<fluid ", port); scm_intprint ((int) FLUID_NUM (exp), 10, port); - scm_putc ('>', port); + scm_putc_unlocked ('>', port); } void scm_i_dynamic_state_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED) { - scm_puts ("#<dynamic-state ", port); + scm_puts_unlocked ("#<dynamic-state ", port); scm_intprint (SCM_UNPACK (exp), 16, port); - scm_putc ('>', port); -} - -void -scm_i_with_fluids_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED) -{ - scm_puts ("#<with-fluids ", port); - scm_intprint (SCM_UNPACK (exp), 16, port); - scm_putc ('>', port); + scm_putc_unlocked ('>', port); } @@ -125,7 +116,7 @@ new_fluid (SCM init) if (allocated_fluids[n] == NULL) break; - if (trial == 0 && n >= allocated_fluids_len) + if (trial == 0 && n >= allocated_fluids_len && allocated_fluids_len) /* All fluid numbers are in use. Run a GC and retry. Explicitly running the GC is costly and bad-style. We only do this because dynamic state fluid vectors would grow unreasonably if fluid numbers @@ -157,7 +148,7 @@ new_fluid (SCM init) allocated_fluids_len += FLUID_GROW; } - allocated_fluids[n] = SCM2PTR (fluid); + 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], @@ -311,79 +302,27 @@ apply_thunk (void *thunk) return scm_call_0 (SCM_PACK (thunk)); } -SCM -scm_i_make_with_fluids (size_t n, SCM *fluids, SCM *vals) -{ - SCM ret; - - /* 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. */ - { - size_t i, j; - - for (j = n; j--;) - for (i = j; i--;) - if (scm_is_eq (fluids[i], fluids[j])) - { - vals[i] = vals[j]; /* later bindings win */ - n--; - fluids[j] = fluids[n]; - vals[j] = vals[n]; - break; - } - } - - ret = scm_words (scm_tc7_with_fluids | (n << 8), 1 + n*2); - SCM_SET_CELL_WORD_1 (ret, n); - - while (n--) - { - if (SCM_UNLIKELY (!IS_FLUID (fluids[n]))) - scm_wrong_type_arg ("with-fluids", 0, fluids[n]); - SCM_SET_CELL_OBJECT (ret, 1 + n * 2, fluids[n]); - SCM_SET_CELL_OBJECT (ret, 2 + n * 2, vals[n]); - } - - return ret; -} - void -scm_i_swap_with_fluids (SCM wf, SCM dynstate) +scm_swap_fluid (SCM fluid, SCM value_box, SCM dynstate) { - SCM fluids; - size_t i, max = 0; + SCM fluid_vector, tmp; + size_t fluid_num; - fluids = DYNAMIC_STATE_FLUIDS (dynstate); + fluid_num = FLUID_NUM (fluid); - /* We could cache the max in the with-fluids, but that would take more mem, - and we're touching all the fluids anyway, so this per-swap traversal should - be OK. */ - for (i = 0; i < SCM_WITH_FLUIDS_LEN (wf); i++) - { - size_t num = FLUID_NUM (SCM_WITH_FLUIDS_NTH_FLUID (wf, i)); - max = (max > num) ? max : num; - } + fluid_vector = DYNAMIC_STATE_FLUIDS (dynstate); - if (SCM_UNLIKELY (max >= SCM_SIMPLE_VECTOR_LENGTH (fluids))) + if (SCM_UNLIKELY (fluid_num >= SCM_SIMPLE_VECTOR_LENGTH (fluid_vector))) { /* Lazily grow the current thread's dynamic state. */ grow_dynamic_state (dynstate); - fluids = DYNAMIC_STATE_FLUIDS (dynstate); + fluid_vector = DYNAMIC_STATE_FLUIDS (dynstate); } - /* Bind the fluids. Order doesn't matter, as all fluids are distinct. */ - for (i = 0; i < SCM_WITH_FLUIDS_LEN (wf); i++) - { - size_t fluid_num; - SCM x; - - fluid_num = FLUID_NUM (SCM_WITH_FLUIDS_NTH_FLUID (wf, i)); - x = SCM_SIMPLE_VECTOR_REF (fluids, fluid_num); - SCM_SIMPLE_VECTOR_SET (fluids, fluid_num, - SCM_WITH_FLUIDS_NTH_VAL (wf, i)); - SCM_WITH_FLUIDS_SET_NTH_VAL (wf, i, x); - } + tmp = SCM_SIMPLE_VECTOR_REF (fluid_vector, fluid_num); + SCM_SIMPLE_VECTOR_SET (fluid_vector, fluid_num, SCM_VARIABLE_REF (value_box)); + SCM_VARIABLE_SET (value_box, tmp); } SCM_DEFINE (scm_with_fluids, "with-fluids*", 3, 0, 0, @@ -403,63 +342,51 @@ SCM scm_c_with_fluids (SCM fluids, SCM values, SCM (*cproc) (), void *cdata) #define FUNC_NAME "scm_c_with_fluids" { - SCM wf, ans; + 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 (SCM_UNLIKELY (flen == 0)) - return cproc (cdata); - - fluidsv = alloca (sizeof(SCM)*flen); - valuesv = alloca (sizeof(SCM)*flen); - for (i = 0; i < flen; i++) { - fluidsv[i] = SCM_CAR (fluids); + scm_dynstack_push_fluid (&thread->dynstack, + SCM_CAR (fluids), SCM_CAR (values), + thread->dynamic_state); fluids = SCM_CDR (fluids); - valuesv[i] = SCM_CAR (values); values = SCM_CDR (values); } - wf = scm_i_make_with_fluids (flen, fluidsv, valuesv); - scm_i_swap_with_fluids (wf, SCM_I_CURRENT_THREAD->dynamic_state); - scm_i_set_dynwinds (scm_cons (wf, scm_i_dynwinds ())); ans = cproc (cdata); - scm_i_swap_with_fluids (wf, SCM_I_CURRENT_THREAD->dynamic_state); - scm_i_set_dynwinds (scm_cdr (scm_i_dynwinds ())); + + for (i = 0; i < flen; i++) + scm_dynstack_unwind_fluid (&thread->dynstack, thread->dynamic_state); return ans; } #undef FUNC_NAME -SCM_DEFINE (scm_with_fluid, "with-fluid*", 3, 0, 0, - (SCM fluid, SCM value, SCM thunk), - "Set @var{fluid} to @var{value} temporarily, and call @var{thunk}.\n" - "@var{thunk} must be a procedure with no argument.") -#define FUNC_NAME s_scm_with_fluid +SCM +scm_with_fluid (SCM fluid, SCM value, SCM thunk) { return scm_c_with_fluid (fluid, value, apply_thunk, (void *) SCM_UNPACK (thunk)); } -#undef FUNC_NAME SCM scm_c_with_fluid (SCM fluid, SCM value, SCM (*cproc) (), void *cdata) #define FUNC_NAME "scm_c_with_fluid" { - SCM ans, wf; + SCM ans; + scm_i_thread *thread = SCM_I_CURRENT_THREAD; - wf = scm_i_make_with_fluids (1, &fluid, &value); - scm_i_swap_with_fluids (wf, SCM_I_CURRENT_THREAD->dynamic_state); - scm_i_set_dynwinds (scm_cons (wf, scm_i_dynwinds ())); + scm_dynstack_push_fluid (&thread->dynstack, fluid, value, + thread->dynamic_state); ans = cproc (cdata); - scm_i_swap_with_fluids (wf, SCM_I_CURRENT_THREAD->dynamic_state); - scm_i_set_dynwinds (scm_cdr (scm_i_dynwinds ())); + scm_dynstack_unwind_fluid (&thread->dynstack, thread->dynamic_state); return ans; } |