From 60b8cd0df3ed844ea5c77286ac27afff5b3c9b37 Mon Sep 17 00:00:00 2001
From: Mistivia <i@mistivia.com>
Date: Tue, 24 Jun 2025 01:42:43 +0800
Subject: stack overflow check

---
 Makefile            |  4 +++-
 src/interp.c        | 28 ++++++++++++++++++++++------
 src/interp.h        |  1 +
 tests/lambda.lisp   |  6 ++++++
 tests/tailcall.lisp |  2 +-
 5 files changed, 33 insertions(+), 8 deletions(-)

diff --git a/Makefile b/Makefile
index 95f3c67..1bfc086 100644
--- a/Makefile
+++ b/Makefile
@@ -25,7 +25,7 @@ install: bamboo-lisp
 src/prelude.c: src/prelude.lisp
 	cat src/prelude.lisp | python scripts/genprelude.py > src/prelude.c
 
-bamboo-lisp:  $(obj) src/main.c 3rdparty/algds/build/lib/libalgds.a
+bamboo-lisp:  $(obj) src/main.o 3rdparty/algds/build/lib/libalgds.a
 	gcc $(cflags) -o $@ $^ $(ldflags)
 
 3rdparty/algds/build/lib/libalgds.a:
@@ -39,6 +39,8 @@ test: bamboo-lisp $(tests_bin)
 	@echo "Run scripts:"
 	./bamboo-lisp tests/test.lisp
 
+src/main.o:src/main.c
+	$(cc) -c $(cflags) $< -MD -MF $@.d -o $@
 
 $(obj):%.o:%.c
 	$(cc) -c $(cflags) $< -MD -MF $@.d -o $@
diff --git a/src/interp.c b/src/interp.c
index 242b821..15aabdb 100644
--- a/src/interp.c
+++ b/src/interp.c
@@ -20,6 +20,7 @@ VECTOR_IMPL(TopBinding);
 #define UNBOUND ((SExpRef){-1})
 
 void Interp_init(Interp *self) {
+    self->recursion_depth = 0;
     self->gensym_cnt = 42;
     self->parser = malloc(sizeof(Parser));
     Parser_init(self->parser);
@@ -396,7 +397,7 @@ void lisp_to_string_impl(str_builder_t *sb, Int2IntHashTable *visited, Interp *i
     if (pe->type == kIntegerSExp) {
         str_builder_append(sb, "%"PRId64, pe->integer);
     } else if (pe->type == kRealSExp) {
-        str_builder_append(sb, "%lf", pe->real);
+        str_builder_append(sb, "%lg", pe->real);
     } else if (pe->type == kCharSExp) {
         str_builder_append(sb, "#\%c", pe->character);
     } else if (pe->type == kBooleanSExp) {
@@ -682,11 +683,20 @@ static SExpRef build_function_env(Interp *interp, SExpRef func, SExpRef args) {
 }
 
 SExpRef lisp_apply(Interp *interp, SExpRef fn, SExpRef args, bool istail) {
+    if (interp->recursion_depth > 2048)
+        return new_error(interp, "apply: stack overflow.\n");
+    interp->recursion_depth++;
     SExpRef exp, env, ret, iter;
-    if (istail) return new_tailcall(interp, fn, args);
+    if (istail) {
+        interp->recursion_depth--;
+        return new_tailcall(interp, fn, args);
+    }
     if (VALTYPE(fn) == kFuncSExp) {
         env = build_function_env(interp, fn, args);
-        if (CTL_FL(env)) return env;
+        if (CTL_FL(env)) {
+            interp->recursion_depth--;
+            return env;
+        }
         interp->stack = CONS(env, interp->stack);
         iter = REF(fn)->func.body;
         while (!NILP(iter)) {
@@ -705,6 +715,7 @@ SExpRef lisp_apply(Interp *interp, SExpRef fn, SExpRef args, bool istail) {
         PUSH_REG(args);
         ret = (*fnptr)(interp, args);
         POP_REG();
+        interp->recursion_depth--;
         return ret;
     }
 end:
@@ -715,12 +726,15 @@ end:
         ret = REF(ret)->ret;
     }
     interp->stack = CDR(interp->stack);
+    interp->recursion_depth--;
     return ret;
-error:
-    return new_error(interp, "function call: syntax error.\n");
 }
 
 SExpRef lisp_eval(Interp *interp, SExpRef sexp, bool istail) {
+    if (interp->recursion_depth > 2048) {
+        return new_error(interp, "eval: stack overflow.\n");
+    }
+    interp->recursion_depth++;
     SExpRef ret;
     SExpType type;
     PUSH_REG(sexp);
@@ -794,15 +808,17 @@ SExpRef lisp_eval(Interp *interp, SExpRef sexp, bool istail) {
             POP_REG();
             goto end;
         } else {
-            return new_error(interp,
+            ret = new_error(interp,
                     "eval: fatal binding eval, %s is not a func, prim "
                     "or macro.\n", REF(symbol)->str);
+            goto end;
         }
     }
     ret = new_error(interp, "eval: unknown syntax.\n");
 end:
     POP_REG();
     Interp_gc(interp, ret);
+    interp->recursion_depth--;
     return ret;
 tailcall:
     while (1) {
diff --git a/src/interp.h b/src/interp.h
index 4b9caba..96173a7 100644
--- a/src/interp.h
+++ b/src/interp.h
@@ -36,6 +36,7 @@ struct interp {
     Parser *parser;
     int gensym_cnt;
     bool alwaysgc;
+    int recursion_depth;
 };
 
 void Interp_init(Interp *self);
diff --git a/tests/lambda.lisp b/tests/lambda.lisp
index 0a1ad1c..759a217 100644
--- a/tests/lambda.lisp
+++ b/tests/lambda.lisp
@@ -31,3 +31,9 @@
     (lambda (x) (setq x 2)))
   (funcall fn x)
   (assert (= x 1)))
+
+(assert-error
+  (let
+    ((f
+       (lambda (x) (funcall f 1) x)))
+    (funcall f 1)))
diff --git a/tests/tailcall.lisp b/tests/tailcall.lisp
index 1b39fb0..4a3e480 100644
--- a/tests/tailcall.lisp
+++ b/tests/tailcall.lisp
@@ -6,7 +6,7 @@
 (defun is-odd (x)
     (is-even (- x 1)))
 
-(assert (is-even 100))
+(assert (is-even 1024))
 (assert (is-even 10))
 (assert (is-even 0))
 (assert (is-odd 1))
-- 
cgit v1.0