Squashed 'lispBM/lispBM/' changes from 202b5763..55553f58

55553f58 hash table of environments for faster lookups
4c559b1f small tweak to env lookup
ef9dead0 A fix to a bug in GC handling of callcc continuations. Temporary, may change fix approach later
63868a8f closed a waring in array extensions
3135b7ec update of benchmarking with a sort benchmark that runs sort 10 times on 500 elt
44ec82cd remove a file that is nolonger in use
123717aa upped version

git-subtree-dir: lispBM/lispBM
git-subtree-split: 55553f580b75dfd66ab00491ed4ff234daf31b0b

benchmarks/bench_chibi/main.c

@@ -39,7 +39,7 @@
 #define EVAL_CPS_STACK_SIZE 256
 #define GC_STACK_SIZE 256
 #define PRINT_STACK_SIZE 256
-#define HEAP_SIZE 2048
+#define HEAP_SIZE 4096
 #define VARIABLE_STORAGE_SIZE 256
 #define EXTENSION_STORAGE_SIZE 256
 
@@ -153,7 +153,8 @@ lbm_value ext_print(lbm_value *args, lbm_uint argn) {
 
 static char str[1024];
 static char outbuf[1024];
-static char file_buffer[2048];
+#define FILE_LEN 8192
+static char file_buffer[FILE_LEN];
 
 void print_ctx_info(eval_context_t *ctx, void *arg1, void *arg2) {
   (void)arg2;
@@ -252,13 +253,16 @@ int main(void) {
       chprintf(chp,"------------------------------------------------------------\r\n");
       memset(outbuf,0, 1024);
     } else if (strncmp(str, ":env", 4) == 0) {
-      lbm_value curr = *lbm_get_env_ptr();
+      lbm_value *glob_env = lbm_get_global_env();
-      chprintf(chp,"Environment:\r\n");
+      for (int i = 0; i < GLOBAL_ENV_ROOTS; i ++) {
-      while (lbm_type_of(curr) == LBM_TYPE_CONS) {
+        lbm_value curr = glob_env[i];
-        res = lbm_print_value(outbuf,1024, lbm_car(curr));
+        chprintf(chp,"Global Environment [%d]:\r\n", i);
-        curr = lbm_cdr(curr);
+        while (lbm_type_of(curr) == LBM_TYPE_CONS) {
+          res = lbm_print_value(outbuf,1024, lbm_car(curr));
+          curr = lbm_cdr(curr);
 
-        chprintf(chp,"  %s \r\n", outbuf);
+          chprintf(chp,"  %s \r\n", outbuf);
+        }
       }
     } else if (strncmp(str, ":threads", 8) == 0) {
       thread_t *tp;
@@ -314,11 +318,11 @@ int main(void) {
 
       break;
     } else if (strncmp(str, ":read", 5) == 0) {
-      memset(file_buffer, 0, 2048);
+      memset(file_buffer, 0, FILE_LEN);
       bool done = false;
       int c;
 
-      for (int i = 0; i < 2048; i ++) {
+      for (int i = 0; i < FILE_LEN; i ++) {
         c = streamGet(chp);
 
         if (c == 4 || c == 26 || c == STM_RESET) {

benchmarks/plot_bench.py

@@ -1,19 +1,22 @@
 from glob import glob
 import pandas as pd
 import matplotlib.pyplot as plt
+import numpy as np
 
 bench_files = glob('stored_results/*')
 headers = ('File','Eval time (s)')
 
 benches = ['q2.lisp', 'fibonacci_tail.lisp', 'dec_cnt3.lisp',
            'dec_cnt1.lisp', 'fibonacci.lisp', 'tak.lisp',
-           'dec_cnt2.lisp', 'insertionsort.lisp', 'tail_call_200k.lisp', 'loop_200k.lisp' ]
+           'dec_cnt2.lisp', 'insertionsort.lisp', 'tail_call_200k.lisp',
+           'loop_200k.lisp', 'sort500.lisp' ]
 
 data = []
 
 plt.figure(figsize=(10.0, 5.0)) # in inches!
-
+cmap = plt.get_cmap('jet')
-for bench in benches:
+colors = cmap(np.linspace(0, 1.0, len(benches)))
+for bench, color in zip(benches,colors):
     dict = {}
     for file in bench_files:
         file_info = file.split('benchresult')[1]
@@ -25,12 +28,12 @@ for bench in benches:
         if (bench in df.index):
             row = df.loc[bench]
             dict.update({date : row[1]});
-        else:
+        # else:
-            print("missing data point ", bench, file )
+        #     print("missing data point ", bench, file )
                         
     lists = sorted(dict.items()) # sorted by key, return a list of tuples
     x, y = zip(*lists) # unpack a list of pairs into two tuples
-    plt.plot(x, y, label=bench)
+    plt.plot(x, y, label=bench, color=color)
 
 
 lgd = plt.legend(loc='center left', bbox_to_anchor=(1, 0.5))
@@ -39,6 +42,7 @@ for tick in ax.get_xticklabels():
     tick.set_rotation(90)
 ax.tick_params(axis='both', which='major', labelsize=6)
 ax.tick_params(axis='both', which='minor', labelsize=4)
+ax.set_facecolor("lightgray");
 plt.ylabel("Sec")
 plt.grid()
 plt.savefig('benchresults.png', dpi=600, bbox_extra_artists=(lgd,), bbox_inches='tight')     

benchmarks/sort500.lisp

@@ -0,0 +1,13 @@
+(def random-list '(19 56 73 42 8 91 3 67 27 10 55 94 38 62 5 80 49 12 74 23 31 98 17 69 45 2 86 29 61 78 14 52 99 36 70 25 83 7 44 58 20 96 34 68 9 50 76 15 64 1 82 39 85 18 54 97 33 71 26 59 6 93 40 72 13 81 47 4 66 22 87 28 63 79 11 53 90 37 75 24 32 89 16 60 77 21 95 35 65 0 51 88 30 58 48 9 13 26 47 82 19 56 73 42 8 91 3 67 27 10 55 94 38 62 5 80 49 12 74 23 31 98 17 69 45 2 86 29 61 78 14 52 99 36 70 25 83 7 44 58 20 96 34 68 9 50 76 15 64 1 82 39 85 18 54 97 33 71 26 59 6 93 40 72 13 81 47 4 66 22 87 28 63 79 11 53 90 37 75 24 32 89 16 60 77 21 95 35 65 0 51 88 30 58 48 9 13 26 47 82 19 56 73 42 8 91 3 67 27 10 55 94 38 62 5 80 49 12 74 23 31 98 17 69 45 2 86 29 61 78 14 52 99 36 70 25 83 7 44 58 20 96 34 68 9 50 76 15 64 1 82 39 85 18 54 97 33 71 26 59 6 93 40 72 13 81 47 4 66 22 87 28 63 79 11 53 90 37 75 24 32 89 16 60 77 21 95 35 65 0 51 88 30 58 48 9 13 26 47 82 19 56 73 42 8 91 3 67 27 10 55 94 38 62 5 80 49 12 74 23 31 98 17 69 45 2 86 29 61 78 14 52 99 36 70 25 83 7 44 58 20 96 34 68 9 50 76 15 64 1 82 39 85 18 54 97 33 71 26 59 6 93 40 72 13 81 47 4 66 22 87 28 63 79 11 53 90 37 75 24 32 89 16 60 77 21 95 35 65 0 51 88 30 58 48 9 13 26 47 82 19 56 73 42 8 91 3 67 27 10 55 94 38 62 5 80 49 12 74 23 31 98 17 69 45 2 86 29 61 78 14 52 99 36 70 25 83 7 44 58 20 96 34 68 9 50 76 15 64 1 82 39 85 18 54 97 33 71 26 59 6 93 40 72 13 81 47 4 66 22 87 28 63 79 11 53 90 37 75 24 32 89 16 60 77 21 95 35 65 0 51 88 30 58 48 9 13 26 47 82 19 56 73 42 8 91 3 67 27 10 55 94 38 62 5 80 49 12 74 23 31 98 17 69 45 2 86 29 61 78 14 52 99 36 70 25 83 7 44 58 20 96 34 68 9 50 76 15 64 1 82 39 85 18 54 97 33 71 26 59 6 93 40 72 13 81 47 4 66 22 87 28 63 79 11 53 90 37 75 24 32 89 16 60 77 21 95 35 65 0 51 88 30 58 48 9 13 26 47 82 19 56 73 42 8 91 3 67 27 10 55 94 38 62 5 80 49 12 74 23 31 98 17 69 45 2 86 29 61 78 14 52 99 36 70 25 83 7 44 58 20 96 34 68 9 50 76 15 64 1 82 39 85 18 54 97 33 71 26 59 6 93 40 72 13 81 47 4 66 22 87 28 63 79 11 53 90 37 75 24 32 89 16 60 77 21 95 35 65 0 51 88 30 58 48 9 13 26 47 82 19 56 73 42 8 91 3 67 27 10 55 94 38 62 5 80 49 12 74 23 31 98 17 69 45 2 86 29 61 78 14 52 99 36 70 25 83 7 44 58 20 96 34 68 9 50 76 15 64 1 82 39 85 18 54 97 33 71 26 59 6 93 40 72 13 81 47 4 66 22 87 28 63 79 11 53 90 37 75 24 32 89 16 60 77 21 95 35 65 0 51 88 30 58 48 9 13 26 47 82 19 56 73 42 8 91 3 67 27 10 55 94 38 62 5 80 49 12 74 23 31 98 17 69 45 2 86 29 61 78 14 52 99 36 70 25 83 7 44 58 20 96 34 68 9 50 76 15 64 1 82 39 85 18 54 97 33 71 26 59 6 93 40 72 13 81 47 4 66 22 87 28 63 79 11 53 90 37 75 24 32 89 16 60 77 21 95 35 65 0 51 88 30 58 48 9 13 26 47 82 19 56 73 42 8 91 3 67 27 10 55 94 38 62 5 80 49 12 74 23 31 98 17 69 45 2 86 29 61 78 14 52 99 36 70 25 83 7 44 58 20 96 34 68 9 50 76 15 64 1 82 39 85 18 54 97 33 71 26 59 6 93 40 72 13 81 47 4 66 22 87 28 63 79 11 53 90 37 75 24 32 89 16 60 77 21 95 35 65 0 51 88 30 58 48 9 13 26 47 82 ))
+
+
+(sort < random-list)
+(sort < random-list)
+(sort < random-list)
+(sort < random-list)
+(sort < random-list)
+(sort < random-list)
+(sort < random-list)
+(sort < random-list)
+(sort < random-list)
+(sort < random-list)

experiment_repl/repl.c

@@ -304,7 +304,7 @@ bool dyn_load(const char *str, const char **code) {
     *code = "(define looprange (macro (it start end body) (me-looprange it start end body)))";
     res = true;
   }
-  
+
   return res;
 }
 
@@ -724,7 +724,7 @@ int main(int argc, char **argv) {
     printf("Extension added.\n");
   else
     printf("Error adding extension.\n");
-  
+
   lbm_add_symbol_const("a01", &sym_res);
   lbm_add_symbol_const("a02", &sym_loop);
   lbm_add_symbol_const("break", &sym_break);
@@ -815,12 +815,15 @@ int main(int argc, char **argv) {
       printf("Total:\t%u samples\n", tot_samples);
       free(str);
     } else if (strncmp(str, ":env", 4) == 0) {
-      lbm_value curr = *lbm_get_env_ptr();
+      for (int i = 0; i < GLOBAL_ENV_ROOTS; i ++) {
-      printf("Environment:\r\n");
+        lbm_value *env = lbm_get_global_env();
-      while (lbm_type_of(curr) == LBM_TYPE_CONS) {
+        lbm_value curr = env[i];
-        res = lbm_print_value(output,1024, lbm_car(curr));
+        printf("Environment [%d]:\r\n", i);
-        curr = lbm_cdr(curr);
+        while (lbm_type_of(curr) == LBM_TYPE_CONS) {
-        printf("  %s\r\n",output);
+          res = lbm_print_value(output,1024, lbm_car(curr));
+          curr = lbm_cdr(curr);
+          printf("  %s\r\n",output);
+        }
       }
       printf("Variables:\r\n");
       for (int i = 0; i < lbm_get_num_variables(); i ++) {

include/env.h

@@ -25,22 +25,20 @@
 extern "C" {
 #endif
 
+#define GLOBAL_ENV_ROOTS 32
+#define GLOBAL_ENV_MASK  0x1F
+
 //environment interface
 /** Initialize the global environment. This sets the global environment to NIL
  *
  * \return 1
  */
 int lbm_init_env(void);
-/**
- * Get a pointer to the global environment.
- * \return A pointer to the global environment variable.
- */
-lbm_value *lbm_get_env_ptr(void);
 /**
  *
  * \return the global environment
  */
-lbm_value lbm_get_env(void);
+lbm_value *lbm_get_global_env(void);
 /** Copy the spine of an environment. The list structure is
  * recreated but the values themselves are not copied but rather
  * just referenced.
@@ -49,13 +47,20 @@ lbm_value lbm_get_env(void);
  * \return Copy of environment.
  */
 lbm_value lbm_env_copy_spine(lbm_value env);
-/** Lookup a value in from the global environment.
+/** Lookup a value in an environment.
- *
+ * \param res Result stored here
  * \param sym The key to look for in the environment
  * \param env The environment to search for the key.
- * \return The value bound to key or lbm_enc_sym(SYM_NOT_FOUND).
+ * \return True on success or false otherwise.
  */
 bool lbm_env_lookup_b(lbm_value *res, lbm_value sym, lbm_value env);
+/** Lookup a value in the global environment.
+ * \param res Result stored here
+ * \param sym The key to look for in the environment
+ * \param env The environment to search for the key.
+ * \return True on success or false otherwise.
+ */
+bool lbm_global_env_lookup(lbm_value *res, lbm_value sym);
 /** Lookup a value in from the global environment.
  *
  * \param sym The key to look for in the environment

include/lbm_version.h

@@ -27,13 +27,20 @@ extern "C" {
 /** LBM major version */
 #define LBM_MAJOR_VERSION 0
 /** LBM minor version */
-#define LBM_MINOR_VERSION 21
+#define LBM_MINOR_VERSION 22
 /** LBM patch revision */
 #define LBM_PATCH_VERSION 0
 
-#define LBM_VERSION_STRING "0.21.0"
+#define LBM_VERSION_STRING "0.22.0"
 
 /*! \page changelog Changelog
+DEC 26 2024: Version 0.22.0
+  - Built-in sort operation on lists.
+  - Built-in list-merge operation.
+  - Bugfix in map.
+  - Literal forms for special characters.
+
+
 NOV 28 2024: Version 0.21.0
   - Removed partial evaluation.
   - Added a built-in loop.

include/qq_expand.h

@@ -1,37 +0,0 @@
-/*
-    Copyright 2020 Joel Svensson        svenssonjoel@yahoo.se
-
-    This program is free software: you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation, either version 3 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program.  If not, see <http://www.gnu.org/licenses/>.
-*/
-/** \file qq_expand.h  */
-
-#ifndef _QQ_EXPAND_H
-#define _QQ_EXPAND_H
-
-#ifdef __cplusplus
-extern "C" {
-#endif
-
-/** Expand a quasiquoted expression using a C:ified
- *  version of the algorithm presented in Alan Bawden's "Quasiquotation in lisp"
- *
- * \param Quasiquoted value
- * \return value where quasiquotations have been removed and expanded.
- */
-lbm_value lbm_qq_expand(lbm_value);
-
-#ifdef __cplusplus
-}
-#endif
-#endif

src/env.c

@@ -1,5 +1,5 @@
 /*
-    Copyright 2018, 2020, 2021 Joel Svensson    svenssonjoel@yahoo.se
+    Copyright 2018, 2020, 2021, 2024 Joel Svensson    svenssonjoel@yahoo.se
 
     This program is free software: you can redistribute it and/or modify
     it under the terms of the GNU General Public License as published by
@@ -21,19 +21,21 @@
 #include "symrepr.h"
 #include "heap.h"
 #include "print.h"
+#include "env.h"
+#include "lbm_memory.h"
 
-static lbm_value env_global;
+static lbm_value *env_global;
 
 int lbm_init_env(void) {
-  env_global = ENC_SYM_NIL;
+  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;
+  }
   return 1;
 }
 
-lbm_value *lbm_get_env_ptr(void) {
+lbm_value *lbm_get_global_env(void) {
-  return &env_global;
-}
-
-lbm_value lbm_get_env(void) {
   return env_global;
 }
 
@@ -61,10 +63,21 @@ bool lbm_env_lookup_b(lbm_value *res, lbm_value sym, lbm_value env) {
 
   lbm_value curr = env;
 
-  if (lbm_is_symbol_nil(sym)) {
+  while (lbm_is_ptr(curr)) {
-    *res = sym;
+    lbm_value c = lbm_ref_cell(curr)->car;
-    return true;
+    if ((lbm_ref_cell(c)->car) == sym) {
+      *res = lbm_ref_cell(c)->cdr;
+      return true;
+    }
+    curr = lbm_ref_cell(curr)->cdr;
   }
+  return false;
+}
+
+bool lbm_global_env_lookup(lbm_value *res, lbm_value sym) {
+  lbm_uint dec_sym = lbm_dec_sym(sym);
+  lbm_uint ix = dec_sym & GLOBAL_ENV_MASK;
+  lbm_value curr = env_global[ix];
 
   while (lbm_is_ptr(curr)) {
     lbm_value c = lbm_ref_cell(curr)->car;
@@ -80,10 +93,6 @@ bool lbm_env_lookup_b(lbm_value *res, lbm_value sym, lbm_value env) {
 lbm_value lbm_env_lookup(lbm_value sym, lbm_value env) {
   lbm_value curr = env;
 
-  if(lbm_dec_sym(sym) == SYM_NIL) {
-    return sym;
-  }
-
   while (lbm_type_of(curr) == LBM_TYPE_CONS) {
     if (lbm_car(lbm_car(curr)) == sym) {
       return lbm_cdr(lbm_car(curr));

src/eval_cps.c

@@ -1,5 +1,5 @@
 /*
-    Copyright 2018, 2020, 2021, 2022, 2023 Joel Svensson    svenssonjoel@yahoo.se
+    Copyright 2018, 2020 - 2024 Joel Svensson    svenssonjoel@yahoo.se
 
     This program is free software: you can redistribute it and/or modify
     it under the terms of the GNU General Public License as published by
@@ -26,7 +26,6 @@
 #include "extensions.h"
 #include "exp_kind.h"
 #include "tokpar.h"
-#include "qq_expand.h"
 #include "lbm_variables.h"
 #include "lbm_channel.h"
 #include "print.h"
@@ -637,7 +636,7 @@ static void call_fundamental(lbm_uint fundamental, lbm_value *args, lbm_uint arg
 }
 
 // block_current_ctx blocks a context until it is
-// woken up externally of a timeout period of time passes.
+// woken up externally or a timeout period of time passes.
 static void block_current_ctx(uint32_t state, lbm_uint sleep_us,  bool do_cont) {
   ctx_running->timestamp = timestamp_us_callback();
   ctx_running->sleep_us = sleep_us;
@@ -676,9 +675,7 @@ lbm_flash_status lbm_write_const_array_padded(uint8_t *data, lbm_uint n, lbm_uin
 
 void print_environments(char *buf, unsigned int size) {
 
-  lbm_value curr_g = lbm_get_env();
   lbm_value curr_l = ctx_running->curr_env;
-
   printf_callback("\tCurrent local environment:\n");
   while (lbm_type_of(curr_l) == LBM_TYPE_CONS) {
 
@@ -687,19 +684,23 @@ void print_environments(char *buf, unsigned int size) {
     printf_callback("\t%s = %s\n", buf, buf+(size/2));
     curr_l = lbm_cdr(curr_l);
   }
-
   printf_callback("\n\n");
   printf_callback("\tCurrent global environment:\n");
-  while (lbm_type_of(curr_g) == LBM_TYPE_CONS) {
+  lbm_value *glob_env = lbm_get_global_env();
 
-    lbm_print_value(buf, (size/2) - 1, lbm_caar(curr_g));
+  for (int i = 0; i < GLOBAL_ENV_ROOTS; i ++) {
-    lbm_print_value(buf + (size/2),size/2, lbm_cdr(lbm_car(curr_g)));
+    printf("Global Environment Ix: %d\n", i);
-    printf_callback("\t%s = %s\n", buf, buf+(size/2));
+    lbm_value curr_g = glob_env[i];;
-    curr_g = lbm_cdr(curr_g);
+    while (lbm_type_of(curr_g) == LBM_TYPE_CONS) {
+
+      lbm_print_value(buf, (size/2) - 1, lbm_caar(curr_g));
+      lbm_print_value(buf + (size/2),size/2, lbm_cdr(lbm_car(curr_g)));
+      printf_callback("\t%s = %s\n", buf, buf+(size/2));
+      curr_g = lbm_cdr(curr_g);
+    }
   }
 }
 
-
 void print_error_message(lbm_value error, bool has_at, lbm_value at, unsigned int row, unsigned int col, lbm_int row0, lbm_int row1) {
   if (!printf_callback) return;
 
@@ -1505,7 +1506,10 @@ static int gc(void) {
   }
   // The freelist should generally be NIL when GC runs.
   lbm_nil_freelist();
-  lbm_gc_mark_env(lbm_get_env());
+  lbm_value *env = lbm_get_global_env();
+  for (int i = 0; i < GLOBAL_ENV_ROOTS; i ++) {
+    lbm_gc_mark_env(env[i]);
+  }
 
   mutex_lock(&qmutex); // Lock the queues.
                        // Any concurrent messing with the queues
@@ -1538,12 +1542,14 @@ int lbm_perform_gc(void) {
 /****************************************************/
 /* Evaluation functions                             */
 
+
+
 static void eval_symbol(eval_context_t *ctx) {
   lbm_uint s = lbm_dec_sym(ctx->curr_exp);
   if (s >= RUNTIME_SYMBOLS_START) {
     lbm_value res;
     if (lbm_env_lookup_b(&res, ctx->curr_exp, ctx->curr_env) ||
-        lbm_env_lookup_b(&res, ctx->curr_exp, lbm_get_env())) {
+        lbm_global_env_lookup(&res, ctx->curr_exp)) {
       ctx->r =  res;
       ctx->app_cont = true;
       return;
@@ -1998,11 +2004,15 @@ static void cont_set_global_env(eval_context_t *ctx){
   lbm_value val = ctx->r;
 
   lbm_pop(&ctx->K, &key);
+  lbm_uint dec_key = lbm_dec_sym(key);
+  lbm_uint ix_key  = dec_key & GLOBAL_ENV_MASK;
+  lbm_value *global_env = lbm_get_global_env();
+  lbm_uint orig_env = global_env[ix_key];
   lbm_value new_env;
   // A key is a symbol and should not need to be remembered.
-  WITH_GC(new_env, lbm_env_set(*lbm_get_env_ptr(),key,val));
+  WITH_GC(new_env, lbm_env_set(orig_env,key,val));
 
-  *lbm_get_env_ptr() = new_env;
+  global_env[ix_key] = new_env;
   ctx->r = val;
 
   ctx->app_cont = true;
@@ -2085,7 +2095,10 @@ static lbm_value perform_setvar(lbm_value key, lbm_value val, lbm_value env) {
   } else if (s >= RUNTIME_SYMBOLS_START) {
     lbm_value new_env = lbm_env_modify_binding(env, key, val);
     if (lbm_is_symbol(new_env) && new_env == ENC_SYM_NOT_FOUND) {
-      new_env = lbm_env_modify_binding(lbm_get_env(), key, val);
+      lbm_uint ix_key = lbm_dec_sym(key) & GLOBAL_ENV_MASK;
+      lbm_value *glob_env = lbm_get_global_env();
+      new_env = lbm_env_modify_binding(glob_env[ix_key], key, val);
+      glob_env[ix_key] = new_env;
     }
     if (lbm_is_symbol(new_env) && new_env == ENC_SYM_NOT_FOUND) {
       lbm_set_error_reason((char*)lbm_error_str_variable_not_bound);
@@ -4101,7 +4114,7 @@ static void cont_move_to_flash(eval_context_t *ctx) {
   get_car_and_cdr(args, &first_arg, &rest);
 
   lbm_value val;
-  if (lbm_is_symbol(first_arg) && lbm_env_lookup_b(&val, first_arg, lbm_get_env())) {
+  if (lbm_is_symbol(first_arg) && lbm_global_env_lookup(&val, first_arg)) {
     // Prepare to copy the rest of the arguments when done with first.
     stack_push_2(&ctx->K, rest, MOVE_TO_FLASH);
     if (lbm_is_ptr(val) &&
@@ -4724,8 +4737,6 @@ lbm_cid lbm_eval_program_ext(lbm_value lisp, unsigned int stack_size) {
 }
 
 int lbm_eval_init() {
-  int res = 1;
-
   if (!qmutex_initialized) {
     mutex_init(&qmutex);
     qmutex_initialized = true;
@@ -4753,10 +4764,9 @@ int lbm_eval_init() {
   mutex_unlock(&lbm_events_mutex);
   mutex_unlock(&qmutex);
 
-  *lbm_get_env_ptr() = ENC_SYM_NIL;
+  if (!lbm_init_env()) return 0;
   eval_running = true;
-
+  return 1;
-  return res;
 }
 
 bool lbm_eval_init_events(unsigned int num_events) {

src/extensions/array_extensions.c

@@ -494,7 +494,7 @@ static lbm_float u_to_float(uint32_t v) {
 
   float sig = 0.0;
   if (e != 0 || sig_i != 0) {
-    sig = (float)sig_i / (8388608.0 * 2.0) + 0.5;
+    sig = (float)sig_i / (8388608.0f * 2.0f) + 0.5f;
     e -= 126;
   }
 

src/extensions/runtime_extensions.c

@@ -118,12 +118,18 @@ lbm_value ext_lbm_heap_state(lbm_value *args, lbm_uint argn) {
 lbm_value ext_env_get(lbm_value *args, lbm_uint argn) {
   (void)args;
   (void)argn;
-  return lbm_get_env();
+  if (argn == 1 && lbm_is_number(args[0])) {
+    lbm_uint ix = lbm_dec_as_u32(args[0]) & GLOBAL_ENV_MASK;
+    return lbm_get_global_env()[ix];
+  }
+  return ENC_SYM_TERROR;
 }
 
 lbm_value ext_env_set(lbm_value *args, lbm_uint argn) {
-  if (argn == 1) {
+  if (argn == 2 && lbm_is_number(args[0])) {
-    *lbm_get_env_ptr() = args[0];
+    lbm_uint ix = lbm_dec_as_u32(args[0]) & GLOBAL_ENV_MASK;
+    lbm_value *glob_env = lbm_get_global_env();
+    glob_env[ix] = args[1];
     return ENC_SYM_TRUE;
   }
   return ENC_SYM_NIL;

src/fundamental.c

@@ -714,28 +714,31 @@ static lbm_value fundamental_append(lbm_value *args, lbm_uint nargs, eval_contex
 
 static lbm_value fundamental_undefine(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
   (void) ctx;
-  lbm_value env = lbm_get_env();
+  lbm_value *global_env = lbm_get_global_env();
-  lbm_value new_env = env;
-  lbm_value result = ENC_SYM_EERROR;
   if (nargs == 1 && lbm_is_symbol(args[0])) {
-    result = lbm_env_drop_binding(env, args[0]);
+    lbm_value key = args[0];
-    if (result == ENC_SYM_NOT_FOUND) {
+    lbm_uint ix_key = lbm_dec_sym(key) & GLOBAL_ENV_MASK;
-      return env;
+    lbm_value env = global_env[ix_key];
+    lbm_value res = lbm_env_drop_binding(env, key);
+    if (res == ENC_SYM_NOT_FOUND) {
+      return ENC_SYM_NIL;
     }
-    *lbm_get_env_ptr() = result;
+    global_env[ix_key] = res;
+    return ENC_SYM_TRUE;
   } else if (nargs == 1 && lbm_is_cons(args[0])) {
     lbm_value curr = args[0];
     while (lbm_type_of(curr) == LBM_TYPE_CONS) {
       lbm_value key = lbm_car(curr);
-      result = lbm_env_drop_binding(new_env, key);
+      lbm_uint ix_key = lbm_dec_sym(key) & GLOBAL_ENV_MASK;
-      if (result != ENC_SYM_NOT_FOUND) {
+      lbm_value env = global_env[ix_key];
-        new_env = result;
+      lbm_value res = lbm_env_drop_binding(env, key);
+      if (res != ENC_SYM_NOT_FOUND) {
+        global_env[ix_key] = res;
       }
       curr = lbm_cdr(curr);
     }
-    *lbm_get_env_ptr() = new_env;
   }
-  return new_env;
+  return ENC_SYM_TRUE;
 }
 
 static lbm_value fundamental_buf_create(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {

src/heap.c

@@ -718,6 +718,18 @@ 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();

src/lbm_c_interop.c

@@ -126,10 +126,9 @@ lbm_cid lbm_eval_defined(char *symbol, bool program) {
     return 0;
   }
 
-  lbm_value binding = lbm_env_lookup(lbm_enc_sym(sym_id), *lbm_get_env_ptr());
+  lbm_value binding;
 
-  if (lbm_type_of(binding) == LBM_TYPE_SYMBOL &&
+  if (!lbm_global_env_lookup(&binding, lbm_enc_sym(sym_id))) {
-      lbm_dec_sym(binding) == SYM_NOT_FOUND) {
     return 0;
   }
 
@@ -214,7 +213,9 @@ int lbm_define(char *symbol, lbm_value value) {
           return 0;
         }
       }
-      *lbm_get_env_ptr() = lbm_env_set(lbm_get_env(), lbm_enc_sym(sym_id), value);
+      lbm_uint ix_key = sym_id & GLOBAL_ENV_MASK;
+      lbm_value *glob_env = lbm_get_global_env();
+      glob_env[ix_key] = lbm_env_set(glob_env[ix_key], lbm_enc_sym(sym_id), value);
     }
   }
   return res;
@@ -225,32 +226,13 @@ int lbm_undefine(char *symbol) {
   if (!lbm_get_symbol_by_name(symbol, &sym_id))
     return 0;
 
-  lbm_value *env = lbm_get_env_ptr();
+  lbm_value *glob_env = lbm_get_global_env();
-
+  lbm_uint ix_key = sym_id & GLOBAL_ENV_MASK;
-  lbm_value curr;
+  lbm_value new_env = lbm_env_drop_binding(glob_env[ix_key], lbm_enc_sym(sym_id));
-  lbm_value prev = *env;
-  int res  = 0;
-
-  while (lbm_dec_sym(lbm_car(lbm_car(prev))) == sym_id ) {
-    *env =lbm_cdr(prev);
-    prev = lbm_cdr(prev);
-    res = 1;
-  }
-
-  curr = lbm_cdr(prev);
-
-  while (lbm_type_of(curr) == LBM_TYPE_CONS) {
-    if (lbm_dec_sym(lbm_car(lbm_car(curr))) == sym_id) {
-
-      /* drop the curr mapping from the env */
-      lbm_set_cdr(prev, lbm_cdr(curr));
-      res = 1;
-    }
-    prev = curr;
-    curr = lbm_cdr(curr);
-  }
-  return res;
 
+  if (new_env == ENC_SYM_NOT_FOUND) return 0;
+  glob_env[ix_key] = new_env;
+  return 1;
 }
 
 int lbm_share_array(lbm_value *value, char *data, lbm_uint num_elt) {

src/tokpar.c

@@ -27,7 +27,6 @@
 #include "tokpar.h"
 #include "symrepr.h"
 #include "heap.h"
-#include "qq_expand.h"
 #include "env.h"
 
 char tokpar_sym_str[TOKENIZER_MAX_SYMBOL_AND_STRING_LENGTH];

tests/test_lisp_code_cps.c

@@ -514,13 +514,13 @@ int main(int argc, char **argv) {
     return FAIL;
   }
 
-  res = lbm_init_env();
+  /* res = lbm_init_env(); */
-  if (res)
+  /* if (res) */
-    printf("Environment initialized.\n");
+  /*   printf("Environment initialized.\n"); */
-  else {
+  /* else { */
-    printf("Error initializing environment.\n");
+  /*   printf("Error initializing environment.\n"); */
-    return FAIL;
+  /*   return FAIL; */
-  }
+  /* } */
 
   res = lbm_eval_init_events(20);
   if (res)