7 files changed, 54 insertions, 8 deletions
diff --git a/src/builtins.c b/src/builtins.c
index 98252f8..fe14b8f 100644
--- a/src/builtins.c
+++ b/src/builtins.c
@@ -6,6 +6,14 @@
 #include <float.h>
 #include <math.h>
 
+SExpRef builtin_alwaysgc(Interp *interp, SExpRef args) {
+    if (LENGTH(args) != 1) return new_error(interp, "_alwaysgc: arg num error.\n");
+    SExpRef arg = CAR(args);
+    if (VALTYPE(arg) != kBooleanSExp) return new_error(interp, "alwaysgc: type error.\n");
+    interp->alwaysgc = REF(arg)->boolean;
+    return NIL;
+}
+
 SExpRef builtin_symbol2string(Interp *interp, SExpRef args) {
     if (LENGTH(args) != 1) return new_error(interp, "symbol->string: arg num error.\n");
     SExpRef arg = CAR(args);
@@ -601,6 +609,7 @@ SExpRef builtin_num_equal(Interp *interp, SExpRef args) {
     }
 }
 
+
 SExpRef builtin_num_neq(Interp *interp, SExpRef args) {
     int args_len = LENGTH(args);
     if (args_len != 2) return new_error(interp, "/=: wrong argument number.\n");
diff --git a/src/builtins.h b/src/builtins.h
index 5b6b763..eb95f2d 100644
--- a/src/builtins.h
+++ b/src/builtins.h
@@ -53,5 +53,6 @@ SExpRef builtin_ge(Interp *interp, SExpRef args);
 SExpRef builtin_le(Interp *interp, SExpRef args);
 SExpRef builtin_princ(Interp *interp, SExpRef args);
 SExpRef builtin_gcstat(Interp *interp, SExpRef args);
+SExpRef builtin_alwaysgc(Interp *interp, SExpRef args);
 
 #endif
diff --git a/src/interp.c b/src/interp.c
index 983ba8e..5a23d0b 100644
--- a/src/interp.c
+++ b/src/interp.c
@@ -140,6 +140,7 @@ void Interp_init(Interp *self) {
 
 
     Interp_add_userfunc(self, "_gcstat", builtin_gcstat);
+    Interp_add_userfunc(self, "_alwaysgc", builtin_alwaysgc);
 
     SExpRef ret = Interp_eval_string(self, bamboo_lisp_prelude);
     Interp *interp = self;
@@ -249,7 +250,7 @@ void Interp_add_primitive(Interp *self, const char *name, LispPrimitive fn) {
 void Interp_gc(Interp *interp, SExpRef tmproot) {
     int freesize = IntVector_len(&interp->empty_space);
     int heapsize = SExpVector_len(&interp->objs);
-    if (freesize > heapsize >> 4) {
+    if (freesize > (heapsize >> 4) && !interp->alwaysgc) {
         return;
     }
     SExpRefVector gcstack;
diff --git a/src/interp.h b/src/interp.h
index 1989ab3..4b9caba 100644
--- a/src/interp.h
+++ b/src/interp.h
@@ -35,6 +35,7 @@ struct interp {
     char *errmsg_buf;
     Parser *parser;
     int gensym_cnt;
+    bool alwaysgc;
 };
 
 void Interp_init(Interp *self);
diff --git a/tests/tailcall-big.lisp b/tests/tailcall-big.lisp
new file mode 100644
index 0000000..ebf64c6
--- /dev/null
+++ b/tests/tailcall-big.lisp
@@ -0,0 +1,24 @@
+(assert (is-even 10000))
+(assert (cnt-down 10000))
+
+;; can pass without stack overflow,
+;; but comment out for too time-consuming
+;; (assert (is-even 1000000)) 
+;; (assert (cnt-down 1000000))
+
+(let ((my-evenp
+       (lambda (x)
+         (if (= x 0)
+           #t
+           (funcall my-oddp (- x 1)))))
+      (my-oddp
+        (lambda (x)
+          (if (= x 0)
+            #f
+            (funcall my-evenp (- x 1))))))
+  (assert (funcall my-evenp 10000))
+  (assert (funcall my-oddp 10009))
+  (assert (not (funcall my-evenp 10009)))
+  (assert (not (funcall my-oddp 10000))))
+
+
diff --git a/tests/tailcall.lisp b/tests/tailcall.lisp
index 86a88c8..1aa5e38 100644
--- a/tests/tailcall.lisp
+++ b/tests/tailcall.lisp
@@ -6,7 +6,6 @@
 (defun is-odd (x)
     (is-even (- x 1)))
 
-(assert (is-even 10000))
 (assert (is-even 10))
 (assert (is-even 0))
 (assert (is-odd 1))
@@ -18,9 +17,3 @@
     (progn
       (cnt-down (- x 1)))))
 
-(assert (cnt-down 10000))
-
-;; can pass without stack overflow,
-;; but comment out for too time-consuming
-;; (assert (is-even 1000000)) 
-;; (assert (cnt-down 1000000))
diff --git a/tests/test.lisp b/tests/test.lisp
index ca8195c..26ba788 100644
--- a/tests/test.lisp
+++ b/tests/test.lisp
@@ -12,6 +12,23 @@
 (test-module error)
 (test-module logic)
 (test-module tailcall)
+(test-module tailcall-big)
+(test-module control-flow)
+(test-module lambda)
+(test-module comment)
+(test-module macro)
+(test-module let-binding)
+
+(princ "\n\nTest with intensive GC:\n\n")
+(_alwaysgc #t)
+
+(test-module math)
+(test-module symbol)
+(test-module eq)
+(test-module arithmetic)
+(test-module tailcall)
+(test-module error)
+(test-module logic)
 (test-module control-flow)
 (test-module lambda)
 (test-module comment)