From f71d005d03029fa47e96db22e561a40d48d77e7d Mon Sep 17 00:00:00 2001
From: Benjamin Vedder <benjamin@vedder.se>
Date: Tue, 9 Jan 2024 23:14:11 +0100
Subject: [PATCH] Squashed 'lispBM/lispBM/' changes from 4a176b04..9c2023ac

9c2023ac revert callcc gc fix and make the env hashmap static
e091c36c added tests of sort and one for callcc
eb164666 small tweak to make static analysis more happy

git-subtree-dir: lispBM/lispBM
git-subtree-split: 9c2023acd81fc12ebdc276b58a5bee6e11c18770
---
 src/env.c                |  4 +---
 src/heap.c               | 12 ------------
 src/print.c              |  2 +-
 tests/test_callcc_6.lisp |  9 +++++++++
 tests/test_sort_10.lisp  | 18 ++++++++++++++++++
 tests/test_sort_8.lisp   | 13 +++++++++++++
 tests/test_sort_9.lisp   | 14 ++++++++++++++
 7 files changed, 56 insertions(+), 16 deletions(-)
 create mode 100644 tests/test_callcc_6.lisp
 create mode 100644 tests/test_sort_10.lisp
 create mode 100644 tests/test_sort_8.lisp
 create mode 100644 tests/test_sort_9.lisp

diff --git a/src/env.c b/src/env.c
index 7d047def..df8ae2ac 100644
--- a/src/env.c
+++ b/src/env.c
@@ -24,11 +24,9 @@
 #include "env.h"
 #include "lbm_memory.h"
 
-static lbm_value *env_global;
+static lbm_value env_global[GLOBAL_ENV_ROOTS];
 
 int lbm_init_env(void) {
-  env_global = (lbm_value*)lbm_malloc(GLOBAL_ENV_ROOTS * sizeof(lbm_value));
-  if (!env_global) return 0;
   for (int i = 0; i < GLOBAL_ENV_ROOTS; i ++) {
     env_global[i] = ENC_SYM_NIL;
   }
diff --git a/src/heap.c b/src/heap.c
index 9e8e1843..1c5fdd9e 100644
--- a/src/heap.c
+++ b/src/heap.c
@@ -722,18 +722,6 @@ void lbm_gc_mark_phase(lbm_value root) {
     if (t_ptr >= LBM_NON_CONS_POINTER_TYPE_FIRST &&
         t_ptr <= LBM_NON_CONS_POINTER_TYPE_LAST) continue;
 
-    if (cell->car == ENC_SYM_CONT) {
-      lbm_value cont = cell->cdr;
-      lbm_array_header_t *arr = (lbm_array_header_t*)lbm_car(cont);
-      lbm_value *arrdata = (lbm_value *)arr->data;
-      for (lbm_uint i = 0; i < arr->size / 4; i ++) {
-        if (lbm_is_ptr(arrdata[i])){
-          if (!lbm_push (s, arrdata[i])) {
-            lbm_critical_error();
-          }
-        }
-      }
-    }
     if (lbm_is_ptr(cell->cdr)) {
       if (!lbm_push(s, cell->cdr)) {
         lbm_critical_error();
diff --git a/src/print.c b/src/print.c
index 39477151..72c23474 100644
--- a/src/print.c
+++ b/src/print.c
@@ -202,7 +202,7 @@ int print_emit_continuation(lbm_char_channel_t *chan, lbm_value v) {
 int print_emit_custom(lbm_char_channel_t *chan, lbm_value v) {
   lbm_uint *custom = (lbm_uint*)lbm_car(v);
   int r;
-  if (custom[CUSTOM_TYPE_DESCRIPTOR]) {
+  if (custom && custom[CUSTOM_TYPE_DESCRIPTOR]) {
     r = print_emit_string(chan, (char*)custom[CUSTOM_TYPE_DESCRIPTOR]);
   } else {
     r = print_emit_string(chan, "Unspecified_Custom_Type");
diff --git a/tests/test_callcc_6.lisp b/tests/test_callcc_6.lisp
new file mode 100644
index 00000000..f1a44761
--- /dev/null
+++ b/tests/test_callcc_6.lisp
@@ -0,0 +1,9 @@
+
+(let ((r '(1 2 3 4)))
+  (def result (eq r (call-cc (fn (k) (define cc k))))))
+
+(gc)
+
+(cc '(1 2 3 4))
+
+(check result)
diff --git a/tests/test_sort_10.lisp b/tests/test_sort_10.lisp
new file mode 100644
index 00000000..e1707540
--- /dev/null
+++ b/tests/test_sort_10.lisp
@@ -0,0 +1,18 @@
+
+(define r-list '(3 7 12 19 25 8 14 30 5 22 17 11))
+
+(defun cmp (x y)
+  {
+  (gc)
+  (> x y)
+  })
+
+(defun f (x)
+  (if (= x 0)
+      t
+    {
+    (sort cmp r-list)
+    (f (- x 1))
+    }))
+
+(check (f 5))
diff --git a/tests/test_sort_8.lisp b/tests/test_sort_8.lisp
new file mode 100644
index 00000000..5a90bb3d
--- /dev/null
+++ b/tests/test_sort_8.lisp
@@ -0,0 +1,13 @@
+
+(define r-list '(3 7 12 19 25 8 14 30 5 22 17 11))
+
+
+(defun f (x)
+  (if (= x 0)
+      t
+    {
+    (sort > r-list)
+    (f (- x 1))
+    }))
+
+(check (f 10000))
diff --git a/tests/test_sort_9.lisp b/tests/test_sort_9.lisp
new file mode 100644
index 00000000..872627cb
--- /dev/null
+++ b/tests/test_sort_9.lisp
@@ -0,0 +1,14 @@
+
+(define r-list '(3 7 12 19 25 8 14 30 5 22 17 11))
+
+
+(defun f (x)
+  (if (= x 0)
+      t
+    {
+    (sort > r-list)
+    (gc)
+    (f (- x 1))
+    }))
+
+(check (f 100))