Merge commit 'a02f11d4d4487b4f7c07679f629a81cf94645c11'

lispBM/lispBM/.gitignore

@@ -63,3 +63,5 @@ dkms.conf
 *.xxd
 style.md
 repl-ChibiOS/build
+repl/repl
+tests/test_lisp_code_cps

lispBM/lispBM/doc/lbmref.lisp

@@ -571,8 +571,8 @@
                         ))
             (para (list "Some times evaluation is impossible. This could be because the program is malformed, a type mismatch or"
                         "a division by zero (among many other possibilities)."
-                        "Errors terminate the evaluation of the expression. To recover from an error and handle it"
+                        "Errors terminate the evaluation of the expression. To recover from an error"
-                        "the programmer needs to explicitly `trap` the error."
+                        "the programmer needs to explicitly `trap` it."
                         ))
             (code '((trap (/ 1 0 ))
                     ))
@@ -599,9 +599,11 @@
                   )
             
             (para (list "Symbols evaluate by a lookup in the environment."
-                        "First, the local environment is searched for a binding of the symbols."
+                        "First, the local environment is searched for a binding of the symbol."
                         "If unable to find a binding in the local environment, the global environment is searched."
-                        "If unable to find a binding in the global environment as well, an error `variable_not_bound` is triggered." 
+                        "If unable to find a binding in the global environment as well, the runtime system attempts to dynamically load"
+                        "a binding using a system provided callback function."
+                        "If all of the above fails to provide a value a `variable_not_bound` error is produced."
                         ))
             (para (list "**Composite forms**"
                         ))
@@ -610,7 +612,7 @@
                         "There are three major categories that `e1` can fall into. Either `e1` is something that"
                         "represents a function and `(e1 ... eN)` is a function application."
                         "Or `e1` is a so-called *special-form* that form the core of the LBM language."
-                        "Or lastly, `e1` is anything else than the above and the composite form is malformed ultimately resulting in an error."
+                        "Or lastly, `e1` is anything else and the composite form is malformed and will ultimately result in an error."
                         ))
             (para (list "The composite form `(e1 ... eN)` is evaluated by first checking if `e1` is a special form or not."
                          "if `e1` is a special form the composite form is passed to a special-form evaluator."
@@ -619,28 +621,34 @@
                          ))
             (para (list "**Special form evaluation**"
                         ))
