mirror of https://github.com/rusefi/bldc.git
Squashed 'lispBM/lispBM/' changes from 20e97c4b..07baa883
07baa883 small tweak to flatten/unflatten 3baa1619 flat values now contain a copy of arrays rather than a pointer to an array c582416d improvement in lbm_lift_array f4229a43 changes to find_receiver_and_send d04a77dd switched to lbm_malloc in lbm_create_ctx 4e2e8ad4 fix buf in lbm_create_ctx thatcould potentially have allocated too little memory for a context 01f3c746 bux fix get_event_value, freed already freed lbm_memory array 2ed2560a bug in unflatten_value 7971a6eb change granularity of locks 51058b80 added an undo_block_ctx_from_extension function and resolved an issue with test_memory_3 on 64 bit platforms git-subtree-dir: lispBM/lispBM git-subtree-split: 07baa883ab18d2f12d69f36cf22aaf9f86954624
This commit is contained in:
parent
6bc0ae9f26
commit
61f48a8fc6
|
@ -222,6 +222,9 @@ lbm_cid lbm_create_ctx(lbm_value program, lbm_value env, lbm_uint stack_size);
|
|||
/** Block a context from an extension
|
||||
*/
|
||||
void lbm_block_ctx_from_extension(void);
|
||||
/** Undo a previous call to lbm_block_ctx_from_extension.
|
||||
*/
|
||||
void lbm_undo_block_ctx_from_extension(void);
|
||||
/** Unblock a context that has been blocked by a C extension
|
||||
* Trying to unblock a context that is waiting on a message
|
||||
* in a mailbox is not encouraged
|
||||
|
|
|
@ -88,7 +88,7 @@ value 4: 0000 0018
|
|||
|
||||
Means bits 0,1,2 will always be empty in a valid address.
|
||||
|
||||
Cons cells also need to be have room for 2 pointers. So each allocated cell from
|
||||
Cons cells also need to be have room for 2 pointers. So each ted cell from
|
||||
memory should be 8bytes.
|
||||
|
||||
Things that needs to be represented within these bits:
|
||||
|
@ -565,6 +565,11 @@ int lbm_lift_array(lbm_value *value, char *data, lbm_type type, lbm_uint num_elt
|
|||
* \param arr Array value.
|
||||
*/
|
||||
int lbm_heap_explicit_free_array(lbm_value arr);
|
||||
/** Query the size in bytes of an lbm_type.
|
||||
* \param t Type
|
||||
* \return Size in bytes of type or 0 if the type represents a composite.
|
||||
*/
|
||||
lbm_uint lbm_size_of(lbm_type t);
|
||||
|
||||
/** Query the type information of a value.
|
||||
*
|
||||
|
|
|
@ -27,14 +27,19 @@ extern "C" {
|
|||
/** LBM major version */
|
||||
#define LBM_MAJOR_VERSION 0
|
||||
/** LBM minor version */
|
||||
#define LBM_MINOR_VERSION 8
|
||||
#define LBM_MINOR_VERSION 9
|
||||
/** LBM patch revision */
|
||||
#define LBM_PATCH_VERSION 1
|
||||
#define LBM_PATCH_VERSION 0
|
||||
|
||||
/*! \page changelog Changelog
|
||||
|
||||
Feb 5 2023: Version 0.8.1
|
||||
- Added queue locking to GC
|
||||
Feb 18 2023: Version 0.9.0
|
||||
- Arrays in flat_value are stored verbatim, not as ptr.
|
||||
- Mutex locking granularity changed in multiple places.
|
||||
|
||||
Feb 10 2023: Version 0.8.1
|
||||
- Flat representation of heap values added.
|
||||
- Added queue locking to GC
|
||||
- As an experiment blocked contexts are unblocked by the evaluator in a safe state.
|
||||
|
||||
Jan 28 2023: Version 0.8.0
|
||||
|
|
|
@ -560,12 +560,12 @@ static eval_context_t *lookup_ctx_nm(eval_context_queue_t *q, lbm_cid cid) {
|
|||
return NULL;
|
||||
}
|
||||
|
||||
static eval_context_t *lookup_ctx(eval_context_queue_t *q, lbm_cid cid) {
|
||||
mutex_lock(&qmutex);
|
||||
eval_context_t *res = lookup_ctx_nm(q,cid);
|
||||
mutex_unlock(&qmutex);
|
||||
return res;
|
||||
}
|
||||
/* static eval_context_t *lookup_ctx(eval_context_queue_t *q, lbm_cid cid) { */
|
||||
/* mutex_lock(&qmutex); */
|
||||
/* eval_context_t *res = lookup_ctx_nm(q,cid); */
|
||||
/* mutex_unlock(&qmutex); */
|
||||
/* return res; */
|
||||
/* } */
|
||||
|
||||
static bool drop_ctx_nm(eval_context_queue_t *q, eval_context_t *ctx) {
|
||||
|
||||
|
@ -609,12 +609,12 @@ static bool drop_ctx_nm(eval_context_queue_t *q, eval_context_t *ctx) {
|
|||
}
|
||||
|
||||
/* Returns true if the context was dropped from the queue */
|
||||
static bool drop_ctx(eval_context_queue_t *q, eval_context_t *ctx) {
|
||||
mutex_lock(&qmutex);
|
||||
bool res = drop_ctx_nm(q,ctx);
|
||||
mutex_unlock(&qmutex);
|
||||
return res;
|
||||
}
|
||||
/* static bool drop_ctx(eval_context_queue_t *q, eval_context_t *ctx) { */
|
||||
/* mutex_lock(&qmutex); */
|
||||
/* bool res = drop_ctx_nm(q,ctx); */
|
||||
/* mutex_unlock(&qmutex); */
|
||||
/* return res; */
|
||||
/* } */
|
||||
|
||||
/* End execution of the running context and add it to the
|
||||
list of finished contexts. */
|
||||
|
@ -625,7 +625,6 @@ static void finish_ctx(void) {
|
|||
}
|
||||
/* Drop the continuation stack immediately to free up lbm_memory */
|
||||
lbm_stack_free(&ctx_running->K);
|
||||
|
||||
if (ctx_done_callback) {
|
||||
ctx_done_callback(ctx_running);
|
||||
}
|
||||
|
@ -806,11 +805,11 @@ static lbm_cid lbm_create_ctx_parent(lbm_value program, lbm_value env, lbm_uint
|
|||
if (lbm_type_of(program) != LBM_TYPE_CONS) return -1;
|
||||
|
||||
eval_context_t *ctx = NULL;
|
||||
ctx = (eval_context_t*)lbm_memory_allocate(sizeof(eval_context_t) / (sizeof(lbm_uint)));
|
||||
ctx = (eval_context_t*)lbm_malloc(sizeof(eval_context_t));
|
||||
if (ctx == NULL) {
|
||||
lbm_gc_mark_phase(2, program, env);
|
||||
gc();
|
||||
ctx = (eval_context_t*)lbm_memory_allocate(sizeof(eval_context_t) / (sizeof(lbm_uint)));
|
||||
ctx = (eval_context_t*)lbm_malloc(sizeof(eval_context_t));
|
||||
}
|
||||
if (ctx == NULL) return -1;
|
||||
|
||||
|
@ -968,43 +967,53 @@ void lbm_block_ctx_from_extension(void) {
|
|||
blocking_extension = true;
|
||||
}
|
||||
|
||||
void lbm_undo_block_ctx_from_extension(void) {
|
||||
blocking_extension = false;
|
||||
mutex_unlock(&blocking_extension_mutex);
|
||||
}
|
||||
|
||||
lbm_value lbm_find_receiver_and_send(lbm_cid cid, lbm_value msg) {
|
||||
mutex_lock(&qmutex);
|
||||
eval_context_t *found = NULL;
|
||||
bool found_blocked = false;
|
||||
|
||||
found = lookup_ctx(&blocked, cid);
|
||||
found = lookup_ctx_nm(&blocked, cid);
|
||||
if (found) found_blocked = true;
|
||||
|
||||
if (found == NULL) {
|
||||
found = lookup_ctx(&queue, cid);
|
||||
found = lookup_ctx_nm(&queue, cid);
|
||||
}
|
||||
|
||||
if (found == NULL) {
|
||||
found = lookup_ctx(&sleeping, cid);
|
||||
found = lookup_ctx_nm(&sleeping, cid);
|
||||
}
|
||||
|
||||
if (found) {
|
||||
if (!mailbox_add_mail(found, msg)) {
|
||||
mutex_unlock(&qmutex);
|
||||
return ENC_SYM_NIL;
|
||||
}
|
||||
|
||||
if (found_blocked){
|
||||
drop_ctx(&blocked,found);
|
||||
drop_ctx(&queue,found);
|
||||
drop_ctx_nm(&blocked,found);
|
||||
//drop_ctx_nm(&queue,found); ????
|
||||
|
||||
enqueue_ctx(&queue,found);
|
||||
enqueue_ctx_nm(&queue,found);
|
||||
}
|
||||
mutex_unlock(&qmutex);
|
||||
return ENC_SYM_TRUE;
|
||||
}
|
||||
|
||||
/* check the current context */
|
||||
if (ctx_running && ctx_running->id == cid) {
|
||||
if (!mailbox_add_mail(ctx_running, msg)) {
|
||||
mutex_unlock(&qmutex);
|
||||
return ENC_SYM_NIL;
|
||||
}
|
||||
mutex_unlock(&qmutex);
|
||||
return ENC_SYM_TRUE;
|
||||
}
|
||||
|
||||
mutex_unlock(&qmutex);
|
||||
return ENC_SYM_NIL;
|
||||
}
|
||||
|
||||
|
@ -3238,14 +3247,15 @@ uint32_t lbm_get_eval_state(void) {
|
|||
|
||||
static void handle_event_unblock_ctx(lbm_cid cid, lbm_value v) {
|
||||
eval_context_t *found = NULL;
|
||||
mutex_lock(&qmutex);
|
||||
|
||||
found = lookup_ctx(&blocked, cid);
|
||||
found = lookup_ctx_nm(&blocked, cid);
|
||||
if (found) {
|
||||
drop_ctx(&blocked,found);
|
||||
drop_ctx_nm(&blocked,found);
|
||||
found->r = v;
|
||||
enqueue_ctx(&queue,found);
|
||||
return;
|
||||
enqueue_ctx_nm(&queue,found);
|
||||
}
|
||||
mutex_unlock(&qmutex);
|
||||
}
|
||||
|
||||
static lbm_value get_event_value(lbm_event_t *e) {
|
||||
|
@ -3259,7 +3269,6 @@ static lbm_value get_event_value(lbm_event_t *e) {
|
|||
lbm_set_flags(LBM_FLAG_HANDLER_EVENT_DELIVERY_FAILED);
|
||||
v = ENC_SYM_EERROR;
|
||||
}
|
||||
lbm_free(fv.buf);
|
||||
} else {
|
||||
v = (lbm_value)e->buf_ptr;
|
||||
}
|
||||
|
@ -3407,13 +3416,15 @@ 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;
|
||||
bool r = false;
|
||||
if (lbm_events) {
|
||||
lbm_events_max = num_events;
|
||||
lbm_events_head = 0;
|
||||
lbm_events_tail = 0;
|
||||
lbm_events_full = false;
|
||||
lbm_event_handler_pid = -1;
|
||||
r = true;
|
||||
}
|
||||
mutex_unlock(&lbm_events_mutex);
|
||||
return true;
|
||||
return r;
|
||||
}
|
||||
|
|
|
@ -569,7 +569,6 @@ static lbm_value cossa_lookup(lbm_value key, lbm_value assoc) {
|
|||
|
||||
static lbm_value fundamental_add(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
|
||||
(void) ctx;
|
||||
|
||||
lbm_uint sum = lbm_enc_u(0);
|
||||
for (lbm_uint i = 0; i < nargs; i ++) {
|
||||
sum = add2(sum, args[i]);
|
||||
|
|
31
src/heap.c
31
src/heap.c
|
@ -1067,7 +1067,7 @@ int lbm_lift_array(lbm_value *value, char *data, lbm_type type, lbm_uint num_elt
|
|||
return 0;
|
||||
}
|
||||
|
||||
array = (lbm_array_header_t*)lbm_memory_allocate(sizeof(lbm_array_header_t) / 4);
|
||||
array = (lbm_array_header_t*)lbm_malloc(sizeof(lbm_array_header_t));
|
||||
|
||||
if (array == NULL) return 0;
|
||||
|
||||
|
@ -1120,3 +1120,32 @@ int lbm_heap_explicit_free_array(lbm_value arr) {
|
|||
|
||||
return r;
|
||||
}
|
||||
|
||||
lbm_uint lbm_size_of(lbm_type t) {
|
||||
lbm_uint s = 0;
|
||||
switch(t) {
|
||||
case LBM_TYPE_BYTE:
|
||||
s = 1;
|
||||
break;
|
||||
case LBM_TYPE_I: /* fall through */
|
||||
case LBM_TYPE_U:
|
||||
case LBM_TYPE_SYMBOL:
|
||||
#ifndef LBM64
|
||||
s = 4;
|
||||
#else
|
||||
s = 8;
|
||||
#endif
|
||||
break;
|
||||
case LBM_TYPE_I32: /* fall through */
|
||||
case LBM_TYPE_U32:
|
||||
case LBM_TYPE_FLOAT:
|
||||
s = 4;
|
||||
break;
|
||||
case LBM_TYPE_I64: /* fall through */
|
||||
case LBM_TYPE_U64:
|
||||
case LBM_TYPE_DOUBLE:
|
||||
s = 8;
|
||||
break;
|
||||
}
|
||||
return s;
|
||||
}
|
||||
|
|
|
@ -1,5 +1,6 @@
|
|||
/*
|
||||
Copyright 2023 Joel Svensson svenssonjoel@yahoo.se
|
||||
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
|
||||
|
@ -19,6 +20,7 @@
|
|||
#include <eval_cps.h>
|
||||
#include <stack.h>
|
||||
|
||||
|
||||
// ------------------------------------------------------------
|
||||
// Access to GC from eval_cps
|
||||
int lbm_perform_gc(void);
|
||||
|
@ -156,18 +158,23 @@ bool f_u64(lbm_flat_value_t *v, uint64_t w) {
|
|||
return res;
|
||||
}
|
||||
|
||||
|
||||
bool f_lbm_array(lbm_flat_value_t *v, uint32_t num_elts, lbm_uint t, uint8_t *data) {
|
||||
bool res = true;
|
||||
res = res && write_byte(v, S_LBM_ARRAY);
|
||||
res = res && write_word(v, num_elts);
|
||||
#ifndef LBM64
|
||||
res = res && write_word(v, t);
|
||||
res = res && write_word(v, (lbm_uint)data);
|
||||
#else
|
||||
res = res && write_dword(v, t);
|
||||
res = res && write_dword(v, (lbm_uint)data);
|
||||
#endif
|
||||
uint32_t num_bytes = num_elts;
|
||||
num_bytes *= lbm_size_of(t);
|
||||
if (res && v->buf_size >= v->buf_pos + num_bytes) {
|
||||
memcpy(v->buf + v->buf_pos, data, num_bytes);
|
||||
v->buf_pos += num_bytes;
|
||||
} else {
|
||||
res = false;
|
||||
}
|
||||
return res;
|
||||
}
|
||||
|
||||
|
@ -210,7 +217,7 @@ static bool extract_dword(lbm_flat_value_t *v, uint64_t *r) {
|
|||
|
||||
/* Recursive and potentially stack hungry for large flat values */
|
||||
static int lbm_unflatten_value_internal(lbm_flat_value_t *v, lbm_value *res) {
|
||||
if (v->buf_size == v->buf_pos) return false;
|
||||
if (v->buf_size == v->buf_pos) return UNFLATTEN_MALFORMED;
|
||||
uint8_t curr = v->buf[v->buf_pos++];
|
||||
|
||||
switch(curr) {
|
||||
|
@ -345,13 +352,13 @@ static int lbm_unflatten_value_internal(lbm_flat_value_t *v, lbm_value *res) {
|
|||
b = extract_dword(v,&t);
|
||||
#endif
|
||||
if (b) {
|
||||
lbm_uint ptr;
|
||||
#ifndef LBM64
|
||||
b = extract_word(v,&ptr);
|
||||
#else
|
||||
b = extract_dword(v,&ptr);
|
||||
#endif
|
||||
if (!lbm_lift_array(res, (char*)ptr, t, num_elt)) {
|
||||
if (lbm_heap_allocate_array(res, num_elt, t)) {
|
||||
lbm_array_header_t *arr = (lbm_array_header_t*)lbm_car(*res);
|
||||
lbm_uint num_bytes = num_elt;
|
||||
num_bytes *= lbm_size_of(t);
|
||||
memcpy(arr->data, v->buf + v->buf_pos, num_bytes);
|
||||
v->buf_pos += num_bytes;
|
||||
} else {
|
||||
return UNFLATTEN_GC_RETRY;
|
||||
}
|
||||
return UNFLATTEN_OK;
|
||||
|
|
|
@ -323,10 +323,6 @@ static lbm_uint *lbm_memory_allocate_internal(lbm_uint num_words) {
|
|||
}
|
||||
|
||||
lbm_uint *lbm_memory_allocate(lbm_uint num_words) {
|
||||
if (memory_num_free < num_words) {
|
||||
lbm_request_gc();
|
||||
return NULL;
|
||||
}
|
||||
if (memory_num_free - num_words < memory_reserve_level) {
|
||||
lbm_request_gc();
|
||||
return NULL;
|
||||
|
|
|
@ -264,24 +264,12 @@ LBM_EXTENSION(ext_event_list_of_float, args, argn) {
|
|||
LBM_EXTENSION(ext_event_array, args, argn) {
|
||||
lbm_value res = ENC_SYM_EERROR;
|
||||
if (argn == 1 && lbm_is_symbol(args[0])) {
|
||||
char *array = lbm_malloc(12);
|
||||
array[0] = 'h';
|
||||
array[1] = 'e';
|
||||
array[2] = 'l';
|
||||
array[3] = 'l';
|
||||
array[4] = 'o';
|
||||
array[5] = ' ';
|
||||
array[6] = 'w';
|
||||
array[7] = 'o';
|
||||
array[8] = 'r';
|
||||
array[9] = 'l';
|
||||
array[10] = 'd';
|
||||
array[11] = 0;
|
||||
char *hello = "hello world";
|
||||
lbm_flat_value_t v;
|
||||
if (lbm_start_flatten(&v, 100)) {
|
||||
f_cons(&v);
|
||||
f_sym(&v,lbm_dec_sym(args[0]));
|
||||
f_lbm_array(&v, 12, LBM_TYPE_CHAR, (uint8_t*)array);
|
||||
f_lbm_array(&v, 12, LBM_TYPE_CHAR, (uint8_t*)hello);
|
||||
lbm_finish_flatten(&v);
|
||||
lbm_event(&v);
|
||||
res = ENC_SYM_TRUE;
|
||||
|
@ -382,14 +370,24 @@ int main(int argc, char **argv) {
|
|||
return 0;
|
||||
}
|
||||
|
||||
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_14K);
|
||||
if (bitmap == NULL) return 0;
|
||||
lbm_uint *memory = NULL;
|
||||
lbm_uint *bitmap = NULL;
|
||||
if (sizeof(lbm_uint) == 4) {
|
||||
memory = malloc(sizeof(lbm_uint) * LBM_MEMORY_SIZE_14K);
|
||||
if (memory == NULL) return 0;
|
||||
bitmap = malloc(sizeof(lbm_uint) * LBM_MEMORY_BITMAP_SIZE_14K);
|
||||
if (bitmap == NULL) return 0;
|
||||
res = lbm_memory_init(memory, LBM_MEMORY_SIZE_14K,
|
||||
bitmap, LBM_MEMORY_BITMAP_SIZE_14K);
|
||||
} else {
|
||||
memory = malloc(sizeof(lbm_uint) * LBM_MEMORY_SIZE_1M);
|
||||
if (memory == NULL) return 0;
|
||||
bitmap = malloc(sizeof(lbm_uint) * LBM_MEMORY_BITMAP_SIZE_1M);
|
||||
if (bitmap == NULL) return 0;
|
||||
res = lbm_memory_init(memory, LBM_MEMORY_SIZE_1M,
|
||||
bitmap, LBM_MEMORY_BITMAP_SIZE_1M);
|
||||
}
|
||||
|
||||
|
||||
res = lbm_memory_init(memory, LBM_MEMORY_SIZE_14K,
|
||||
bitmap, LBM_MEMORY_BITMAP_SIZE_14K);
|
||||
if (res)
|
||||
printf("Memory initialized.\n");
|
||||
else {
|
||||
|
|
|
@ -2,16 +2,19 @@
|
|||
|
||||
(def n (* (word-size) (mem-longest-free)))
|
||||
|
||||
(def a (array-create (- n 1500)))
|
||||
(def a (array-create (/ n 2)))
|
||||
|
||||
(defun f () (array-create 1500)) ;; Should not succeed
|
||||
(defun f ()
|
||||
(progn
|
||||
(+ 1 2)
|
||||
(array-create (/ n 2)))) ;; Should not succeed
|
||||
|
||||
|
||||
(spawn-trap f)
|
||||
|
||||
|
||||
(def err (recv ((exit-error (? tid) (? e)) e)
|
||||
(def res (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
|
||||
(and (eq res out_of_memory) ;; error caught
|
||||
(= (+ 1 2) 3)) ;; eval is alive
|
||||
|
|
|
@ -0,0 +1,18 @@
|
|||
|
||||
|
||||
(def n (* (word-size) (mem-longest-free)))
|
||||
|
||||
(def a (array-create (/ n 4)))
|
||||
|
||||
(defun f ()
|
||||
(array-create (/ n 4))) ;; probably fine
|
||||
|
||||
|
||||
(spawn-trap f)
|
||||
|
||||
|
||||
(def res (recv ((exit-error (? tid) (? e)) e)
|
||||
((exit-ok (? tid) (? r)) r)))
|
||||
|
||||
(and (eq (type-of res) 'type-array ) ;; OK status cought
|
||||
(= (+ 1 2) 3)) ;; eval is alive
|
Loading…
Reference in New Issue