From a14508cee42df45f938fee643cd4f13ac8774f28 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= <daniel@turtleware.eu>
Date: Fri, 28 Mar 2025 20:26:51 +0100
Subject: [PATCH] stacks: merge stack overflow errors into a single handler

Replace calls to cl_error and cl_cerror with CEstack_overflow.
---
 src/c/error.d    | 18 ++++++++++++++++
 src/c/stacks.d   | 53 +++++++++++-------------------------------------
 src/h/external.h |  1 +
 3 files changed, 31 insertions(+), 41 deletions(-)

diff --git a/src/c/error.d b/src/c/error.d
index 2885792a5..b420e47af 100644
--- a/src/c/error.d
+++ b/src/c/error.d
@@ -162,6 +162,24 @@ CEerror(cl_object c, const char *err, int narg, ...)
  * Conditions signaler *
  ***********************/
 
+void
+CEstack_overflow(cl_object type, cl_object limit, cl_object resume)
+{
+  cl_env_ptr the_env = ecl_process_env();
+  cl_index the_size;
+  if (!Null(resume)) resume = @"Extend stack size";
+  ECL_UNWIND_PROTECT_BEGIN(the_env) {
+    cl_cerror(6, resume, @'ext::stack-overflow', @':type', type, @':size', limit);
+  } ECL_UNWIND_PROTECT_EXIT {
+    /* reset the margin */
+    si_set_limit(type, limit);
+  } ECL_UNWIND_PROTECT_END;
+  /* resize the stack */
+  the_size = ecl_to_size(limit);
+  the_size = the_size + the_size/2;
+  si_set_limit(type, ecl_make_fixnum(the_size));
+}
+
 void
 FEprogram_error(const char *s, int narg, ...)
 {
diff --git a/src/c/stacks.d b/src/c/stacks.d
index 46826b046..b50984461 100644
--- a/src/c/stacks.d
+++ b/src/c/stacks.d
@@ -52,6 +52,8 @@ cs_set_size(cl_env_ptr env, cl_index new_size)
 {
   volatile char foo = 0;
   cl_index margin = ecl_option_values[ECL_OPT_C_STACK_SAFETY_AREA];
+  if (new_size > env->c_stack.max_size)
+    new_size = env->c_stack.max_size;
 #if defined(ECL_CAN_SET_STACK_SIZE)
   {
     struct rlimit rl;
@@ -118,26 +120,11 @@ ecl_cs_overflow(void)
     env->c_stack.limit += margin;
 #endif
   else
-    ecl_unrecoverable_error(env, stack_overflow_msg);
-  ECL_UNWIND_PROTECT_BEGIN(env) {
-    if (env->c_stack.max_size == (cl_index)0 || env->c_stack.size < env->c_stack.max_size)
-      cl_cerror(6, @"Extend stack size",
-                @'ext::stack-overflow',
-                @':size', ecl_make_fixnum(size),
-                @':type', @'ext::c-stack');
-    else
-      cl_error(5,
-               @'ext::stack-overflow',
-               @':size', ECL_NIL,
-               @':type', @'ext::c-stack');
-  } ECL_UNWIND_PROTECT_EXIT {
-    /* reset margin */
-    cs_set_size(env, size);
-  } ECL_UNWIND_PROTECT_END;
-  size += size/2;
-  if (size > env->c_stack.max_size)
-    size = env->c_stack.max_size;
-  cs_set_size(env, size);
+    ecl_internal_error(stack_overflow_msg);
+  if (env->c_stack.max_size == (cl_index)0 || env->c_stack.size < env->c_stack.max_size)
+    CEstack_overflow(@'ext::c-stack', ecl_make_fixnum(size), ECL_T);
+  else
+    CEstack_overflow(@'ext::c-stack', ecl_make_fixnum(size), ECL_NIL);
 }
 
 /* ------------------------- LISP STACK ------------------------------- */
@@ -340,18 +327,10 @@ ecl_bds_overflow(void)
   ecl_bds_ptr org = env->bds_stack.org;
   ecl_bds_ptr last = org + size;
   if (env->bds_stack.limit >= last) {
-    ecl_unrecoverable_error(env, stack_overflow_msg);
+    ecl_internal_error(stack_overflow_msg);
   }
   env->bds_stack.limit += margin;
-  ECL_UNWIND_PROTECT_BEGIN(env) {
-    cl_cerror(6, @"Extend stack size",
-              @'ext::stack-overflow', @':size', ecl_make_fixnum(size),
-              @':type', @'ext::binding-stack');
-  } ECL_UNWIND_PROTECT_EXIT {
-    /* reset margin */
-    bds_set_limit(env, limit_size);
-  } ECL_UNWIND_PROTECT_END;
-  bds_set_limit(env, limit_size + (limit_size / 2));
+  CEstack_overflow(@'ext::binding-stack', ecl_make_fixnum(size), ECL_T);
   return env->bds_stack.top;
 }
 
@@ -700,7 +679,7 @@ frs_set_limit(cl_env_ptr env, cl_index new_lim_size)
 }
 
 static void
-frs_overflow(void)              /* used as condition in list.d */
+frs_overflow(void)
 {
   static const char *stack_overflow_msg =
     "\n;;;\n;;; Frame stack overflow.\n"
@@ -713,18 +692,10 @@ frs_overflow(void)              /* used as condition in list.d */
   ecl_frame_ptr org = env->frs_stack.org;
   ecl_frame_ptr last = org + size;
   if (env->frs_stack.limit >= last) {
-    ecl_unrecoverable_error(env, stack_overflow_msg);
+    ecl_internal_error(stack_overflow_msg);
   }
   env->frs_stack.limit += margin;
-  ECL_UNWIND_PROTECT_BEGIN(env) {
-    cl_cerror(6, @"Extend stack size",
-              @'ext::stack-overflow', @':size', ecl_make_fixnum(size),
-              @':type', @'ext::frame-stack');
-  } ECL_UNWIND_PROTECT_EXIT {
-    /* reset margin */
-    frs_set_limit(env, limit_size);
-  } ECL_UNWIND_PROTECT_END;
-  frs_set_limit(env, limit_size + limit_size / 2);
+  CEstack_overflow(@'ext::frame-stack', ecl_make_fixnum(size), ECL_T);
 }
 
 ecl_frame_ptr
diff --git a/src/h/external.h b/src/h/external.h
index f85f0a0ac..93389e143 100755
--- a/src/h/external.h
+++ b/src/h/external.h
@@ -596,6 +596,7 @@ extern ECL_API void FEtimeout() ecl_attr_noreturn;
 extern ECL_API void FEerror_not_owned(cl_object lock) ecl_attr_noreturn;
 extern ECL_API void FEunknown_lock_error(cl_object lock) ecl_attr_noreturn;
 extern ECL_API cl_object CEerror(cl_object c, const char *err_str, int narg, ...);
+extern ECL_API void CEstack_overflow(cl_object type, cl_object limit, cl_object resume);
 extern ECL_API void FElibc_error(const char *msg, int narg, ...) ecl_attr_noreturn;
 #if defined(ECL_MS_WINDOWS_HOST) || defined(cygwin)
 extern ECL_API void FEwin32_error(const char *msg, int narg, ...) ecl_attr_noreturn;