From c686f07ec193704737380150ead24f8322f6e8f9 Mon Sep 17 00:00:00 2001
From: Benjamin Vedder <benjamin@vedder.se>
Date: Sun, 10 Dec 2023 14:07:56 +0100
Subject: [PATCH] Squashed 'lispBM/lispBM/' changes from d3da43bf..1405c6a8

1405c6a8 bugfix in setq related to saving the environment
1b4f84df added gc tests

git-subtree-dir: lispBM/lispBM
git-subtree-split: 1405c6a8d857c6af55606902b5a52ce64d712c2f
---
 src/eval_cps.c         | 8 ++++----
 tests/test_gc_14.lisp  | 6 ++++++
 tests/test_gc_15.lisp  | 6 ++++++
 tests/test_setq_5.lisp | 7 +++++++
 tests/test_setq_6.lisp | 8 ++++++++
 5 files changed, 31 insertions(+), 4 deletions(-)
 create mode 100644 tests/test_gc_14.lisp
 create mode 100644 tests/test_gc_15.lisp
 create mode 100644 tests/test_setq_5.lisp
 create mode 100644 tests/test_setq_6.lisp

diff --git a/src/eval_cps.c b/src/eval_cps.c
index 52c33b45..f895cf8c 100644
--- a/src/eval_cps.c
+++ b/src/eval_cps.c
@@ -1752,7 +1752,7 @@ static void eval_setq(eval_context_t *ctx) {
   lbm_value args = get_cdr(ctx->curr_exp);
   lbm_value sym = get_car(args);
   lbm_value v_exp = get_cadr(args);
-  stack_push_2(&ctx->K, sym, SETQ);
+  stack_push_3(&ctx->K, ctx->curr_env, sym, SETQ);
   ctx->curr_exp = v_exp;
 }
 
@@ -2077,7 +2077,6 @@ static lbm_value perform_setvar(lbm_value key, lbm_value val, lbm_value env) {
 
   lbm_uint s = lbm_dec_sym(key);
   lbm_value res = val;
-
   if (s >= VARIABLE_SYMBOLS_START &&
       s <  VARIABLE_SYMBOLS_END) {
     return lbm_set_var(s, val);
@@ -3659,9 +3658,10 @@ static void cont_progn_var(eval_context_t* ctx) {
 
 static void cont_setq(eval_context_t *ctx) {
   lbm_value sym;
-  lbm_pop(&ctx->K, &sym);
+  lbm_value env;
+  lbm_pop_2(&ctx->K, &sym, &env);
   lbm_value res;
-  WITH_GC(res, perform_setvar(sym, ctx->r, ctx->curr_env));
+  WITH_GC(res, perform_setvar(sym, ctx->r, env));
   ctx->r = res;
   ctx->app_cont = true;
 }
diff --git a/tests/test_gc_14.lisp b/tests/test_gc_14.lisp
new file mode 100644
index 00000000..6dbdcffa
--- /dev/null
+++ b/tests/test_gc_14.lisp
@@ -0,0 +1,6 @@
+
+(define a 2u32)
+
+(gc)
+
+(check (= a 2))
diff --git a/tests/test_gc_15.lisp b/tests/test_gc_15.lisp
new file mode 100644
index 00000000..b137df51
--- /dev/null
+++ b/tests/test_gc_15.lisp
@@ -0,0 +1,6 @@
+
+(define ls (list 1u32 2u32 3u32 4u32 5u32 6u32))
+
+(gc)
+
+(check (eq ls (list 1u32 2u32 3u32 4u32 5u32 6u32)))
diff --git a/tests/test_setq_5.lisp b/tests/test_setq_5.lisp
new file mode 100644
index 00000000..2b4c497b
--- /dev/null
+++ b/tests/test_setq_5.lisp
@@ -0,0 +1,7 @@
+
+
+{
+(var a 10)
+(setq a 100)
+(check (= a 100))
+}
diff --git a/tests/test_setq_6.lisp b/tests/test_setq_6.lisp
new file mode 100644
index 00000000..dcda0474
--- /dev/null
+++ b/tests/test_setq_6.lisp
@@ -0,0 +1,8 @@
+
+(define f (lambda (x) (+ x 1)))
+
+{
+(var a 10)
+(setq a (f 1))
+(check (= a 2))
+}