Squashed 'lispBM/lispBM/' changes from 1eceb43f..1267d006

1267d006 added one more memory test
a9782eda added two tests that try to be quite hard on the lbm_memory.
5c0841f8 small additions to matvec
bcb1ad7f added vector multiplication by scalar
ce5025cc small additions to matvec.
1758b335 renamed blas_extensions to matvec extensions as they wont provide the same set of operations as a blas library usually does
2e48e6b4 fix silly typo in lbm_memory.c
62154010 only initialized mutices 1 time
d1dbfd7c added a test of events
cb97d623 only add events to the event queue if there is an event handler
7a642222 removed usage of send_message in process_events
e3a68115 events are moving into the evaluator
64239a9b tweaks to random extensions
d61950d9 removed a print from sierpinski
f8a1d586 added sierpinski and flake examples to sdlrepl
72d8e4f4 added random number extensions to sdlrepl
ba9c449a changed constants involved in the pseudorandom generator.
8806e369 remove left over debug printing
10cc7fab added random number generator extensions
184c756b added memory leakage tests for string extensions
4373713d work in progress linear_algebra extensions
135591bd added str-merge test
7bff0e97 added a test. more to follow
e1aad339 added a small set of runtime system related extensions
5495b5da updates to custom type interface.
4e3b408a rename strnlen to strlen_max
03644f64 pulling in string extensions from vedderb\bldc into string_extensions.c
294f013b grabbed a few extra array-extensions into array_extensions.c from Vedderb/BLDC
87f95e67 adding all the Math extensions from Vedder/BLDC to math_extensions.c

git-subtree-dir: lispBM/lispBM
git-subtree-split: 1267d006e90085920a3de720480dc2d19d71c8ff

include/eval_cps.h

@@ -62,6 +62,23 @@ typedef struct eval_context_s{
   struct eval_context_s *next;
 } eval_context_t;
 
+typedef enum {
+  LBM_EVENT_SYM = 0,
+  LBM_EVENT_SYM_INT,
+  LBM_EVENT_SYM_INT_INT,
+  LBM_EVENT_SYM_ARRAY,
+  LBM_EVENT_SYM_INT_ARRAY,
+} lbm_event_type_t;
+
+typedef struct {
+  lbm_event_type_t type;
+  lbm_uint sym;
+  int32_t i;
+  int32_t i2;
+  char *array;
+  int32_t array_len;
+} lbm_event_t;
+
 /** Fundamental operation type */
 typedef lbm_value (*fundamental_fun)(lbm_value *, lbm_uint, eval_context_t*);
 
@@ -93,7 +110,26 @@ int lbm_eval_init(void);
  *   \param quota The new quota.
  */
 void lbm_set_eval_step_quota(uint32_t quota);
-
+/** Initialize events
+ * \param num_events The maximum number of unprocessed events.
+ * \return true on success, false otherwise.
+ */
+bool lbm_eval_init_events(unsigned int num_events);
+/** Get the process ID for the current event handler.
+ * \return process ID on success and -1 if no event handler is registered.
+ */
+lbm_cid lbm_get_event_handler_pid(void);
+/** Set the event handler process ID.
+ * \param pid The ID of the process to which events should be sent
+ */
+void lbm_set_event_handler_pid(lbm_cid pid);
+/** Send an event to the registered event handler process.
+ * \param event The event to send to the registered handler.
+ * \param opt_array An optional array to pass to the event handler.
+ * \param opt_array_len Length of array mandatory if array is passed in.
+ * \return true if the event was successfully enqueued to be sent, false otherwise.
+ */
+bool lbm_event(lbm_event_t event, uint8_t* opt_array, int opt_array_len);
 /** Remove a context that has finished executing and free up its associated memory.
  *
  * \param cid Context id of context to free.

include/extensions/matvec_extensions.h

@@ -0,0 +1,32 @@
+/*
+    Copyright 2023 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/>.
+*/
+
+#ifndef MATVEC_EXTENSIONS_H_
+#define MATVEC_EXTENSIONS_H_
+
+#include <stdbool.h>
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+bool lbm_matvec_extensions_init(void);
+
+#ifdef __cplusplus
+}
+#endif
+#endif

include/extensions/random_extensions.h

@@ -0,0 +1,32 @@
+/*
+    Copyright 2023 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/>.
+*/
+
+#ifndef RANDOM_EXTENSIONS_H_
+#define RANDOM_EXTENSIONS_H_
+
+#include <stdbool.h>
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+bool lbm_random_extensions_init(void);
+
+#ifdef __cplusplus
+}
+#endif
+#endif

include/extensions/runtime_extensions.h

@@ -0,0 +1,32 @@
+/*
+    Copyright 2023 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/>.
+*/
+
+#ifndef RUNTIME_EXTENSIONS_H_
+#define RUNTIME_EXTENSIONS_H_
+
+#include <stdbool.h>
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+bool lbm_runtime_extensions_init(void);
+
+#ifdef __cplusplus
+}
+#endif
+#endif

include/heap.h

@@ -446,6 +446,16 @@ int lbm_set_car_and_cdr(lbm_value c, lbm_value car_val, lbm_value cdr_val);
  * \return The length of the list. Unless the value is a cyclic structure on the heap, this function will terminate.
  */
 unsigned int lbm_list_length(lbm_value c);
+
+/** Calculate the length of a proper list and evaluate a predicate for each element.
+ * \warning This is a dangerous function that should be used carefully. Cyclic structures on the heap
+ * may lead to the function not terminating.
+ *
+ * \param c A list
+ * \param pres Boolean result of predicate, false if predicate is false for any of the elements in the list, otherwise true.
+ * \param pred Predicate to evaluate for each element of the list.
+ */
+unsigned int lbm_list_length_pred(lbm_value c, bool *pres, bool (*pred)(lbm_value));
 /** Reverse a proper list
  * \warning This is a dangerous function that should be used carefully. Cyclic structures on the heap
  * may lead to the function not terminating.
@@ -533,6 +543,15 @@ int lbm_gc_sweep_phase(void);
  * \return 1 for success of 0 for failure.
  */
 int lbm_heap_allocate_array(lbm_value *res, lbm_uint size, lbm_type type);
+/** Convert a C array into an lbm array. If the C array is allocated in LBM MEMORY
+ *  the lifetime of the array will be managed by GC.
+ * \param res lbm_value result pointer for storage of the result array.
+ * \param data C array.
+ * \param type The type tag to assign to the resulting LBM array.
+ * \param num_elt Number of elements in the array.
+ * \return 1 for success and 0 for failure.
+ */
+int lbm_lift_array(lbm_value *value, char *data, lbm_type type, lbm_uint num_elt);
 /** Explicitly free an array.
  *  This function needs to be used with care and knowledge.
  * \param arr Array value.

include/lbm_custom_type.h

@@ -20,7 +20,10 @@
 #define LBM_CUSTOM_TYPE_H_
 
 #include <stdbool.h>
+#include <stddef.h>
 #include <lbm_types.h>
+#include <lbm_defines.h>
+#include <heap.h>
 
 #ifdef __cplusplus
 extern "C" {
@@ -60,6 +63,19 @@ bool lbm_custom_type_create(lbm_uint value, custom_type_destructor fptr, const c
  */
 bool lbm_custom_type_destroy(lbm_uint *lbm_mem_ptr);
 
+static inline const char *lbm_get_custom_descriptor(lbm_value value) {
+  if (lbm_type_of(value) == LBM_TYPE_CUSTOM) {
+    lbm_uint *m = (lbm_uint*)lbm_dec_custom(value);
+    return (const char*)m[CUSTOM_TYPE_DESCRIPTOR];
+  }
+  return NULL;
+}
+
+static inline lbm_uint lbm_get_custom_value(lbm_value value) {
+  lbm_uint *m = (lbm_uint*)lbm_dec_custom(value);
+  return m[CUSTOM_TYPE_VALUE];
+}
+
 #ifdef __cplusplus
 }
 #endif

include/lbm_defines.h

@@ -270,7 +270,8 @@
 #define SYM_RANGE               0x238
 #define SYM_NUM_NOT_EQ          0x239
 #define SYM_NOT_EQ              0x23A
-#define FUNDAMENTALS_END        0x23A
+#define SYM_REG_EVENT_HANDLER   0x23B
+#define FUNDAMENTALS_END        0x23B
 
 #define SPECIAL_SYMBOLS_START    0
 #define SPECIAL_SYMBOLS_END      0xFFFF

include/lbm_memory.h

@@ -76,6 +76,7 @@
 
 #include "lbm_types.h"
 #include <stdint.h>
