rusefi
/
bldc
mirror of https://github.com/rusefi/bldc.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Squashed 'lispBM/lispBM/' changes from c94f3404..d77214e9 

d77214e9 a cleaning pass that removes some now dead code and fixes some comments. Also removed a pointless clearing of gc mark bit in allocate_cell and allocate_list
115b38f5 adding closing of read channel in case of errors while reading
9a0fb3ca added some gc tormenting tests that also uses the new list allocator
a75c10a7 fix bug in heap_allocate_list and fix bug in reader (read channel not closed if reading fails)
ad8243d2 rewrote fundamental_range using heap_allocate_list.
b7320588 added lbm_heap_allocate_list and adapted fundamental_list to use it.
20906de7 Rearrangement of heap_allocate_cell. May make cons slightly more efficient

git-subtree-dir: lispBM/lispBM
git-subtree-split: d77214e93497506118add4ff6b3f63520239a445
This commit is contained in:
Benjamin Vedder 2022-12-16 15:38:41 +01:00
parent 0576e2dba1
commit 8b336eecd8
13 changed files with 167 additions and 88 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
include/env.h
View File

@ -41,15 +41,6 @@ lbm_value *lbm_get_env_ptr(void);
* \return the global environment
*/
lbm_value lbm_get_env(void);
/** Performs a shallow copy of a proper list. A shallow copy does
* not recurse into the elements of the list to copy
* those as well. So if the list contains complex elements, the
* original list and the copy will share these elements on the heap.
*
* \param env List to copy.
* \return Shallow copy of input list.
*/
lbm_value lbm_env_copy_shallow(lbm_value env);
/** Lookup a value in from the global environment.
*
* \param sym The key to look for in the environment

5
include/heap.h
View File

@ -303,6 +303,11 @@ lbm_uint lbm_heap_size_bytes(void);
* \return An lbm_value referring to a cons_cell or enc_sym(SYM_MERROR) in case the heap is full.
*/
lbm_value lbm_heap_allocate_cell(lbm_type type);
/** Allocate a list of n heap-cells.
* \param n The number of heap-cells to allocate.
* \return A list of heap-cells of Memory error if unable to allocate.
*/
lbm_value lbm_heap_allocate_list(unsigned int n);
/** Decode an lbm_value representing a string into a C string
*
* \param val Value

4
include/lbm_version.h
View File

@ -33,6 +33,10 @@ extern "C" {
/*! \page changelog Changelog
Dec 11: Version 0.7.1
- Changes to heap_allocate_cell for readability and perhaps performance.
- Added heap_allocate_list for allocation of multiple cells at once.
Nov 9: Version 0.7.1
- Bugfix: string literal lengths.
- not-eq and != added.

23
src/env.c
View File

@ -37,29 +37,6 @@ lbm_value lbm_get_env(void) {
return env_global;
}
// Copies just the skeleton structure of an environment
// The new "copy" will have pointers to the original key-val bindings.
lbm_value lbm_env_copy_shallow(lbm_value env) {
lbm_value res = ENC_SYM_NIL;
lbm_value curr = env;
while (lbm_type_of(curr) == LBM_TYPE_CONS) {
lbm_value key = lbm_car(lbm_car(curr));
if (lbm_dec_sym(key) != SYM_NIL) {
res = lbm_cons(lbm_car(curr), res);
// Check for "out of memory"
if (lbm_type_of(res) == LBM_TYPE_SYMBOL &&
lbm_dec_sym(res) == SYM_MERROR) {
return res;
}
}
curr = lbm_cdr(curr);
}
return res;
}
// A less safe version of lookup. It should be fine unless env is corrupted.
bool lbm_env_lookup_b(lbm_value *res, lbm_value sym, lbm_value env) {

42
src/eval_cps.c
View File

@ -187,7 +187,7 @@ typedef struct {
} eval_context_queue_t;
/* Callbacks and task queue */
/* Process queues */
static eval_context_queue_t blocked = {NULL, NULL};
static eval_context_queue_t sleeping = {NULL, NULL};
static eval_context_queue_t queue = {NULL, NULL};
@ -587,7 +587,7 @@ int lbm_set_error_reason(char *error_str) {
return r;
}
// Not possible to CONS_WITH_GC ins error_ctx_base (potential loop)
// Not possible to CONS_WITH_GC in error_ctx_base (potential loop)
static void error_ctx_base(lbm_value err_val, unsigned int row, unsigned int column) {
ctx_running->r = err_val;
@ -2461,6 +2461,7 @@ static void read_process_token(eval_context_t *ctx, lbm_value stream, lbm_value
ctx->app_cont = true;
} else {
/* Parsing failed */
lbm_channel_reader_close(str);
lbm_set_error_reason((char*)lbm_error_str_parse_eof);
read_error_ctx(lbm_channel_row(str), lbm_channel_column(str));
done_reading(ctx->id);
@ -2540,6 +2541,12 @@ static void cont_read_start_array(eval_context_t *ctx) {
lbm_pop(&ctx->K, &stream);
lbm_char_channel_t *str = lbm_dec_channel(stream);
if (str == NULL || str->state == NULL) {
error_ctx(ENC_SYM_FATAL_ERROR);
return;
}
lbm_uint num_free = lbm_memory_longest_free();
lbm_uint initial_size = (lbm_uint)((float)num_free * 0.9);
if (initial_size == 0) {
@ -2547,6 +2554,7 @@ static void cont_read_start_array(eval_context_t *ctx) {
num_free = lbm_memory_longest_free();
initial_size = (lbm_uint)((float)num_free * 0.9);
if (initial_size == 0) {
lbm_channel_reader_close(str);
error_ctx(ENC_SYM_MERROR);
return;
}
@ -2565,6 +2573,7 @@ static void cont_read_start_array(eval_context_t *ctx) {
case ENC_SYM_TYPE_FLOAT: t = LBM_TYPE_FLOAT; break;
case ENC_SYM_TYPE_CHAR: t = LBM_TYPE_CHAR; break;
default:
lbm_channel_reader_close(str);
error_ctx(ENC_SYM_TERROR);
return;
}
@ -2575,6 +2584,7 @@ static void cont_read_start_array(eval_context_t *ctx) {
lbm_value array;
if (!lbm_heap_allocate_array(&array, initial_size, t)) {
lbm_channel_reader_close(str);
error_ctx(ENC_SYM_FATAL_ERROR);
return;
}
@ -2586,6 +2596,7 @@ static void cont_read_start_array(eval_context_t *ctx) {
lbm_value array;
initial_size = sizeof(lbm_uint) * initial_size;
if (!lbm_heap_allocate_array(&array, initial_size, LBM_TYPE_CHAR)) {
lbm_channel_reader_close(str);
error_ctx(ENC_SYM_FATAL_ERROR);
return;
}
@ -2594,13 +2605,8 @@ static void cont_read_start_array(eval_context_t *ctx) {
CHECK_STACK(lbm_push(&ctx->K, READ_APPEND_ARRAY));
ctx->app_cont = true;
} else {
lbm_char_channel_t *str = lbm_dec_channel(stream);
if (str == NULL) {
error_ctx(ENC_SYM_FATAL_ERROR);
} else {
lbm_channel_reader_close(str);
read_error_ctx(lbm_channel_row(str), lbm_channel_column(str));
}
lbm_channel_reader_close(str);
read_error_ctx(lbm_channel_row(str), lbm_channel_column(str));
}
}
@ -2678,6 +2684,12 @@ static void cont_read_append_continue(eval_context_t *ctx) {
lbm_value last_cell = sptr[1];
lbm_value stream = sptr[2];
lbm_char_channel_t *str = lbm_dec_channel(stream);
if (str == NULL || str->state == NULL) {
error_ctx(ENC_SYM_FATAL_ERROR);
return;
}
if (lbm_type_of(ctx->r) == LBM_TYPE_SYMBOL) {
switch(lbm_dec_sym(ctx->r)) {
@ -2699,8 +2711,12 @@ static void cont_read_append_continue(eval_context_t *ctx) {
return;
}
}
lbm_value new_cell;
CONS_WITH_GC(new_cell, ctx->r, ENC_SYM_NIL, ENC_SYM_NIL);
lbm_value new_cell = cons_with_gc(ctx->r, ENC_SYM_NIL, ENC_SYM_NIL);
if (lbm_is_symbol_merror(new_cell)) {
lbm_channel_reader_close(str);
return;
}
if (lbm_type_of(last_cell) == LBM_TYPE_CONS) {
lbm_set_cdr(last_cell, new_cell);
last_cell = new_cell;
@ -2731,6 +2747,7 @@ static void cont_read_expect_closepar(eval_context_t *ctx) {
ctx->r = res;
ctx->app_cont = true;
} else {
lbm_channel_reader_close(str);
lbm_set_error_reason((char*)lbm_error_str_parse_close);
read_error_ctx(lbm_channel_row(str), lbm_channel_column(str));
done_reading(ctx->id);
@ -2760,6 +2777,7 @@ static void cont_read_dot_terminate(eval_context_t *ctx) {
if (lbm_type_of(ctx->r) == LBM_TYPE_SYMBOL &&
(lbm_dec_sym(ctx->r) == SYM_CLOSEPAR ||
lbm_dec_sym(ctx->r) == SYM_DOT)) {
lbm_channel_reader_close(str);
lbm_set_error_reason((char*)lbm_error_str_parse_dot);
read_error_ctx(lbm_channel_row(str), lbm_channel_column(str));
done_reading(ctx->id);
@ -2775,6 +2793,7 @@ static void cont_read_dot_terminate(eval_context_t *ctx) {
CHECK_STACK(lbm_push_2(&ctx->K, stream, READ_NEXT_TOKEN));
ctx->app_cont = true;
} else {
lbm_channel_reader_close(str);
lbm_set_error_reason((char*)lbm_error_str_parse_dot);
read_error_ctx(lbm_channel_row(str), lbm_channel_column(str));
done_reading(ctx->id);
@ -2801,6 +2820,7 @@ static void cont_read_done(eval_context_t *ctx) {
see if the tokenizer feels it is done here. */
lbm_channel_reader_close(str);
if (tok != ENC_SYM_TOKENIZER_DONE) {
lbm_channel_reader_close(str);
lbm_set_error_reason((char*)lbm_error_str_parse_eof);
read_error_ctx(lbm_channel_row(str), lbm_channel_column(str));
} else {

44
src/fundamental.c
View File

@ -913,11 +913,13 @@ static lbm_value fundamental_cdr(lbm_value *args, lbm_uint nargs, eval_context_t
static lbm_value fundamental_list(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
(void) ctx;
lbm_value result = ENC_SYM_NIL;
for (lbm_uint i = 1; i <= nargs; i ++) {
result = lbm_cons(args[nargs-i], result);
if (lbm_type_of(result) == LBM_TYPE_SYMBOL)
break;
lbm_value result = lbm_heap_allocate_list(nargs);
if (lbm_is_cons(result)) {
lbm_value curr = result;
for (lbm_uint i = 0; i < nargs; i ++) {
lbm_set_car(curr, args[i]);
curr = lbm_cdr(curr);
}
}
return result;
}
@ -1489,25 +1491,31 @@ static lbm_value fundamental_range(lbm_value *args, lbm_uint nargs, eval_context
return result;
}
int num;
if (end == start) return ENC_SYM_NIL;
else if (end < start) {
int32_t tmp = end;
end = start;
start = tmp;
rev = true;
num = start - end;
} else {
num = end - start;
}
int num = end - start;
if ((unsigned int)num > lbm_heap_num_free()) {
return ENC_SYM_MERROR;
lbm_value r_list = lbm_heap_allocate_list((unsigned int)num);
if (lbm_is_cons(r_list)) {
lbm_value curr = r_list;
if (rev) {
for (int i = start-1; i >= end; i --) {
lbm_set_car(curr, lbm_enc_i(i));
curr = lbm_cdr(curr);
}
} else {
for (int i = start; i < end; i ++) {
lbm_set_car(curr, lbm_enc_i(i));
curr = lbm_cdr(curr);
}
}
}
lbm_value r_list = ENC_SYM_NIL;
for (int i = end - 1; i >= start; i --) {
r_list = lbm_cons(lbm_enc_i(i), r_list);
}
return rev ? lbm_list_destructive_reverse(r_list) : r_list;
return r_list;
}
const fundamental_fun fundamental_table[] =

65
src/heap.c
View File

@ -517,38 +517,53 @@ lbm_value lbm_heap_allocate_cell(lbm_type ptr_type) {
lbm_value res;
if (!lbm_is_ptr(lbm_heap_state.freelist)) {
// Free list not a ptr (should be Symbol NIL)
if ((lbm_type_of(lbm_heap_state.freelist) == LBM_TYPE_SYMBOL) &&
(lbm_dec_sym(lbm_heap_state.freelist) == SYM_NIL)) {
// all is as it should be (but no free cells)
return ENC_SYM_MERROR;
} else {
// something is most likely very wrong
return ENC_SYM_FATAL_ERROR;
}
}
// it is a ptr replace freelist with cdr of freelist;
res = lbm_heap_state.freelist;
if (lbm_type_of(res) != LBM_TYPE_CONS) {
if (lbm_type_of(res) == LBM_TYPE_CONS) {
lbm_heap_state.freelist = lbm_cdr(lbm_heap_state.freelist);
lbm_heap_state.num_alloc++;
// set some ok initial values (nil . nil)
lbm_ref_cell(res)->car = ENC_SYM_NIL;
lbm_ref_cell(res)->cdr = ENC_SYM_NIL;
res = res | ptr_type;
return res;
}
else if ((lbm_type_of(lbm_heap_state.freelist) == LBM_TYPE_SYMBOL) &&
(lbm_dec_sym(lbm_heap_state.freelist) == SYM_NIL)) {
// all is as it should be (but no free cells)
return ENC_SYM_MERROR;
}
else {
return ENC_SYM_FATAL_ERROR;
}
}
lbm_heap_state.freelist = lbm_cdr(lbm_heap_state.freelist);
lbm_value lbm_heap_allocate_list(unsigned int n) {
if (n == 0) return ENC_SYM_NIL;
if (lbm_heap_num_free() < n) return ENC_SYM_MERROR;
lbm_heap_state.num_alloc++;
lbm_value res = lbm_heap_state.freelist;
if (lbm_type_of(res) == LBM_TYPE_CONS) {
// set some ok initial values (nil . nil)
lbm_ref_cell(res)->car = ENC_SYM_NIL;
lbm_ref_cell(res)->cdr = ENC_SYM_NIL;
// clear GC bit on allocated cell
clr_gc_mark(lbm_ref_cell(res));
res = res | ptr_type;
return res;
lbm_value curr = res;
unsigned int count = 0;
while (lbm_type_of(curr) == LBM_TYPE_CONS && count < (n - 1)) {
lbm_ref_cell(curr)->car = ENC_SYM_NIL;
curr = lbm_cdr(curr);
count ++;
}
lbm_set_car(curr, ENC_SYM_NIL);
lbm_heap_state.freelist = lbm_cdr(curr);
lbm_set_cdr(curr, ENC_SYM_NIL);
lbm_heap_state.num_alloc+=count;
return res;
} else {
return ENC_SYM_FATAL_ERROR;
}
}
lbm_uint lbm_heap_num_allocated(void) {
@ -705,7 +720,7 @@ int lbm_gc_sweep_phase(void) {
default:
break;
}
}
}
// create pointer to use as new freelist
lbm_uint addr = lbm_enc_cons_ptr(i);

4
src/lbm_memory.c
View File

@ -83,9 +83,9 @@ static inline lbm_uint address_to_bitmap_ix(lbm_uint *ptr) {
}
lbm_int lbm_memory_address_to_ix(lbm_uint *ptr) {
/* TODO: assuming that that index
/* TODO: assuming that index
will have more then enough room in the
positive halv of a 28bit integer */
positive half of a 28bit integer */
return (lbm_int)address_to_bitmap_ix(ptr);
}

1
tests/test_list_5.lisp Normal file
View File

@ -0,0 +1 @@
(eq (list) nil)

8
tests/test_range_5.lisp Normal file
View File

@ -0,0 +1,8 @@
(range 100)
(range 100)
(range 100)
(range 100)
(range 100)
(range 100)
(range 100)
(eq (range 10) '(0 1 2 3 4 5 6 7 8 9))

15
tests/test_range_6.lisp Normal file
View File

@ -0,0 +1,15 @@
;; Force gc about twice in 512 element heap
;; and once in 1024
(range 100)
(range 100)
(range 100)
(range 100)
(range 100)
(range 100)
(range 100)
(range 100)
(range 100)
(range 100)
(range 100)
(range 100)
(eq (range 10) '(0 1 2 3 4 5 6 7 8 9))

27
tests/test_range_7.lisp Normal file
View File

@ -0,0 +1,27 @@
;; Force gc about four times in 512 element heap
;; and twice in 1024
(range 100)
(range 100)
(range 100)
(range 100)
(range 100)
(range 100)
(range 100)
(range 100)
(range 100)
(range 100)
(range 100)
(range 100)
(range 100)
(range 100)
(range 100)
(range 100)
(range 100)
(range 100)
(range 100)
(range 100)
(range 100)
(range 100)
(range 100)
(range 100)
(eq (range 10) '(0 1 2 3 4 5 6 7 8 9))

8
tests/test_range_8.lisp Normal file
View File

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