Squashed 'lispBM/lispBM/' changes from 7930b985..f6ae1498

f6ae1498 gc should free array header always
ee321014 fix in unsafe-free
1e9f2399 test of unsafe-free
c97eb831 added unsafe-free to array_extensions
0076f553 fix bug in gc sweep related to arrays allocated in lbm_memory
9c414d5a fix bug in c function for creating array in lbm

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

benchmarks/fibonacci_tail.lisp

@@ -6,4 +6,4 @@
 		(fib0 n 0 1))))
 
 
-(fib 100)
+(fib 23)

src/extensions/array_extensions.c

@@ -20,12 +20,14 @@
 
 #include "extensions.h"
 #include "symrepr.h"
+#include "lbm_memory.h"
 
 #include <math.h>
 
 static lbm_uint little_endian = 0;
 static lbm_uint big_endian = 0;
 
+static lbm_value array_extension_unsafe_free_array(lbm_value *args, lbm_uint argn);
 static lbm_value array_extension_buffer_append_i8(lbm_value *args, lbm_uint argn);
 static lbm_value array_extension_buffer_append_i16(lbm_value *args, lbm_uint argn);
 static lbm_value array_extension_buffer_append_i32(lbm_value *args, lbm_uint argn);
@@ -55,6 +57,7 @@ bool lbm_array_extensions_init(void) {
     }
   }
   bool res = true;
+  res = res && lbm_add_extension("unsafe-free", array_extension_unsafe_free_array);
   res = res && lbm_add_extension("buffer-append-i8", array_extension_buffer_append_i8);
   res = res && lbm_add_extension("buffer-append-i16", array_extension_buffer_append_i16);
   res = res && lbm_add_extension("buffer-append-i32", array_extension_buffer_append_i32);
@@ -73,6 +76,25 @@ bool lbm_array_extensions_init(void) {
   return res;
 }
 
+lbm_value array_extension_unsafe_free_array(lbm_value *args, lbm_uint argn) {
+
+  lbm_value res = lbm_enc_sym(SYM_EERROR);
+  if (argn != 1 ||
+      lbm_type_of(args[0]) != LBM_PTR_TYPE_ARRAY) {
+    return res;
+  }
+  lbm_array_header_t *array = (lbm_array_header_t *)lbm_car(args[0]);
+  if (lbm_memory_ptr_inside(array->data)) {
+    lbm_memory_free((uint32_t *)array->data);
+    lbm_uint ptr = lbm_dec_ptr(args[0]);
+    lbm_value cons_ptr = lbm_enc_cons_ptr(ptr);
+    lbm_set_car(cons_ptr,lbm_enc_sym(SYM_NIL));
+    lbm_set_cdr(cons_ptr,lbm_enc_sym(SYM_NIL));
+    res = lbm_enc_sym(SYM_TRUE);
+  }
+  lbm_memory_free((uint32_t *)array);
+  return res;
+}
 
 lbm_value array_extension_buffer_append_i8(lbm_value *args, lbm_uint argn) {
 

src/heap.c

@@ -474,10 +474,11 @@ int lbm_gc_sweep_phase(void) {
       if (lbm_type_of(heap[i].cdr) == LBM_VAL_TYPE_SYMBOL &&
           lbm_dec_sym(heap[i].cdr) == SYM_ARRAY_TYPE) {
         lbm_array_header_t *arr = (lbm_array_header_t*)heap[i].car;
-        if (lbm_memory_ptr_inside((uint32_t*)arr)) {
+        if (lbm_memory_ptr_inside((uint32_t*)arr->data)) {
-          lbm_memory_free((uint32_t *)arr);
+          lbm_memory_free((uint32_t *)arr->data);
           heap_state.gc_recovered_arrays++;
         }
+        lbm_memory_free((uint32_t *)arr);
       }
 
       // create pointer to use as new freelist
@@ -535,7 +536,7 @@ lbm_value lbm_cdr(lbm_value c){
     return lbm_enc_sym(SYM_NIL); // if nil, return nil.
   }
 
-  if (lbm_type_of(c) == LBM_PTR_TYPE_CONS) {
+  if (lbm_is_ptr(c)) {
     lbm_cons_t *cell = ref_cell(c);
     return read_cdr(cell);
   }
@@ -544,7 +545,7 @@ lbm_value lbm_cdr(lbm_value c){
 
 int lbm_set_car(lbm_value c, lbm_value v) {
   int r = 0;
-  if (lbm_is_ptr(c) && lbm_type_of(c) == LBM_PTR_TYPE_CONS) {
+  if (lbm_type_of(c) == LBM_PTR_TYPE_CONS) {
     lbm_cons_t *cell = ref_cell(c);
     set_car_(cell,v);
     r = 1;

src/lbm_c_interop.c

@@ -236,5 +236,5 @@ int lbm_share_array(lbm_value *value, char *data, lbm_type type, uint32_t num_el
 }
 
 int lbm_create_array(lbm_value *value, lbm_type type, uint32_t num_elt) {
-  return lbm_heap_allocate_array(value, type, num_elt);
+  return lbm_heap_allocate_array(value, num_elt, type);
 }

tests/test_array_extensions_5.lisp

@@ -0,0 +1,7 @@
+
+(define arr (array-create type-byte 16))
+
+(unsafe-free arr)
+
+(and (= (car arr) nil)
+     (= (cdr arr) nil))