From e9e97815bc258ff6eb8d4c43e5a70e6fe46eabc8 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= <daniel@turtleware.eu>
Date: Thu, 29 May 2025 11:36:48 +0200
Subject: [PATCH] stacks: make stack frame state consistent based on its
 operators

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.
---
 src/c/eval.d     |  2 +-
 src/c/stacks.d   | 58 +++++++++++++++++++++++++++++++++++++++---------
 src/h/external.h |  1 +
 3 files changed, 49 insertions(+), 12 deletions(-)

diff --git a/src/c/eval.d b/src/c/eval.d
index 237f54660..97fb81668 100644
--- a/src/c/eval.d
+++ b/src/c/eval.d
@@ -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) {
diff --git a/src/c/stacks.d b/src/c/stacks.d
index 018797423..adab860cc 100644
--- a/src/c/stacks.d
+++ b/src/c/stacks.d
@@ -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;
 }
 
diff --git a/src/h/external.h b/src/h/external.h
index fa888a91c..e1af3207b 100755
--- a/src/h/external.h
+++ b/src/h/external.h
@@ -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);