diff --git a/src/c/stacks.d b/src/c/stacks.d index daf3f2726..a9b8f1781 100644 --- a/src/c/stacks.d +++ b/src/c/stacks.d @@ -889,6 +889,90 @@ si_ihs_env(cl_object arg) ecl_return1(env, get_ihs_ptr(ecl_to_size(arg))->lex_env); } +/* -- General purpose stack implementation ----------------------------------- */ + +/* Stacks are based on actually adjustable simple vectors. */ +cl_object +ecl_make_stack(cl_index size) +{ + cl_object x = ecl_malloc(sizeof(struct ecl_vector)); + x->vector.elttype = ecl_aet_object; + x->vector.self.t = NULL; + x->vector.displaced = ECL_NIL; + x->vector.dim = size; + x->vector.fillp = 0; + x->vector.flags = ECL_FLAG_ADJUSTABLE | ECL_FLAG_HAS_FILL_POINTER; + x->vector.self.t = (cl_object *)ecl_malloc(size * sizeof(cl_object)); + return x; +} +void +ecl_free_stack(cl_object self) +{ + ecl_free(self->vector.self.t); +} + +void +ecl_stack_resize(cl_object self, cl_index nsize) +{ + cl_index osize = self->vector.dim; + self->vector.self.t = (cl_object *)ecl_realloc(self->vector.self.t, + osize * sizeof(cl_object), + nsize * sizeof(cl_object)); + self->vector.dim = nsize; +} + +void +stack_ensure_size(cl_object self, cl_index nsize) +{ + if (nsize >= self->vector.dim) { + ecl_stack_resize(self, nsize); + } +} + +cl_index +ecl_stack_index(cl_object self) { + return self->vector.fillp; +} + +cl_object +ecl_stack_push(cl_object self, cl_object elt) +{ + cl_index fillp = self->vector.fillp; + cl_index dim = self->vector.dim; + if (ecl_unlikely(fillp == dim)) { + cl_index new_dim = dim+dim/2+1; + ecl_stack_resize(self, new_dim); + } + self->vector.self.t[self->vector.fillp++] = elt; + return self; +} + +cl_object +ecl_stack_del(cl_object self, cl_object elt) +{ + cl_index idx; + cl_index ndx = self->vector.fillp; + cl_object *v = self->vector.self.t; + for(idx = 0; idx < ndx; idx++) { + if (v[idx] == elt) { + do { v[idx] = v[idx+1]; } while (++idx <= ndx); + ecl_stack_popu(self); + break; + } + } + return self; +} + +/* Unsafe operations */ + +cl_object +ecl_stack_popu(cl_object self) +{ + cl_object result = self->vector.self.t[--self->vector.fillp]; + self->vector.self.t[self->vector.fillp] = ECL_NIL; + return result; +} + /* -- Lisp ops on stacks ---------------------------------------------------- */ cl_object diff --git a/src/h/ecl-inl.h b/src/h/ecl-inl.h index 16101fc93..9376c9e34 100644 --- a/src/h/ecl-inl.h +++ b/src/h/ecl-inl.h @@ -82,6 +82,26 @@ } else do { #define end_loop_for_on(list) } while (list = ECL_CONS_CDR(list), ECL_CONSP(list)) +/* + * Loops over a vector. + */ +#define loop_across_stack_fifo(var, obj) { \ + cl_index __ecl_idx; \ + cl_index __ecl_ndx = obj->vector.fillp; \ + cl_object *__ecl_v = obj->vector.self.t; \ + for(__ecl_idx = 0; __ecl_idx < __ecl_ndx; __ecl_idx++) { \ + cl_object var = __ecl_v[__ecl_idx]; + + +#define loop_across_stack_filo(var, obj) { \ + cl_index __ecl_idx; \ + cl_index __ecl_ndx = obj->vector.fillp; \ + cl_object *__ecl_v = obj->vector.self.t; \ + for(__ecl_idx = __ecl_ndx; __ecl_idx > 0; __ecl_idx--) { \ + cl_object var = __ecl_v[__ecl_idx-1]; + +#define end_loop_across_stack() }} + /* * Static constant definition. */ diff --git a/src/h/external.h b/src/h/external.h index 93389e143..31d13e004 100755 --- a/src/h/external.h +++ b/src/h/external.h @@ -320,6 +320,11 @@ extern ECL_API cl_index cl_num_symbols_in_core; extern ECL_API cl_object APPLY_fixed(cl_narg n, cl_object (*f)(), cl_object *x); extern ECL_API cl_object APPLY(cl_narg n, cl_objectfn, cl_object *x); +/* stack.c */ +extern ECL_API cl_object ecl_make_stack(cl_index dim); +extern ECL_API cl_object ecl_stack_push(cl_object stack, cl_object elt); +extern ECL_API cl_object ecl_stack_del(cl_object stack, cl_object elt); +extern ECL_API cl_object ecl_stack_popu(cl_object stack); /* array.c */