mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-03-10 23:20:23 -07:00
Code Issues Projects Releases Packages Wiki Activity

stacks: make stack frame state consistent based on its operators

Browse source 
Previously we did not perform necessary checks for whether we should update the
frame size and stack pointer or whether we should resize the stack. This commit
fixes these functions and adds a missing function to API ecl_stack_frame_pop.
This commit is contained in:
Daniel Kochmański 2025-05-29 11:36:48 +02:00
parent 8fcac4bd9f
commit e9e97815bc
3 changed files with 49 additions and 12 deletions
Download patch file Download diff file Expand all files Collapse all files

2
src/c/eval.d
View file

@ -149,7 +149,7 @@ cl_funcall(cl_narg narg, cl_object function, ...)
(cl_object)&frame_aux,
narg -= 2);
for (i = 0; i < narg; i++) {
ECL_STACK_FRAME_SET(frame, i, lastarg);
ecl_stack_frame_push(frame, lastarg);
lastarg = ecl_va_arg(args);
}
if (ecl_t_of(lastarg) == t_frame) {

58
src/c/stacks.d
View file

@ -222,7 +222,7 @@ ecl_data_stack_push_values(cl_env_ptr env) {
cl_index i = env->nvalues;
cl_object *b = env->run_stack.top;
cl_object *p = b + i;
if (p >= env->run_stack.limit) {
while (p >= env->run_stack.limit) {
b = ecl_data_stack_grow(env);
p = b + i;
}
@ -266,35 +266,71 @@ ecl_stack_frame_open(cl_env_ptr env, cl_object f, cl_index size)
void
ecl_stack_frame_push(cl_object f, cl_object o)
{
cl_env_ptr env = f->frame.env;
cl_object *top = env->run_stack.top;
if (top >= env->run_stack.limit) {
top = ecl_data_stack_grow(env);
cl_object *frame_top = ECL_STACK_FRAME_TOP(f);
cl_index limit_index = f->frame.base + f->frame.size;
if (f->frame.sp < limit_index) {
*frame_top = o;
f->frame.sp++;
} else {
/* XXX we allow here for a frame overflow. -- jd 2025-05-29 */
/* assert(frame_top == env->run_stack.top, "frame overflow"); */
cl_env_ptr env = f->frame.env;
ECL_STACK_PUSH(env, o);
f->frame.sp++;
f->frame.size++;
}
env->run_stack.top = ++top;
*(top-1) = o;
f->frame.size++;
}
cl_object
ecl_stack_frame_pop(cl_object f)
{
if (f->frame.sp <= f->frame.base) {
ecl_internal_error("ecl_stack_frame_pop: frame underflow.");
}
f->frame.sp--;
return *ECL_STACK_FRAME_TOP(f);
}
void
ecl_stack_frame_push_values(cl_object f)
{
cl_env_ptr env = f->frame.env;
ecl_data_stack_push_values(env);
f->frame.size += env->nvalues;
cl_index limit_index = f->frame.base + f->frame.size;
cl_index vals_length = env->nvalues;
cl_index value_index = f->frame.sp + vals_length;
cl_object *top = ECL_STACK_FRAME_TOP(f);
if (value_index < limit_index) {
ecl_copy(top, env->values, vals_length * sizeof(cl_object));
f->frame.sp = value_index;
} else {
/* XXX we allow here for a frame overflow. -- jd 2025-05-29 */
/* assert(frame_top == env->run_stack.top, "frame overflow"); */
cl_object *ptr = top + vals_length;
while (ptr >= env->run_stack.limit) {
ecl_data_stack_grow(env);
top = ECL_STACK_FRAME_TOP(f);
ptr = top + vals_length;
env->run_stack.top = ptr;
}
ecl_copy(top, env->values, vals_length * sizeof(cl_object));
f->frame.sp = value_index;
f->frame.size = value_index - f->frame.base;
}
}
cl_object
ecl_stack_frame_pop_values(cl_object f)
{
cl_env_ptr env = f->frame.env;
cl_index n = f->frame.size % ECL_MULTIPLE_VALUES_LIMIT;
cl_index top_size = f->frame.sp - f->frame.base;
cl_index n = top_size % ECL_MULTIPLE_VALUES_LIMIT;
cl_object o;
env->nvalues = n;
env->values[0] = o = ECL_NIL;
while (n--) {
env->values[n] = o = ECL_STACK_FRAME_REF(f, n);
}
f->frame.sp -= n;
return o;
}

1
src/h/external.h
View file

@ -539,6 +539,7 @@ extern ECL_API cl_object si_eval_with_env _ECL_ARGS((cl_narg narg, cl_object for
extern ECL_API cl_object si_interpreter_stack();
extern ECL_API cl_object ecl_stack_frame_open(cl_env_ptr env, cl_object f, cl_index size);
extern ECL_API void ecl_stack_frame_push(cl_object f, cl_object o);
extern ECL_API cl_object ecl_stack_frame_pop(cl_object f);
extern ECL_API void ecl_stack_frame_push_values(cl_object f);
extern ECL_API cl_object ecl_stack_frame_pop_values(cl_object f);
extern ECL_API void ecl_stack_frame_close(cl_object f);