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

Remove one test from the implementation of ecl_bds_bind().

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2010-01-22 18:47:55 +01:00
parent 058d247bd4
commit 39e4b6826f
5 changed files with 53 additions and 40 deletions
Download patch file Download diff file Expand all files Collapse all files

2
src/c/all_symbols.d
View file

@ -193,7 +193,7 @@ make_this_symbol(int i, cl_object s, int code, const char *name,
s->symbol.t = t_symbol;
s->symbol.dynamic = 0;
#ifdef ECL_THREADS
s->symbol.binding = 0;
s->symbol.binding = ECL_MISSING_SPECIAL_BINDING;
#endif
ECL_SET(s, OBJNULL);
SYM_FUN(s) = Cnil;

22
src/c/main.d
View file

@ -441,7 +441,7 @@ cl_boot(int argc, char **argv)
Cnil_symbol->symbol.hpack = Cnil;
Cnil_symbol->symbol.stype = stp_constant;
#ifdef ECL_THREADS
Cnil_symbol->symbol.binding = 0;
Cnil_symbol->symbol.binding = ECL_MISSING_SPECIAL_BINDING;
#endif
cl_num_symbols_in_core=1;
@ -454,7 +454,7 @@ cl_boot(int argc, char **argv)
Ct->symbol.hpack = Cnil;
Ct->symbol.stype = stp_constant;
#ifdef ECL_THREADS
Ct->symbol.binding = 0;
Ct->symbol.binding = ECL_MISSING_SPECIAL_BINDING;
#endif
cl_num_symbols_in_core=2;
@ -542,6 +542,15 @@ cl_boot(int argc, char **argv)
ecl_make_pathname(Cnil, Cnil, Cnil, Cnil, Cnil, Cnil));
#endif
#ifdef ECL_THREADS
cl_core.last_var_index = 0;
cl_core.reused_indices = Cnil;
env->bindings_hash = si_make_vector(Ct, MAKE_FIXNUM(256),
Cnil, Cnil, Cnil, Cnil);
si_fill_array_with_elt(env->bindings_hash, OBJNULL, MAKE_FIXNUM(0), Cnil);
ECL_SET(@'mp::*current-process*', env->own_process);
#endif
/*
* Initialize Unicode character database.
*/
@ -627,15 +636,6 @@ cl_boot(int argc, char **argv)
init_unixtime();
#ifdef ECL_THREADS
cl_core.last_var_index = 0;
cl_core.reused_indices = Cnil;
env->bindings_hash = si_make_vector(Ct, MAKE_FIXNUM(256),
Cnil, Cnil, Cnil, Cnil);
si_fill_array_with_elt(env->bindings_hash, OBJNULL, MAKE_FIXNUM(0), Cnil);
ECL_SET(@'mp::*current-process*', env->own_process);
#endif
/*
* Initialize I/O subsystem.
*/

64
src/c/stacks.d
View file

