Squashed 'lispBM/lispBM/' changes from c53ee21f..c1b12e9d

c1b12e9d Fix bug: Attempt GC if creation of a symbol fails. Also added error reasons to string extensions and changed some eval_errors to type_error
141e7fb1 update lbmref
ae677d30 added a section about flash directives and functions in flash memory

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

doc/gotchas.md

@@ -45,6 +45,8 @@ Note that the global environment is not "saved" in the same way inside the closu
 Currently no (efficient) solution in mind for this gotcha. Just be careful if you use `undefine`.
 
 
+## Flash memory
+
 
 
 

doc/lbmref.md

@@ -953,68 +953,6 @@ Example that evaluates to 20:
 ``` 
 ---
 
-### @const-start
-
-`@const-start` opens a block of code where each global definition is
-moved to constant memory (flash) automatically. This can be used only together with the
-incremental reader (such as `read-eval-program`).
-
-A `@const-start` opened block should be closed with a `@const-end`. Constant blocks
-cannot be nested. 
-
-Example:
-
-```clj
-@const-start
-
-(defun f (x) (+ x 1))  ; a function stored in constant memory
-
-@const-end
-
-(+ f 2)
-``` 
-
-### @const-end
-
-`@const-end` closes an block opened by `@const-start`.
-
-
-### move-to-flash
-
-A value can be moved to flash storage to save space on the normal evaluation heap or lbm memory.
-A `move-to-flash` expression is of the form `(move-to-flash sym opt-sym1 ... opt-symN)`.
-The symbols `sym`, `opt-sym1 ... opt-symN` should be globally bound to the values you want moved
-to flash. After the value has been moved, the environment binding is updated to point into flash
-memory. **CAUTION** This function should be used carefully. Ideally a value should be moved
-to flash immediately after it is created so there is no chance that other references to original value
-exists.
-
-Example that moves an array to flash storage:
-
-```clj
-(define a [1 2 3 4 5 6])
-
-(move-to-flash a)
-```
-
-Example that moves a list to flash storage:
-
-```clj
-(define ls '(1 2 3 4 5))
-
-(move-to-flash ls)
-```
-
-Functions can be moved to flash storage as well:
-
-```clj
-(defun f (x) (+ x 1))
-
-(move-to-flash f)
-```
-
----
-
 ## Lists and cons cells
 
 Lists are built using cons cells. A cons cell is represented by the lbm_cons_t struct in the
@@ -1897,6 +1835,86 @@ The `variable_not_bound` symbol is returned when evaluating a
 variable (symbol) that is neighter bound nor special (built-in function).
 
 
+## Flash memory
+
+Flash memory can be used to store data and functions that are constant.
+Things can be moved to flash explicitly using the `move-to-flash` function
+or as part of the reading procedure. To move things automatically to flash during
+reading, there are `@`directives.
+
+---
+
+### @const-symbol-strings
+
+if `@const-symbol-strings` directive is placed in a file, symbols will be created
+in flash memory instead of the arrays memory.
+
+---
+
+### @const-start
+
+`@const-start` opens a block of code where each global definition is
+moved to constant memory (flash) automatically. This can be used only together with the
+incremental reader (such as `read-eval-program`).
+
+A `@const-start` opened block should be closed with a `@const-end`. Constant blocks
+cannot be nested.
+
+Example:
+
+```clj
+@const-start
+
+(defun f (x) (+ x 1))  ; a function stored in constant memory
+
+@const-end
+
+(+ f 2)
+```
+
+---
+
+### @const-end
+
+`@const-end` closes an block opened by `@const-start`.
+
+---
+
+### move-to-flash
+
+A value can be moved to flash storage to save space on the normal evaluation heap or lbm memory.
+A `move-to-flash` expression is of the form `(move-to-flash sym opt-sym1 ... opt-symN)`.
+The symbols `sym`, `opt-sym1 ... opt-symN` should be globally bound to the values you want moved
+to flash. After the value has been moved, the environment binding is updated to point into flash
+memory. **CAUTION** This function should be used carefully. Ideally a value should be moved
+to flash immediately after it is created so there is no chance that other references to original value
+exists.
+
+Example that moves an array to flash storage:
+
+```clj
+(define a [1 2 3 4 5 6])
+
+(move-to-flash a)
+```
+
+Example that moves a list to flash storage:
+
+```clj
+(define ls '(1 2 3 4 5))
+
+(move-to-flash ls)
+```
+
+Functions can be moved to flash storage as well:
+
+```clj
+(defun f (x) (+ x 1))
+
+(move-to-flash f)
+```
+
+---
 
 ## Types
 

src/eval_cps.c

@@ -3102,6 +3102,10 @@ static void cont_read_next_token(eval_context_t *ctx) {
           r = lbm_add_symbol_flash(tokpar_sym_str, &symbol_id);
         } else {
           r = lbm_add_symbol(tokpar_sym_str, &symbol_id);
+          if (!r) {
+            gc();
+            r = lbm_add_symbol(tokpar_sym_str, &symbol_id);
+          }
         }
       }
       if (r) {

src/extensions/string_extensions.c

@@ -43,12 +43,16 @@ static size_t strlen_max(const char *s, size_t maxlen) {
 }
 
 static lbm_value ext_str_from_n(lbm_value *args, lbm_uint argn) {
-  if ((argn != 1 && argn != 2) || !lbm_is_number(args[0])) {
+  if (argn != 1 && argn != 2) {
+    lbm_set_error_reason((char*)lbm_error_str_num_args);
     return ENC_SYM_EERROR;
   }
+  if (!lbm_is_number(args[0])) {
+    return ENC_SYM_TERROR;
+  }
 
   if (argn == 2 && !lbm_is_array_r(args[1])) {
-    return ENC_SYM_EERROR;
+    return ENC_SYM_TERROR;
   }
 
   char *format = 0;
@@ -97,7 +101,7 @@ static lbm_value ext_str_merge(lbm_value *args, lbm_uint argn) {
     if (str) {
       len_tot += strlen(str);
     } else {
-      return ENC_SYM_EERROR;
+      return ENC_SYM_TERROR;
     }
   }
 
@@ -117,18 +121,19 @@ static lbm_value ext_str_merge(lbm_value *args, lbm_uint argn) {
 
 static lbm_value ext_str_to_i(lbm_value *args, lbm_uint argn) {
   if (argn != 1 && argn != 2) {
+    lbm_set_error_reason((char*)lbm_error_str_num_args);
     return ENC_SYM_EERROR;
   }
 
   char *str = lbm_dec_str(args[0]);
   if (!str) {
-    return ENC_SYM_EERROR;
+    return ENC_SYM_TERROR;
   }
 
   int base = 0;
   if (argn == 2) {
     if (!lbm_is_number(args[1])) {
-      return ENC_SYM_EERROR;
+      return ENC_SYM_TERROR;
     }
 
     base = (int)lbm_dec_as_u32(args[1]);
@@ -139,12 +144,13 @@ static lbm_value ext_str_to_i(lbm_value *args, lbm_uint argn) {
 
 static lbm_value ext_str_to_f(lbm_value *args, lbm_uint argn) {
   if (argn != 1) {
+    lbm_set_error_reason((char*)lbm_error_str_num_args);
     return ENC_SYM_EERROR;
   }
 
   char *str = lbm_dec_str(args[0]);
   if (!str) {
-    return ENC_SYM_EERROR;
+    return ENC_SYM_TERROR;
   }
 
   return lbm_enc_float(strtof(str, NULL));
@@ -152,12 +158,13 @@ static lbm_value ext_str_to_f(lbm_value *args, lbm_uint argn) {
 
 static lbm_value ext_str_part(lbm_value *args, lbm_uint argn) {
   if ((argn != 2 && argn != 3) || !lbm_is_number(args[1])) {
-    return ENC_SYM_EERROR;
+    lbm_set_error_reason((char*)lbm_error_str_num_args);
+    return ENC_SYM_TERROR;
   }
 
   char *str = lbm_dec_str(args[0]);
   if (!str) {
-    return ENC_SYM_EERROR;
+    return ENC_SYM_TERROR;
   }
 
   uint32_t len = (uint32_t)strlen(str);
@@ -171,7 +178,7 @@ static lbm_value ext_str_part(lbm_value *args, lbm_uint argn) {
   uint32_t n = len - start;
   if (argn == 3) {
     if (!lbm_is_number(args[2])) {
-      return ENC_SYM_EERROR;
+      return ENC_SYM_TERROR;
     }
 
     n = MIN(lbm_dec_as_u32(args[2]), n);
@@ -190,12 +197,13 @@ static lbm_value ext_str_part(lbm_value *args, lbm_uint argn) {
 
 static lbm_value ext_str_split(lbm_value *args, lbm_uint argn) {
   if (argn != 2) {
+    lbm_set_error_reason((char*)lbm_error_str_num_args);
     return ENC_SYM_EERROR;
   }
 
   char *str = lbm_dec_str(args[0]);
   if (!str) {
-    return ENC_SYM_EERROR;
+    return ENC_SYM_TERROR;
   }
 
   char *split = lbm_dec_str(args[1]);
@@ -204,7 +212,7 @@ static lbm_value ext_str_split(lbm_value *args, lbm_uint argn) {
     if (lbm_is_number(args[1])) {
       step = MAX(lbm_dec_as_i32(args[1]), 1);
     } else {
-      return ENC_SYM_EERROR;
+      return ENC_SYM_TERROR;
     }
   }
 
@@ -260,6 +268,7 @@ static lbm_value ext_str_split(lbm_value *args, lbm_uint argn) {
 // Todo: Clean this up for 64bit
 static lbm_value ext_str_replace(lbm_value *args, lbm_uint argn) {
   if (argn != 2 && argn != 3) {
+    lbm_set_error_reason((char*)lbm_error_str_num_args);
     return ENC_SYM_EERROR;
   }
 
@@ -331,6 +340,7 @@ static lbm_value ext_str_replace(lbm_value *args, lbm_uint argn) {
 
 static lbm_value ext_str_to_lower(lbm_value *args, lbm_uint argn) {
   if (argn != 1) {
+    lbm_set_error_reason((char*)lbm_error_str_num_args);
     return ENC_SYM_EERROR;
   }
 
@@ -355,6 +365,7 @@ static lbm_value ext_str_to_lower(lbm_value *args, lbm_uint argn) {
 
 static lbm_value ext_str_to_upper(lbm_value *args, lbm_uint argn) {
   if (argn != 1) {
+    lbm_set_error_reason((char*)lbm_error_str_num_args);
     return ENC_SYM_EERROR;
   }
 
@@ -385,12 +396,12 @@ static lbm_value ext_str_cmp(lbm_value *args, lbm_uint argn) {
 
   char *str1 = lbm_dec_str(args[0]);
   if (!str1) {
-    return ENC_SYM_EERROR;
+    return ENC_SYM_TERROR;
   }
 
   char *str2 = lbm_dec_str(args[1]);
   if (!str2) {
-    return ENC_SYM_EERROR;
+    return ENC_SYM_TERROR;
   }
 
   int n = -1;
@@ -467,12 +478,13 @@ static lbm_value ext_to_str(lbm_value *args, lbm_uint argn) {
 
 static lbm_value ext_to_str_delim(lbm_value *args, lbm_uint argn) {
   if (argn < 1) {
+    lbm_set_error_reason((char*)lbm_error_str_num_args);
     return ENC_SYM_EERROR;
   }
 
   char *delim = lbm_dec_str(args[0]);
   if (!delim) {
-    return ENC_SYM_EERROR;
+    return ENC_SYM_TERROR;
   }
 
   return to_str(delim, args + 1, argn - 1);
@@ -483,7 +495,7 @@ static lbm_value ext_str_len(lbm_value *args, lbm_uint argn) {
 
   char *str = lbm_dec_str(args[0]);
   if (!str) {
-    return ENC_SYM_EERROR;
+    return ENC_SYM_TERROR;
   }
 
   lbm_array_header_t *array = (lbm_array_header_t *)lbm_car(args[0]);

tests/test_read_stress.lisp

@@ -0,0 +1,17 @@
+
+(defun repeat_eval (c n)
+  (if ( = n 0)
+      ()
+    (progn
+      (c n)
+      (bufcreate 10)
+      (repeat_eval c (- n 1)))))
+
+
+
+(defun code (x) (def apa (eval `(read (str-merge "bepa" (str-from-n x))))))
+
+; Create just enough symbols and symbols and arrays to trigger GC.
+(repeat_eval code 432)
+
+(check (eq apa 'bepa1))