diff --git a/lispBM/lispBM/benchmarks/fibonacci_tail.lisp b/lispBM/lispBM/benchmarks/fibonacci_tail.lisp index ee7243fc..70c53df9 100644 --- a/lispBM/lispBM/benchmarks/fibonacci_tail.lisp +++ b/lispBM/lispBM/benchmarks/fibonacci_tail.lisp @@ -6,4 +6,4 @@ (fib0 n 0 1)))) -(fib 100) +(fib 23) diff --git a/lispBM/lispBM/src/extensions/array_extensions.c b/lispBM/lispBM/src/extensions/array_extensions.c index 32800046..5b4413fb 100644 --- a/lispBM/lispBM/src/extensions/array_extensions.c +++ b/lispBM/lispBM/src/extensions/array_extensions.c @@ -20,12 +20,14 @@ #include "extensions.h" #include "symrepr.h" +#include "lbm_memory.h" #include 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) { diff --git a/lispBM/lispBM/src/heap.c b/lispBM/lispBM/src/heap.c index ac163bab..5084c240 100644 --- a/lispBM/lispBM/src/heap.c +++ b/lispBM/lispBM/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)) { - lbm_memory_free((uint32_t *)arr); + if (lbm_memory_ptr_inside((uint32_t*)arr->data)) { + 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; diff --git a/lispBM/lispBM/src/lbm_c_interop.c b/lispBM/lispBM/src/lbm_c_interop.c index fb815a67..73fbeff8 100644 --- a/lispBM/lispBM/src/lbm_c_interop.c +++ b/lispBM/lispBM/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); } diff --git a/lispBM/lispBM/tests/test_array_extensions_5.lisp b/lispBM/lispBM/tests/test_array_extensions_5.lisp new file mode 100644 index 00000000..70120941 --- /dev/null +++ b/lispBM/lispBM/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))