@ -104,7 +104,7 @@ ecl_cs_set_org(cl_env_ptr env)
/********************* BINDING STACK ************************/
#ifdef ECL_THREADS
cl_index
static cl_index
ecl_new_binding_index(cl_object symbol)
{
cl_object pool;
@ -112,7 +112,7 @@ ecl_new_binding_index(cl_object symbol)
THREAD_OP_LOCK();
symbol->symbol.dynamic |= 1;
new_index = symbol->symbol.binding;
if (!new_index) {
if (new_index == ECL_MISSING_SPECIAL_BINDING) {
si_set_finalizer(symbol, Ct);
pool = cl_core.reused_indices;
if (!Null(pool)) {
@ -121,12 +121,13 @@ ecl_new_binding_index(cl_object symbol)
} else {
new_index = ++cl_core.last_var_index;
}
symbol->symbol.binding = new_index;
}
THREAD_OP_UNLOCK();
return new_index;
}
cl_object
static cl_object
ecl_extend_bindings_array(cl_object vector)
{
cl_index new_size = cl_core.last_var_index * 1.25;
@ -136,18 +137,34 @@ ecl_extend_bindings_array(cl_object vector)
return new_vector;
}
static cl_index
ecl_bds_bind_special_case(cl_object s)
{
if (s->symbol.binding == 0) {
printf("\nFOO\n");
abort();
}
if (s->symbol.binding == ECL_MISSING_SPECIAL_BINDING) {
return ecl_new_binding_index(s);
} else {
cl_env_ptr env = ecl_process_env();
cl_object vector = env->bindings_hash;
env->bindings_hash = ecl_extend_bindings_array(vector);
return s->symbol.binding;
}
}
void
ecl_bds_bind(cl_env_ptr env, cl_object s, cl_object value)
{
cl_object bindings, *location, old_value;
struct bds_bd *slot;
cl_index index = s->symbol.binding;
if (!index) {
s->symbol.binding = index = ecl_new_binding_index(s);
}
AGAIN:
bindings = env->bindings_hash;
if (index >= bindings->vector.dim) {
bindings = ecl_extend_bindings_array(bindings);
index = ecl_bds_bind_special_case(s);
goto AGAIN;
}
location = bindings->array.self.t + index;
slot = ++env->bds_top;
@ -166,12 +183,11 @@ ecl_bds_push(cl_env_ptr env, cl_object s)
cl_object bindings, *location, old_value;
struct bds_bd *slot;
cl_index index = s->symbol.binding;
if (!index) {
s->symbol.binding = index = ecl_new_binding_index(s);
}
AGAIN:
bindings = env->bindings_hash;
if (index >= bindings->vector.dim) {
bindings = ecl_extend_bindings_array(bindings);
index = ecl_bds_bind_special_case(s);
goto AGAIN;
}
location = bindings->array.self.t + index;
slot = ++env->bds_top;
@ -201,13 +217,11 @@ ecl_symbol_slot(cl_env_ptr env, cl_object s)
s = Cnil_symbol;
} else {
cl_index index = s->symbol.binding;
if (index) {
cl_object bindings = env->bindings_hash;
if (index < bindings->vector.dim) {
cl_object *location = bindings->vector.self.t + index;
if (*location)
return location;
}
cl_object bindings = env->bindings_hash;
if (index < bindings->vector.dim) {
cl_object *location = bindings->vector.self.t + index;
if (*location)
return location;
}
return &s->symbol.value;
}
@ -217,14 +231,12 @@ cl_object
ecl_set_symbol(cl_env_ptr env, cl_object s, cl_object value)
{
cl_index index = s->symbol.binding;
if (index) {
cl_object bindings = env->bindings_hash;
if (index < bindings->vector.dim) {
cl_object *location = bindings->vector.self.t + index;
if (*location)
return (*location) = value;
}
}
cl_object bindings = env->bindings_hash;
if (index < bindings->vector.dim) {
cl_object *location = bindings->vector.self.t + index;
if (*location)
return (*location) = value;
}
return (s->symbol.value = value);
}
#endif

4
src/c/symbol.d
View file

@ -120,7 +120,7 @@ cl_make_symbol(cl_object str)
x->symbol.name = str;
x->symbol.dynamic = 0;
#ifdef ECL_THREADS
x->symbol.binding = 0;
x->symbol.binding = ECL_MISSING_SPECIAL_BINDING;
#endif /* */
ECL_SET(x,OBJNULL);
SYM_FUN(x) = Cnil;
@ -329,7 +329,7 @@ cl_symbol_name(cl_object x)
x->symbol.gfdef = sym->symbol.gfdef;
x->symbol.plist = cl_copy_list(sym->symbol.plist);
#ifdef ECL_THREADS
x->symbol.binding = 0;
x->symbol.binding = ECL_MISSING_SPECIAL_BINDING;
#endif
/* FIXME!!! We should also copy the system property list */
}

1
src/h/stacks.h
View file

@ -44,6 +44,7 @@ typedef struct bds_bd {
typedef struct cl_env_struct *cl_env_ptr;
#ifdef ECL_THREADS
#define ECL_MISSING_SPECIAL_BINDING (~((cl_index)0))
extern ECL_API void ecl_bds_bind(cl_env_ptr env, cl_object symbol, cl_object v);
extern ECL_API void ecl_bds_push(cl_env_ptr env, cl_object symbol);
extern ECL_API void ecl_bds_unwind1(cl_env_ptr env);