diff --git a/libguile/dynstack.c b/libguile/dynstack.c index ce9a2feae..5f19a2bc2 100644 --- a/libguile/dynstack.c +++ b/libguile/dynstack.c @@ -1,4 +1,4 @@ -/* Copyright (C) 2012 Free Software Foundation, Inc. +/* Copyright (C) 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 @@ -49,8 +49,9 @@ #define DYNWIND_ENTER(top) (SCM_PACK ((top)[0])) #define DYNWIND_LEAVE(top) (SCM_PACK ((top)[1])) -#define WITH_FLUIDS_FLUIDS(top) ((SCM*)((top) + 1)) -#define WITH_FLUIDS_VALUES(top) ((SCM*)((top)[0])) +#define WITH_FLUID_WORDS 2 +#define WITH_FLUID_FLUID(top) (SCM_PACK ((top)[0])) +#define WITH_FLUID_VALUE_BOX(top) (SCM_PACK ((top)[1])) @@ -64,15 +65,6 @@ copy_scm_t_bits (scm_t_bits *dst, scm_t_bits *src, size_t n) dst[i] = src[i]; } -static void -copy_scm (SCM *dst, SCM *src, size_t n) -{ - size_t i; - - for (i = 0; i < n; i++) - dst[i] = src[i]; -} - static void clear_scm_t_bits (scm_t_bits *items, size_t n) { @@ -147,7 +139,8 @@ scm_dynstack_push_rewinder (scm_t_dynstack *dynstack, { scm_t_bits *words; - words = push_dynstack_entry (dynstack, SCM_DYNSTACK_TYPE_REWINDER, flags, 2); + words = push_dynstack_entry (dynstack, SCM_DYNSTACK_TYPE_REWINDER, flags, + WINDER_WORDS); words[0] = (scm_t_bits) proc; words[1] = (scm_t_bits) data; } @@ -159,33 +152,34 @@ scm_dynstack_push_unwinder (scm_t_dynstack *dynstack, { scm_t_bits *words; - words = push_dynstack_entry (dynstack, SCM_DYNSTACK_TYPE_UNWINDER, flags, 2); + words = push_dynstack_entry (dynstack, SCM_DYNSTACK_TYPE_UNWINDER, flags, + WINDER_WORDS); words[0] = (scm_t_bits) proc; words[1] = (scm_t_bits) data; } -/* The fluids are stored on the stack. However, the values have to be - stored on the heap, so that all continuations that capture this - dynamic scope capture the same bindings. */ +/* The fluid is stored on the stack, but the value has to be stored on the heap, + so that all continuations that capture this dynamic scope capture the same + binding. */ void -scm_dynstack_push_fluids (scm_t_dynstack *dynstack, size_t n, - SCM *fluids, SCM *values, SCM dynamic_state) +scm_dynstack_push_fluid (scm_t_dynstack *dynstack, SCM fluid, SCM value, + SCM dynamic_state) { scm_t_bits *words; - SCM *heap_values; + SCM value_box; - n = scm_prepare_fluids (n, fluids, values); - heap_values = scm_gc_malloc (n * sizeof (scm_t_bits), "with-fluids"); - copy_scm (heap_values, values, n); + if (SCM_UNLIKELY (!SCM_FLUID_P (fluid))) + scm_wrong_type_arg ("with-fluid*", 0, fluid); - words = push_dynstack_entry (dynstack, SCM_DYNSTACK_TYPE_WITH_FLUIDS, - 0, n + 1); - words[0] = (scm_t_bits) heap_values; - copy_scm (WITH_FLUIDS_FLUIDS (words), fluids, n); + value_box = scm_make_variable (value); + + words = push_dynstack_entry (dynstack, SCM_DYNSTACK_TYPE_WITH_FLUID, 0, + WITH_FLUID_WORDS); + words[0] = SCM_UNPACK (fluid); + words[1] = SCM_UNPACK (value_box); /* Go ahead and swap them. */ - scm_swap_fluids (n, WITH_FLUIDS_FLUIDS (words), WITH_FLUIDS_VALUES (words), - dynamic_state); + scm_swap_fluid (fluid, value_box, dynamic_state); } void @@ -211,7 +205,8 @@ scm_dynstack_push_dynwind (scm_t_dynstack *dynstack, SCM enter, SCM leave) { scm_t_bits *words; - words = push_dynstack_entry (dynstack, SCM_DYNSTACK_TYPE_DYNWIND, 0, 2); + words = push_dynstack_entry (dynstack, SCM_DYNSTACK_TYPE_DYNWIND, 0, + DYNWIND_WORDS); words[0] = SCM_UNPACK (enter); words[1] = SCM_UNPACK (leave); } @@ -296,10 +291,10 @@ scm_dynstack_wind_1 (scm_t_dynstack *dynstack, scm_t_bits *item) WINDER_PROC (item) (WINDER_DATA (item)); break; - case SCM_DYNSTACK_TYPE_WITH_FLUIDS: - scm_swap_fluids (len - 1, WITH_FLUIDS_FLUIDS (item), - WITH_FLUIDS_VALUES (item), - SCM_I_CURRENT_THREAD->dynamic_state); + case SCM_DYNSTACK_TYPE_WITH_FLUID: + scm_swap_fluid (WITH_FLUID_FLUID (item), + WITH_FLUID_VALUE_BOX (item), + SCM_I_CURRENT_THREAD->dynamic_state); break; case SCM_DYNSTACK_TYPE_PROMPT: @@ -328,12 +323,10 @@ scm_dynstack_unwind_1 (scm_t_dynstack *dynstack) scm_t_bits tag; scm_t_bits *words; scm_t_dynstack_item_type type; - size_t len; tag = dynstack_pop (dynstack, &words); type = SCM_DYNSTACK_TAG_TYPE (tag); - len = SCM_DYNSTACK_TAG_LEN (tag); switch (type) { @@ -349,11 +342,11 @@ scm_dynstack_unwind_1 (scm_t_dynstack *dynstack) clear_scm_t_bits (words, WINDER_WORDS); break; - case SCM_DYNSTACK_TYPE_WITH_FLUIDS: - scm_swap_fluids (len - 1, WITH_FLUIDS_FLUIDS (words), - WITH_FLUIDS_VALUES (words), - SCM_I_CURRENT_THREAD->dynamic_state); - clear_scm_t_bits (words, len); + case SCM_DYNSTACK_TYPE_WITH_FLUID: + scm_swap_fluid (WITH_FLUID_FLUID (words), + WITH_FLUID_VALUE_BOX (words), + SCM_I_CURRENT_THREAD->dynamic_state); + clear_scm_t_bits (words, WITH_FLUID_WORDS); break; case SCM_DYNSTACK_TYPE_PROMPT: @@ -532,7 +525,7 @@ scm_dynstack_unwind_frame (scm_t_dynstack *dynstack) /* This function must not allocate. */ void -scm_dynstack_unwind_fluids (scm_t_dynstack *dynstack, SCM dynamic_state) +scm_dynstack_unwind_fluid (scm_t_dynstack *dynstack, SCM dynamic_state) { scm_t_bits tag, *words; size_t len; @@ -540,11 +533,11 @@ scm_dynstack_unwind_fluids (scm_t_dynstack *dynstack, SCM dynamic_state) tag = dynstack_pop (dynstack, &words); len = SCM_DYNSTACK_TAG_LEN (tag); - assert (SCM_DYNSTACK_TAG_TYPE (tag) == SCM_DYNSTACK_TYPE_WITH_FLUIDS); - assert (len >= 1); + assert (SCM_DYNSTACK_TAG_TYPE (tag) == SCM_DYNSTACK_TYPE_WITH_FLUID); + assert (len == WITH_FLUID_WORDS); - scm_swap_fluids (len - 1, WITH_FLUIDS_FLUIDS (words), - WITH_FLUIDS_VALUES (words), dynamic_state); + scm_swap_fluid (WITH_FLUID_FLUID (words), WITH_FLUID_VALUE_BOX (words), + dynamic_state); clear_scm_t_bits (words, len); } diff --git a/libguile/dynstack.h b/libguile/dynstack.h index 207638ec7..c27c675dd 100644 --- a/libguile/dynstack.h +++ b/libguile/dynstack.h @@ -3,7 +3,7 @@ #ifndef SCM_DYNSTACK_H #define SCM_DYNSTACK_H -/* Copyright (C) 2012 Free Software Foundation, Inc. +/* Copyright (C) 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 @@ -79,7 +79,7 @@ typedef enum { SCM_DYNSTACK_TYPE_FRAME, SCM_DYNSTACK_TYPE_UNWINDER, SCM_DYNSTACK_TYPE_REWINDER, - SCM_DYNSTACK_TYPE_WITH_FLUIDS, + SCM_DYNSTACK_TYPE_WITH_FLUID, SCM_DYNSTACK_TYPE_PROMPT, SCM_DYNSTACK_TYPE_DYNWIND, } scm_t_dynstack_item_type; @@ -148,11 +148,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_fluids (scm_t_dynstack *, - size_t, - SCM *fluids, - SCM *values, - SCM dynamic_state); +SCM_INTERNAL void scm_dynstack_push_fluid (scm_t_dynstack *, + SCM fluid, SCM value, + SCM dynamic_state); SCM_INTERNAL void scm_dynstack_push_prompt (scm_t_dynstack *, scm_t_dynstack_prompt_flags, SCM key, @@ -187,8 +185,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_fluids (scm_t_dynstack *dynstack, - SCM dynamic_state); +SCM_INTERNAL void scm_dynstack_unwind_fluid (scm_t_dynstack *dynstack, + SCM 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 1199451b2..22d825beb 100644 --- a/libguile/fluids.c +++ b/libguile/fluids.c @@ -302,52 +302,17 @@ apply_thunk (void *thunk) return scm_call_0 (SCM_PACK (thunk)); } -size_t -scm_prepare_fluids (size_t n, SCM *fluids, SCM *values) -{ - size_t j; - - /* 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; - } - } - - return n; -} - void -scm_swap_fluids (size_t n, SCM *fluids, SCM *values, SCM dynstate) +scm_swap_fluid (SCM fluid, SCM value_box, SCM dynstate) { - SCM fluid_vector; - size_t i, max = 0; + SCM fluid_vector, tmp; + size_t fluid_num; + + fluid_num = FLUID_NUM (fluid); 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))) + if (SCM_UNLIKELY (fluid_num >= SCM_SIMPLE_VECTOR_LENGTH (fluid_vector))) { /* Lazily grow the current thread's dynamic state. */ grow_dynamic_state (dynstate); @@ -355,17 +320,9 @@ scm_swap_fluids (size_t n, SCM *fluids, SCM *values, SCM 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; - } + 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, @@ -387,7 +344,6 @@ scm_c_with_fluids (SCM fluids, SCM values, SCM (*cproc) (), void *cdata) { SCM ans; long flen, vlen, i; - SCM *fluidsv, *valuesv; scm_i_thread *thread = SCM_I_CURRENT_THREAD; SCM_VALIDATE_LIST_COPYLEN (1, fluids, flen); @@ -395,24 +351,19 @@ scm_c_with_fluids (SCM fluids, SCM values, SCM (*cproc) (), void *cdata) 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); } - scm_dynstack_push_fluids (&thread->dynstack, flen, fluidsv, valuesv, - thread->dynamic_state); ans = cproc (cdata); - scm_dynstack_unwind_fluids (&thread->dynstack, thread->dynamic_state); + + for (i = 0; i < flen; i++) + scm_dynstack_unwind_fluid (&thread->dynstack, thread->dynamic_state); return ans; } @@ -432,10 +383,10 @@ scm_c_with_fluid (SCM fluid, SCM value, SCM (*cproc) (), void *cdata) SCM ans; scm_i_thread *thread = SCM_I_CURRENT_THREAD; - scm_dynstack_push_fluids (&thread->dynstack, 1, &fluid, &value, - thread->dynamic_state); + scm_dynstack_push_fluid (&thread->dynstack, fluid, value, + thread->dynamic_state); ans = cproc (cdata); - scm_dynstack_unwind_fluids (&thread->dynstack, thread->dynamic_state); + scm_dynstack_unwind_fluid (&thread->dynstack, thread->dynamic_state); return ans; } diff --git a/libguile/fluids.h b/libguile/fluids.h index 227877251..a550d9a34 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, 2011, 2012 Free Software Foundation, Inc. +/* Copyright (C) 1996,2000,2001, 2006, 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 @@ -59,9 +59,7 @@ 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 size_t scm_prepare_fluids (size_t n, SCM *fluids, SCM *vals); -SCM_INTERNAL void scm_swap_fluids (size_t n, SCM *fluids, SCM *vals, - SCM dynamic_state); +SCM_INTERNAL void scm_swap_fluid (SCM fluid, SCM value_box, SCM dynamic_state); SCM_API SCM scm_c_with_fluids (SCM fluids, SCM vals, SCM (*cproc)(void *), void *cdata); diff --git a/libguile/memoize.c b/libguile/memoize.c index 7dca50bd2..daad14a18 100644 --- a/libguile/memoize.c +++ b/libguile/memoize.c @@ -84,8 +84,8 @@ static SCM do_push_fluid (SCM fluid, SCM val) { scm_i_thread *thread = SCM_I_CURRENT_THREAD; - scm_dynstack_push_fluids (&thread->dynstack, 1, &fluid, &val, - thread->dynamic_state); + scm_dynstack_push_fluid (&thread->dynstack, fluid, val, + thread->dynamic_state); return SCM_UNSPECIFIED; } @@ -93,7 +93,7 @@ static SCM do_pop_fluid (void) { scm_i_thread *thread = SCM_I_CURRENT_THREAD; - scm_dynstack_unwind_fluids (&thread->dynstack, thread->dynamic_state); + scm_dynstack_unwind_fluid (&thread->dynstack, thread->dynamic_state); return SCM_UNSPECIFIED; } diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c index d0708233b..8b11e7f24 100644 --- a/libguile/vm-engine.c +++ b/libguile/vm-engine.c @@ -2519,39 +2519,34 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) NEXT (1); } - /* wind-fluids fluid-base:24 _:8 n:24 value0:24 0:8 ... + /* push-fluid fluid:12 value:12 * * Dynamically bind N fluids to values. The fluids are expected to be * allocated in a continguous range on the stack, starting from * FLUID-BASE. The values do not have this restriction. */ - VM_DEFINE_OP (69, wind_fluids, "wind-fluids", OP2 (U8_U24, X8_R24)) -#if 0 + VM_DEFINE_OP (69, push_fluid, "push-fluid", OP1 (U8_U12_U12)) { - scm_t_uint32 fluid_base, n; + scm_t_uint32 fluid, value; - SCM_UNPACK_RTL_24 (op, fluid_base); - SCM_UNPACK_RTL_24 (ip[1], n); + SCM_UNPACK_RTL_12_12 (op, fluid, value); - scm_dynstack_push_fluids_shuffled (¤t_thread->dynstack, n, - &fp[fluid_base], fp, &ip[2], - current_thread->dynamic_state); - NEXT (n + 2); + scm_dynstack_push_fluid (¤t_thread->dynstack, + fp[fluid], fp[value], + current_thread->dynamic_state); + NEXT (1); } -#else - abort(); -#endif - /* unwind-fluids _:24 + /* pop-fluid _:24 * * Leave the dynamic extent of a with-fluids expression, restoring the * fluids to their previous values. */ - VM_DEFINE_OP (70, unwind_fluids, "unwind-fluids", OP1 (U8_X24)) + VM_DEFINE_OP (70, pop_fluid, "pop-fluid", OP1 (U8_X24)) { /* This function must not allocate. */ - scm_dynstack_unwind_fluids (¤t_thread->dynstack, - current_thread->dynamic_state); + scm_dynstack_unwind_fluid (¤t_thread->dynstack, + current_thread->dynamic_state); NEXT (1); } diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c index 442350d40..248db9af0 100644 --- a/libguile/vm-i-system.c +++ b/libguile/vm-i-system.c @@ -1495,16 +1495,16 @@ VM_DEFINE_INSTRUCTION (91, push_fluid, "push-fluid", 0, 2, 0) SCM fluid, val; POP2 (val, fluid); SYNC_REGISTER (); - scm_dynstack_push_fluids (¤t_thread->dynstack, 1, &fluid, &val, - current_thread->dynamic_state); + scm_dynstack_push_fluid (¤t_thread->dynstack, fluid, val, + current_thread->dynamic_state); NEXT; } VM_DEFINE_INSTRUCTION (92, pop_fluid, "pop-fluid", 0, 0, 0) { /* This function must not allocate. */ - scm_dynstack_unwind_fluids (¤t_thread->dynstack, - current_thread->dynamic_state); + scm_dynstack_unwind_fluid (¤t_thread->dynstack, + current_thread->dynamic_state); NEXT; }