mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-24 05:21:20 -08:00
Code Issues Projects Releases Packages Wiki Activity

stacks: move the binding stack to a separate structure

Browse source
This commit is contained in:
Daniel Kochmański 2024-04-03 12:51:17 +02:00
parent 9d8394f0cd
commit da3dc34241
8 changed files with 138 additions and 136 deletions
Download patch file Download diff file Expand all files Collapse all files

6
src/c/alloc_2.d
View file

@ -1160,9 +1160,9 @@ ecl_mark_env(struct cl_env_struct *env)
GC_push_conditional((void *)env->frs_org, (void *)(env->frs_top+1), 1);
GC_set_mark_bit((void *)env->frs_org);
}
if (env->bds_top) {
GC_push_conditional((void *)env->bds_org, (void *)(env->bds_top+1), 1);
GC_set_mark_bit((void *)env->bds_org);
if (env->bds_stack.top) {
GC_push_conditional((void *)env->bds_stack.org, (void *)(env->bds_stack.top+1), 1);
GC_set_mark_bit((void *)env->bds_stack.org);
}
/* When not using threads, "env" is mmaped or statically allocated. */
GC_push_all((void *)env, (void *)(env + 1));

2
src/c/compiler.d
View file

@ -1446,7 +1446,7 @@ c_catch(cl_env_ptr env, cl_object args, int flags) {
static int
c_compiler_let(cl_env_ptr env, cl_object args, int flags) {
cl_object bindings;
cl_index old_bds_top_index = env->bds_top - env->bds_org;
cl_index old_bds_top_index = env->bds_stack.top - env->bds_stack.org;
for (bindings = pop(&args); !Null(bindings); ) {
cl_object form = pop(&bindings);

10
src/c/main.d
View file

@ -196,11 +196,11 @@ ecl_init_first_env(cl_env_ptr env)
init_threads();
#endif
#ifdef ECL_THREADS
env->bindings_array = si_make_vector(ECL_T, ecl_make_fixnum(1024),
ECL_NIL, ECL_NIL, ECL_NIL, ECL_NIL);
si_fill_array_with_elt(env->bindings_array, ECL_NO_TL_BINDING, ecl_make_fixnum(0), ECL_NIL);
env->thread_local_bindings_size = env->bindings_array->vector.dim;
env->thread_local_bindings = env->bindings_array->vector.self.t;
env->bds_stack.bindings_array
= si_make_vector(ECL_T, ecl_make_fixnum(1024), ECL_NIL, ECL_NIL, ECL_NIL, ECL_NIL);
si_fill_array_with_elt(env->bds_stack.bindings_array, ECL_NO_TL_BINDING, ecl_make_fixnum(0), ECL_NIL);
env->bds_stack.thread_local_bindings_size = env->bds_stack.bindings_array->vector.dim;
env->bds_stack.thread_local_bindings = env->bds_stack.bindings_array->vector.self.t;
#endif
init_env_mp(env);
init_env_int(env);

104
src/c/stacks.d
View file

@ -291,23 +291,23 @@ ecl_bds_unwind_n(cl_env_ptr env, int n)
static void
ecl_bds_set_size(cl_env_ptr env, cl_index new_size)
{
ecl_bds_ptr old_org = env->bds_org;
cl_index limit = env->bds_top - old_org;
ecl_bds_ptr old_org = env->bds_stack.org;
cl_index limit = env->bds_stack.top - old_org;
if (new_size <= limit) {
FEerror("Cannot shrink the binding stack below ~D.", 1,
ecl_make_unsigned_integer(limit));
} else {
cl_index margin = ecl_option_values[ECL_OPT_BIND_STACK_SAFETY_AREA];
ecl_bds_ptr org;
env->bds_limit_size = new_size - 2*margin;
env->bds_stack.limit_size = new_size - 2*margin;
org = ecl_alloc_atomic(new_size * sizeof(*org));
ECL_STACK_RESIZE_DISABLE_INTERRUPTS(env);
memcpy(org, old_org, (limit + 1) * sizeof(*org));
env->bds_top = org + limit;
env->bds_org = org;
env->bds_limit = org + (new_size - 2*margin);
env->bds_size = new_size;
env->bds_stack.top = org + limit;
env->bds_stack.org = org;
env->bds_stack.limit = org + (new_size - 2*margin);
env->bds_stack.size = new_size;
ECL_STACK_RESIZE_ENABLE_INTERRUPTS(env);
ecl_dealloc(old_org);
@ -323,39 +323,39 @@ ecl_bds_overflow(void)
";;;\n\n";
cl_env_ptr env = ecl_process_env();
cl_index margin = ecl_option_values[ECL_OPT_BIND_STACK_SAFETY_AREA];
cl_index size = env->bds_size;
ecl_bds_ptr org = env->bds_org;
cl_index size = env->bds_stack.size;
ecl_bds_ptr org = env->bds_stack.org;
ecl_bds_ptr last = org + size;
if (env->bds_limit >= last) {
if (env->bds_stack.limit >= last) {
ecl_unrecoverable_error(env, stack_overflow_msg);
}
env->bds_limit += margin;
env->bds_stack.limit += margin;
si_serror(6, @"Extend stack size",
@'ext::stack-overflow', @':size', ecl_make_fixnum(size),
@':type', @'ext::binding-stack');
ecl_bds_set_size(env, size + (size / 2));
return env->bds_top;
return env->bds_stack.top;
}
void
ecl_bds_unwind(cl_env_ptr env, cl_index new_bds_top_index)
{
ecl_bds_ptr new_bds_top = new_bds_top_index + env->bds_org;
ecl_bds_ptr bds = env->bds_top;
ecl_bds_ptr new_bds_top = new_bds_top_index + env->bds_stack.org;
ecl_bds_ptr bds = env->bds_stack.top;
for (; bds > new_bds_top; bds--)
#ifdef ECL_THREADS
ecl_bds_unwind1(env);
#else
bds->symbol->symbol.value = bds->value;
#endif
env->bds_top = new_bds_top;
env->bds_stack.top = new_bds_top;
}
cl_index
ecl_progv(cl_env_ptr env, cl_object vars0, cl_object values0)
{
cl_object vars = vars0, values = values0;
cl_index n = env->bds_top - env->bds_org;
cl_index n = env->bds_stack.top - env->bds_stack.org;
for (; LISTP(vars) && LISTP(values); vars = ECL_CONS_CDR(vars)) {
if (Null(vars)) {
return n;
@ -383,8 +383,8 @@ get_bds_ptr(cl_object x)
{
if (ECL_FIXNUMP(x)) {
cl_env_ptr env = ecl_process_env();
ecl_bds_ptr p = env->bds_org + ecl_fixnum(x);
if (env->bds_org <= p && p <= env->bds_top)
ecl_bds_ptr p = env->bds_stack.org + ecl_fixnum(x);
if (env->bds_stack.org <= p && p <= env->bds_stack.top)
return(p);
}
FEerror("~S is an illegal bds index.", 1, x);
@ -394,7 +394,7 @@ cl_object
si_bds_top()
{
cl_env_ptr env = ecl_process_env();
ecl_return1(env, ecl_make_fixnum(env->bds_top - env->bds_org));
ecl_return1(env, ecl_make_fixnum(env->bds_stack.top - env->bds_stack.org));
}
cl_object
@ -459,11 +459,11 @@ invalid_or_too_large_binding_index(cl_env_ptr env, cl_object s)
if (index == ECL_MISSING_SPECIAL_BINDING) {
index = ecl_new_binding_index(env, s);
}
if (index >= env->thread_local_bindings_size) {
cl_object vector = env->bindings_array;
env->bindings_array = vector = ecl_extend_bindings_array(vector);
env->thread_local_bindings_size = vector->vector.dim;
env->thread_local_bindings = vector->vector.self.t;
if (index >= env->bds_stack.thread_local_bindings_size) {
cl_object vector = env->bds_stack.bindings_array;
env->bds_stack.bindings_array = vector = ecl_extend_bindings_array(vector);
env->bds_stack.thread_local_bindings_size = vector->vector.dim;
env->bds_stack.thread_local_bindings = vector->vector.self.t;
}
return index;
}
@ -479,15 +479,15 @@ ecl_bds_bind(cl_env_ptr env, cl_object s, cl_object v)
cl_object *location;
ecl_bds_ptr slot;
cl_index index = s->symbol.binding;
if (index >= env->thread_local_bindings_size) {
if (index >= env->bds_stack.thread_local_bindings_size) {
index = invalid_or_too_large_binding_index(env,s);
}
location = env->thread_local_bindings + index;
slot = env->bds_top+1;
if (slot >= env->bds_limit) slot = ecl_bds_overflow();
location = env->bds_stack.thread_local_bindings + index;
slot = env->bds_stack.top+1;
if (slot >= env->bds_stack.limit) slot = ecl_bds_overflow();
slot->symbol = ECL_DUMMY_TAG;
AO_nop_full();
++env->bds_top;
++env->bds_stack.top;
ecl_disable_interrupts_env(env);
slot->symbol = s;
slot->value = *location;
@ -495,7 +495,7 @@ ecl_bds_bind(cl_env_ptr env, cl_object s, cl_object v)
ecl_enable_interrupts_env(env);
#else
ecl_bds_check(env);
ecl_bds_ptr slot = ++(env->bds_top);
ecl_bds_ptr slot = ++(env->bds_stack.top);
ecl_disable_interrupts_env(env);
slot->symbol = s;
slot->value = s->symbol.value;
@ -511,15 +511,15 @@ ecl_bds_push(cl_env_ptr env, cl_object s)
cl_object *location;
ecl_bds_ptr slot;
cl_index index = s->symbol.binding;
if (index >= env->thread_local_bindings_size) {
if (index >= env->bds_stack.thread_local_bindings_size) {
index = invalid_or_too_large_binding_index(env,s);
}
location = env->thread_local_bindings + index;
slot = env->bds_top+1;
if (slot >= env->bds_limit) slot = ecl_bds_overflow();
location = env->bds_stack.thread_local_bindings + index;
slot = env->bds_stack.top+1;
if (slot >= env->bds_stack.limit) slot = ecl_bds_overflow();
slot->symbol = ECL_DUMMY_TAG;
AO_nop_full();
++env->bds_top;
++env->bds_stack.top;
ecl_disable_interrupts_env(env);
slot->symbol = s;
slot->value = *location;
@ -527,7 +527,7 @@ ecl_bds_push(cl_env_ptr env, cl_object s)
ecl_enable_interrupts_env(env);
#else
ecl_bds_check(env);
ecl_bds_ptr slot = ++(env->bds_top);
ecl_bds_ptr slot = ++(env->bds_stack.top);
ecl_disable_interrupts_env(env);
slot->symbol = s;
slot->value = s->symbol.value;
@ -538,14 +538,14 @@ ecl_bds_push(cl_env_ptr env, cl_object s)
void
ecl_bds_unwind1(cl_env_ptr env)
{
cl_object s = env->bds_top->symbol;
cl_object s = env->bds_stack.top->symbol;
#ifdef ECL_THREADS
cl_object *location = env->thread_local_bindings + s->symbol.binding;
*location = env->bds_top->value;
cl_object *location = env->bds_stack.thread_local_bindings + s->symbol.binding;
*location = env->bds_stack.top->value;
#else
s->symbol.value = env->bds_top->value;
s->symbol.value = env->bds_stack.top->value;
#endif
--env->bds_top;
--env->bds_stack.top;
}
#ifdef ECL_THREADS
@ -553,8 +553,8 @@ cl_object
ecl_bds_read(cl_env_ptr env, cl_object s)
{
cl_index index = s->symbol.binding;
if (index < env->thread_local_bindings_size) {
cl_object x = env->thread_local_bindings[index];
if (index < env->bds_stack.thread_local_bindings_size) {
cl_object x = env->bds_stack.thread_local_bindings[index];
if (x != ECL_NO_TL_BINDING) return x;
}
return s->symbol.value;
@ -564,8 +564,8 @@ cl_object *
ecl_bds_ref(cl_env_ptr env, cl_object s)
{
cl_index index = s->symbol.binding;
if (index < env->thread_local_bindings_size) {
cl_object *location = env->thread_local_bindings + index;
if (index < env->bds_stack.thread_local_bindings_size) {
cl_object *location = env->bds_stack.thread_local_bindings + index;
if (*location != ECL_NO_TL_BINDING)
return location;
}
@ -701,7 +701,7 @@ _ecl_frs_push(cl_env_ptr env)
output->frs_val = ECL_DUMMY_TAG;
AO_nop_full();
++env->frs_top;
output->frs_bds_top_index = env->bds_top - env->bds_org;
output->frs_bds_top_index = env->bds_stack.top - env->bds_stack.org;
output->frs_ihs = env->ihs_top;
output->frs_sp = ECL_STACK_INDEX(env);
return output;
@ -829,7 +829,7 @@ si_get_limit(cl_object type)
if (type == @'ext::frame-stack')
output = env->frs_limit_size;
else if (type == @'ext::binding-stack')
output = env->bds_limit_size;
output = env->bds_stack.limit_size;
else if (type == @'ext::c-stack')
output = env->cs_limit_size;
else if (type == @'ext::lisp-stack')
@ -849,7 +849,7 @@ si_reset_margin(cl_object type)
if (type == @'ext::frame-stack')
frs_set_size(env, env->frs_size);
else if (type == @'ext::binding-stack')
ecl_bds_set_size(env, env->bds_size);
ecl_bds_set_size(env, env->bds_stack.size);
else if (type == @'ext::c-stack')
cs_set_size(env, env->cs_size);
else
@ -873,10 +873,10 @@ init_stacks(cl_env_ptr env)
/* bind stack */
margin = ecl_option_values[ECL_OPT_BIND_STACK_SAFETY_AREA];
size = ecl_option_values[ECL_OPT_BIND_STACK_SIZE] + 2 * margin;
env->bds_size = size;
env->bds_org = (ecl_bds_ptr)ecl_alloc_atomic(size * sizeof(*env->bds_org));
env->bds_top = env->bds_org-1;
env->bds_limit = &env->bds_org[size - 2*margin];
env->bds_stack.size = size;
env->bds_stack.org = (ecl_bds_ptr)ecl_alloc_atomic(size * sizeof(*env->bds_stack.org));
env->bds_stack.top = env->bds_stack.org-1;
env->bds_stack.limit = &env->bds_stack.org[size - 2*margin];
/* ihs stack */
env->ihs_top = &ihs_org;
ihs_org.function = ECL_NIL;

20
src/c/threads/thread.d
View file

@ -285,12 +285,12 @@ alloc_process(cl_object name, cl_object initial_bindings)
process->process.interrupt = ECL_NIL;
process->process.exit_values = ECL_NIL;
process->process.env = NULL;
if (initial_bindings != ECL_NIL || env->bindings_array == OBJNULL) {
if (initial_bindings != ECL_NIL || env->bds_stack.bindings_array == OBJNULL) {
array = si_make_vector(ECL_T, ecl_make_fixnum(256),
ECL_NIL, ECL_NIL, ECL_NIL, ECL_NIL);
si_fill_array_with_elt(array, ECL_NO_TL_BINDING, ecl_make_fixnum(0), ECL_NIL);
} else {
array = cl_copy_seq(ecl_process_env()->bindings_array);
array = cl_copy_seq(ecl_process_env()->bds_stack.bindings_array);
}
process->process.initial_bindings = array;
process->process.woken_up = ECL_NIL;
@ -358,9 +358,9 @@ ecl_import_current_thread(cl_object name, cl_object bindings)
/* Copy initial bindings from process to the fake environment */
env_aux->cleanup = registered;
env_aux->bindings_array = process->process.initial_bindings;
env_aux->thread_local_bindings_size = env_aux->bindings_array->vector.dim;
env_aux->thread_local_bindings = env_aux->bindings_array->vector.self.t;
env_aux->bds_stack.bindings_array = process->process.initial_bindings;
env_aux->bds_stack.thread_local_bindings_size = env_aux->bds_stack.bindings_array->vector.dim;
env_aux->bds_stack.thread_local_bindings = env_aux->bds_stack.bindings_array->vector.self.t;
/* Switch over to the real environment */
memcpy(env, env_aux, sizeof(*env));
@ -515,11 +515,11 @@ mp_process_enable(cl_object process)
ecl_init_env(process_env);
process_env->trap_fpe_bits = process->process.trap_fpe_bits;
process_env->bindings_array = process->process.initial_bindings;
process_env->thread_local_bindings_size =
process_env->bindings_array->vector.dim;
process_env->thread_local_bindings =
process_env->bindings_array->vector.self.t;
process_env->bds_stack.bindings_array = process->process.initial_bindings;
process_env->bds_stack.thread_local_bindings_size =
process_env->bds_stack.bindings_array->vector.dim;
process_env->bds_stack.thread_local_bindings =
process_env->bds_stack.bindings_array->vector.self.t;
ecl_disable_interrupts_env(the_env);
#ifdef ECL_WINDOWS_THREADS

4
src/c/unixint.d
View file

@ -400,11 +400,11 @@ handle_all_queued_interrupt_safe(cl_env_ptr env)
struct ecl_frame top_frame;
memcpy(&top_frame, env->frs_top+1, sizeof(struct ecl_frame));
struct ecl_bds_frame top_binding;
memcpy(&top_binding, env->bds_top+1, sizeof(struct ecl_bds_frame));
memcpy(&top_binding, env->bds_stack.top+1, sizeof(struct ecl_bds_frame));
/* Finally we can handle the queued signals ... */
handle_all_queued(env);
/* ... and restore everything again */
memcpy(env->bds_top+1, &top_binding, sizeof(struct ecl_bds_frame));
memcpy(env->bds_stack.top+1, &top_binding, sizeof(struct ecl_bds_frame));
memcpy(env->frs_top+1, &top_frame, sizeof(struct ecl_frame));
env->stack_top--;
ecl_clear_bignum_registers(env);

28
src/h/external.h
View file

@ -10,6 +10,20 @@ extern "C" {
#define _ECL_ARGS(x) x
/* The BinDing Stack stores the bindings of special variables. */
struct ecl_binding_stack {
#ifdef ECL_THREADS
cl_index thread_local_bindings_size;
cl_object *thread_local_bindings;
cl_object bindings_array;
#endif
cl_index size;
cl_index limit_size;
struct ecl_bds_frame * org;
struct ecl_bds_frame * top;
struct ecl_bds_frame * limit;
};
/*
* Per-thread data.
*/
@ -41,19 +55,7 @@ struct cl_env_struct {
cl_object *stack_top;
cl_object *stack_limit;
/*
* The BinDing Stack stores the bindings of special variables.
*/
#ifdef ECL_THREADS
cl_index thread_local_bindings_size;
cl_object *thread_local_bindings;
cl_object bindings_array;
#endif
cl_index bds_size;
cl_index bds_limit_size;
struct ecl_bds_frame *bds_org;
struct ecl_bds_frame *bds_top;
struct ecl_bds_frame *bds_limit;
struct ecl_binding_stack bds_stack;
/*
* The Invocation History Stack (IHS) keeps a list of the names of the

100
src/h/stacks.h
View file

@ -78,7 +78,7 @@ typedef struct ecl_bds_frame {
} *ecl_bds_ptr;
#define ecl_bds_check(env) \
(ecl_unlikely(env->bds_top >= env->bds_limit)? (ecl_bds_overflow(),1) : 0)
(ecl_unlikely(env->bds_stack.top >= env->bds_stack.limit)? (ecl_bds_overflow(),1) : 0)
#define ECL_MISSING_SPECIAL_BINDING (~((cl_index)0))
@ -107,18 +107,18 @@ static inline void ecl_bds_bind_inl(cl_env_ptr env, cl_object s, cl_object v)
# ifdef ECL_THREADS
cl_object *location;
const cl_index index = s->symbol.binding;
if (index >= env->thread_local_bindings_size) {
if (index >= env->bds_stack.thread_local_bindings_size) {
ecl_bds_bind(env,s,v);
} else {
location = env->thread_local_bindings + index;
slot = env->bds_top+1;
if (slot >= env->bds_limit) slot = ecl_bds_overflow();
location = env->bds_stack.thread_local_bindings + index;
slot = env->bds_stack.top+1;
if (slot >= env->bds_stack.limit) slot = ecl_bds_overflow();
/* First, we push a dummy symbol in the stack to
* prevent segfaults when we are interrupted with a
* call to ecl_bds_unwind. */
slot->symbol = ECL_DUMMY_TAG;
AO_nop_full();
++env->bds_top;
++env->bds_stack.top;
/* Then we disable interrupts to ensure that
* ecl_bds_unwind doesn't overwrite the symbol with
* some random value. */
@ -129,8 +129,8 @@ static inline void ecl_bds_bind_inl(cl_env_ptr env, cl_object s, cl_object v)
ecl_enable_interrupts_env(env);
}
# else
slot = ++env->bds_top;
if (slot >= env->bds_limit) slot = ecl_bds_overflow();
slot = ++env->bds_stack.top;
if (slot >= env->bds_stack.limit) slot = ecl_bds_overflow();
ecl_disable_interrupts_env(env);
slot->symbol = s;
slot->value = s->symbol.value;
@ -145,15 +145,15 @@ static inline void ecl_bds_push_inl(cl_env_ptr env, cl_object s)
# ifdef ECL_THREADS
cl_object *location;
const cl_index index = s->symbol.binding;
if (index >= env->thread_local_bindings_size) {
if (index >= env->bds_stack.thread_local_bindings_size) {
ecl_bds_push(env, s);
} else {
location = env->thread_local_bindings + index;
slot = env->bds_top+1;
if (slot >= env->bds_limit) slot = ecl_bds_overflow();
location = env->bds_stack.thread_local_bindings + index;
slot = env->bds_stack.top+1;
if (slot >= env->bds_stack.limit) slot = ecl_bds_overflow();
slot->symbol = ECL_DUMMY_TAG;
AO_nop_full();
++env->bds_top;
++env->bds_stack.top;
ecl_disable_interrupts_env(env);
slot->symbol = s;
slot->value = *location;
@ -161,8 +161,8 @@ static inline void ecl_bds_push_inl(cl_env_ptr env, cl_object s)
ecl_enable_interrupts_env(env);
}
# else
slot = ++env->bds_top;
if (slot >= env->bds_limit) slot = ecl_bds_overflow();
slot = ++env->bds_stack.top;
if (slot >= env->bds_stack.limit) slot = ecl_bds_overflow();
ecl_disable_interrupts_env(env);
slot->symbol = s;
slot->value = s->symbol.value;
@ -172,22 +172,22 @@ static inline void ecl_bds_push_inl(cl_env_ptr env, cl_object s)
static inline void ecl_bds_unwind1_inl(cl_env_ptr env)
{
cl_object s = env->bds_top->symbol;
cl_object s = env->bds_stack.top->symbol;
# ifdef ECL_THREADS
cl_object *location = env->thread_local_bindings + s->symbol.binding;
*location = env->bds_top->value;
cl_object *location = env->bds_stack.thread_local_bindings + s->symbol.binding;
*location = env->bds_stack.top->value;
# else
s->symbol.value = env->bds_top->value;
s->symbol.value = env->bds_stack.top->value;
# endif
--env->bds_top;
--env->bds_stack.top;
}
# ifdef ECL_THREADS
static inline cl_object ecl_bds_read_inl(cl_env_ptr env, cl_object s)
{
cl_index index = s->symbol.binding;
if (index < env->thread_local_bindings_size) {
cl_object x = env->thread_local_bindings[index];
if (index < env->bds_stack.thread_local_bindings_size) {
cl_object x = env->bds_stack.thread_local_bindings[index];
if (x != ECL_NO_TL_BINDING) return x;
}
return s->symbol.value;
@ -195,8 +195,8 @@ static inline cl_object ecl_bds_read_inl(cl_env_ptr env, cl_object s)
static inline cl_object *ecl_bds_ref_inl(cl_env_ptr env, cl_object s)
{
cl_index index = s->symbol.binding;
if (index < env->thread_local_bindings_size) {
cl_object *location = env->thread_local_bindings + index;
if (index < env->bds_stack.thread_local_bindings_size) {
cl_object *location = env->bds_stack.thread_local_bindings + index;
if (*location != ECL_NO_TL_BINDING) return location;
}
return &s->symbol.value;
@ -209,32 +209,32 @@ static inline cl_object *ecl_bds_ref_inl(cl_env_ptr env, cl_object s)
# define ecl_bds_unwind1 ecl_bds_unwind1_inl
#else /* !__GNUC__ */
# ifndef ECL_THREADS
# define ecl_bds_bind(env,sym,val) do { \
const cl_env_ptr env_copy = (env); \
const cl_object s = (sym); \
const cl_object v = (val); \
ecl_bds_check(env_copy); \
ecl_bds_ptr slot = ++(env_copy->bds_top); \
ecl_disable_interrupts_env(env_copy); \
slot->symbol = s; \
slot->value = s->symbol.value; \
s->symbol.value = v; \
ecl_enable_interrupts_env(env_copy); } while (0)
# define ecl_bds_push(env,sym) do { \
const cl_env_ptr env_copy = (env); \
const cl_object s = (sym); \
const cl_object v = s->symbol.value; \
ecl_bds_check(env_copy); \
ecl_bds_ptr slot = ++(env_copy->bds_top); \
ecl_disable_interrupts_env(env_copy); \
slot->symbol = s; \
slot->value = s->symbol.value; \
ecl_enable_interrupts_env(env_copy); } while (0);
# define ecl_bds_unwind1(env) do { \
# define ecl_bds_bind(env,sym,val) do { \
const cl_env_ptr env_copy = (env); \
const cl_object s = env_copy->bds_top->symbol; \
s->symbol.value = env_copy->bds_top->value; \
--(env_copy->bds_top); } while (0)
const cl_object s = (sym); \
const cl_object v = (val); \
ecl_bds_check(env_copy); \
ecl_bds_ptr slot = ++(env_copy->bds_stack.top); \
ecl_disable_interrupts_env(env_copy); \
slot->symbol = s; \
slot->value = s->symbol.value; \
s->symbol.value = v; \
ecl_enable_interrupts_env(env_copy); } while (0)
# define ecl_bds_push(env,sym) do { \
const cl_env_ptr env_copy = (env); \
const cl_object s = (sym); \
const cl_object v = s->symbol.value; \
ecl_bds_check(env_copy); \
ecl_bds_ptr slot = ++(env_copy->bds_stack.top); \
ecl_disable_interrupts_env(env_copy); \
slot->symbol = s; \
slot->value = s->symbol.value; \
ecl_enable_interrupts_env(env_copy); } while (0);
# define ecl_bds_unwind1(env) do { \
const cl_env_ptr env_copy = (env); \
const cl_object s = env_copy->bds_stack.top->symbol; \
s->symbol.value = env_copy->bds_stack.top->value; \
--(env_copy->bds_stack.top); } while (0)
# endif /* !ECL_THREADS */
#endif /* !__GNUC__ */
@ -257,7 +257,7 @@ typedef struct ecl_ihs_frame {
r->function=(fun); \
r->lex_env=(lisp_env); \
r->index=__the_env->ihs_top->index+1; \
r->bds=__the_env->bds_top - __the_env->bds_org; \
r->bds=__the_env->bds_stack.top - __the_env->bds_stack.org; \
__the_env->ihs_top = r; \
} while(0)