-            (para (list "The special-forms in lispBM are:"
+            (para (list "Below are a selection of basic special-forms in lispBM together with their evaluation process"
                         ))
-            (bullet (list "quote"
+            (bullet (list "**quote**: `(quote a)` evaluates to a for any a"
-                          "define"
+                          "**define**: `(define s e)`, `e` is evaluated into `v` and the global environment is augmented with the pair `(s . v)`"
-                          "progn"
+                          "**lambda**: `(lambda params body)` is evaluated into '(closure params body env)`. `env` is the local environment there the lambda expression is evaluated."
-                          "lambda"
+                          "**if**: `(if e1 e2 e3)` is evaluated by evaluating `e1` into `v1` if `v1` is nil, `e3` is evaluated otherwise `e2` is evaluated."
-                          "if"
+			  "**progn**: `(progn e1 e2 ... eN)` is evaluated by evaluating `e1` then `e2` and so on until `eN`. The value `v` that `eN` evaluats into is the value `(progn e1 e2 ... eN)` evaluates to."
-                          "let"
+			  "**and**: `(and e1 e2 ... eN)` evaluates the `eI` expressions from left to right as long as they result in a non-nil value."
-                          "and"
+			  "**or**: `(or e1 e2 ... eN)` evaluates the `eI` expressions from left to right until there is a non-nil result."
-                          "or"
-                          "match"
-                          "receive"
-                          "callcc"
-                          "atomic"
-                          "macro"
-                          "closure"
-                          "cond"
-                          "setq"
-                          "move-to-flash"
-                          "loop"
-                          "trap"
 			  ))
+	    (para (list "`and`, `or`, `progn` and `if` evaluates expressions in sequence."
+			"`if` evaluates first the condition expression and then"
+			"either the true or false branch. `progn` evaluates all of the expressions in sequence."
+			"In the case of `and`, `or`, `progn` and `if`, the constituent expressions are all evaluated in the same local environment."
+			"Any extensions to the local environment performed by an expresison in the sequence is only visible within that expression itself."
+			))
+	    (bullet (list "**let**: `(let ((s1 e1) (s2 e2) ... (sN eN) e)` eI are evaluated in order into `vI`. The local environment is extended with `(sI . vI)`. `sI` is visible in `eJ` for `J >= I`. `e` is then evaluated in the extended local environment."
+			  "**setq**: `(setq s e)' is evaluated by first evaluating `e` into `v`. The environments are then scanned for a bining of `s`. local environment is searched first followed by global. If a binding of `s` is found it is modified into `(s . v)`."
+			  ))
+	    (para (list "If no binding of `s` is found when evaluating `(setq s e)` a `variable_not_bound` error is triggered."
+			))
+            ;; (bullet (list "callcc"
+            ;;               "atomic"
+            ;;               "macro"
+            ;;               "closure"
+            ;;               "cond"
+            ;;               "trap"
+            ;;               ))
             (para (list "**Function application evaluation**"
                         ))
             (para (list "The evaluation strategies explained here are applied to composite expressions"
@@ -648,6 +656,12 @@
                         ))
             (para (list "**The quote and the quasiquote**"
                         ))
+            (para (list "The LBM parser (Reader) expands usages of the character sequences:"
+                        "`'`, `` ` ``, `,` and `,@`."
+                        "The `'` as in `'a` is expanded into `(quote a)` for any a."
+                        "The remaining `` ` ``, `,` and `,@` are expanded into applications of `quote`, `append` and `cons`"
+                        "using the algorithms described by Bawden in [quasiquotation in lisp](https://brics.dk/NS/99/1/BRICS-NS-99-1.pdf#page=6)."
+                        ))
             ))
   )
 

lispBM/lispBM/doc/lbmref.md

@@ -527,7 +527,7 @@ Still, it is worthwhile to remember that values can be expressions and expressio
 
 **Errors** 
 
-Some times evaluation is impossible. This could be because the program is malformed, a type mismatch or a division by zero (among many other possibilities). Errors terminate the evaluation of the expression. To recover from an error and handle it the programmer needs to explicitly `trap` the error. 
+Some times evaluation is impossible. This could be because the program is malformed, a type mismatch or a division by zero (among many other possibilities). Errors terminate the evaluation of the expression. To recover from an error the programmer needs to explicitly `trap` it. 
 
 <table>
 <tr>
@@ -623,37 +623,32 @@ hello world
 </tr>
 </table>
 
-Symbols evaluate by a lookup in the environment. First, the local environment is searched for a binding of the symbols. If unable to find a binding in the local environment, the global environment is searched. If unable to find a binding in the global environment as well, an error `variable_not_bound` is triggered. 
+Symbols evaluate by a lookup in the environment. First, the local environment is searched for a binding of the symbol. If unable to find a binding in the local environment, the global environment is searched. If unable to find a binding in the global environment as well, the runtime system attempts to dynamically load a binding using a system provided callback function. If all of the above fails to provide a value a `variable_not_bound` error is produced. 
 
 **Composite forms** 
 
-A composite form, such as `(e1 ... eN)` is evaluated in different ways depending on what `e1` is. There are three major categories that `e1` can fall into. Either `e1` is something that represents a function and `(e1 ... eN)` is a function application. Or `e1` is a so-called *special-form* that form the core of the LBM language. Or lastly, `e1` is anything else than the above and the composite form is malformed ultimately resulting in an error. 
+A composite form, such as `(e1 ... eN)` is evaluated in different ways depending on what `e1` is. There are three major categories that `e1` can fall into. Either `e1` is something that represents a function and `(e1 ... eN)` is a function application. Or `e1` is a so-called *special-form* that form the core of the LBM language. Or lastly, `e1` is anything else and the composite form is malformed and will ultimately result in an error. 
 
 The composite form `(e1 ... eN)` is evaluated by first checking if `e1` is a special form or not. if `e1` is a special form the composite form is passed to a special-form evaluator. if `e1` is not a special form,  the composite form is evaluated as a function application. These two major branches of composite form evaluation are described below. 
 
 **Special form evaluation** 
 
-The special-forms in lispBM are: 
+Below are a selection of basic special-forms in lispBM together with their evaluation process 
 
-   - quote
+   - **quote**: `(quote a)` evaluates to a for any a
-   - define
+   - **define**: `(define s e)`, `e` is evaluated into `v` and the global environment is augmented with the pair `(s . v)`
-   - progn
+   - **lambda**: `(lambda params body)` is evaluated into '(closure params body env)`. `env` is the local environment there the lambda expression is evaluated.
-   - lambda
+   - **if**: `(if e1 e2 e3)` is evaluated by evaluating `e1` into `v1` if `v1` is nil, `e3` is evaluated otherwise `e2` is evaluated.
-   - if
+   - **progn**: `(progn e1 e2 ... eN)` is evaluated by evaluating `e1` then `e2` and so on until `eN`. The value `v` that `eN` evaluats into is the value `(progn e1 e2 ... eN)` evaluates to.
-   - let
+   - **and**: `(and e1 e2 ... eN)` evaluates the `eI` expressions from left to right as long as they result in a non-nil value.
-   - and
+   - **or**: `(or e1 e2 ... eN)` evaluates the `eI` expressions from left to right until there is a non-nil result.
-   - or
+
-   - match
+`and`, `or`, `progn` and `if` evaluates expressions in sequence. `if` evaluates first the condition expression and then either the true or false branch. `progn` evaluates all of the expressions in sequence. In the case of `and`, `or`, `progn` and `if`, the constituent expressions are all evaluated in the same local environment. Any extensions to the local environment performed by an expresison in the sequence is only visible within that expression itself. 
-   - receive
+
-   - callcc
+   - **let**: `(let ((s1 e1) (s2 e2) ... (sN eN) e)` eI are evaluated in order into `vI`. The local environment is extended with `(sI . vI)`. `sI` is visible in `eJ` for `J >= I`. `e` is then evaluated in the extended local environment.
-   - atomic
+   - **setq**: `(setq s e)' is evaluated by first evaluating `e` into `v`. The environments are then scanned for a bining of `s`. local environment is searched first followed by global. If a binding of `s` is found it is modified into `(s . v)`.
-   - macro
+
-   - closure
+If no binding of `s` is found when evaluating `(setq s e)` a `variable_not_bound` error is triggered. 
-   - cond
-   - setq
-   - move-to-flash
-   - loop
-   - trap
 
 **Function application evaluation** 
 
@@ -661,6 +656,8 @@ The evaluation strategies explained here are applied to composite expressions of
 
 **The quote and the quasiquote** 
 
+The LBM parser (Reader) expands usages of the character sequences: `'`, `` ` ``, `,` and `,@`. The `'` as in `'a` is expanded into `(quote a)` for any a. The remaining `` ` ``, `,` and `,@` are expanded into applications of `quote`, `append` and `cons` using the algorithms described by Bawden in [quasiquotation in lisp](https://brics.dk/NS/99/1/BRICS-NS-99-1.pdf#page=6). 
+
 ### Concurrency and Semantics
 
 TODO: Finish section. 

lispBM/lispBM/include/heap.h

@@ -390,6 +390,20 @@ int64_t lbm_dec_as_i64(lbm_value val);
  */
 double lbm_dec_as_double(lbm_value val);
 
+/** Decode a numerical value into the architecture defined unsigned integer type.
+ *
+ * \param val Value to decode
+ * \return The value encoded in val casted to an unsigned int. Returns 0 if val does not encode a number.
+ */
+lbm_uint lbm_dec_as_uint(lbm_value val);
+
+/** Decode a numerical value into the architecture defined signed integer type.
+ *
+ * \param val Value to decode
+ * \return The value encoded in val casted to a signed int. Returns 0 if val does not encode a number.
+ */
+lbm_int lbm_dec_as_int(lbm_value val);
+
 lbm_uint lbm_dec_raw(lbm_value v);
 /** Allocates an lbm_cons_t cell from the heap and populates it.
  *

lispBM/lispBM/include/lbm_types.h

@@ -1,6 +1,7 @@
 /** \file lbm_types.h */
 /*
     Copyright 2019, 2022 Joel Svensson        svenssonjoel@yahoo.se
+    Copyright 2024       Rasmus Söderhielm    rasmus.soderhielm@gmail.com
 
     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
@@ -49,6 +50,10 @@ typedef int32_t  lbm_int;
 typedef float    lbm_float;
 typedef double   lbm_double;
 
+#define LBM_UINT_MAX UINT32_MAX
+#define LBM_INT_MIN  INT32_MIN
+#define LBM_INT_MAX  INT32_MAX
+
 #define PRI_VALUE PRIu32
 #define PRI_TYPE  PRIu32
 #define PRI_UINT  PRIu32
@@ -72,6 +77,10 @@ typedef int64_t   lbm_int;
 typedef float    lbm_float;
 typedef double   lbm_double;
 
+#define LBM_UINT_MAX UINT64_MAX
+#define LBM_INT_MIN  INT64_MIN
+#define LBM_INT_MAX  INT64_MAX
+
 #define PRI_VALUE PRIu64
 #define PRI_TYPE  PRIu64
 #define PRI_UINT  PRIu64

lispBM/lispBM/include/symrepr.h

@@ -51,6 +51,7 @@ int lbm_symrepr_init(void);
  * \param symrepr_name_iterator_fun function taking a string
  */
 void lbm_symrepr_name_iterator(symrepr_name_iterator_fun f);
+int lbm_add_symbol_base(char *name, lbm_uint *id, bool flash);
 /** Add a symbol to the symbol table. The symbol name string is copied to arrays and symbols memory.
  *
  * \param name String representation of the symbol.
@@ -72,6 +73,7 @@ int lbm_add_symbol_flash(char *name, lbm_uint* id);
     \return 1 for success and 0 for failure.
 */
 int lbm_str_to_symbol(char *name, lbm_uint *sym_id);
+int lbm_add_symbol_const_base(char *name, lbm_uint* id);
 /** Add a symbol to the symbol table. The name is assumed to be a statically allocated string.
  *
  * \param name Statically allocated name string.

lispBM/lispBM/src/eval_cps.c

@@ -3860,16 +3860,16 @@ static void cont_read_next_token(eval_context_t *ctx) {
       } else {
         if (ctx->flags & EVAL_CPS_CONTEXT_FLAG_CONST_SYMBOL_STRINGS &&
             ctx->flags & EVAL_CPS_CONTEXT_FLAG_INCREMENTAL_READ) {
-          r = lbm_add_symbol_flash(tokpar_sym_str, &symbol_id);
+          r = lbm_add_symbol_base(tokpar_sym_str, &symbol_id, true); //flash
            if (!r) {
             lbm_set_error_reason((char*)lbm_error_str_flash_error);
             error_ctx(ENC_SYM_FATAL_ERROR);
           }
         } else {
-          r = lbm_add_symbol(tokpar_sym_str, &symbol_id);
+          r = lbm_add_symbol_base(tokpar_sym_str, &symbol_id,false); //ram
           if (!r) {
             gc();
-            r = lbm_add_symbol(tokpar_sym_str, &symbol_id);
+            r = lbm_add_symbol_base(tokpar_sym_str, &symbol_id,false); //ram
           }
         }
       }
@@ -4433,11 +4433,9 @@ static void cont_move_val_to_flash_dispatch(eval_context_t *ctx) {
   lbm_value val = ctx->r;
 
   if (lbm_is_cons(val)) {
-    lbm_value flash_cell = ENC_SYM_NIL;
-    handle_flash_status(request_flash_storage_cell(val, &flash_cell));
     lbm_value *rptr = stack_reserve(ctx, 5);
-    rptr[0] = flash_cell;
+    rptr[0] = ENC_SYM_NIL; // fst cell of list
-    rptr[1] = flash_cell;
+    rptr[1] = ENC_SYM_NIL; // last cell of list
     rptr[2] = get_cdr(val);
     rptr[3] = MOVE_LIST_TO_FLASH;
     rptr[4] = MOVE_VAL_TO_FLASH_DISPATCH;
@@ -4453,19 +4451,18 @@ static void cont_move_val_to_flash_dispatch(eval_context_t *ctx) {
   }
 
   if (lbm_is_ptr(val)) {
-    // Request a flash storage cell.
-    lbm_value flash_cell = ENC_SYM_NIL;
-    handle_flash_status(request_flash_storage_cell(val, &flash_cell));
-    ctx->r = flash_cell;
     lbm_cons_t *ref = lbm_ref_cell(val);
     if (lbm_type_of(ref->cdr) == LBM_TYPE_SYMBOL) {
       switch (ref->cdr) {
       case ENC_SYM_RAW_I_TYPE: /* fall through */
       case ENC_SYM_RAW_U_TYPE:
-      case ENC_SYM_RAW_F_TYPE:
+      case ENC_SYM_RAW_F_TYPE: {
+	lbm_value flash_cell = ENC_SYM_NIL;
+	handle_flash_status(request_flash_storage_cell(val, &flash_cell));
         handle_flash_status(write_const_car(flash_cell, ref->car));
         handle_flash_status(write_const_cdr(flash_cell, ref->cdr));
-        break;
+	ctx->r = flash_cell;
+      } break;
       case ENC_SYM_IND_I_TYPE: /* fall through */
       case ENC_SYM_IND_U_TYPE:
       case ENC_SYM_IND_F_TYPE: {
@@ -4475,8 +4472,11 @@ static void cont_move_val_to_flash_dispatch(eval_context_t *ctx) {
         lbm_uint flash_ptr;
 
         handle_flash_status(lbm_write_const_raw(lbm_mem_ptr, 2, &flash_ptr));
+	lbm_value flash_cell = ENC_SYM_NIL;
+	handle_flash_status(request_flash_storage_cell(val, &flash_cell));
         handle_flash_status(write_const_car(flash_cell, flash_ptr));
         handle_flash_status(write_const_cdr(flash_cell, ref->cdr));
+	ctx->r = flash_cell;
 #else
         // There are no indirect types in LBM64
         error_ctx(ENC_SYM_FATAL_ERROR);
@@ -4487,8 +4487,9 @@ static void cont_move_val_to_flash_dispatch(eval_context_t *ctx) {
         lbm_uint size = arr->size / sizeof(lbm_uint);
         lbm_uint flash_addr;
         lbm_value *arrdata = (lbm_value *)arr->data;
+	lbm_value flash_cell = ENC_SYM_NIL;
+	handle_flash_status(request_flash_storage_cell(val, &flash_cell));
         handle_flash_status(lbm_allocate_const_raw(size, &flash_addr));
-
         lift_array_flash(flash_cell,
                          false,
                          (char *)flash_addr,
@@ -4509,10 +4510,13 @@ static void cont_move_val_to_flash_dispatch(eval_context_t *ctx) {
         // arbitrary address: flash_arr.
         lbm_uint flash_arr;
         handle_flash_status(lbm_write_const_array_padded((uint8_t*)arr->data, arr->size, &flash_arr));
+	lbm_value flash_cell = ENC_SYM_NIL;
+	handle_flash_status(request_flash_storage_cell(val, &flash_cell));
         lift_array_flash(flash_cell,
                          true,
                          (char *)flash_arr,
                          arr->size);
+	ctx->r = flash_cell;
       } break;
       case ENC_SYM_CHANNEL_TYPE: /* fall through */
       case ENC_SYM_CUSTOM_TYPE:
@@ -4522,7 +4526,6 @@ static void cont_move_val_to_flash_dispatch(eval_context_t *ctx) {
     } else {
       error_ctx(ENC_SYM_FATAL_ERROR);
     }
-    ctx->r = flash_cell;
     ctx->app_cont = true;
     return;
   }
@@ -4540,14 +4543,24 @@ static void cont_move_list_to_flash(eval_context_t *ctx) {
   lbm_value lst = sptr[1];
   lbm_value val = sptr[2];
 
+
+  lbm_value new_lst = ENC_SYM_NIL;
+  // Allocate element ptr storage after storing the element to flash. 
+  handle_flash_status(request_flash_storage_cell(lbm_enc_cons_ptr(LBM_PTR_NULL), &new_lst)); 
+  
+  if (lbm_is_symbol_nil(fst)) {
+    lst = new_lst;
+    fst = new_lst;
     handle_flash_status(write_const_car(lst, ctx->r));
+  } else {
+    handle_flash_status(write_const_cdr(lst, new_lst)); // low before high
+    handle_flash_status(write_const_car(new_lst, ctx->r));
+    lst = new_lst;	
+  }
 
   if (lbm_is_cons(val)) {
-    // prepare cell for rest of list
+    sptr[0] = fst;
-    lbm_value rest_cell = ENC_SYM_NIL;
+    sptr[1] = lst;//rest_cell;
-    handle_flash_status(request_flash_storage_cell(val, &rest_cell));
-    handle_flash_status(write_const_cdr(lst, rest_cell));
-    sptr[1] = rest_cell;
     sptr[2] = get_cdr(val);
     lbm_value *rptr = stack_reserve(ctx, 2);
     rptr[0] = MOVE_LIST_TO_FLASH;

lispBM/lispBM/src/extensions/string_extensions.c

@@ -1,6 +1,7 @@
 /*
     Copyright 2022, 2023 Joel Svensson        svenssonjoel@yahoo.se
     Copyright 2022, 2023 Benjamin Vedder
+    Copyright 2024       Rasmus Söderhielm    rasmus.soderhielm@gmail.com
 
     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,6 +22,7 @@
 #include "heap.h"
 #include "fundamental.h"
 #include "lbm_c_interop.h"
+#include "eval_cps.h"
 #include "print.h"
 
 #include <ctype.h>
@@ -34,6 +36,9 @@
 
 static char print_val_buffer[256];
 
+static lbm_uint sym_left;
+static lbm_uint sym_right;
+
 static size_t strlen_max(const char *s, size_t maxlen) {
   size_t i;
   for (i = 0; i < maxlen; i ++) {
@@ -94,29 +99,75 @@ static lbm_value ext_str_from_n(lbm_value *args, lbm_uint argn) {
   }
 }
 
-static lbm_value ext_str_merge(lbm_value *args, lbm_uint argn) {
+// signature: (str-join strings [delim]) -> str
-  size_t len_tot = 0;
+static lbm_value ext_str_join(lbm_value *args, lbm_uint argn) {
-  for (unsigned int i = 0;i < argn;i++) {
+  // This function does not check that the string arguments contain any
-    char *str = lbm_dec_str(args[i]);
+  // terminating null bytes.
-    if (str) {
+  
-      len_tot += strlen(str);
+  if (argn != 1 && argn != 2) {
-    } else {
+    lbm_set_error_reason((char *)lbm_error_str_num_args);
+    return ENC_SYM_EERROR;
+  }
+
+  size_t str_len   = 0;
+  size_t str_count = 0;
+  if (!lbm_is_list(args[0])) {
+    lbm_set_error_reason((char *)lbm_error_str_incorrect_arg);
+    lbm_set_error_suspect(args[0]);
+    return ENC_SYM_TERROR;
+  }
+  for (lbm_value current = args[0]; lbm_is_cons(current); current = lbm_cdr(current)) {
+    char *str = lbm_dec_str(lbm_car(current));
+    if (!str) {
+      lbm_set_error_reason((char *)lbm_error_str_incorrect_arg);
+      lbm_set_error_suspect(args[0]);
+      return ENC_SYM_TERROR;
+    }
+
+    str_len   += (strlen(str));
+    str_count += 1;
+  }
+  
+  const char *delim = "";
+  if (argn >= 2) {
+    delim = lbm_dec_str(args[1]);
+    if (!delim) {
+      lbm_set_error_reason((char *)lbm_error_str_incorrect_arg);
+      lbm_set_error_suspect(args[1]);
       return ENC_SYM_TERROR;
     }
   }
 
-  lbm_value res;
+  size_t delim_len = strlen(delim);
-  if (lbm_create_array(&res, len_tot + 1)) {
+  if (str_count > 0) {
-    lbm_array_header_t *arr = (lbm_array_header_t*)lbm_car(res);
+    str_len += (str_count - 1) * delim_len;
-    unsigned int offset = 0;
-    for (unsigned int i = 0;i < argn;i++) {
-      offset += (unsigned int)sprintf((char*)arr->data + offset, "%s", lbm_dec_str(args[i]));
   }
-    ((char*)(arr->data))[len_tot] = '\0';
+  
-    return res;
+  lbm_value result;
-  } else {
+  if (!lbm_create_array(&result, str_len + 1)) {
     return ENC_SYM_MERROR;
   }
+  char *result_str = lbm_dec_str(result);
+
+  size_t i      = 0;
+  size_t offset = 0;
+  for (lbm_value current = args[0]; lbm_is_cons(current); current = lbm_cdr(current)) {
+    const char *str = lbm_dec_str(lbm_car(current));
+    size_t len      = strlen(str);
+
+    memcpy(result_str + offset, str, len);
+    offset += len;
+
+    if (i != str_count - 1) {
+      memcpy(result_str + offset, delim, delim_len);
+      offset += delim_len;
+    }
+    i++;
+  }
+
+  result_str[str_len] = '\0';
+
+  return result;
 }
 
 static lbm_value ext_str_to_i(lbm_value *args, lbm_uint argn) {
@@ -525,13 +576,158 @@ static lbm_value ext_str_replicate(lbm_value *args, lbm_uint argn) {
   return res;
 }
 
+// signature: (str-find str:byte-array substr [start:int] [occurrence:int] [dir]) -> int
+// where
+//   seq = string|(..string)
+//   dir = 'left|'right
+static lbm_value ext_str_find(lbm_value *args, lbm_uint argn) {
+  if (argn < 2 || 5 < argn) {
+    lbm_set_error_reason((char *)lbm_error_str_num_args);
+    return ENC_SYM_EERROR;
+  }
+  if (!lbm_is_array_r(args[0])) {
+    lbm_set_error_suspect(args[0]);
+    lbm_set_error_reason((char *)lbm_error_str_incorrect_arg);
+    return ENC_SYM_TERROR;
+  }
 
+  lbm_array_header_t *str_header = (lbm_array_header_t *)lbm_car(args[0]);
+  const char *str   = (const char *)str_header->data;
+  lbm_int str_size = (lbm_int)str_header->size;
+
+  // Guaranteed to be list containing strings.
+  lbm_value substrings;
+  lbm_int min_substr_len = LBM_INT_MAX;
+  if (lbm_is_array_r(args[1])) {
+    substrings = lbm_cons(args[1], ENC_SYM_NIL);
+    if (substrings == ENC_SYM_MERROR) {
+      return ENC_SYM_MERROR;
+    }
+    lbm_array_header_t *header =
+        (lbm_array_header_t *)lbm_car(args[1]);
+    if (!header) {
+      // Should not be possible
+      return ENC_SYM_FATAL_ERROR;
+    }
+
+    lbm_int len = (lbm_int)header->size - 1;
+    if (len < 0) {
+      // substr is zero length array
+      return lbm_enc_i(-1);
+    }
+    min_substr_len = len;
+  } else if (lbm_is_list(args[1])) {
+    for (lbm_value current = args[1]; lbm_is_cons(current); current = lbm_cdr(current)) {
+      if (!lbm_is_array_r(lbm_car(current))) {
+        lbm_set_error_suspect(args[1]);
+        lbm_set_error_reason((char *)lbm_error_str_incorrect_arg);
+        return ENC_SYM_TERROR;
+      }
+
+      lbm_array_header_t *header =
+          (lbm_array_header_t *)lbm_car(lbm_car(current));
+
+      lbm_int len = (lbm_int)header->size - 1;
+      if (len < 0) {
+        // substr is zero length array
+        continue;
+      }
+      if (len < min_substr_len) {
+        min_substr_len = len;
+      }
+    }
+    substrings = args[1];
+  } else {
+    lbm_set_error_suspect(args[1]);
+    lbm_set_error_reason((char *)lbm_error_str_incorrect_arg);
+    return ENC_SYM_TERROR;
+  }
+
+  bool to_right    = true;
+  lbm_uint dir_index = 4;
+  if (argn >= 3 && lbm_is_symbol(args[argn - 1])) {
+    dir_index       = argn - 1;
+    lbm_uint symbol = lbm_dec_sym(args[dir_index]);
+
+    if (symbol == sym_left) {
+      to_right = false;
+    } else if (symbol != sym_right) {
+      lbm_set_error_suspect(args[dir_index]);
+      lbm_set_error_reason((char *)lbm_error_str_incorrect_arg);
+      return ENC_SYM_TERROR;
+    }
+  }
+
+  lbm_int start = to_right ? 0 : str_size - min_substr_len;
+  if (argn >= 3 && dir_index != 2) {
+    if (!lbm_is_number(args[2])) {
+      lbm_set_error_reason((char *)lbm_error_str_no_number);
+      lbm_set_error_suspect(args[2]);
+      return ENC_SYM_TERROR;
+    }
+
+    start = lbm_dec_as_int(args[2]);
+  }
+  
+  uint32_t occurrence = 0;
+  if (argn >= 4 && dir_index != 3) {
+    if (!lbm_is_number(args[3])) {
+      lbm_set_error_reason((char *)lbm_error_str_no_number);
+      lbm_set_error_suspect(args[3]);
+      return ENC_SYM_TERROR;
+    }
+
+    occurrence = lbm_dec_as_u32(args[3]);
+  }
+
+  if (start < 0) {
+    // start: -1 starts the search at the character index before the final null
+    // byte index.
+    start = str_size - 1 + start;
+  }
+
+  if (!to_right && (start > str_size - min_substr_len)) {
+    start = str_size - min_substr_len;
+  }
+  else if (to_right && (start < 0)) {
+    start = 0;
+  }
+
+  lbm_int dir = to_right ? 1 : -1;
+  for (lbm_int i = start; to_right ? (i <= str_size - min_substr_len) : (i >= 0); i += dir) {
+    for (lbm_value current = substrings; lbm_is_cons(current); current = lbm_cdr(current)) {
+      lbm_array_header_t *header = (lbm_array_header_t *)lbm_car(lbm_car(current));
+      lbm_int substr_len         = (lbm_int)header->size - 1;
+      const char *substr         = (const char *)header->data;
+
+      if (
+        i > str_size - substr_len // substr length runs over str end.
+        || substr_len < 0 // substr was zero bytes in size
+      ) {
+        continue;
+      }
+      
+      if (memcmp(&str[i], substr, (size_t)substr_len) == 0) {
+        if (occurrence == 0) {
+          return lbm_enc_i(i);
+        }
+        occurrence -= 1;
+      }
+    }
+  }
+
+  return lbm_enc_i(-1);
+}
 
 bool lbm_string_extensions_init(void) {
 
   bool res = true;
+  
+  res = res && lbm_add_symbol_const("left", &sym_left);
+  res = res && lbm_add_symbol_const("right", &sym_right);
+  
   res = res && lbm_add_extension("str-from-n", ext_str_from_n);
-  res = res && lbm_add_extension("str-merge", ext_str_merge);
+  res = res && lbm_add_extension("str-join", ext_str_join);
   res = res && lbm_add_extension("str-to-i", ext_str_to_i);
   res = res && lbm_add_extension("str-to-f", ext_str_to_f);
   res = res && lbm_add_extension("str-part", ext_str_part);
@@ -544,6 +740,7 @@ bool lbm_string_extensions_init(void) {
   res = res && lbm_add_extension("to-str-delim", ext_to_str_delim);
   res = res && lbm_add_extension("str-len", ext_str_len);
   res = res && lbm_add_extension("str-replicate", ext_str_replicate);
+  res = res && lbm_add_extension("str-find", ext_str_find);
 
   return res;
 }

lispBM/lispBM/src/heap.c

@@ -238,12 +238,11 @@ int64_t lbm_dec_i64(lbm_value x) {
 
 char *lbm_dec_str(lbm_value val) {
   char *res = 0;
+  // If val is an array, car of val will be non-null. 
   if (lbm_is_array_r(val)) {
     lbm_array_header_t *array = (lbm_array_header_t *)lbm_car(val);
-    if (array) {
     res = (char *)array->data;
   }
-  }
   return res;
 }
 
@@ -384,6 +383,54 @@ uint64_t lbm_dec_as_u64(lbm_value a) {
   return 0;
 }
 
+lbm_uint lbm_dec_as_uint(lbm_value a) {
+  switch (lbm_type_of_functional(a)) {
+  case LBM_TYPE_CHAR:
+    return (lbm_uint) lbm_dec_char(a);
+  case LBM_TYPE_I:
+    return (lbm_uint) lbm_dec_i(a);
+  case LBM_TYPE_U:
+    return (lbm_uint) lbm_dec_u(a);
+  case LBM_TYPE_I32:
+    return (lbm_uint) lbm_dec_i32(a);
+  case LBM_TYPE_U32:
+    return (lbm_uint) lbm_dec_u32(a);
+  case LBM_TYPE_FLOAT:
+    return (lbm_uint) lbm_dec_float(a);
+  case LBM_TYPE_I64:
+    return (lbm_uint) lbm_dec_i64(a);
+  case LBM_TYPE_U64:
+    return (lbm_uint) lbm_dec_u64(a);
+  case LBM_TYPE_DOUBLE:
+    return (lbm_uint) lbm_dec_double(a);
+  }
+  return 0;
+}
+
+lbm_int lbm_dec_as_int(lbm_value a) {
+  switch (lbm_type_of_functional(a)) {
+  case LBM_TYPE_CHAR:
+    return (lbm_int) lbm_dec_char(a);
+  case LBM_TYPE_I:
+    return (lbm_int) lbm_dec_i(a);
+  case LBM_TYPE_U:
+    return (lbm_int) lbm_dec_u(a);
+  case LBM_TYPE_I32:
+    return (lbm_int) lbm_dec_i32(a);
+  case LBM_TYPE_U32:
+    return (lbm_int) lbm_dec_u32(a);
+  case LBM_TYPE_FLOAT:
+    return (lbm_int)lbm_dec_float(a);
+  case LBM_TYPE_I64:
+    return (lbm_int) lbm_dec_i64(a);
+  case LBM_TYPE_U64:
+    return (lbm_int) lbm_dec_u64(a);
+  case LBM_TYPE_DOUBLE:
+    return (lbm_int) lbm_dec_double(a);
+  }
+  return 0;
+}
+
 float lbm_dec_as_float(lbm_value a) {
 
   switch (lbm_type_of_functional(a)) {

lispBM/lispBM/src/lbm_c_interop.c

@@ -92,7 +92,7 @@ lbm_cid eval_cps_load_and_define(lbm_char_channel_t *tokenizer, char *symbol, bo
   lbm_uint sym_id;
 
   if (!lbm_get_symbol_by_name(symbol, &sym_id)) {
-    if (!lbm_add_symbol(symbol, &sym_id)) {
+    if (!lbm_add_symbol_base(symbol, &sym_id,false)) { //ram
       //lbm_explicit_free_token_stream(stream);
       return 0;
     }
@@ -200,7 +200,7 @@ int lbm_define(char *symbol, lbm_value value) {
   lbm_uint sym_id;
   if (lbm_get_eval_state() == EVAL_CPS_STATE_PAUSED) {
     if (!lbm_get_symbol_by_name(symbol, &sym_id)) {
-      if (!lbm_add_symbol_const(symbol, &sym_id)) {
+      if (!lbm_add_symbol_const_base(symbol, &sym_id)) {
         return 0;
       }
     }

lispBM/lispBM/src/lbm_flat_value.c

@@ -744,7 +744,7 @@ static int lbm_unflatten_value_internal(lbm_flat_value_t *v, lbm_value *res) {
     lbm_uint sym_id;
     int r = lbm_get_symbol_by_name((char *)(v->buf + v->buf_pos), &sym_id);
     if (!r) {
-      r = lbm_add_symbol((char *)(v->buf + v->buf_pos), &sym_id);
+      r = lbm_add_symbol_base((char *)(v->buf + v->buf_pos), &sym_id,false); //ram
     }
     if (r) {
       lbm_uint num_bytes = strlen((char*)(v->buf + v->buf_pos)) + 1;

lispBM/lispBM/src/symrepr.c

@@ -416,7 +416,7 @@ static bool add_symbol_to_symtab_flash(lbm_uint name, lbm_uint id) {
   return false;
 }
 
-static int lbm_add_symbol_base(char *name, lbm_uint *id, bool flash) {
+int lbm_add_symbol_base(char *name, lbm_uint *id, bool flash) {
   lbm_uint symbol_name_storage;
   if (flash) {
     if (!store_symbol_name_flash(name, &symbol_name_storage)) return 0;
@@ -431,14 +431,28 @@ static int lbm_add_symbol_base(char *name, lbm_uint *id, bool flash) {
 }
 
 int lbm_add_symbol(char *name, lbm_uint* id) {
+  lbm_uint sym_id;
+  if (!lbm_get_symbol_by_name(name, &sym_id)) {
     return lbm_add_symbol_base(name, id, false);
+  } else {
+    *id = sym_id;
+    return 1;
+  }
+  return 0;
 }
 
 int lbm_add_symbol_flash(char *name, lbm_uint* id) {
+  lbm_uint sym_id;
+  if (!lbm_get_symbol_by_name(name, &sym_id)) {
     return lbm_add_symbol_base(name, id, true);
+  } else {
+    *id = sym_id;
+    return 1;
+  }
+  return 0;
 }
 
-int lbm_add_symbol_const(char *name, lbm_uint* id) {
+int lbm_add_symbol_const_base(char *name, lbm_uint* id) {
   lbm_uint *m = lbm_memory_allocate(3);
   if (m == NULL) return 0;
   symbol_table_size_list += 3;
@@ -450,6 +464,17 @@ int lbm_add_symbol_const(char *name, lbm_uint* id) {
   return 1;
 }
 
+int lbm_add_symbol_const(char *name, lbm_uint* id) {
+  lbm_uint sym_id;
+  if (!lbm_get_symbol_by_name(name, &sym_id)) {
+    return lbm_add_symbol_const_base(name, id);
+  } else {
+    *id = sym_id;
+    return 1;
+  }
+  return 0;
+}
+
 int lbm_str_to_symbol(char *name, lbm_uint *sym_id) {
   if (lbm_get_symbol_by_name(name, sym_id))
     return 1;

lispBM/lispBM/tests/run_tests.sh

@@ -2,7 +2,7 @@
 
 echo "BUILDING"
 
-make clean
+# make clean
 make
 
 date=$(date +"%Y-%m-%d_%H-%M")
@@ -14,14 +14,14 @@ fi
 
 echo "PERFORMING TESTS: " $date
 
-expected_fails=("test_lisp_code_cps -h 1024 test_take_iota_0.lisp"
+expected_fails=("test_lisp_code_cps -h 1024 tests/test_take_iota_0.lisp"
-                "test_lisp_code_cps -s -h 1024 test_take_iota_0.lisp"
+                "test_lisp_code_cps -s -h 1024 tests/test_take_iota_0.lisp"
-                "test_lisp_code_cps -h 512 test_take_iota_0.lisp"
+                "test_lisp_code_cps -h 512 tests/test_take_iota_0.lisp"
-                "test_lisp_code_cps -s -h 512 test_take_iota_0.lisp"
+                "test_lisp_code_cps -s -h 512 tests/test_take_iota_0.lisp"
-                "test_lisp_code_cps -i -h 1024 test_take_iota_0.lisp"
+                "test_lisp_code_cps -i -h 1024 tests/test_take_iota_0.lisp"
-                "test_lisp_code_cps -i -s -h 1024 test_take_iota_0.lisp"
+                "test_lisp_code_cps -i -s -h 1024 tests/test_take_iota_0.lisp"
-                "test_lisp_code_cps -i -h 512 test_take_iota_0.lisp"
+                "test_lisp_code_cps -i -h 512 tests/test_take_iota_0.lisp"
-                "test_lisp_code_cps -i -s -h 512 test_take_iota_0.lisp"
+                "test_lisp_code_cps -i -s -h 512 tests/test_take_iota_0.lisp"
               )
 
 
@@ -85,7 +85,7 @@ test_config=("-h 32768"
 for prg in "test_lisp_code_cps" ; do
     for arg in "${test_config[@]}"; do
         echo "Configuration: " $arg
-        for lisp in *.lisp; do
+        for lisp in tests/*.lisp; do
             tmp_file=$(mktemp)
             ./$prg $arg $lisp > $tmp_file
             result=$?

lispBM/lispBM/tests/run_tests64.sh

@@ -16,14 +16,14 @@ fi
 echo "PERFORMING TESTS: " $date
 
 
-expected_fails=("test_lisp_code_cps -h 1024 test_take_iota_0.lisp"
+expected_fails=("test_lisp_code_cps -h 1024 tests/test_take_iota_0.lisp"
-                "test_lisp_code_cps -s -h 1024 test_take_iota_0.lisp"
+                "test_lisp_code_cps -s -h 1024 tests/test_take_iota_0.lisp"
-                "test_lisp_code_cps -h 512 test_take_iota_0.lisp"
+                "test_lisp_code_cps -h 512 tests/test_take_iota_0.lisp"
-                "test_lisp_code_cps -s -h 512 test_take_iota_0.lisp"
+                "test_lisp_code_cps -s -h 512 tests/test_take_iota_0.lisp"
-                "test_lisp_code_cps -i -h 1024 test_take_iota_0.lisp"
+                "test_lisp_code_cps -i -h 1024 tests/test_take_iota_0.lisp"
-                "test_lisp_code_cps -i -s -h 1024 test_take_iota_0.lisp"
+                "test_lisp_code_cps -i -s -h 1024 tests/test_take_iota_0.lisp"
-                "test_lisp_code_cps -i -h 512 test_take_iota_0.lisp"
+                "test_lisp_code_cps -i -h 512 tests/test_take_iota_0.lisp"
-                "test_lisp_code_cps -i -s -h 512 test_take_iota_0.lisp"
+                "test_lisp_code_cps -i -s -h 512 tests/test_take_iota_0.lisp"
               )
 
 success_count=0
@@ -86,7 +86,7 @@ test_config=("-h 32768"
 for prg in "test_lisp_code_cps" ; do
     for arg in "${test_config[@]}"; do
         echo "Configuration: " $arg
-        for lisp in *.lisp; do
+        for lisp in tests/*.lisp; do
             tmp_file=$(mktemp)
             ./$prg $arg $lisp > $tmp_file
             result=$?

lispBM/lispBM/tests/run_tests_gc.sh

@@ -15,14 +15,14 @@ fi
 
 echo "PERFORMING TESTS: " $date
 
-expected_fails=("test_lisp_code_cps -t 25 -h 1024 test_take_iota_0.lisp"
+expected_fails=("test_lisp_code_cps -t 25 -h 1024 tests/test_take_iota_0.lisp"
-                "test_lisp_code_cps -t 25 -s -h 1024 test_take_iota_0.lisp"
+                "test_lisp_code_cps -t 25 -s -h 1024 tests/test_take_iota_0.lisp"
-                "test_lisp_code_cps -t 25 -h 512 test_take_iota_0.lisp"
+                "test_lisp_code_cps -t 25 -h 512 tests/test_take_iota_0.lisp"
-                "test_lisp_code_cps -t 25 -s -h 512 test_take_iota_0.lisp"
+                "test_lisp_code_cps -t 25 -s -h 512 tests/test_take_iota_0.lisp"
-                "test_lisp_code_cps -t 25 -i -h 1024 test_take_iota_0.lisp"
+                "test_lisp_code_cps -t 25 -i -h 1024 tests/test_take_iota_0.lisp"
-                "test_lisp_code_cps -t 25 -i -s -h 1024 test_take_iota_0.lisp"
+                "test_lisp_code_cps -t 25 -i -s -h 1024 tests/test_take_iota_0.lisp"
-                "test_lisp_code_cps -t 25 -i -h 512 test_take_iota_0.lisp"
+                "test_lisp_code_cps -t 25 -i -h 512 tests/test_take_iota_0.lisp"
-                "test_lisp_code_cps -t 25 -i -s -h 512 test_take_iota_0.lisp"
+                "test_lisp_code_cps -t 25 -i -s -h 512 tests/test_take_iota_0.lisp"
                )
 
 
@@ -86,7 +86,7 @@ test_config=("-t 25 -h 32768"
 for prg in "test_lisp_code_cps" ; do
     for arg in "${test_config[@]}"; do
         echo "Configuration: " $arg
-        for lisp in *.lisp; do
+        for lisp in tests/*.lisp; do
             tmp_file=$(mktemp)
             ./$prg $arg $lisp > $tmp_file
             result=$?

lispBM/lispBM/tests/run_tests_gc_rev.sh

@@ -7,14 +7,14 @@ make allrev
 
 echo "PERFORMING TESTS:"
 
-expected_fails=("test_lisp_code_cps -h 1024 test_take_iota_0.lisp"
+expected_fails=("test_lisp_code_cps -h 1024 tests/test_take_iota_0.lisp"
-                "test_lisp_code_cps -s -h 1024 test_take_iota_0.lisp"
+                "test_lisp_code_cps -s -h 1024 tests/test_take_iota_0.lisp"
-                "test_lisp_code_cps -h 512 test_take_iota_0.lisp"
+                "test_lisp_code_cps -h 512 tests/test_take_iota_0.lisp"
-                "test_lisp_code_cps -s -h 512 test_take_iota_0.lisp"
+                "test_lisp_code_cps -s -h 512 tests/test_take_iota_0.lisp"
-                "test_lisp_code_cps -i -h 1024 test_take_iota_0.lisp"
+                "test_lisp_code_cps -i -h 1024 tests/test_take_iota_0.lisp"
-                "test_lisp_code_cps -i -s -h 1024 test_take_iota_0.lisp"
+                "test_lisp_code_cps -i -s -h 1024 tests/test_take_iota_0.lisp"
-                "test_lisp_code_cps -i -h 512 test_take_iota_0.lisp"
+                "test_lisp_code_cps -i -h 512 tests/test_take_iota_0.lisp"
-                "test_lisp_code_cps -i -s -h 512 test_take_iota_0.lisp"
+                "test_lisp_code_cps -i -s -h 512 tests/test_take_iota_0.lisp"
                )
 
 
@@ -78,7 +78,7 @@ test_config=("-h 32768"
 #"test_lisp_code_cps_nc"
 for prg in "test_lisp_code_cps" ; do
     for arg in "${test_config[@]}"; do
-        for lisp in *.lisp; do
+        for lisp in tests/*.lisp; do
 
             ./$prg $arg $lisp
 

lispBM/lispBM/tests/test_lisp_code_cps.c

@@ -740,7 +740,7 @@ int main(int argc, char **argv) {
   lbm_pause_eval_with_gc(20);
   int wait_count = 0;
   while (lbm_get_eval_state() != EVAL_CPS_STATE_PAUSED) {
-    if (wait_count >= 10) {
+    if (wait_count >= 100) {
       printf("Could not pause the evaluator\n");
       return FAIL;
     }

lispBM/lispBM/tests/test_move_to_flash_7.lisp

@@ -0,0 +1,6 @@
+
+
+(define a (list 1))
+(move-to-flash a)
+
+(check (eq a (list 1)))

lispBM/lispBM/tests/test_move_to_flash_8.lisp

@@ -0,0 +1,15 @@
+
+(define a 1u32)
+(define b 1.0f32)
+(define c 1u64)
+(define d 1.0f64)
+
+
+
+(move-to-flash a)
+(move-to-flash b)
+
+(check (and (= 1u32 a)
+	    (= 1.0f32 b)
+	    (= 1u64 c)
+	    (= 1.0f64 d)))

lispBM/lispBM/tests/test_str_merge_1.lisp

@@ -1,21 +0,0 @@
-
-(defun repeatq (f n)
-  (if ( = n 0)
-      ()
-    (progn
-      f
-      (repeatq f (- n 1)))))
-
-
-(define apa "apa")
-(define bepa "bepa")
-
-(gc)
-
-(define n (mem-num-free))
-
-(repeatq '(str-merge apa bepa) 1000)
-
-(gc)
-
-(check (= n (mem-num-free)))