Squashed 'lispBM/lispBM/' changes from 5f69e529..bad046b0

bad046b0 indentation fix
e7115787 bump version
fc2646ac slight improvements in read errors.
a3389b91 added env-get and env-set to runtime extensions
9ddb702d cleanup
b7472ae2 more details on flash error temporarily
0db26c7f slight cleanup, should be equivalent

git-subtree-dir: lispBM/lispBM
git-subtree-split: bad046b0ce19871caecdf061890744e6daaed095

include/lbm_defines.h

@@ -145,6 +145,7 @@
 #define SYM_TYPE_CHANNEL   0x5E
 
 //Relevant for the tokenizer and reader
+#define TOKENIZER_SYMBOLS_START 0x70
 #define SYM_OPENPAR          0x70
 #define SYM_CLOSEPAR         0x71
 #define SYM_BACKQUOTE        0x72
@@ -160,6 +161,7 @@
 #define SYM_TOKENIZER_RERROR 0x82
 #define SYM_OPENCURL         0x84
 #define SYM_CONST            0x85
+#define TOKENIZER_SYMBOLS_END 0x85
 
 // Built in special forms:
 // Special forms get their arguments unevaluated

include/lbm_version.h

@@ -27,12 +27,20 @@ extern "C" {
 /** LBM major version */
 #define LBM_MAJOR_VERSION 0
 /** LBM minor version */
-#define LBM_MINOR_VERSION 14
+#define LBM_MINOR_VERSION 15
 /** LBM patch revision */
 #define LBM_PATCH_VERSION 0
 
 /*! \page changelog Changelog
 
+JUN 29 2023: version 0.15.0
+  - Bug fix in lift_array_flash.
+  - Bug fix in map.
+  - Bug fix in reader.
+  - Bug fix in dynamic load.
+  - Bug fix in quasiquotation expansion.
+  - 
+
 JUN 8 2023: Version 0.14.0
   - wait-for that blocks code unless a flag is set.
   - Bug fix in undefine.

repl/repl.c

@@ -54,8 +54,19 @@ lbm_uint constants_memory[CONSTANT_MEMORY_SIZE];
 
 bool const_heap_write(lbm_uint ix, lbm_uint w) {
   if (ix >= CONSTANT_MEMORY_SIZE) return false;
-  constants_memory[ix] = w;
-  return true;
+  if (constants_memory[ix] == 0xffffffff) {
+    constants_memory[ix] = w;
+    return true;
+  } else if (constants_memory[ix] == w) {
+    return true;
+  }
+
+  char buf[1024];
+  lbm_print_value(buf, 1024, constants_memory[ix]);
+  printf("prev: %x | %s\n", constants_memory[ix], buf);
+  lbm_print_value(buf, 1024, w);
+  printf("curr: %x | %s\n", w, buf);
+  return false;
 }
 
 static volatile bool allow_print = true;
@@ -514,6 +525,7 @@ int main(int argc, char **argv) {
     return 0;
   }
 
+  memset(constants_memory, 0xFF, CONSTANT_MEMORY_SIZE * sizeof(lbm_uint));
   if (!lbm_const_heap_init(const_heap_write,
                            &const_heap,constants_memory,
                            CONSTANT_MEMORY_SIZE)) {
@@ -717,6 +729,14 @@ int main(int argc, char **argv) {
                  print_stack_storage, PRINT_STACK_SIZE,
                  extension_storage, EXTENSION_STORAGE_SIZE);
 
+        if (!lbm_const_heap_init(const_heap_write,
+                           &const_heap,constants_memory,
+                           CONSTANT_MEMORY_SIZE)) {
+          return 0;
+        } else {
+          printf("Constants memory initialized\n");
+        }
+  
         lbm_variables_init(variable_storage, VARIABLE_STORAGE_SIZE);
 
         if (lbm_array_extensions_init()) {
@@ -759,6 +779,14 @@ int main(int argc, char **argv) {
                print_stack_storage, PRINT_STACK_SIZE,
                extension_storage, EXTENSION_STORAGE_SIZE);
 
+      if (!lbm_const_heap_init(const_heap_write,
+                               &const_heap,constants_memory,
+                               CONSTANT_MEMORY_SIZE)) {
+        return 0;
+      } else {
+        printf("Constants memory initialized\n");
+      }
+  
       lbm_variables_init(variable_storage, VARIABLE_STORAGE_SIZE);
 
       if (lbm_array_extensions_init()) {
@@ -779,6 +807,50 @@ int main(int argc, char **argv) {
         printf("Loading math extensions failed\n");
       }
 
+      if (lbm_runtime_extensions_init(false)) {
+        printf("Runtime extensions loaded\n");
+      } else {
+        printf("Loading runtime extensions failed\n");
+      }
+
+      res = lbm_add_extension("block", ext_block);
+      if (res)
+        printf("Extension added.\n");
+      else
+        printf("Error adding extension.\n");
+
+      res = lbm_add_extension("print", ext_print);
+      if (res)
+        printf("Extension added.\n");
+      else
+        printf("Error adding extension.\n");
+
+      res = lbm_add_extension("custom", ext_custom);
+      if (res)
+        printf("Extension added.\n");
+      else
+        printf("Error adding extension.\n");
+
+      res = lbm_add_extension("event", ext_event);
+      if (res)
+        printf("Extension added.\n");
+      else
+        printf("Error adding extension.\n");
+
+      res = lbm_add_extension("unflatten", ext_unflatten);
+      if (res)
+        printf("Extension added.\n");
+      else
+        printf("Error adding extension.\n");
+
+      res = lbm_add_extension("trigger", ext_trigger);
+      if (res)
+        printf("Extension added.\n");
+      else
+        printf("Error adding extension.\n");
+
+      
+
       lbm_add_extension("print", ext_print);
       free(str);
     } else if (strncmp(str, ":send", 5) == 0) {

src/eval_cps.c

@@ -2786,6 +2786,15 @@ static void read_finish(lbm_char_channel_t *str, eval_context_t *ctx) {
      In case 2, we should find the READ_DONE at sp - 5.
 
   */
+
+  if (lbm_is_symbol(ctx->r)) {
+    lbm_uint sym_val = lbm_dec_sym(ctx->r);
+    if (sym_val >= TOKENIZER_SYMBOLS_START &&
+        sym_val <= TOKENIZER_SYMBOLS_END) {
+      read_error_ctx(lbm_channel_row(str), lbm_channel_column(str));
+    }
+  }
+
   if (ctx->K.data[ctx->K.sp-1] == READ_DONE &&
       lbm_dec_u(ctx->K.data[ctx->K.sp-3]) == 0) {
     /* successfully finished reading an expression  (CASE 3) */
@@ -2878,6 +2887,7 @@ static void cont_read_next_token(eval_context_t *ctx) {
                    stream,
                    READ_APPEND_CONTINUE);
       stack_push_3(&ctx->K, stream, lbm_enc_u(0), READ_NEXT_TOKEN);
+      ctx->r = ENC_SYM_OPENPAR;
       return;
     case TOKCLOSEPAR: {
       lbm_stack_drop(&ctx->K, 2);
@@ -2888,6 +2898,7 @@ static void cont_read_next_token(eval_context_t *ctx) {
       sptr[1] = READ_START_ARRAY;
       //stack_push_2(&ctx->K, stream, READ_START_ARRAY);
       stack_push_3(&ctx->K, stream, lbm_enc_u(0), READ_NEXT_TOKEN);
+      ctx->r = ENC_SYM_OPENBRACK;
       return;
     case TOKCLOSEBRACK:
       lbm_stack_drop(&ctx->K, 2);
@@ -3337,6 +3348,13 @@ static void cont_read_done(eval_context_t *ctx) {
   }
 
   lbm_channel_reader_close(str);
+  if (lbm_is_symbol(ctx->r)) {
+    lbm_uint sym_val = lbm_dec_sym(ctx->r);
+    if (sym_val >= TOKENIZER_SYMBOLS_START &&
+        sym_val <= TOKENIZER_SYMBOLS_END) {
+      read_error_ctx(lbm_channel_row(str), lbm_channel_column(str));
+    }
+  }
   
   ctx->row0 = -1;
   ctx->row1 = -1;
@@ -3730,11 +3748,8 @@ lbm_value quote_it(lbm_value qquoted) {
   if (lbm_is_symbol(qquoted) &&
       lbm_is_special(qquoted)) return qquoted;
 
-  lbm_value val;
-  WITH_GC_RMBR(val, lbm_cons(qquoted, ENC_SYM_NIL), 1, qquoted);
-  lbm_value q;
-  WITH_GC_RMBR(q, lbm_cons(ENC_SYM_QUOTE, val), 1, val);
-  return q;
+  lbm_value val = cons_with_gc(qquoted, ENC_SYM_NIL, ENC_SYM_NIL);
+  return cons_with_gc(ENC_SYM_QUOTE, val, ENC_SYM_NIL);
 }
 
 bool is_append(lbm_value a) {
@@ -3768,20 +3783,15 @@ lbm_value append(lbm_value front, lbm_value back) {
 
   if (is_append(back)) {
     back  = lbm_cdr(back);
-    lbm_value new;
-    WITH_GC_RMBR(new, lbm_cons(front, back), 2, front, back);
-    lbm_value tmp;
-    WITH_GC_RMBR(tmp, lbm_cons(ENC_SYM_APPEND, new), 1, new);
-    return tmp;
+    lbm_value new = cons_with_gc(front, back, ENC_SYM_NIL);
+    return cons_with_gc(ENC_SYM_APPEND, new, ENC_SYM_NIL);
   }
 
-  lbm_value t0, t1, t2;
+  lbm_value t0, t1;
 
-  WITH_GC(t0, lbm_cons(back, ENC_SYM_NIL));
-  WITH_GC_RMBR(t1, lbm_cons(front, t0), 1, t0);
-  WITH_GC_RMBR(t2, lbm_cons(ENC_SYM_APPEND, t1), 1, t1);
-  
-  return t2;
+  t0 = cons_with_gc(back, ENC_SYM_NIL, ENC_SYM_NIL);
+  t1 = cons_with_gc(front, t0, ENC_SYM_NIL);
+  return cons_with_gc(ENC_SYM_APPEND, t1, ENC_SYM_NIL);
 }
 
 /* Bawden's qq-expand implementation
@@ -3888,12 +3898,9 @@ static void cont_qq_expand_list(eval_context_t* ctx) {
     
   } break;
   default: {
-    lbm_value a_list;
-    WITH_GC(a_list, lbm_cons(l, ENC_SYM_NIL));
-    lbm_value tl;
-    WITH_GC_RMBR(tl, lbm_cons(a_list, ENC_SYM_NIL), 1, a_list);
-    lbm_value tmp;
-    WITH_GC_RMBR(tmp, lbm_cons(ENC_SYM_QUOTE, tl), 1, tl);
+    lbm_value a_list = cons_with_gc(l, ENC_SYM_NIL, ENC_SYM_NIL);
+    lbm_value tl = cons_with_gc(a_list, ENC_SYM_NIL, ENC_SYM_NIL);
+    lbm_value tmp = cons_with_gc(ENC_SYM_QUOTE, tl, ENC_SYM_NIL);
     ctx->r = append(ctx->r, tmp);
     ctx->app_cont = true;
   }
@@ -3902,10 +3909,8 @@ static void cont_qq_expand_list(eval_context_t* ctx) {
 
 static void cont_qq_list(eval_context_t *ctx) {
   lbm_value val = ctx->r;
-  lbm_value apnd_app;
-  lbm_value tmp;
-  WITH_GC(apnd_app, lbm_cons(val, ENC_SYM_NIL));
-  WITH_GC_RMBR(tmp, lbm_cons(ENC_SYM_LIST, apnd_app), 1, apnd_app);
+  lbm_value apnd_app = cons_with_gc(val, ENC_SYM_NIL, ENC_SYM_NIL);
+  lbm_value tmp = cons_with_gc(ENC_SYM_LIST, apnd_app, ENC_SYM_NIL);
   ctx->r = tmp;
   ctx->app_cont = true;
 }

src/extensions/runtime_extensions.c

@@ -21,6 +21,7 @@
 #include <extensions.h>
 #include <lbm_utils.h>
 #include <lbm_version.h>
+#include <env.h>
 
 static lbm_uint sym_heap_size;
 static lbm_uint sym_heap_bytes;
@@ -123,6 +124,19 @@ lbm_value ext_lbm_heap_state(lbm_value *args, lbm_uint argn) {
   return res;
 }
 
+lbm_value ext_env_get(lbm_value *args, lbm_uint argn) {
+  (void)args;
+  (void)argn;
+  return lbm_get_env();
+}
+
+lbm_value ext_env_set(lbm_value *args, lbm_uint argn) {
+  if (argn == 1) {
+    *lbm_get_env_ptr() = args[0];
+    return ENC_SYM_TRUE;
+  }
+  return ENC_SYM_NIL;
+}
 bool lbm_runtime_extensions_init(bool minimal) {
 
   if (!minimal) {
@@ -152,6 +166,8 @@ bool lbm_runtime_extensions_init(bool minimal) {
     res = res && lbm_add_extension("word-size", ext_memory_word_size);
     res = res && lbm_add_extension("lbm-version", ext_lbm_version);
     res = res && lbm_add_extension("lbm-heap-state", ext_lbm_heap_state);
+    res = res && lbm_add_extension("env-get", ext_env_get);
+    res = res && lbm_add_extension("env-set", ext_env_set);
   }
   return res;
 }

src/symrepr.c

@@ -346,7 +346,6 @@ int lbm_add_symbol(char *name, lbm_uint* id) {
   }
 
   *id = next_symbol_id ++;
-
   return 1;
 }