+#include <stddef.h>
 
 #ifdef __cplusplus
 extern "C" {
@@ -148,7 +149,15 @@ lbm_uint *lbm_memory_allocate(lbm_uint num_words);
  * \return 1 on success and 0 on failure.
  */
 int lbm_memory_free(lbm_uint *ptr);
-
+/** Malloc like interface to lbm_memory
+ * \param size Size in bytes of memory to allocate.
+ * \return Pointer to array or NULL.
+ */
+void* lbm_malloc(size_t size);
+/** Free memory allocated with lbm_malloc
+ * \param Pointer to array to free
+ */
+void lbm_free(void *ptr);
 /** Shrink an allocated array.
  * \param ptr Pointer to array to shrink
  * \param n New smaller size of array

lispbm.mk

@@ -18,7 +18,10 @@ LISPBM_SRC = $(LISPBM)/src/env.c \
              $(LISPBM)/src/lbm_channel.c \
              $(LISPBM)/src/extensions/array_extensions.c \
              $(LISPBM)/src/extensions/string_extensions.c \
-             $(LISPBM)/src/extensions/math_extensions.c
+             $(LISPBM)/src/extensions/math_extensions.c \
+             $(LISPBM)/src/extensions/runtime_extensions.c \
+             $(LISPBM)/src/extensions/matvec_extensions.c \
+             $(LISPBM)/src/extensions/random_extensions.c
 
 
 LISPBM_INC = -I$(LISPBM)/include \

repl/repl.c

@@ -393,6 +393,17 @@ static lbm_value ext_custom(lbm_value *args, lbm_uint argn) {
   return res;
 }
 
+static lbm_value ext_event(lbm_value *args, lbm_uint argn) {
+
+  if (argn != 1 || !lbm_is_symbol(args[0])) return ENC_SYM_EERROR;
+  lbm_event_t e;
+  e.type = LBM_EVENT_SYM;
+  e.sym = lbm_dec_sym(args[0]);
+  if (lbm_event(e, NULL, 0)) {
+    return ENC_SYM_TRUE;
+  }
+  return ENC_SYM_NIL;
+}
 
 /* load a file, caller is responsible for freeing the returned string */
 char * load_file(char *filename) {
@@ -522,6 +533,11 @@ int main(int argc, char **argv) {
     return 0;
   }
 
+  if (!lbm_eval_init_events(20)) {
+    printf("Failed to initialize events\n");
+    return 0;
+  }
+
   lbm_set_ctx_done_callback(done_callback);
   lbm_set_timestamp_us_callback(timestamp_callback);
   lbm_set_usleep_callback(sleep_callback);
@@ -573,6 +589,12 @@ int main(int argc, char **argv) {
   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");
+
 
   /* Start evaluator thread */
   if (pthread_create(&lispbm_thd, NULL, eval_thd_wrapper, NULL)) {

sdlrepl/flake.lisp

@@ -0,0 +1,105 @@
+
+
+(sdl-init)
+
+(define w 500)
+(define h 500)
+
+(defun degtorad (d)
+  (/ (* d 3.141) 180.0))
+
+(defun rotate (p angle)
+  `(,(- (* (car p) (cos (degtorad angle)))
+        (* (cdr p) (sin (degtorad angle))))
+    .
+    ,(+ (* (car p) (sin (degtorad angle)))
+        (* (cdr p) (cos (degtorad angle))))))
+
+
+(defun trans (p v)
+  `(,(+ (car p) (car v)) . ,(+ (cdr p) (cdr v))))
+
+(defun move (p ang s)
+  (let ((v (rotate `( 0 . ,(- s)) ang)))
+    (trans p v)))
+
+(defun event-loop (w)
+  (let ((event (sdl-poll-event)))
+    (if (eq event 'sdl-quit-event)
+        (custom-destruct w)
+        (progn  
+          (yield 5000)
+          (event-loop w)))))
+
+(defun line (rend p1 p2)
+  (sdl-draw-line rend (car p1) (cdr p1) (car p2) (cdr p2)))
+
+
+;; (defun draw-figure (rend p ang s)
+;;   (if (<= s 1)
+;;       ()
+;;       (let ((p1 (move p ang s)))
+;;         (progn
+;;           (line rend p p1)
+;;           (draw-figure rend p1 (+ ang 2) (- s 1))
+;;           (draw-figure rend p1 (- ang 27) (/ s 2))
+;;           (draw-figure rend p1 (+ ang 27) (/ s 2))))))
+
+
+
+(defun draw-figure (rend p ang s)
+  (if (<= s 1)
+      ()
+    (let ((p1 (move p ang s))
+          (p2 (move p (+ ang 60) s))
+          (p3 (move p (+ ang 120) s))
+          (p4 (move p (+ ang 180) s))
+          (p5 (move p (+ ang 240) s))
+          (p6 (move p (+ ang 300) s)))
+      (progn
+        (yield 100)
+        (line rend p p1)
+        (line rend p p2)
+        (line rend p p3)
+        (line rend p p4)
+        (line rend p p5)
+        (line rend p p6)
+        (sdl-present rend)
+        (draw-figure rend p1 (+ ang 10) (/ s 2))
+        (draw-figure rend p2 (+ ang 70) (/ s 2))
+        (draw-figure rend p3 (+ ang 130) (/ s 2))
+        (draw-figure rend p4 (+ ang 190) (/ s 2))
+        (draw-figure rend p5 (+ ang 250) (/ s 2))
+        (draw-figure rend p6 (+ ang 310) (/ s 2))))))
+
+
+(defun start-figure (rend p ang s)
+  (progn
+    (spawn draw-figure rend p (+ ang ) s)
+    (spawn draw-figure rend p (+ ang 60) s)
+    (spawn draw-figure rend p (+ ang 120) s)
+    (spawn draw-figure rend p (+ ang 180) s)
+    (spawn draw-figure rend p (+ ang 240) s)
+    (spawn draw-figure rend p (+ ang 300) s)))
+
+
+
+(defun main ()
+  (let ((win (sdl-create-window "LISP-GFX" 500 500))
+        (rend (sdl-create-soft-renderer win)))
+    (progn
+      (spawn 100 event-loop win)
+      (sdl-renderer-set-color rend 0 0 0)
+      (sdl-clear rend)
+      (sdl-renderer-set-color rend 255 255 255)
+
+      (start-figure rend '(250 . 250) 0 100)
+
+      (sdl-present rend)
+      
+      ;;(custom-destruct rend)
+      'done
+      )))
+
+(defun clean ()
+  (gc))

sdlrepl/lbm_sdl.c

@@ -162,6 +162,25 @@ static lbm_value ext_sdl_draw_line(lbm_value *args, lbm_uint argn) {
   return res;
 }
 
+static lbm_value ext_sdl_draw_point(lbm_value *args, lbm_uint argn) {
+
+  lbm_value res = ENC_SYM_EERROR;
+
+  if (argn == 3 && lbm_type_of(args[0]) == LBM_TYPE_CUSTOM) {
+    lbm_uint *m = (lbm_uint *)lbm_dec_custom(args[0]);
+    SDL_Renderer *rend = (SDL_Renderer*)m[CUSTOM_TYPE_VALUE];
+
+    int32_t x1 = lbm_dec_as_i32(args[1]);
+    int32_t y1 = lbm_dec_as_i32(args[2]);
+    res = ENC_SYM_TRUE;
+    if (SDL_RenderDrawPoint(rend, x1, y1)) {
+      res = ENC_SYM_NIL;
+    }
+  }
+  return res;
+}
+
+
 static lbm_value ext_sdl_clear(lbm_value *args, lbm_uint argn) {
 
   lbm_value res = lbm_enc_sym(SYM_TRUE);
@@ -270,6 +289,7 @@ bool lbm_sdl_init(void) {
   res = res && lbm_add_extension("sdl-create-window",ext_sdl_create_window);
   res = res && lbm_add_extension("sdl-create-soft-renderer", ext_sdl_create_soft_renderer);
   res = res && lbm_add_extension("sdl-renderer-set-color", ext_sdl_renderer_set_color);
+  res = res && lbm_add_extension("sdl-draw-point", ext_sdl_draw_point);
   res = res && lbm_add_extension("sdl-draw-line", ext_sdl_draw_line);
   res = res && lbm_add_extension("sdl-clear", ext_sdl_clear);
   res = res && lbm_add_extension("sdl-present", ext_sdl_present);

sdlrepl/repl.c

@@ -30,6 +30,7 @@
 #include "extensions/array_extensions.h"
 #include "extensions/string_extensions.h"
 #include "extensions/math_extensions.h"
+#include "extensions/random_extensions.h"
 
 #include "lbm_custom_type.h"
 #include "lbm_sdl.h"
@@ -547,6 +548,12 @@ int main(int argc, char **argv) {
     printf("Loading math extensions failed\n");
   }
 
+  if (lbm_random_extensions_init()) {
+    printf("Random extensions loaded\n");
+  } else {
+    printf("Loading random extensions failed\n");
+  }
+
   res = lbm_add_extension("block", ext_block);
   if (res)
     printf("Extension added.\n");

sdlrepl/sierpinski.lisp

@@ -0,0 +1,107 @@
+(sdl-init)
+
+(define w 500)
+(define h 500)
+
+(define corners '((10 . 490) (490 . 490) (250 . 10)))
+
+
+(defun degtorad (d)
+  (/ (* d 3.141) 180.0))
+
+(defun rotate (p angle)
+  `(,(- (* (car p) (cos (degtorad angle)))
+        (* (cdr p) (sin (degtorad angle))))
+    .
+    ,(+ (* (car p) (sin (degtorad angle)))
+        (* (cdr p) (cos (degtorad angle))))))
+
+
+(defun trans (p v)
+  `(,(+ (car p) (car v)) . ,(+ (cdr p) (cdr v))))
+
+(defun move (p ang s)
+  (let ((v (rotate `( 0 . ,(- s)) ang)))
+    (trans p v)))
+
+(defun event-loop (w)
+  (let ((event (sdl-poll-event)))
+    (if (eq event 'sdl-quit-event)
+        (custom-destruct w)
+        (progn  
+          (yield 5000)
+          (event-loop w)))))
+
+(defun line (rend p1 p2)
+  (sdl-draw-line rend (car p1) (cdr p1) (car p2) (cdr p2)))
+
+(defun point (rend p)
+  (sdl-draw-point rend (car p) (cdr p)))
+
+;; (defun draw-figure (rend p ang s)
+;;   (if (<= s 1)
+;;       ()
+;;       (let ((p1 (move p ang s)))
+;;         (progn
+;;           (line rend p p1)
+;;           (draw-figure rend p1 (+ ang 2) (- s 1))
+;;           (draw-figure rend p1 (- ang 27) (/ s 2))
+;;           (draw-figure rend p1 (+ ang 27) (/ s 2))))))
+
+
+(defun mid-point (p1 p2)
+  (progn
+    ;(print "p1: " p1)
+    ;(print "p2: " p2)
+    (let ((x (/ (+ (car p1) (car p2)) 2))
+          (y (/ (+ (cdr p1) (cdr p2)) 2)))
+      (cons x y))))
+
+(defun sierpinsky (n rend corners p)
+  (if (= n 0) ()
+    (let ((i (mod (random) 3))
+          (target (ix corners i))
+          (mid    (mid-point p target)))
+      (progn
+        ;(print "p " p)
+        ;(print "target " target)
+        ;(print "mid "mid)
+        ;(print "i " i)
+        (point rend mid)
+        (sdl-present rend)
+        (sierpinsky (- n 1) rend corners mid))
+      )))
+          
+      
+    
+
+(defun draw-figure (rend)
+  (progn
+    (seed 3)
+    (map (point rend) corners)
+    (sierpinsky 25000 rend corners (car corners))))
+
+
+
+
+
+
+(defun main ()
+  (let ((win (sdl-create-window "LISP-GFX" 500 500))
+        (rend (sdl-create-soft-renderer win)))
+    (progn
+      (spawn 100 event-loop win)
+      (sdl-renderer-set-color rend 0 0 0)
+      (sdl-clear rend)
+      (sdl-renderer-set-color rend 255 255 255)
+
+      (draw-figure rend)
+
+      (sdl-present rend)
+      
+      ;;(custom-destruct rend)
+      'done
+      )))
+
+(defun clean ()
+  (gc))

src/eval_cps.c

@@ -1,5 +1,5 @@
 /*
-    Copyright 2018, 2020, 2021, 2022 Joel Svensson    svenssonjoel@yahoo.se
+    Copyright 2018, 2020, 2021, 2022, 2023 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
@@ -164,6 +164,67 @@ static volatile uint32_t eval_cps_next_state = EVAL_CPS_STATE_RUNNING;
 static volatile uint32_t eval_cps_next_state_arg = 0;
 static volatile bool     eval_cps_state_changed = false;
 
+static volatile lbm_event_t *lbm_events = NULL;
+static unsigned int lbm_events_head = 0;
+static unsigned int lbm_events_tail = 0;
+static unsigned int lbm_events_max  = 0;
+static bool         lbm_events_full = false;
+static mutex_t      lbm_events_mutex;
+static bool         lbm_events_mutex_initialized = false;
+static volatile lbm_cid  lbm_event_handler_pid = -1;
+
+lbm_cid lbm_get_event_handler_pid(void) {
+  return lbm_event_handler_pid;
+}
+
+void lbm_set_event_handler_pid(lbm_cid pid) {
+  lbm_event_handler_pid = pid;
+}
+
+bool lbm_event(lbm_event_t event, uint8_t* opt_array, int opt_array_len) {
+
+  if (lbm_event_handler_pid == -1 || !lbm_events) {
+    return false;
+  }
+  mutex_lock(&lbm_events_mutex);
+  if (lbm_events_full) return false;
+  if (opt_array != NULL) {
+    event.array = lbm_malloc((size_t)opt_array_len);
+    event.array_len = opt_array_len;
+    if (event.array == NULL) return false;
+    memcpy(event.array, opt_array, (size_t)opt_array_len);
+  }
+  lbm_events[lbm_events_head] = event;
+
+  lbm_events_head = (lbm_events_head + 1) % lbm_events_max;
+  mutex_unlock(&lbm_events_mutex);
+  return true;
+}
+
+static bool lbm_event_pop(lbm_event_t *event) {
+  mutex_lock(&lbm_events_mutex);
+  if (lbm_events_head == lbm_events_tail && !lbm_events_full) {
+    mutex_unlock(&lbm_events_mutex);
+    return false;
+  }
+  *event = lbm_events[lbm_events_tail];
+  lbm_events_tail = (lbm_events_tail + 1) % lbm_events_max;
+  lbm_events_full = false;
+  mutex_unlock(&lbm_events_mutex);
+  return true;
+}
+
+static unsigned int lbm_event_num(void) {
+  mutex_lock(&lbm_events_mutex);
+  unsigned int res = lbm_events_max;
+  if (!lbm_events_full) {
+    if (lbm_events_head >= lbm_events_tail) res = lbm_events_head - lbm_events_tail;
+    else res = lbm_events_max - lbm_events_tail + lbm_events_head;
+  }
+  mutex_unlock(&lbm_events_mutex);
+  return res;
+}
+
 /*
    On ChibiOs the CH_CFG_ST_FREQUENCY setting in chconf.h sets the
    resolution of the timer used for sleep operations.  If this is set
@@ -194,6 +255,7 @@ static eval_context_queue_t queue    = {NULL, NULL};
 
 /* one mutex for all queue operations */
 mutex_t qmutex;
+bool    qmutex_initialized = false;
 
 static void usleep_nonsense(uint32_t us) {
   (void) us;
@@ -386,8 +448,6 @@ bool lift_char_channel(lbm_char_channel_t *chan , lbm_value *res) {
 }
 
 
-
-
 /****************************************************/
 /* Queue functions                                  */
 
@@ -3126,6 +3186,103 @@ uint32_t lbm_get_eval_state(void) {
   return eval_cps_run_state;
 }
 
+static void process_events(void) {
+
+  if (!lbm_events) return;
+
+  if (lbm_event_handler_pid < 0) {
+    lbm_events_head = 0;
+    lbm_events_tail = 0;
+    lbm_events_full = false;
+    return;
+  }
+
+  unsigned int event_cnt = lbm_event_num();
+
+  lbm_event_t e;
+
+  if (event_cnt > 0) {
+    while (lbm_event_pop(&e) && lbm_event_handler_pid >= 0) {
+      if (e.type == LBM_EVENT_SYM) {
+        lbm_find_receiver_and_send(lbm_event_handler_pid, lbm_enc_sym(e.sym));
+      } else if (e.type == LBM_EVENT_SYM_INT) {
+        lbm_value msg = lbm_cons(lbm_enc_sym(e.sym), lbm_enc_i(e.i));
+        if (lbm_is_symbol_merror(msg)) {
+          gc();
+          msg = lbm_cons(lbm_enc_sym(e.sym), lbm_enc_i(e.i));
+        }
+        if (lbm_is_ptr(msg)) {
+          lbm_find_receiver_and_send(lbm_event_handler_pid, msg);
+        }
+      } else if (e.type == LBM_EVENT_SYM_INT_INT) {
+        lbm_value ints = lbm_cons(lbm_enc_i(e.i), lbm_enc_i(e.i2));
+        if (lbm_is_symbol_merror(ints)) {
+          gc();
+          ints = lbm_cons(lbm_enc_i(e.i), lbm_enc_i(e.i2));
+        }
+        lbm_value msg = lbm_cons(lbm_enc_sym(e.sym), ints);
+        if (lbm_is_symbol_merror(msg)) {
+          lbm_gc_mark_phase(1,ints);
+          gc();
+          msg = lbm_cons(lbm_enc_sym(e.sym), ints);
+        }
+        if (lbm_is_ptr(ints) && lbm_is_ptr(msg)) {
+          lbm_find_receiver_and_send(lbm_event_handler_pid, msg);
+        }
+      } else if (e.type == LBM_EVENT_SYM_ARRAY) {
+        lbm_value val;
+        if (!lbm_lift_array(&val, e.array, LBM_TYPE_BYTE, (size_t)e.array_len)) {
+          gc();
+          lbm_lift_array(&val, e.array, LBM_TYPE_BYTE, (size_t)e.array_len);
+        }
+        if (lbm_is_array(val)) {
+          lbm_value msg;
+          msg = lbm_cons(lbm_enc_sym(e.sym), val);
+          if (lbm_is_symbol_merror(msg)) {
+            lbm_gc_mark_phase(1, val);
+            gc();
+            msg = lbm_cons(lbm_enc_sym(e.sym), val);
+          }
+          if (!lbm_is_symbol_merror(msg)) {
+            lbm_find_receiver_and_send(lbm_event_handler_pid, msg);
+          } else {
+            lbm_heap_explicit_free_array(val);
+          }
+        }
+      } else if (e.type == LBM_EVENT_SYM_INT_ARRAY) {
+        lbm_value val;
+        if (!lbm_lift_array(&val, e.array,  LBM_TYPE_BYTE, (size_t)e.array_len)) {
+          gc();
+          lbm_lift_array(&val, e.array,  LBM_TYPE_BYTE, (size_t)e.array_len);
+        }
+        if (lbm_is_array(val)) {
+          lbm_value msg_data;
+          msg_data = lbm_cons(lbm_enc_i32(e.i),val);
+          if (lbm_is_symbol_merror(msg_data)) {
+            lbm_gc_mark_phase(1,val);
+            gc();
+            msg_data = lbm_cons(lbm_enc_i32(e.i), val);
+          }
+          if (!lbm_is_symbol_merror(msg_data)) {
+            lbm_value msg;
+            msg = lbm_cons(lbm_enc_sym(e.sym), msg_data);
+            if (lbm_is_symbol_merror(msg)) {
+              lbm_gc_mark_phase(1, msg_data);
+              gc();
+              msg = lbm_cons(lbm_enc_sym(e.sym), msg_data);
+            }
+            if (!lbm_is_symbol_merror(msg)) {
+              lbm_find_receiver_and_send(lbm_event_handler_pid, msg);
+            } else {
+              lbm_heap_explicit_free_array(val);
+            }
+          }
+        }
+      }
+    }
+  }
+}
+
 /* eval_cps_run can be paused
    I think it would be better use a mailbox for
    communication between other threads and the run_eval
@@ -3173,6 +3330,7 @@ void lbm_run_eval(void){
             // report an error in.
           }
         } else {
+          process_events();
           next_to_run = dequeue_ctx(&sleeping, &us);
         }
 
@@ -3205,6 +3363,16 @@ 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);
+  }
+  if (!lbm_events_mutex_initialized) {
+    mutex_init(&lbm_events_mutex);
+  }
+
+  mutex_lock(&qmutex);
+  mutex_lock(&lbm_events_mutex);
+
   blocked.first = NULL;
   blocked.last = NULL;
   sleeping.first = NULL;
@@ -3215,7 +3383,8 @@ int lbm_eval_init() {
 
   eval_cps_run_state = EVAL_CPS_STATE_RUNNING;
 
-  mutex_init(&qmutex);
+  mutex_unlock(&qmutex);
+  mutex_unlock(&lbm_events_mutex);
 
   *lbm_get_env_ptr() = ENC_SYM_NIL;
   eval_running = true;
@@ -3223,3 +3392,17 @@ int lbm_eval_init() {
   return res;
 }
 
+bool lbm_eval_init_events(unsigned int num_events) {
+
+  mutex_lock(&lbm_events_mutex);
+  lbm_events = (lbm_event_t*)lbm_malloc(num_events * sizeof(lbm_event_t));
+
+  if (!lbm_events) return false;
+  lbm_events_max = num_events;
+  lbm_events_head = 0;
+  lbm_events_tail = 0;
+  lbm_events_full = false;
+  lbm_event_handler_pid = -1;
+  mutex_unlock(&lbm_events_mutex);
+  return true;
+}

src/extensions/array_extensions.c

@@ -1,6 +1,6 @@
 /*
-    Copyright 2022 Joel Svensson        svenssonjoel@yahoo.se
+    Copyright 2022, 2023 Joel Svensson        svenssonjoel@yahoo.se
-    Copyright 2022 Benjamin Vedder
+    Copyright 2022, 2023 Benjamin Vedder
 
     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 +49,10 @@ static lbm_value array_extension_buffer_get_f32(lbm_value *args, lbm_uint argn);
 
 static lbm_value array_extension_buffer_length(lbm_value *args, lbm_uint argn);
 
+static lbm_value array_extensions_bufclear(lbm_value *args, lbm_uint argn);
+static lbm_value array_extensions_bufcpy(lbm_value *args, lbm_uint argn);
+static lbm_value array_extensions_bufset_bit(lbm_value *args, lbm_uint argn);
+
 bool lbm_array_extensions_init(void) {
 
   if (!lbm_get_symbol_by_name("little-endian", &little_endian)) {
@@ -83,6 +87,10 @@ bool lbm_array_extensions_init(void) {
   res = res && lbm_add_extension("bufget-f32", array_extension_buffer_get_f32);
 
   res = res && lbm_add_extension("buflen",  array_extension_buffer_length);
+  res = res && lbm_add_extension("bufclear", array_extensions_bufclear);
+  res = res && lbm_add_extension("bufcpy", array_extensions_bufcpy);
+  res = res && lbm_add_extension("bufset-bit", array_extensions_bufset_bit);
+  
   return res;
 }
 
@@ -960,3 +968,122 @@ lbm_value array_extension_buffer_length(lbm_value *args, lbm_uint argn) {
   }
   return res;
 }
+
+
+static lbm_value array_extensions_bufclear(lbm_value *args, lbm_uint argn) {
+  lbm_value res = ENC_SYM_EERROR;
+
+  if ((argn != 1 && argn != 2 && argn != 3 && argn != 4) || !lbm_is_array(args[0])) {
+    return res;
+  }
+
+  lbm_array_header_t *array = (lbm_array_header_t *)lbm_car(args[0]);
+  if (array->elt_type != LBM_TYPE_BYTE) {
+    return res;
+  }
+
+  uint8_t clear_byte = 0;
+  if (argn >= 2) {
+    if (!lbm_is_number(args[1])) {
+      return res;
+    }
+    clear_byte = (uint8_t)lbm_dec_as_u32(args[1]);
+  }
+
+  unsigned int start = 0;
+  if (argn >= 3) {
+    if (!lbm_is_number(args[2])) {
+      return res;
+    }
+    unsigned int start_new = lbm_dec_as_u32(args[2]);
+    if (start_new < array->size) {
+      start = start_new;
+    } else {
+      return res;
+    }
+  }
+
+  unsigned int len = array->size - start;
+  if (argn >= 4) {
+    if (!lbm_is_number(args[3])) {
+      return res;
+    }
+    unsigned int len_new = lbm_dec_as_u32(args[3]);
+    if (len_new <= len) {
+      len = len_new;
+    }
+  }
+
+  memset((char*)array->data + start, clear_byte, len);
+  res = ENC_SYM_TRUE;
+
+  return res;
+}
+
+static lbm_value array_extensions_bufcpy(lbm_value *args, lbm_uint argn) {
+  lbm_value res = ENC_SYM_EERROR;
+
+  if (argn != 5 || !lbm_is_array(args[0]) || !lbm_is_number(args[1])
+      || !lbm_is_array(args[2]) || !lbm_is_number(args[3]) || !lbm_is_number(args[4])) {
+    return res;
+  }
+
+  lbm_array_header_t *array1 = (lbm_array_header_t *)lbm_car(args[0]);
+  if (array1->elt_type != LBM_TYPE_BYTE) {
+    return res;
+  }
+
+  unsigned int start1 = lbm_dec_as_u32(args[1]);
+
+  lbm_array_header_t *array2 = (lbm_array_header_t *)lbm_car(args[2]);
+  if (array2->elt_type != LBM_TYPE_BYTE) {
+    return res;
+  }
+
+  unsigned int start2 = lbm_dec_as_u32(args[3]);
+  unsigned int len = lbm_dec_as_u32(args[4]);
+
+  if (start1 < array1->size && start2 < array2->size) {
+    if (len > (array1->size - start1)) {
+      len = (array1->size - start1);
+    }
+    if (len > (array2->size - start2)) {
+      len = (array2->size - start2);
+    }
+
+    memcpy((char*)array1->data + start1, (char*)array2->data + start2, len);
+  }
+
+  res = ENC_SYM_TRUE;
+
+  return res;
+}
+
+static lbm_value array_extensions_bufset_bit(lbm_value *args, lbm_uint argn) {
+  lbm_value res = ENC_SYM_EERROR;
+
+  if (argn != 3 || !lbm_is_array(args[0]) ||
+      !lbm_is_number(args[1]) || !lbm_is_number(args[2])) {
+    return res;
+  }
+
+  lbm_array_header_t *array = (lbm_array_header_t *)lbm_car(args[0]);
+  if (array->elt_type != LBM_TYPE_BYTE) {
+    return res;
+  }
+
+  unsigned int pos = lbm_dec_as_u32(args[1]);
+  unsigned int bit = lbm_dec_as_u32(args[2]) ? 1 : 0;
+
+  unsigned int bytepos = pos / 8;
+  unsigned int bitpos = pos % 8;
+
+  if (bytepos < array->size) {
+    ((uint8_t*)array->data)[bytepos] &= (uint8_t)~(1 << bitpos);
+    ((uint8_t*)array->data)[bytepos] |= (uint8_t)(bit << bitpos);
+  }
+
+  res = ENC_SYM_TRUE;
+
+  return res;
+}

src/extensions/math_extensions.c

@@ -1,6 +1,6 @@
 /*
-    Copyright 2022 Joel Svensson        svenssonjoel@yahoo.se
+    Copyright 2022, 2023 Joel Svensson        svenssonjoel@yahoo.se
-    Copyright 2022 Benjamin Vedder
+    Copyright 2022, 2023 Benjamin Vedder
 
     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
@@ -23,20 +23,6 @@
 
 // Helpers
 
-static bool is_number_all(lbm_value *args, lbm_uint argn) {
-	for (lbm_uint i = 0;i < argn;i++) {
-		if (!lbm_is_number(args[i])) {
-			return false;
-		}
-	}
-	return true;
-}
-
-#define CHECK_NUMBER_ALL()			if (!is_number_all(args, argn)) {return ENC_SYM_EERROR;}
-#define CHECK_ARGN(n)				if (argn != n) {return ENC_SYM_EERROR;}
-#define CHECK_ARGN_NUMBER(n)		if (argn != n || !is_number_all(args, argn)) {return ENC_SYM_EERROR;}
-
-
 void rotate_vector3(float *input, float *rotation, float *output, bool reverse) {
   float s1, c1, s2, c2, s3, c3;
 
@@ -81,63 +67,79 @@ void rotate_vector3(float *input, float *rotation, float *output, bool reverse)
 
 // Math
 
-static lbm_value ext_sinf(lbm_value *args, lbm_uint argn) {
+
-  CHECK_ARGN_NUMBER(1)
+static lbm_value ext_sin(lbm_value *args, lbm_uint argn) {
+        LBM_CHECK_ARGN_NUMBER(1)
         return lbm_enc_float(sinf(lbm_dec_as_float(args[0])));
 }
 
-static lbm_value ext_cosf(lbm_value *args, lbm_uint argn) {
+static lbm_value ext_cos(lbm_value *args, lbm_uint argn) {
-  CHECK_ARGN_NUMBER(1)
+        LBM_CHECK_ARGN_NUMBER(1)
         return lbm_enc_float(cosf(lbm_dec_as_float(args[0])));
 }
 
-static lbm_value ext_tanf(lbm_value *args, lbm_uint argn) {
+static lbm_value ext_tan(lbm_value *args, lbm_uint argn) {
-  CHECK_ARGN_NUMBER(1)
+        LBM_CHECK_ARGN_NUMBER(1)
         return lbm_enc_float(tanf(lbm_dec_as_float(args[0])));
 }
 
-static lbm_value ext_asinf(lbm_value *args, lbm_uint argn) {
+static lbm_value ext_asin(lbm_value *args, lbm_uint argn) {
-  CHECK_ARGN_NUMBER(1)
+        LBM_CHECK_ARGN_NUMBER(1)
         return lbm_enc_float(asinf(lbm_dec_as_float(args[0])));
 }
 
-static lbm_value ext_acosf(lbm_value *args, lbm_uint argn) {
+static lbm_value ext_acos(lbm_value *args, lbm_uint argn) {
-  CHECK_ARGN_NUMBER(1)
+        LBM_CHECK_ARGN_NUMBER(1)
         return lbm_enc_float(acosf(lbm_dec_as_float(args[0])));
 }
 
-static lbm_value ext_atanf(lbm_value *args, lbm_uint argn) {
+static lbm_value ext_atan(lbm_value *args, lbm_uint argn) {
-  CHECK_ARGN_NUMBER(1)
+        LBM_CHECK_ARGN_NUMBER(1)
         return lbm_enc_float(atanf(lbm_dec_as_float(args[0])));
 }
 
-static lbm_value ext_atan2f(lbm_value *args, lbm_uint argn) {
+static lbm_value ext_atan2(lbm_value *args, lbm_uint argn) {
-  CHECK_ARGN_NUMBER(2)
+        LBM_CHECK_ARGN_NUMBER(2)
         return lbm_enc_float(atan2f(lbm_dec_as_float(args[0]), lbm_dec_as_float(args[1])));
 }
 
-static lbm_value ext_powf(lbm_value *args, lbm_uint argn) {
+static lbm_value ext_pow(lbm_value *args, lbm_uint argn) {
-  CHECK_ARGN_NUMBER(2)
+        LBM_CHECK_ARGN_NUMBER(2)
         return lbm_enc_float(powf(lbm_dec_as_float(args[0]), lbm_dec_as_float(args[1])));
 }
 
-static lbm_value ext_sqrtf(lbm_value *args, lbm_uint argn) {
+static lbm_value ext_sqrt(lbm_value *args, lbm_uint argn) {
-  CHECK_ARGN_NUMBER(1)
+        LBM_CHECK_ARGN_NUMBER(1)
         return lbm_enc_float(sqrtf(lbm_dec_as_float(args[0])));
 }
 
-static lbm_value ext_logf(lbm_value *args, lbm_uint argn) {
+static lbm_value ext_log(lbm_value *args, lbm_uint argn) {
-  CHECK_ARGN_NUMBER(1)
+        LBM_CHECK_ARGN_NUMBER(1)
         return lbm_enc_float(logf(lbm_dec_as_float(args[0])));
 }
 
-static lbm_value ext_log10f(lbm_value *args, lbm_uint argn) {
+static lbm_value ext_log10(lbm_value *args, lbm_uint argn) {
-  CHECK_ARGN_NUMBER(1)
+        LBM_CHECK_ARGN_NUMBER(1)
         return lbm_enc_float(log10f(lbm_dec_as_float(args[0])));
 }
 
-static lbm_value ext_deg2radf(lbm_value *args, lbm_uint argn) {
+static lbm_value ext_floor(lbm_value *args, lbm_uint argn) {
-  CHECK_NUMBER_ALL();
+        LBM_CHECK_ARGN_NUMBER(1)
+        return lbm_enc_float(floorf(lbm_dec_as_float(args[0])));
+}
+
+static lbm_value ext_ceil(lbm_value *args, lbm_uint argn) {
+        LBM_CHECK_ARGN_NUMBER(1)
+        return lbm_enc_float(ceilf(lbm_dec_as_float(args[0])));
+}
+
+static lbm_value ext_round(lbm_value *args, lbm_uint argn) {
+        LBM_CHECK_ARGN_NUMBER(1)
+        return lbm_enc_float(roundf(lbm_dec_as_float(args[0])));
+}
+
+static lbm_value ext_deg2rad(lbm_value *args, lbm_uint argn) {
+        LBM_CHECK_NUMBER_ALL();
 
         if (argn == 1) {
                 return lbm_enc_float(DEG2RAD_f(lbm_dec_as_float(args[0])));
@@ -150,8 +152,8 @@ static lbm_value ext_deg2radf(lbm_value *args, lbm_uint argn) {
         }
 }
 
-static lbm_value ext_rad2degf(lbm_value *args, lbm_uint argn) {
+static lbm_value ext_rad2deg(lbm_value *args, lbm_uint argn) {
-  CHECK_NUMBER_ALL();
+        LBM_CHECK_NUMBER_ALL();
 
         if (argn == 1) {
                 return lbm_enc_float(RAD2DEG_f(lbm_dec_as_float(args[0])));
@@ -164,8 +166,8 @@ static lbm_value ext_rad2degf(lbm_value *args, lbm_uint argn) {
         }
 }
 
-static lbm_value ext_vec3_rotf(lbm_value *args, lbm_uint argn) {
+static lbm_value ext_vec3_rot(lbm_value *args, lbm_uint argn) {
-  CHECK_NUMBER_ALL();
+        LBM_CHECK_NUMBER_ALL();
         if (argn != 6 && argn != 7) {
                 return ENC_SYM_EERROR;
         }
@@ -192,20 +194,22 @@ static lbm_value ext_vec3_rotf(lbm_value *args, lbm_uint argn) {
 bool lbm_math_extensions_init(void) {
 
   bool res = true;
-  res = res && lbm_add_extension("sin", ext_sinf);
+  res = res && lbm_add_extension("sin", ext_sin);
-  res = res && lbm_add_extension("cos", ext_cosf);
+  res = res && lbm_add_extension("cos", ext_cos);
-  res = res && lbm_add_extension("tan", ext_tanf);
+  res = res && lbm_add_extension("tan", ext_tan);
-  res = res && lbm_add_extension("asin", ext_asinf);
+  res = res && lbm_add_extension("asin", ext_asin);
-  res = res && lbm_add_extension("acos", ext_acosf);
+  res = res && lbm_add_extension("acos", ext_acos);
-  res = res && lbm_add_extension("atan", ext_atanf);
+  res = res && lbm_add_extension("atan", ext_atan);
-  res = res && lbm_add_extension("atan2", ext_atan2f);
+  res = res && lbm_add_extension("atan2", ext_atan2);
-  res = res && lbm_add_extension("pow", ext_powf);
+  res = res && lbm_add_extension("pow", ext_pow);
-  res = res && lbm_add_extension("sqrt", ext_sqrtf);
+  res = res && lbm_add_extension("sqrt", ext_sqrt);
-  res = res && lbm_add_extension("log", ext_logf);
+  res = res && lbm_add_extension("log", ext_log);
-  res = res && lbm_add_extension("log10", ext_log10f);
+  res = res && lbm_add_extension("log10", ext_log10);
-  res = res && lbm_add_extension("deg2rad", ext_deg2radf);
+  res = res && lbm_add_extension("floor", ext_floor);
-  res = res && lbm_add_extension("rad2deg", ext_rad2degf);
+  res = res && lbm_add_extension("ceil", ext_ceil);
-  res = res && lbm_add_extension("vec3-rot", ext_vec3_rotf);
+  res = res && lbm_add_extension("round", ext_round);
-
+  res = res && lbm_add_extension("deg2rad", ext_deg2rad);
+  res = res && lbm_add_extension("rad2deg", ext_rad2deg);
+  res = res && lbm_add_extension("vec3-rot", ext_vec3_rot);
   return res;
 }

src/extensions/matvec_extensions.c

@@ -0,0 +1,354 @@
+/*
+    Copyright 2023 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/>.
+*/
+
+#include "extensions.h"
+#include "lbm_utils.h"
+#include "lbm_custom_type.h"
+
+#include <math.h>
+
+static const char *vector_float_desc = "Vector-Float";
+static const char *matrix_float_desc = "Matrix-Float";
+
+typedef struct {
+  unsigned int size;
+  float data[1];
+} vector_float_t;
+
+static bool common_destructor(lbm_uint value) {
+  lbm_free((void*)value);
+  return true;
+}
+
+static lbm_value vector_float_allocate(lbm_uint size) {
+  vector_float_t *mem = lbm_malloc( 1 * sizeof(lbm_uint) +
+                                    size * sizeof(float));
+  if (!mem) return ENC_SYM_MERROR;
+  mem->size = size;
+  lbm_value res;
+  lbm_custom_type_create((lbm_uint)mem,
+                         common_destructor,
+                         vector_float_desc,
+                         &res);
+  return res;
+}
+
+static bool is_vector_float(lbm_value v) {
+  return ((lbm_uint)lbm_get_custom_descriptor(v) == (lbm_uint)vector_float_desc);
+}
+
+/* **************************************************
+ * Matrices stored in row-major form
+ */
+
+typedef struct {
+  lbm_uint rows;
+  lbm_uint cols;
+  float data[1];
+} matrix_float_t;
+
+static lbm_value matrix_float_allocate(unsigned int rows, unsigned int cols) {
+  matrix_float_t *mem = lbm_malloc(1 * sizeof(lbm_uint) +
+                                   1 * sizeof(lbm_uint) +
+                                   rows * cols * sizeof(float));
+  if (!mem) return ENC_SYM_MERROR;
+  mem->rows = rows;
+  mem->cols = cols;
+  lbm_value res;
+  lbm_custom_type_create((lbm_uint)mem,
+                         common_destructor,
+                         matrix_float_desc,
+                         &res);
+  return res;
+}
+
+static bool is_matrix_float(lbm_value m) {
+  return ((lbm_uint)lbm_get_custom_descriptor(m) == (lbm_uint)matrix_float_desc);
+}
+
+/* **************************************************
+ * Extension implementations
+ */
+
+static lbm_value ext_vector(lbm_value *args, lbm_uint argn) {
+
+  LBM_CHECK_NUMBER_ALL();
+
+  if (argn < 1) return ENC_SYM_TERROR;
+
+  lbm_value vec = vector_float_allocate(argn);
+  if (lbm_is_error(vec)) return vec;
+
+  vector_float_t *lvec = (vector_float_t*)lbm_get_custom_value(vec);
+
+  for (lbm_uint i = 0; i < argn; i ++) {
+    lvec->data[i] = lbm_dec_as_float(args[i]);
+  }
+  return vec;
+}
+
+static lbm_value ext_list_to_vector(lbm_value *args, lbm_uint argn) {
+
+  lbm_value res = ENC_SYM_TERROR;
+
+  if (argn == 1 &&
+      lbm_is_list(args[0])) {
+
+    bool nums = true;
+    unsigned int len = lbm_list_length_pred(args[0], &nums, lbm_is_number);
+
+    if (len > 0 && nums) {
+      lbm_value vec = vector_float_allocate(len);
+      if (lbm_is_error(vec)) return vec;
+      vector_float_t *lvec = (vector_float_t*)lbm_get_custom_value(vec);
+
+      lbm_value curr = args[0];
+      unsigned int i = 0;
+      while (lbm_is_cons(curr)) {
+        lvec->data[i] = lbm_dec_as_float(lbm_car(curr));
+        i ++;
+        curr = lbm_cdr(curr);
+      }
+      res = vec;
+    }
+  }
+  return res;
+}
+
+static lbm_value ext_vector_to_list(lbm_value *args, lbm_uint argn) {
+
+  lbm_value res = ENC_SYM_TERROR;
+  if (argn == 1 && is_vector_float(args[0])) {
+    vector_float_t *lvec = (vector_float_t*)lbm_get_custom_value(args[0]);
+
+    lbm_value result = lbm_heap_allocate_list(lvec->size);
+    if (lbm_is_cons(result)) {
+      lbm_value curr = result;
+      for (lbm_uint i = 0; i < lvec->size; i ++) {
+        lbm_value f_val = lbm_enc_float(lvec->data[i]);
+        if (lbm_is_error(f_val)) {
+          result = f_val;
+          break;
+        }
+        lbm_set_car(curr, f_val);
+        curr = lbm_cdr(curr);
+      }
+      res = result;
+    }
+  }
+  return res;
+}
+
+static lbm_value ext_vproj(lbm_value *args, lbm_uint argn) {
+  lbm_value res = ENC_SYM_TERROR;
+  if (argn == 2 &&
+      is_vector_float(args[0]) &&
+      lbm_is_number(args[1])) {
+    vector_float_t *vec = (vector_float_t*)lbm_get_custom_value(args[0]);
+    uint32_t i = lbm_dec_as_u32(args[1]);
+    if (i < vec->size) {
+      res = lbm_enc_float(vec->data[i]);
+    }
+  }
+  return res;
+}
+
+static lbm_value ext_axpy(lbm_value *args, lbm_uint argn ) {
+
+  lbm_value res = ENC_SYM_TERROR;
+
+  if (argn != 3) return res;
+  lbm_value a = args[0];
+  lbm_value x = args[1];
+  lbm_value y = args[2];
+
+  if (is_vector_float(x) && is_vector_float(y) && lbm_is_number(a)) {
+
+    float alpha = lbm_dec_as_float(a);
+    vector_float_t *X = (vector_float_t*)lbm_get_custom_value(x);
+    vector_float_t *Y = (vector_float_t*)lbm_get_custom_value(y);
+
+    if (X->size == Y->size) {
+
+      unsigned int res_size = X->size;
+
+      res = vector_float_allocate(res_size);
+      if (!lbm_is_symbol_merror(res)) {
+
+        vector_float_t *R = (vector_float_t*)lbm_get_custom_value(res);
+
+        for (unsigned i = 0; i < res_size; i ++) {
+          R->data[i] = alpha * X->data[i] + Y->data[i];
+        }
+      }
+    }
+  }
+  return res;
+}
+
+static lbm_value ext_dot(lbm_value *args, lbm_uint argn) {
+
+  lbm_value res = ENC_SYM_TERROR;
+
+  if (argn != 2) return res;
+  lbm_value x = args[0];
+  lbm_value y = args[1];
+
+  if (is_vector_float(x) && is_vector_float(y)) {
+
+    vector_float_t *X = (vector_float_t*)lbm_get_custom_value(x);
+    vector_float_t *Y = (vector_float_t*)lbm_get_custom_value(y);
+
+    if (X->size == Y->size) {
+      unsigned int res_size = X->size;
+
+      float f_res = 0;
+      for (unsigned i = 0; i < res_size; i ++) {
+        f_res +=  X->data[i] * Y->data[i];
+      }
+      res = lbm_enc_float(f_res);
+    }
+  }
+  return res;
+}
+
+static float vector_float_mag(vector_float_t *v) {
+    float mag = 0.0;
+    for (unsigned int i = 0; i < v->size; i ++) {
+      mag += (v->data[i] * v->data[i]);
+    }
+    mag = sqrtf(mag);
+    return mag;
+}
+
+static lbm_value ext_mag(lbm_value *args, lbm_uint argn) {
+  lbm_value res = ENC_SYM_TERROR;
+
+  if (argn == 1 &&
+      is_vector_float(args[0])) {
+    vector_float_t *v = (vector_float_t *)lbm_get_custom_value(args[0]);
+    float mag = vector_float_mag(v);
+    res = lbm_enc_float(mag);
+  }
+  return res;
+}
+
+static lbm_value ext_vmult(lbm_value *args, lbm_uint argn) {
+  lbm_value res = ENC_SYM_TERROR;
+  if (argn == 2 &&
+      lbm_is_number(args[0]) &&
+      is_vector_float(args[1])) {
+
+    float alpha = lbm_dec_as_float(args[0]);
+    vector_float_t *x = (vector_float_t *)lbm_get_custom_value(args[1]);
+    lbm_value y = vector_float_allocate(x->size);
+    res = y;
+    if (!lbm_is_error(y)) {
+      vector_float_t *y_vec = (vector_float_t *)lbm_get_custom_value(y);
+      for (unsigned int i = 0; i < x->size; i ++) {
+        y_vec->data[i] = alpha * x->data[i];
+      }
+    }
+  }
+  return res;
+}
+
+static lbm_value ext_list_to_matrix(lbm_value *args, lbm_uint argn) {
+
+  lbm_value res = ENC_SYM_TERROR;
+
+  if (argn == 2 &&
+      lbm_is_number(args[0]) &&
+      lbm_is_list(args[1])) {
+
+    bool nums = true;
+    unsigned int len = lbm_list_length_pred(args[1], &nums, lbm_is_number);
+
+    if (len > 0 && nums) {
+      uint32_t cols = lbm_dec_as_u32(args[0]);
+      uint32_t rows = len / cols;
+
+      if (len % cols == 0) {
+        lbm_value mat = matrix_float_allocate(rows, cols);
+        if (lbm_is_error(mat)) return mat;
+        matrix_float_t *lmat = (matrix_float_t*)lbm_get_custom_value(mat);
+
+        lbm_value curr = args[1];
+        unsigned int i = 0;
+        while (lbm_is_cons(curr)) {
+          float f = lbm_dec_as_float(lbm_car(curr));
+          lmat->data[i] = lbm_dec_as_float(lbm_car(curr));
+          i ++;
+          curr = lbm_cdr(curr);
+        }
+        res = mat;
+      }
+    }
+  }
+  return res;
+}
+
+static lbm_value ext_matrix_to_list(lbm_value *args, lbm_uint argn) {
+
+  lbm_value res = ENC_SYM_TERROR;
+  if (argn == 1 && is_matrix_float(args[0])) {
+    matrix_float_t *lmat = (matrix_float_t*)lbm_get_custom_value(args[0]);
+    unsigned int size = lmat->rows * lmat->cols;
+
+    res = lbm_heap_allocate_list(size);
+    if (lbm_is_cons(res)) {
+      lbm_value curr = res;
+      for (unsigned int i = 0; i < size; i ++) {
+        lbm_value f_val = lbm_enc_float(lmat->data[i]);
+        if (lbm_is_error(f_val)) {
+          res = f_val;
+          break;
+        }
+        lbm_set_car(curr, f_val);
+        curr = lbm_cdr(curr);
+      }
+    }
+  }
+  return res;
+}
+
+
+
+/* **************************************************
+ * Initialization
+ */
+
+bool lbm_matvec_extensions_init(void) {
+  bool res = true;
+
+  // Vectors
+  res = res && lbm_add_extension("vector", ext_vector);
+  res = res && lbm_add_extension("list-to-vector", ext_list_to_vector);
+  res = res && lbm_add_extension("vector-to-list", ext_vector_to_list);
+  res = res && lbm_add_extension("vproj", ext_vproj);
+  res = res && lbm_add_extension("axpy", ext_axpy);
+  res = res && lbm_add_extension("dot", ext_dot);
+  res = res && lbm_add_extension("mag", ext_mag);
+  res = res && lbm_add_extension("vmult", ext_vmult);
+
+  // Matrices
+  res = res && lbm_add_extension("list-to-matrix", ext_list_to_matrix);
+  res = res && lbm_add_extension("matrix-to-list", ext_matrix_to_list);
+
+  return res;
+}
+

src/extensions/random_extensions.c

@@ -0,0 +1,49 @@
+/*
+    Copyright 2023 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/>.
+*/
+
+#include <extensions.h>
+#include <lbm_utils.h>
+
+#define M 268435183 //(1 << 28)
+#define A 268435043
+#define C 268434949
+
+
+static lbm_uint random_seed = 177739;
+
+static lbm_value ext_seed(lbm_value *args, lbm_uint argn) {
+
+  LBM_CHECK_ARGN_NUMBER(1);
+
+  random_seed = lbm_dec_as_u32(args[0]);
+  return ENC_SYM_TRUE;
+}
+
+static lbm_value ext_random(lbm_value *args, lbm_uint argn) {
+  (void)args;
+  (void)argn;
+  random_seed = (A * random_seed + C) % M;
+  return lbm_enc_u(random_seed);
+}
+
+bool lbm_random_extensions_init(void) {
+
+  bool res = true;
+  res = res && lbm_add_extension("seed", ext_seed);
+  res = res && lbm_add_extension("random", ext_random);
+  return res;
+}

src/extensions/runtime_extensions.c

@@ -0,0 +1,67 @@
+/*
+    Copyright 2023 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/>.
+*/
+
+#include <lbm_memory.h>
+#include <heap.h>
+#include <eval_cps.h>
+#include <extensions.h>
+#include <lbm_utils.h>
+
+lbm_value ext_eval_set_quota(lbm_value *args, lbm_uint argn) {
+  LBM_CHECK_ARGN_NUMBER(1);
+  uint32_t q = lbm_dec_as_u32(args[0]);
+  lbm_set_eval_step_quota(q);
+  return ENC_SYM_TRUE;
+}
+
+lbm_value ext_memory_num_free(lbm_value *args, lbm_uint argn) {
+  (void)args;
+  (void)argn;
+  lbm_uint n = lbm_memory_num_free();
+  return lbm_enc_i((lbm_int)n);
+}
+
+lbm_value ext_memory_longest_free(lbm_value *args, lbm_uint argn) {
+  (void)args;
+  (void)argn;
+  lbm_uint n = lbm_memory_longest_free();
+  return lbm_enc_i((lbm_int)n);
+}
+
+lbm_value ext_memory_size(lbm_value *args, lbm_uint argn) {
+  (void)args;
+  (void)argn;
+  lbm_uint n = lbm_memory_num_words();
+  return lbm_enc_i((lbm_int)n);
+}
+
+lbm_value ext_memory_word_size(lbm_value *args, lbm_uint argn) {
+  (void)args;
+  (void)argn;
+  return lbm_enc_i((lbm_int)sizeof(lbm_uint));
+}
+
+bool lbm_runtime_extensions_init(void) {
+
+  bool res = true;
+  res = res && lbm_add_extension("set-eval-quota", ext_eval_set_quota);
+  res = res && lbm_add_extension("mem-num-free", ext_memory_num_free);
+  res = res && lbm_add_extension("mem-longest-free", ext_memory_longest_free);
+  res = res && lbm_add_extension("mem-size", ext_memory_size);
+  res = res && lbm_add_extension("word-size", ext_memory_word_size);
+  return res;
+}

src/extensions/string_extensions.c

@@ -1,6 +1,6 @@
 /*
-    Copyright 2022 Joel Svensson        svenssonjoel@yahoo.se
+    Copyright 2022, 2023 Joel Svensson        svenssonjoel@yahoo.se
-    Copyright 2022 Benjamin Vedder
+    Copyright 2022, 2023 Benjamin Vedder
 
     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 +21,7 @@
 #include "heap.h"
 #include "fundamental.h"
 #include "lbm_c_interop.h"
+#include "print.h"
 
 #include <ctype.h>
 
@@ -31,6 +32,15 @@
 #define MAX(a,b) (((a)>(b))?(a):(b))
 #endif
 
+static char print_val_buffer[256];
+
+static size_t strlen_max(const char *s, size_t maxlen) {
+  size_t i;
+  for (i = 0; i < maxlen; i ++) {
+    if (s[i] == 0) break;
+  }
+  return i;
+}
 
 static lbm_value ext_str_from_n(lbm_value *args, lbm_uint argn) {
   if ((argn != 1 && argn != 2) || !lbm_is_number(args[0])) {
@@ -52,7 +62,7 @@ static lbm_value ext_str_from_n(lbm_value *args, lbm_uint argn) {
   switch (lbm_type_of(args[0])) {
   case LBM_TYPE_FLOAT:
     if (!format) {
-      format = "%f";
+      format = "%g";
     }
     len = (size_t)snprintf(buffer, sizeof(buffer), format, (double)lbm_dec_as_float(args[0]));
     break;
@@ -81,18 +91,18 @@ 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) {
-  int len_tot = 0;
+  size_t len_tot = 0;
   for (unsigned int i = 0;i < argn;i++) {
     char *str = lbm_dec_str(args[i]);
     if (str) {
-      len_tot += (int)strlen(str);
+      len_tot += strlen(str);
     } else {
       return ENC_SYM_EERROR;
     }
   }
 
   lbm_value res;
-  if (lbm_create_array(&res, LBM_TYPE_CHAR, (lbm_uint)len_tot + 1)) {
+  if (lbm_create_array(&res, LBM_TYPE_CHAR, len_tot + 1)) {
     lbm_array_header_t *arr = (lbm_array_header_t*)lbm_car(res);
     unsigned int offset = 0;
     for (unsigned int i = 0;i < argn;i++) {
@@ -121,10 +131,10 @@ static lbm_value ext_str_to_i(lbm_value *args, lbm_uint argn) {
       return ENC_SYM_EERROR;
     }
 
-    base = lbm_dec_as_i32(args[1]);
+    base = (int)lbm_dec_as_u32(args[1]);
   }
 
-  return lbm_enc_i(strtol(str, NULL, base));
+  return lbm_enc_i32(strtol(str, NULL, base));
 }
 
 static lbm_value ext_str_to_f(lbm_value *args, lbm_uint argn) {
@@ -152,13 +162,13 @@ static lbm_value ext_str_part(lbm_value *args, lbm_uint argn) {
 
   size_t len = strlen(str);
 
-  uint32_t start = lbm_dec_as_u32(args[1]);
+  unsigned int start = lbm_dec_as_u32(args[1]);
 
   if (start >= len) {
     return ENC_SYM_EERROR;
   }
 
-  uint32_t n = (uint32_t)len - start;
+  unsigned int n = len - start;
   if (argn == 3) {
     if (!lbm_is_number(args[2])) {
       return ENC_SYM_EERROR;
@@ -215,7 +225,7 @@ static lbm_value ext_str_split(lbm_value *args, lbm_uint argn) {
       lbm_value tok;
       if (lbm_create_array(&tok, LBM_TYPE_CHAR, (lbm_uint)step_now + 1)) {
         lbm_array_header_t *arr = (lbm_array_header_t*)lbm_car(tok);
-        memcpy(arr->data, str + ind_now, (size_t)step_now);
+        memcpy(arr->data, str + ind_now, (unsigned int)step_now);
         ((char*)(arr->data))[step_now] = '\0';
         res = lbm_cons(tok, res);
       } else {
@@ -224,13 +234,6 @@ static lbm_value ext_str_split(lbm_value *args, lbm_uint argn) {
     }
 
     return res;
-  } else if (!split) {
-    // This case is here to make static analysis happy.
-    // The SA tools does not seem to understand that there
-    // is a relationship between the split and step variables
-    // such that if split is null step will be greater than zero and if
-    // step is zero, split will be non-nil.
-    return ENC_SYM_MERROR;
   } else {
     lbm_value res = ENC_SYM_NIL;
     const char *s = str;
@@ -278,20 +281,20 @@ static lbm_value ext_str_replace(lbm_value *args, lbm_uint argn) {
   }
 
   // See https://stackoverflow.com/questions/779875/what-function-is-to-replace-a-substring-from-a-string-in-c
-  //char *result; // the return string
+  char *result; // the return string
   char *ins;    // the next insert point
   char *tmp;    // varies
-  int len_rep;  // length of rep (the string to remove)
+  size_t len_rep;  // length of rep (the string to remove)
-  int len_with; // length of with (the string to replace rep with)
+  size_t len_with; // length of with (the string to replace rep with)
-  int len_front; // distance between rep and end of last rep
+  size_t len_front; // distance between rep and end of last rep
   int count;    // number of replacements
 
-  len_rep = (int)strlen(rep);
+  len_rep = strlen(rep);
   if (len_rep == 0) {
     return args[0]; // empty rep causes infinite loop during count
   }
 
-  len_with = (int)strlen(with);
+  len_with = strlen(with);
 
   // count the number of replacements needed
   ins = orig;
@@ -299,12 +302,11 @@ static lbm_value ext_str_replace(lbm_value *args, lbm_uint argn) {
     ins = tmp + len_rep;
   }
 
-  size_t len_res = strlen(orig) + (size_t)((len_with - len_rep) * count + 1);
+  size_t len_res = strlen(orig) + (len_with - len_rep) * (unsigned int)count + 1;
   lbm_value lbm_res;
   if (lbm_create_array(&lbm_res, LBM_TYPE_CHAR, len_res)) {
     lbm_array_header_t *arr = (lbm_array_header_t*)lbm_car(lbm_res);
-    //tmp = result = (char*)arr->data;
+    tmp = result = (char*)arr->data;
-    tmp = (char*)arr->data; // result is never accessed so should not be needed.
   } else {
     return ENC_SYM_MERROR;
   }
@@ -316,8 +318,8 @@ static lbm_value ext_str_replace(lbm_value *args, lbm_uint argn) {
   //    orig points to the remainder of orig after "end of rep"
   while (count--) {
     ins = strstr(orig, rep);
-    len_front = (int)((lbm_uint)ins - (lbm_uint)orig);
+    len_front = (size_t)ins - (unsigned int)orig;
-    tmp = strncpy(tmp, orig, (size_t)len_front) + len_front;
+    tmp = strncpy(tmp, orig, len_front) + len_front;
     tmp = strcpy(tmp, with) + len_with;
     orig += len_front + len_rep; // move to next "end of rep"
   }
@@ -336,11 +338,11 @@ static lbm_value ext_str_to_lower(lbm_value *args, lbm_uint argn) {
     return ENC_SYM_TERROR;
   }
 
-  int len = (int)strlen(orig);
+  size_t len = strlen(orig);
   lbm_value lbm_res;
-  if (lbm_create_array(&lbm_res, LBM_TYPE_CHAR, (lbm_uint)len + 1)) {
+  if (lbm_create_array(&lbm_res, LBM_TYPE_CHAR, len + 1)) {
     lbm_array_header_t *arr = (lbm_array_header_t*)lbm_car(lbm_res);
-    for (int i = 0;i < len;i++) {
+    for (unsigned int i = 0;i < len;i++) {
       ((char*)(arr->data))[i] = (char)tolower(orig[i]);
     }
     ((char*)(arr->data))[len] = '\0';
@@ -375,7 +377,8 @@ static lbm_value ext_str_to_upper(lbm_value *args, lbm_uint argn) {
 }
 
 static lbm_value ext_str_cmp(lbm_value *args, lbm_uint argn) {
-  if (argn != 2) {
+  if (argn != 2 && argn != 3) {
+    lbm_set_error_reason((char*)lbm_error_str_num_args);
     return ENC_SYM_EERROR;
   }
 
@@ -389,30 +392,125 @@ static lbm_value ext_str_cmp(lbm_value *args, lbm_uint argn) {
     return ENC_SYM_EERROR;
   }
 
+  int n = -1;
+  if (argn == 3) {
+    if (!lbm_is_number(args[2])) {
+      return ENC_SYM_EERROR;
+    }
+
+    n = lbm_dec_as_i32(args[2]);
+  }
+
+  if (n > 0) {
+    return lbm_enc_i(strncmp(str1, str2, (unsigned int)n));
+  } else {
     return lbm_enc_i(strcmp(str1, str2));
+  }
 }
 
-static lbm_value ext_str_n_cmp(lbm_value *args, lbm_uint argn) {
+// TODO: This is very similar to ext-print. Maybe they can share code.
-  if (argn != 3) {
+static lbm_value to_str(char *delimiter, lbm_value *args, lbm_uint argn) {
+  const int str_len = 300;
+  char *str = lbm_malloc(str_len);
+  if (!str) {
+    return ENC_SYM_MERROR;
+  }
+
+  int str_ofs = 0;
+
+  for (lbm_uint i = 0; i < argn; i ++) {
+    lbm_value t = args[i];
+    int max = str_len - str_ofs - 1;
+
+    if (lbm_is_ptr(t) && lbm_type_of(t) == LBM_TYPE_ARRAY) {
+      lbm_array_header_t *array = (lbm_array_header_t *)lbm_car(t);
+      switch (array->elt_type){
+      case LBM_TYPE_CHAR: {
+        int chars = 0;
+        if (str_ofs == 0) {
+          chars = snprintf(str + str_ofs, (unsigned int)max, "%s", (char*)array->data);
+        } else {
+          chars = snprintf(str + str_ofs, (unsigned int)max, "%s%s", delimiter, (char*)array->data);
+        }
+        if (chars >= max) {
+          str_ofs += max;
+        } else {
+          str_ofs += chars;
+        }
+      } break;
+      default:
+        return ENC_SYM_NIL;
+        break;
+      }
+    } else if (lbm_type_of(t) == LBM_TYPE_CHAR) {
+      int chars = 0;
+      if (str_ofs == 0) {
+        chars = snprintf(str + str_ofs, (unsigned int)max, "%c", lbm_dec_char(t));
+      } else {
+        chars = snprintf(str + str_ofs, (unsigned int)max, "%s%c", delimiter, lbm_dec_char(t));
+      }
+      if (chars >= max) {
+        str_ofs += max;
+      } else {
+        str_ofs += chars;
+      }
+    }  else {
+      lbm_print_value(print_val_buffer, 256, t);
+
+      int chars = 0;
+      if (str_ofs == 0) {
+        chars = snprintf(str + str_ofs, (unsigned int)max, "%s", print_val_buffer);
+      } else {
+        chars = snprintf(str + str_ofs, (unsigned int)max, "%s%s", delimiter, print_val_buffer);
+      }
+      if (chars >= max) {
+        str_ofs += max;
+      } else {
+        str_ofs += chars;
+      }
+    }
+  }
+
+  lbm_value res;
+  if (lbm_create_array(&res, LBM_TYPE_CHAR, (lbm_uint)str_ofs + 1)) {
+    lbm_array_header_t *arr = (lbm_array_header_t*)lbm_car(res);
+    strncpy((char*)arr->data, str, (unsigned int)str_ofs + 1);
+    lbm_free(str);
+    return res;
+  } else {
+    lbm_free(str);
+    return ENC_SYM_MERROR;
+  }
+}
+
+static lbm_value ext_to_str(lbm_value *args, lbm_uint argn) {
+  return to_str(" ", args, argn);
+}
+
+static lbm_value ext_to_str_delim(lbm_value *args, lbm_uint argn) {
+  if (argn < 1) {
     return ENC_SYM_EERROR;
   }
 
-  char *str1 = lbm_dec_str(args[0]);
+  char *delim = lbm_dec_str(args[0]);
-  if (!str1) {
+  if (!delim) {
     return ENC_SYM_EERROR;
   }
 
-  char *str2 = lbm_dec_str(args[1]);
+  return to_str(delim, args + 1, argn - 1);
-  if (!str2) {
+}
+
+static lbm_value ext_str_len(lbm_value *args, lbm_uint argn) {
+  LBM_CHECK_ARGN(1);
+
+  char *str = lbm_dec_str(args[0]);
+  if (!str) {
     return ENC_SYM_EERROR;
   }
 
-  if (lbm_is_number(args[2])) {
+  lbm_array_header_t *array = (lbm_array_header_t *)lbm_car(args[0]);
-    int n = lbm_dec_as_i32(args[2]);
 
-    return lbm_enc_i(strncmp(str1, str2, n));
+  return lbm_enc_i((int)strlen_max(str, array->size));
-  }
-  return ENC_SYM_TERROR;
 }
 
 
@@ -430,6 +528,9 @@ bool lbm_string_extensions_init(void) {
   res = res && lbm_add_extension("str-to-lower", ext_str_to_lower);
   res = res && lbm_add_extension("str-to-upper", ext_str_to_upper);
   res = res && lbm_add_extension("str-cmp", ext_str_cmp);
-  res = res && lbm_add_extension("str-n-cmp", ext_str_n_cmp);
+  res = res && lbm_add_extension("to-str", ext_to_str);
+  res = res && lbm_add_extension("to-str-delim", ext_to_str_delim);
+  res = res && lbm_add_extension("str-len", ext_str_len);
+
   return res;
 }

src/fundamental.c

@@ -1,5 +1,5 @@
 /*
-    Copyright 2019, 2021, 2022 Joel Svensson   svenssonjoel@yahoo.se
+    Copyright 2019, 2021, 2022, 2023 Joel Svensson   svenssonjoel@yahoo.se
                           2022       Benjamin Vedder
 
     This program is free software: you can redistribute it and/or modify
@@ -1518,6 +1518,16 @@ static lbm_value fundamental_range(lbm_value *args, lbm_uint nargs, eval_context
   return r_list;
 }
 
+static lbm_value fundamental_reg_event_handler(lbm_value *args, lbm_uint argn, eval_context_t *ctx) {
+  (void)ctx;
+  if (argn != 1 || !lbm_is_number(args[0])) {
+    return ENC_SYM_EERROR;
+  }
+
+  lbm_set_event_handler_pid((lbm_cid)lbm_dec_i(args[0]));
+  return ENC_SYM_TRUE;
+}
+
 const fundamental_fun fundamental_table[] =
   { fundamental_add,
     fundamental_sub,
@@ -1577,5 +1587,6 @@ const fundamental_fun fundamental_table[] =
     fundamental_list_length,
     fundamental_range,
     fundamental_num_not_eq,
-    fundamental_not_eq
+    fundamental_not_eq,
+    fundamental_reg_event_handler
   };

src/heap.c

@@ -188,13 +188,12 @@ char *lbm_dec_str(lbm_value val) {
   char *res = 0;
   if (lbm_type_of(val) == LBM_TYPE_ARRAY) {
     lbm_array_header_t *array = (lbm_array_header_t *)lbm_car(val);
-    if (array == NULL) {
+    if (array) {
-      return NULL;
-    }
       if (array->elt_type == LBM_TYPE_CHAR) {
         res = (char *)array->data;
       }
     }
+  }
   return res;
 }
 
@@ -885,6 +884,21 @@ unsigned int lbm_list_length(lbm_value c) {
   return len;
 }
 
+/* calculate the length of a list and check that each element
+   fullfills the predicate pred */
+unsigned int lbm_list_length_pred(lbm_value c, bool *pres, bool (*pred)(lbm_value)) {
+  bool res = true;
+  unsigned int len = 0;
+
+  while (lbm_type_of(c) == LBM_TYPE_CONS){
+    len ++;
+    res = res && pred(lbm_car(c));
+    c = lbm_cdr(c);
+  }
+  *pres = res;
+  return len;
+}
+
 /* reverse a proper list */
 lbm_value lbm_list_reverse(lbm_value list) {
   if (lbm_type_of(list) == LBM_TYPE_SYMBOL) {
@@ -1031,6 +1045,33 @@ int lbm_heap_allocate_array(lbm_value *res, lbm_uint size, lbm_type type){
   return 1;
 }
 
+// Convert a C array into an lbm_array.
+// if the array is in LBM_MEMORY, the lifetime will be managed by the GC.
+int lbm_lift_array(lbm_value *value, char *data, lbm_type type, lbm_uint num_elt) {
+
+  lbm_array_header_t *array = NULL;
+  lbm_value cell  = lbm_heap_allocate_cell(LBM_TYPE_CONS);
+
+  if (lbm_type_of(cell) == LBM_TYPE_SYMBOL) { // Out of heap memory
+    *value = cell;
+    return 0;
+  }
+
+  array = (lbm_array_header_t*)lbm_memory_allocate(sizeof(lbm_array_header_t) / 4);
+
+  if (array == NULL) return 0;
+
+  array->data = (lbm_uint*)data;
+  array->elt_type = type;
+  array->size = num_elt;
+
+  lbm_set_car(cell, (lbm_uint)array);
+  lbm_set_cdr(cell, lbm_enc_sym(SYM_ARRAY_TYPE));
+
+  cell = lbm_set_ptr_type(cell, LBM_TYPE_ARRAY);
+  *value = cell;
+  return 1;
+}
 
 /* Explicitly freeing an array.
 

src/lbm_c_interop.c

@@ -226,29 +226,7 @@ int lbm_undefine(char *symbol) {
 }
 
 int lbm_share_array(lbm_value *value, char *data, lbm_type type, lbm_uint num_elt) {
-
+  return lbm_lift_array(value, data, type, num_elt);
-  lbm_array_header_t *array = NULL;
-  lbm_value cell  = lbm_heap_allocate_cell(LBM_TYPE_CONS);
-
-  if (lbm_type_of(cell) == LBM_TYPE_SYMBOL) { // Out of heap memory
-    *value = cell;
-    return 0;
-  }
-
-  array = (lbm_array_header_t*)lbm_memory_allocate(sizeof(lbm_array_header_t) / 4);
-
-  if (array == NULL) return 0;
-
-  array->data = (lbm_uint*)data;
-  array->elt_type = type;
-  array->size = num_elt;
-
-  lbm_set_car(cell, (lbm_uint)array);
-  lbm_set_cdr(cell, lbm_enc_sym(SYM_ARRAY_TYPE));
-
-  cell = lbm_set_ptr_type(cell, LBM_TYPE_ARRAY);
-  *value = cell;
-  return 1;
 }
 
 int lbm_create_array(lbm_value *value, lbm_type type, lbm_uint num_elt) {

src/lbm_memory.c

@@ -41,10 +41,16 @@ static lbm_uint memory_size;  // in 4 or 8 byte words depending on 32 or 64 bit
 static lbm_uint bitmap_size;  // in 4 or 8 byte words
 static lbm_uint memory_base_address = 0;
 static mutex_t lbm_mem_mutex;
+static bool    lbm_mem_mutex_initialized;
 
 int lbm_memory_init(lbm_uint *data, lbm_uint data_size,
                     lbm_uint *bits, lbm_uint bits_size) {
 
+  if (!lbm_mem_mutex_initialized) {
+    mutex_init(&lbm_mem_mutex);
+  }
+  mutex_lock(&lbm_mem_mutex);
+  int res = 0;
   if (data == NULL || bits == NULL) return 0;
 
   if (((lbm_uint)data % sizeof(lbm_uint) != 0) ||
@@ -56,8 +62,7 @@ int lbm_memory_init(lbm_uint *data, lbm_uint data_size,
     // data is not aligned to sizeof lbm_uint
     // size is too small
     // or size is not a multiple of 4
-    return 0;
+  } else {
-  }
 
     bitmap = bits;
     bitmap_size = bits_size;
@@ -69,9 +74,10 @@ int lbm_memory_init(lbm_uint *data, lbm_uint data_size,
     memory = data;
     memory_base_address = (lbm_uint)data;
     memory_size = data_size;
-
+    res = 1;
-  mutex_init(&lbm_mem_mutex);
+  }
-  return 1;
+  mutex_unlock(&lbm_mem_mutex);
+  return res;
 }
 
 static inline lbm_uint address_to_bitmap_ix(lbm_uint *ptr) {
@@ -325,6 +331,21 @@ int lbm_memory_free(lbm_uint *ptr) {
   }
   return r;
 }
+//Malloc/free like interface
+void* lbm_malloc(size_t size) {
+  lbm_uint alloc_size;
+  if (size % sizeof(lbm_uint) == 0) {
+    alloc_size = size / (sizeof(lbm_uint));
+  } else {
+    alloc_size = (size / (sizeof(lbm_uint))) + 1;
+  }
+
+  return lbm_memory_allocate(alloc_size);
+}
+
+void lbm_free(void *ptr) {
+  lbm_memory_free(ptr);
+}
 
 int lbm_memory_shrink(lbm_uint *ptr, lbm_uint n) {
   lbm_uint ix = address_to_bitmap_ix(ptr);

src/symrepr.c

@@ -196,6 +196,8 @@ special_sym const special_symbols[] =  {
   {"to-double"      , SYM_TO_DOUBLE},
   {"to-byte"        , SYM_TO_BYTE},
 
+  {"event-register-handler", SYM_REG_EVENT_HANDLER},
+
   // fast access in list
   {"ix"             , SYM_IX},
 

src/tokpar.c

@@ -611,7 +611,12 @@ lbm_value lbm_get_next_token(lbm_char_channel_t *chan, bool peek) {
     if (!peek) lbm_channel_drop(chan, (unsigned int)n);
     // TODO: Proper error checking here!
     // TODO: Check if anything has to be allocated for the empty string
-    lbm_heap_allocate_array(&res, (unsigned int)(string_len+1), LBM_TYPE_CHAR);
+    if (!lbm_heap_allocate_array(&res, (unsigned int)(string_len+1), LBM_TYPE_CHAR)) {
+      // Should really be a tokenizer memory error.
+      // GC should run and tokenizer be retried.
+      // Needs some thinking on how to do that.
+      return lbm_enc_sym(TOKENIZER_ERROR);
+    }
     lbm_array_header_t *arr = (lbm_array_header_t*)lbm_car(res);
     char *data = (char *)arr->data;
     memset(data, 0, (string_len+1) * sizeof(char));

tests/test_dot_1.lisp

@@ -0,0 +1,7 @@
+
+(define x (vector 1 2 3))
+(define y (vector 1 5 7))
+
+(define r (dot x y))
+
+(= r 32.0)

tests/test_event_1.lisp

@@ -0,0 +1,12 @@
+
+
+
+(event-register-handler (self))
+
+
+(spawn (fn ()
+           (event-sym 'apa)))
+
+
+
+(recv ((? x) (eq x 'apa)))

tests/test_event_2.lisp

@@ -0,0 +1,10 @@
+
+(event-register-handler (self))
+
+
+(spawn (fn ()
+           (event-array 'apa)))
+
+
+
+(recv (((? x) . (? arr)) (and (eq x 'apa) (eq arr "Hello world"))))

tests/test_event_3.lisp

@@ -0,0 +1,18 @@
+(event-register-handler (self))
+
+
+(spawn (fn ()
+           (progn 
+             (event-sym 'apa)
+             (event-sym 'bepa)
+             (event-array 'cepa))))
+
+
+
+(recv ( apa  1))
+(recv ( bepa 2))
+(recv (( cepa . (? arr)) 3))
+
+
+
+'t

tests/test_event_4.lisp

@@ -0,0 +1,28 @@
+
+
+
+(event-register-handler (self))
+
+(defun event-sender (n)
+  (if (= 0 n) ()
+    (progn
+      (event-sym 'apa)
+      (event-sender (- n 1)))))
+    
+(spawn event-sender 100)
+
+
+
+(and (recv ((? x) (eq x 'apa)))
+     (recv ((? x) (eq x 'apa)))
+     (recv ((? x) (eq x 'apa)))
+     (recv ((? x) (eq x 'apa)))
+     (recv ((? x) (eq x 'apa)))
+     (recv ((? x) (eq x 'apa)))
+     (recv ((? x) (eq x 'apa)))
+     (recv ((? x) (eq x 'apa)))
+     (recv ((? x) (eq x 'apa)))
+     (recv ((? x) (eq x 'apa)))
+     (recv ((? x) (eq x 'apa))))
+     
+

tests/test_lisp_code_cps.c

@@ -1,5 +1,5 @@
 /*
-    Copyright 2018,2020 Joel Svensson   svenssonjoel@yahoo.se
+    Copyright 2018, 2020, 2023 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
@@ -27,6 +27,11 @@
 
 #include "lispbm.h"
 #include "extensions/array_extensions.h"
+#include "extensions/math_extensions.h"
+#include "extensions/string_extensions.h"
+#include "extensions/runtime_extensions.h"
+#include "extensions/matvec_extensions.h"
+#include "extensions/random_extensions.h"
 #include "lbm_channel.h"
 
 #define WAIT_TIMEOUT 2500
@@ -194,6 +199,30 @@ LBM_EXTENSION(ext_numbers, args, argn) {
 }
 
 
+LBM_EXTENSION(ext_event_sym, args, argn) {
+  lbm_value res = ENC_SYM_EERROR;
+  if (argn == 1 && lbm_is_symbol(args[0])) {
+    lbm_event_t e;
+    e.type = LBM_EVENT_SYM;
+    e.sym  = lbm_dec_sym(args[0]);
+    lbm_event(e, NULL, 0);
+    res = ENC_SYM_TRUE;
+  }
+  return res;
+}
+
+LBM_EXTENSION(ext_event_array, args, argn) {
+  lbm_value res = ENC_SYM_EERROR;
+  if (argn == 1 && lbm_is_symbol(args[0])) {
+    lbm_event_t e;
+    e.type = LBM_EVENT_SYM_ARRAY;
+    e.sym = lbm_dec_sym(args[0]);
+    lbm_event(e, "Hello world", 12);
+    res = ENC_SYM_TRUE;
+  }
+  return res;
+}
+
 
 int main(int argc, char **argv) {
 
@@ -263,14 +292,14 @@ int main(int argc, char **argv) {
     return 0;
   }
 
-  lbm_uint *memory = malloc(sizeof(lbm_uint) * LBM_MEMORY_SIZE_12K);
+  lbm_uint *memory = malloc(sizeof(lbm_uint) * LBM_MEMORY_SIZE_14K);
   if (memory == NULL) return 0;
-  lbm_uint *bitmap = malloc(sizeof(lbm_uint) * LBM_MEMORY_BITMAP_SIZE_12K);
+  lbm_uint *bitmap = malloc(sizeof(lbm_uint) * LBM_MEMORY_BITMAP_SIZE_14K);
   if (bitmap == NULL) return 0;
 
 
-  res = lbm_memory_init(memory, LBM_MEMORY_SIZE_12K,
+  res = lbm_memory_init(memory, LBM_MEMORY_SIZE_14K,
-                        bitmap, LBM_MEMORY_BITMAP_SIZE_12K);
+                        bitmap, LBM_MEMORY_BITMAP_SIZE_14K);
   if (res)
     printf("Memory initialized.\n");
   else {
@@ -323,6 +352,14 @@ int main(int argc, char **argv) {
     return 0;
   }
 
+  res = lbm_eval_init_events(20);
+  if (res)
+    printf("Events initialized.\n");
+  else {
+    printf("Error initializing events.\n");
+    return 0;
+  }
+
   res = lbm_extensions_init(extension_storage, EXTENSION_STORAGE_SIZE);
   if (res)
     printf("Extensions initialized.\n");
@@ -331,7 +368,47 @@ int main(int argc, char **argv) {
     return 0;
   }
 
-  lbm_array_extensions_init();
+  if (lbm_array_extensions_init()) {
+    printf("Array extensions initialized.\n");
+  } else {
+    printf("Array extensions failed.\n");
+    return 0;
+  }
+
+  if (lbm_math_extensions_init()) {
+    printf("Math extensions initialized.\n");
+  } else {
+    printf("Math extensions failed.\n");
+    return 0;
+  }
+
+  if (lbm_string_extensions_init()) {
+    printf("String extensions initialized.\n");
+  } else {
+    printf("String extensions failed.\n");
+    return 0;
+  }
+
+  if (lbm_runtime_extensions_init()) {
+    printf("Runtime extensions initialized.\n");
+  } else {
+    printf("Runtime extensions failed.\n");
+    return 0;
+  }
+
+  if (lbm_matvec_extensions_init()) {
+    printf("Matvec extensions initialized.\n");
+  } else {
+    printf("Matvec extensions failed.\n");
+    return 0;
+  }
+
+  if (lbm_random_extensions_init()) {
+    printf("Random extensions initialized.\n");
+  } else {
+    printf("Random extensions failed.\n");
+    return 0;
+  }
 
   res = lbm_add_extension("ext-even", ext_even);
   if (res)
@@ -357,6 +434,22 @@ int main(int argc, char **argv) {
     return 0;
   }
 
+  res = lbm_add_extension("event-sym", ext_event_sym);
+  if (res)
+    printf("Extension added.\n");
+  else {
+    printf("Error adding extension.\n");
+    return 0;
+  }
+
+  res = lbm_add_extension("event-array", ext_event_array);
+  if (res)
+    printf("Extension added.\n");
+  else {
+    printf("Error adding extension.\n");
+    return 0;
+  }
+
   lbm_set_dynamic_load_callback(dyn_load);
   lbm_set_timestamp_us_callback(timestamp_callback);
   lbm_set_usleep_callback(sleep_callback);

tests/test_match_13.lisp

@@ -0,0 +1,6 @@
+
+(defun f (x y)
+  (match (cons x y)
+         ((1 . 2) 'a-symbol)))
+
+(eq (f 1 2) 'a-symbol)

tests/test_match_14.lisp

@@ -0,0 +1,6 @@
+
+(defun f (x y)
+  (match `(,x . ,y)
+         ((1 . 2) 'a-symbol)))
+
+(eq (f 1 2) 'a-symbol)

tests/test_match_15.lisp

@@ -0,0 +1,7 @@
+
+(defun f (x y)
+  (match (cons x y)
+         ((1 . 2) 'a-symbol)
+         ( _ 'whatever)))
+
+(eq (f 1 4) 'whatever)

tests/test_matrix_1.lisp

@@ -0,0 +1,12 @@
+
+
+(def d '(1.0 0.0 0.0
+         0.0 1.0 0.0
+         0.0 0.0 1.0))
+
+(def m (list-to-matrix 3 d))
+                       
+
+(def d-new (matrix-to-list m))
+
+(eq d-new d)

tests/test_memory_1.lisp

@@ -0,0 +1,14 @@
+
+
+(defun repeat (n c)
+  (if (= n 0) nil
+    (progn
+      (c)
+      (repeat (- n 1) c)
+      )))
+
+
+(def n (* 4 (mem-longest-free)))
+(repeat 100 (fn () (array-create (- n 1))))
+
+t

tests/test_memory_2.lisp

@@ -0,0 +1,21 @@
+
+
+(defun repeat (n c)
+  (if (= n 0) 'repeat-done
+    (progn
+      (c)
+      (repeat (- n 1) c)
+      )))
+
+
+(def n (* 4 (mem-longest-free)))
+(defun f () (repeat 100 (fn () (array-create (- n 1500)))))
+
+
+
+(spawn-trap f)
+
+
+(eq (recv ((exit-error (? tid) (? e)) 'error)
+         ((exit-ok    (? tid) (? r)) r))
+   'repeat-done)

tests/test_memory_3.lisp

@@ -0,0 +1,17 @@
+
+
+(def n (* 4 (mem-longest-free)))
+
+(def a (array-create (- n 1500)))
+
+(defun f () (array-create 1500)) ;; Should not succeed
+
+
+(spawn-trap f)
+
+
+(def err (recv ((exit-error (? tid) (? e)) e)
+               ((exit-ok    (? tid) (? r)) r)))
+
+(and (eq err out_of_memory) ;; error caught
+     (= (+ 1 2) 3))         ;; eval is alive

tests/test_random_1.lisp

@@ -0,0 +1,3 @@
+(define r (random))
+
+(eq (type-of r) type-u)

tests/test_range_9.lisp

@@ -0,0 +1,8 @@
+
+(defun f (n) (if (= n 0)
+                 0
+               (progn (range 5) (f (- n 1)))))
+
+;; Trigger gc lots of times.
+(f 100000)
+(eq (range 10) '(0 1 2 3 4 5 6 7 8 9))

tests/test_saxpy_1.lisp

@@ -0,0 +1,9 @@
+
+
+(define x (vector 1.0 2.0 3.0))
+(define y (vector 0.1 0.2 0.3))
+(define alpha 2)
+
+(define r (axpy alpha x y))
+
+(eq (vector-to-list r) (list 2.1 4.2 6.3))

tests/test_saxpy_2.lisp

@@ -0,0 +1,9 @@
+
+
+(define x (vector 1.0 2.0 3.0 4.0 5.0))
+(define y (vector 0.1 0.2 0.3 0.4 0.5))
+(define alpha 2)
+
+(define r (axpy alpha x y))
+
+(eq (vector-to-list r) (list 2.1 4.2 6.3 8.4 10.5))

tests/test_str_cmp_1.lisp

@@ -0,0 +1,21 @@
+
+(defun repeatq (f n)
+  (if ( = n 0)
+      ()
+    (progn
+      f
+      (repeatq f (- n 1)))))
+
+
+(define apa  "a string that is quite unique")
+(define bepa "a string tat is quite oonique")
+
+(gc)
+
+(define n (mem-num-free))
+
+(repeatq '(str-cmp apa bepa) 1000)
+
+(gc)
+
+(= n (mem-num-free))

tests/test_str_from_n_1.lisp

@@ -0,0 +1,10 @@
+
+(gc)
+
+(define n (mem-num-free))
+
+(str-from-n 132)
+
+(gc)
+
+(= n (mem-num-free))

tests/test_str_from_n_2.lisp

@@ -0,0 +1,18 @@
+
+(defun repeat (f n)
+  (if ( = n 0)
+      ()
+    (progn
+      (f n)
+      (repeat f (- n 1)))))
+                    
+
+(gc)
+
+(define n (mem-num-free))
+
+(repeat (lambda (n) (str-from-n n)) 1000)
+
+(gc)
+
+(= n (mem-num-free))

tests/test_str_len_1.lisp

@@ -0,0 +1,19 @@
+
+(defun repeatq (f n)
+  (if ( = n 0)
+      ()
+    (progn
+      f
+      (repeatq f (- n 1)))))
+
+(define my-string "anjovis")
+
+(gc)
+
+(define n (mem-num-free))
+
+(repeatq '(str-len my-string) 1000)
+
+(gc)
+
+(= n (mem-num-free))

tests/test_str_merge_1.lisp

@@ -0,0 +1,21 @@
+
+(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)
+
+(= n (mem-num-free))

tests/test_str_part_1.lisp

@@ -0,0 +1,20 @@
+
+(defun repeatq (f n)
+  (if ( = n 0)
+      ()
+    (progn
+      f
+      (repeatq f (- n 1)))))
+
+
+(define apa "Hello world")
+
+(gc)
+
+(define n (mem-num-free))
+
+(repeatq '(str-part apa 4) 1000)
+
+(gc)
+
+(= n (mem-num-free))

tests/test_str_replace_1.lisp

@@ -0,0 +1,22 @@
+
+(defun repeatq (f n)
+  (if ( = n 0)
+      ()
+    (progn
+      f
+      (repeatq f (- n 1)))))
+
+
+(define apa "a couple of words in a row")
+(define r "words")
+(define w "penguins")
+
+(gc)
+
+(define n (mem-num-free))
+
+(repeatq '(str-replace apa r w) 1000)
+
+(gc)
+
+(= n (mem-num-free))

tests/test_str_split_1.lisp

@@ -0,0 +1,21 @@
+
+(defun repeatq (f n)
+  (if ( = n 0)
+      ()
+    (progn
+      f
+      (repeatq f (- n 1)))))
+
+
+(define apa "a couple of words in a row")
+(define delim " ")
+
+(gc)
+
+(define n (mem-num-free))
+
+(repeatq '(str-split apa delim) 1000)
+
+(gc)
+
+(= n (mem-num-free))

tests/test_str_to_f_1.lisp

@@ -0,0 +1,20 @@
+
+(defun repeatq (f n)
+  (if ( = n 0)
+      ()
+    (progn
+      f
+      (repeatq f (- n 1)))))
+
+
+(define apa "124.321")
+
+(gc)
+
+(define n (mem-num-free))
+
+(repeatq '(str-to-f apa) 1000)
+
+(gc)
+
+(= n (mem-num-free))

tests/test_str_to_i_1.lisp

@@ -0,0 +1,20 @@
+
+(defun repeatq (f n)
+  (if ( = n 0)
+      ()
+    (progn
+      f
+      (repeatq f (- n 1)))))
+
+
+(define apa "124")
+
+(gc)
+
+(define n (mem-num-free))
+
+(repeatq '(str-to-i apa) 1000)
+
+(gc)
+
+(= n (mem-num-free))

tests/test_str_to_lower_1.lisp

@@ -0,0 +1,20 @@
+
+(defun repeatq (f n)
+  (if ( = n 0)
+      ()
+    (progn
+      f
+      (repeatq f (- n 1)))))
+
+
+(define apa "A VERY LOUD STRING")
+
+(gc)
+
+(define n (mem-num-free))
+
+(repeatq '(str-to-lower apa) 1000)
+
+(gc)
+
+(= n (mem-num-free))

tests/test_str_to_upper_1.lisp

@@ -0,0 +1,20 @@
+
+(defun repeatq (f n)
+  (if ( = n 0)
+      ()
+    (progn
+      f
+      (repeatq f (- n 1)))))
+
+
+(define apa "a very gentle string")
+
+(gc)
+
+(define n (mem-num-free))
+
+(repeatq '(str-to-upper apa) 1000)
+
+(gc)
+
+(= n (mem-num-free))

tests/test_to_str_1.lisp

@@ -0,0 +1,17 @@
+
+(defun repeatq (f n)
+  (if ( = n 0)
+      ()
+    (progn
+      f
+      (repeatq f (- n 1)))))
+
+(gc)
+
+(define n (mem-num-free))
+
+(repeatq '(to-str 1 2 3 4 5 6 7 8 9) 1000)
+
+(gc)
+
+(= n (mem-num-free))

tests/test_to_str_delim_1.lisp

@@ -0,0 +1,19 @@
+
+(defun repeatq (f n)
+  (if ( = n 0)
+      ()
+    (progn
+      f
+      (repeatq f (- n 1)))))
+
+(define delim "anjovis")
+
+(gc)
+
+(define n (mem-num-free))
+
+(repeatq '(to-str-delim delim 1 2 3 4 5 6 7 8 9) 1000)
+
+(gc)
+
+(= n (mem-num-free))

tests/test_vector_1.lisp

@@ -0,0 +1,7 @@
+
+
+(def vec (list-to-vector '(1 2 3)))
+(def lis (vector-to-list vec))
+
+
+(eq lis '(1.0 2.0 3.0))

tests/test_vector_2.lisp

@@ -0,0 +1,20 @@
+
+(def v (vector 1.0 2.0 3.0))
+
+(def v2 (vmult 2.0 v))
+
+(defun zipwith (f x y)
+  (match (cons x y)
+         ((_ . nil) nil)
+         ((nil . _) nil)
+         (((? a). (? b)) (cons (f (car a) (car b)) (zipwith f (cdr a) (cdr b))))))
+
+(defun fold (f i x)
+  (match x
+         (nil i)
+         (((? x) . (? xs)) (f x (fold f i xs)))))
+
+(def diff (zipwith (fn (x y) (- x y))  (vector-to-list v2) '(2.0 4.0 6.0)))
+(def sum (fold (fn (x y) (+ x y)) 0.0 diff))
+
+(< sum 0.001)

tests/test_vector_3.lisp

@@ -0,0 +1,7 @@
+
+(def v (list-to-vector '(1.0 2.0 3.0 4.0)))
+
+(and (= (vproj v 0) 1.0)
+     (= (vproj v 1) 2.0)
+     (= (vproj v 2) 3.0)
+     (= (vproj v 3) 4.0))

tests/test_word_size.lisp

@@ -0,0 +1,3 @@
+
+(or (= (word-size 4))
+    (= (word-size 8)))