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

Merge commit '369b723a16b8c660845f22cbe8894970366427d4'

This commit is contained in:
Benjamin Vedder 2023-09-26 16:21:00 +02:00
parent caff67ef95 369b723a16
commit 234ee30416
11 changed files with 174 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lispBM/lispBM/examples/evaluator.c
View File

@ -250,7 +250,7 @@ int main(int argc, char **argv) {
sleep_callback(10);
}
cid = lbm_load_and_eval_program(&string_tok);
cid = lbm_load_and_eval_program(&string_tok,NULL);
lbm_continue_eval();

2
lispBM/lispBM/include/eval_cps.h
View File

@ -39,7 +39,7 @@ extern "C" {
#define EVAL_CPS_CONTEXT_FLAG_TRAP (uint32_t)0x1
#define EVAL_CPS_CONTEXT_FLAG_CONST (uint32_t)0x2
#define EVAL_CPS_CONTEXT_FLAG_CONST_SYMBOL_STRINGS (uint32_t)0x4
#define EVAL_CPS_CONTEXT_FLAG_INCREMENTAL_READ (uint32_t)0x5
#define EVAL_CPS_CONTEXT_FLAG_INCREMENTAL_READ (uint32_t)0x8
/** The eval_context_t struct represents a lispbm process.
*

2
lispBM/lispBM/include/heap.h
View File

@ -691,7 +691,7 @@ extern lbm_value lbm_enc_u32(uint32_t x);
* \param x float value to encode.
* \return result encoded value.
*/
extern lbm_value lbm_enc_float(lbm_float x);
extern lbm_value lbm_enc_float(float x);
/** Encode a 64 bit integer into an lbm_value.
* \param x 64 bit integer to encode.

1
lispBM/lispBM/include/lbm_defines.h
View File

@ -60,6 +60,7 @@
#define LBM_POINTER_TYPE_FIRST (lbm_uint)0x1000000000000000
#define LBM_TYPE_CONS (lbm_uint)0x1000000000000000
#define LBM_TYPE_CONS_CONST (lbm_uint)0x1400000000000000
#define LBM_NON_CONS_POINTER_TYPE_FIRST (lbm_uint)0x2000000000000000
#define LBM_TYPE_U64 (lbm_uint)0x2800000000000000
#define LBM_TYPE_I64 (lbm_uint)0x3800000000000000

122
lispBM/lispBM/repl/repl.c
View File

@ -55,6 +55,24 @@ lbm_value variable_storage[VARIABLE_STORAGE_SIZE];
lbm_uint constants_memory[CONSTANT_MEMORY_SIZE];
lbm_prof_t prof_data[100];
static lbm_uint sym_res;
static lbm_uint sym_loop;
static lbm_uint sym_break;
static lbm_uint sym_brk;
static lbm_uint sym_rst;
static lbm_uint sym_return;
static lbm_value make_list(int num, ...) {
va_list arguments;
va_start (arguments, num);
lbm_value res = ENC_SYM_NIL;
for (int i = 0; i < num; i++) {
res = lbm_cons(va_arg(arguments, lbm_value), res);
}
va_end (arguments);
return lbm_list_destructive_reverse(res);
}
bool const_heap_write(lbm_uint ix, lbm_uint w) {
if (ix >= CONSTANT_MEMORY_SIZE) return false;
if (constants_memory[ix] == 0xffffffff) {
@ -276,10 +294,95 @@ bool dyn_load(const char *str, const char **code) {
*code = "(define foldl (lambda (f i xs)"
"(if (eq xs nil) i (foldl f (f i (car xs)) (cdr xs)))))";
res = true;
} else if (strncmp(str, "loopforeach", 11) == 0) {
*code = "(define loopforeach (macro (it lst body) (me-loopforeach it lst body)))";
res = true;
} else if (strncmp(str, "looprange", 9) == 0) {
*code = "(define looprange (macro (it start end body) (me-looprange it start end body)))";
res = true;
}
return res;
}
static lbm_value ext_me_loopforeach(lbm_value *args, lbm_uint argn) {
if (argn != 3) {
return ENC_SYM_EERROR;
}
lbm_value it = args[0];
lbm_value lst = args[1];
lbm_value body = args[2];
// (let ((loop (lambda (it rst res break) (if (eq it nil) res (loop (car rst) (cdr rst) body break))))) (call-cc (lambda (brk) (loop (car lst) (cdr lst) nil brk))))
return make_list(3,
lbm_enc_sym(SYM_LET),
make_list(1,
make_list(2,
lbm_enc_sym(sym_loop),
make_list(3,
lbm_enc_sym(SYM_LAMBDA),
make_list(4, it, lbm_enc_sym(sym_rst), lbm_enc_sym(sym_res), lbm_enc_sym(sym_break)),
make_list(4,
lbm_enc_sym(SYM_IF),
make_list(3, lbm_enc_sym(SYM_EQ), it, ENC_SYM_NIL),
lbm_enc_sym(sym_res),
make_list(5,
lbm_enc_sym(sym_loop),
make_list(2, lbm_enc_sym(SYM_CAR), lbm_enc_sym(sym_rst)),
make_list(2, lbm_enc_sym(SYM_CDR), lbm_enc_sym(sym_rst)),
body,
lbm_enc_sym(sym_break))
)))),
make_list(2,
lbm_enc_sym(SYM_CALLCC),
make_list(3,
lbm_enc_sym(SYM_LAMBDA),
make_list(1, lbm_enc_sym(sym_brk)),
make_list(5,
lbm_enc_sym(sym_loop),
make_list(2, lbm_enc_sym(SYM_CAR), lst),
make_list(2, lbm_enc_sym(SYM_CDR), lst),
ENC_SYM_NIL,
lbm_enc_sym(sym_brk)))));
}
static lbm_value ext_me_looprange(lbm_value *args, lbm_uint argn) {
if (argn != 4) {
return ENC_SYM_EERROR;
}
lbm_value it = args[0];
lbm_value start = args[1];
lbm_value end = args[2];
lbm_value body = args[3];
// (let ((loop (lambda (it res break) (if (< it end) (loop (+ it 1) body break) res)))) (call-cc (lambda (brk) (loop start nil brk))))
return make_list(3,
lbm_enc_sym(SYM_LET),
make_list(1,
make_list(2,
lbm_enc_sym(sym_loop),
make_list(3,
lbm_enc_sym(SYM_LAMBDA),
make_list(3, it, lbm_enc_sym(sym_res), lbm_enc_sym(sym_break)),
make_list(4,
lbm_enc_sym(SYM_IF),
make_list(3, lbm_enc_sym(SYM_LT), it, end),
make_list(4, lbm_enc_sym(sym_loop), make_list(3, lbm_enc_sym(SYM_ADD), it, lbm_enc_i(1)), body, lbm_enc_sym(sym_break)),
lbm_enc_sym(sym_res))))),
make_list(2,
lbm_enc_sym(SYM_CALLCC),
make_list(3,
lbm_enc_sym(SYM_LAMBDA),
make_list(1, lbm_enc_sym(sym_brk)),
make_list(4, lbm_enc_sym(sym_loop), start, ENC_SYM_NIL, lbm_enc_sym(sym_brk)))));
}
lbm_value ext_block(lbm_value *args, lbm_uint argn) {
printf("blocking CID: %d\n", (int32_t)lbm_get_current_cid());
@ -592,6 +695,25 @@ int main(int argc, char **argv) {
else
printf("Error adding extension.\n");
res = lbm_add_extension("me-loopforeach", ext_me_loopforeach);
if (res)
printf("Extension added.\n");
else
printf("Error adding extension.\n");
res = lbm_add_extension("me-looprange", ext_me_looprange);
if (res)
printf("Extension added.\n");
else
printf("Error adding extension.\n");
lbm_add_symbol_const("a01", &sym_res);
lbm_add_symbol_const("a02", &sym_loop);
lbm_add_symbol_const("break", &sym_break);
lbm_add_symbol_const("a03", &sym_brk);
lbm_add_symbol_const("a04", &sym_rst);
lbm_add_symbol_const("return", &sym_return);
/* Start evaluator thread */
if (pthread_create(&lispbm_thd, NULL, eval_thd_wrapper, NULL)) {
printf("Error creating evaluation thread\n");

11
lispBM/lispBM/src/eval_cps.c
View File

@ -119,7 +119,6 @@ const char* lbm_error_str_flash_not_possible = "Value cannot be written to flash
const char* lbm_error_str_flash_error = "Error writing to flash";
const char* lbm_error_str_flash_full = "Flash memory is full";
#define WITH_GC(y, x) \
(y) = (x); \
if (lbm_is_symbol_merror((y))) { \
@ -1239,7 +1238,6 @@ static void advance_ctx(eval_context_t *ctx) {
stack_push(&ctx->K, DONE);
get_car_and_cdr(ctx->program, &ctx->curr_exp, &ctx->program);
ctx->curr_env = ENC_SYM_NIL;
ctx->app_cont = false;
} else {
if (ctx_running == ctx) { // This should always be the case because of odd historical reasons.
ok_ctx();
@ -1609,7 +1607,6 @@ static void eval_callcc(eval_context_t *ctx) {
acont), acont);
ctx->curr_exp = app;
ctx->app_cont = false;
}
// (define sym exp)
@ -2531,7 +2528,6 @@ static void cont_closure_application_args(eval_context_t *ctx) {
lbm_stack_drop(&ctx->K, 5);
ctx->curr_env = clo_env;
ctx->curr_exp = exp;
ctx->app_cont = false;
} else if (!a_nil && p_nil) {
// Application with extra arguments
lbm_set_error_reason((char*)lbm_error_str_num_args);
@ -3361,7 +3357,6 @@ static void cont_read_eval_continue(eval_context_t *ctx) {
stack_push_3(&ctx->K, stream, env, READ_EVAL_CONTINUE);
stack_push_3(&ctx->K, stream, lbm_enc_u(1), READ_NEXT_TOKEN);
ctx->app_cont = false;
ctx->curr_env = env;
ctx->curr_exp = ctx->r;
}
@ -3498,7 +3493,6 @@ static void cont_application_start(eval_context_t *ctx) {
// No param closure
ctx->curr_exp = cl[CLO_BODY];
ctx->curr_env = cl[CLO_ENV];
ctx->app_cont = false;
} else {
ctx->app_cont = true;
}
@ -3511,7 +3505,6 @@ static void cont_application_start(eval_context_t *ctx) {
reserved[3] = CLOSURE_ARGS;
ctx->curr_exp = arg0;
ctx->curr_env = arg_env;
ctx->app_cont = false;
}
} break;
case ENC_SYM_CONT:{
@ -3545,7 +3538,6 @@ static void cont_application_start(eval_context_t *ctx) {
memcpy(ctx->K.data, arr->data, arr->size);
ctx->curr_exp = arg;
ctx->app_cont = false;
break;
}
case ENC_SYM_MACRO:{
@ -3582,8 +3574,6 @@ static void cont_application_start(eval_context_t *ctx) {
lbm_value exp = get_cadr(get_cdr(ctx->r));
ctx->curr_exp = exp;
ctx->curr_env = expand_env;
ctx->app_cont = false;
} break;
default:
error_ctx(ENC_SYM_EERROR);
@ -3598,7 +3588,6 @@ static void cont_eval_r(eval_context_t* ctx) {
lbm_pop(&ctx->K, &env);
ctx->curr_exp = ctx->r;
ctx->curr_env = env;
ctx->app_cont = false;
}
/* progn + var stack

16
lispBM/lispBM/src/fundamental.c
View File

@ -265,8 +265,12 @@ static lbm_value assoc_lookup(lbm_value key, lbm_value assoc) {
lbm_value curr = assoc;
while (lbm_is_cons(curr)) {
lbm_value c = lbm_ref_cell(curr)->car;
if (struct_eq(lbm_ref_cell(c)->car, key)) {
return lbm_ref_cell(c)->cdr;
if (lbm_is_cons(c)) {
if (struct_eq(lbm_ref_cell(c)->car, key)) {
return lbm_ref_cell(c)->cdr;
}
} else {
return ENC_SYM_EERROR;
}
curr = lbm_ref_cell(curr)->cdr;
}
@ -277,8 +281,12 @@ static lbm_value cossa_lookup(lbm_value key, lbm_value assoc) {
lbm_value curr = assoc;
while (lbm_is_cons(curr)) {
lbm_value c = lbm_ref_cell(curr)->car;
if (struct_eq(lbm_ref_cell(c)->cdr, key)) {
return lbm_ref_cell(c)->car;
if (lbm_is_cons(c)) {
if (struct_eq(lbm_ref_cell(c)->cdr, key)) {
return lbm_ref_cell(c)->car;
}
} else {
return ENC_SYM_EERROR;
}
curr = lbm_ref_cell(curr)->cdr;
}

6
lispBM/lispBM/src/heap.c
View File

@ -79,7 +79,7 @@ lbm_value lbm_enc_u32(uint32_t x) {
#endif
}
lbm_value lbm_enc_float(lbm_float x) {
lbm_value lbm_enc_float(float x) {
#ifndef LBM64
lbm_uint t;
memcpy(&t, &x, sizeof(lbm_float));
@ -87,8 +87,8 @@ lbm_value lbm_enc_float(lbm_float x) {
if (lbm_type_of(f) == LBM_TYPE_SYMBOL) return f;
return lbm_set_ptr_type(f, LBM_TYPE_FLOAT);
#else
uint32_t t;
memcpy(&t, &x, sizeof(float)); /*TODO: Assumes something about storage here ?*/
lbm_uint t = 0;
memcpy(&t, &x, sizeof(float));
return (((lbm_uint)t) << LBM_VAL_SHIFT) | LBM_TYPE_FLOAT;
#endif
}

9
lispBM/lispBM/tests/test_progn_var_5.lisp Normal file
View File

@ -0,0 +1,9 @@
(defun f (x) {
(var a 10)
(var b 20)
(var a 100)
(+ a b x)
})
(check (= (f 1) 121))

16
lispBM/lispBM/tests/test_setq_3.lisp Normal file
View File

@ -0,0 +1,16 @@
(def x 1)
(def y 2)
(def z 3)
(defun f (x y z) {
(setq x 10)
(setq y 20)
(setq z 30)
(+ x y z)
})
(check (and (= (f 0 0 0) 60)
(= x 1)
(= y 2)
(= z 3)))

8
lispBM/lispBM/tests/test_setq_4.lisp Normal file
View File

@ -0,0 +1,8 @@
(defun f (x) {
(var a 10)
(setq a 100)
(+ x a)
})
(check (= (f 1) 101))