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

Merge commit 'fb303346de910fa234a478addc4d705ac4b18112'

This commit is contained in:
Benjamin Vedder 2022-09-23 14:04:35 +02:00
parent ed60bf7306 fb303346de
commit babb352df2
15 changed files with 170 additions and 136 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
lispBM/lispBM/README.md
View File

@ -11,10 +11,7 @@ The LispBM mascot, Lispy the llama, was created by
## Information
From version 0.6.0 LispBM implements round-robin scheduling and is
no-longer cooperatively concurrent. The documentation is not yet
updated to reflect this change. If it turns out that the new approach
to scheduling makes sense over time, the documentation will be
updated.
no-longer cooperatively concurrent.
This is not a semantics preserving update. Using the cooperative
scheduler one could assume totally exclusive access to the runtime

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

@ -41,11 +41,8 @@ lbm_value variable_storage[VARIABLE_STORAGE_SIZE];
/* Tokenizer state for strings */
static lbm_tokenizer_string_state_t string_tok_state;
/* Tokenizer statefor compressed data */
static tokenizer_compressed_state_t comp_tok_state;
/* shared tokenizer */
static lbm_tokenizer_char_stream_t string_tok;
static lbm_string_channel_state_t string_tok_state;
static lbm_char_channel_t string_tok;
bool dyn_load(const char *str, const char **code) {
@ -166,20 +163,16 @@ void *eval_thd_wrapper(void *v) {
int main(int argc, char **argv) {
unsigned int heap_size = 8 * 1024 * 1024; // 8 Megabytes is standard
bool compress_decompress = false;
pthread_t lispbm_thd;
int c;
opterr = 1;
while (( c = getopt(argc, argv, "gch:")) != -1) {
while (( c = getopt(argc, argv, "gh:")) != -1) {
switch (c) {
case 'h':
heap_size = (unsigned int)atoi((char *)optarg);
break;
case 'c':
compress_decompress = true;
break;
case '?':
break;
default:
@ -188,7 +181,6 @@ int main(int argc, char **argv) {
}
printf("------------------------------------------------------------\n");
printf("Heap size: %u\n", heap_size);
printf("Compression: %s\n", compress_decompress ? "yes" : "no");
printf("------------------------------------------------------------\n");
if (argc - optind < 1) {
@ -249,27 +241,9 @@ int main(int argc, char **argv) {
lbm_cid cid;
lbm_value t;
char *compressed_code;
char decompress_code[8192];
if (compress_decompress) {
uint32_t compressed_size = 0;
compressed_code = lbm_compress(code_buffer, &compressed_size);
if (!compressed_code) {
printf("Error compressing code\n");
return 0;
}
lbm_decompress(decompress_code, 8192, compressed_code);
printf("\n\nDECOMPRESS TEST: %s\n\n", decompress_code);
lbm_create_char_stream_from_compressed(&comp_tok_state,
&string_tok,
compressed_code);
} else {
lbm_create_char_stream_from_string(&string_tok_state,
&string_tok,
code_buffer);
}
lbm_create_string_char_channel(&string_tok_state,
&string_tok,
code_buffer);
lbm_pause_eval();
while(lbm_get_eval_state() != EVAL_CPS_STATE_PAUSED) {
@ -280,13 +254,7 @@ int main(int argc, char **argv) {
lbm_continue_eval();
t = lbm_wait_ctx(cid, WAIT_TIMEOUT);
char output[1024];
if (compress_decompress) {
free(compressed_code);
}
lbm_wait_ctx(cid, WAIT_TIMEOUT);
return 0;
}

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

@ -767,8 +767,7 @@ static inline bool lbm_is_channel(lbm_value x) {
lbm_dec_sym(lbm_cdr(x)) == SYM_CHANNEL_TYPE);
}
static inline bool lbm_is_char(lbm_value x) {
lbm_uint t = lbm_type_of(x);
return (t == LBM_TYPE_CHAR);
return (lbm_type_of(x) == LBM_TYPE_CHAR);
}
static inline bool lbm_is_special(lbm_value symrep) {
@ -847,11 +846,8 @@ static inline bool lbm_is_symbol_merror(lbm_value exp) {
/* all error signaling symbols are in the range 0x20 - 0x2F */
static inline bool lbm_is_error(lbm_value v){
if (lbm_type_of(v) == LBM_TYPE_SYMBOL &&
((lbm_dec_sym(v) & ERROR_SYMBOL_MASK) == 0x20)) {
return true;
}
return false;
return (lbm_type_of(v) == LBM_TYPE_SYMBOL &&
((lbm_dec_sym(v) & ERROR_SYMBOL_MASK) == 0x20));
}
// ref_cell: returns a reference to the cell addressed by bits 3 - 26

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

@ -85,7 +85,7 @@
#define LBM_TYPE_I32 (lbm_uint)0x18// 00 01 10 0 0
#define LBM_TYPE_FLOAT (lbm_uint)0x1C// 00 01 11 0 0
#endif
#endif
/* ------------------------------------------------------------
Built in symbols
------------------------------------------------------------ */
@ -290,6 +290,7 @@
#define ENC_SYM_NO_MATCH ((SYM_NO_MATCH << LBM_VAL_SHIFT) | LBM_TYPE_SYMBOL)
#define ENC_SYM_NIL ((SYM_NIL << LBM_VAL_SHIFT) | LBM_TYPE_SYMBOL)
#define ENC_SYM_RECOVERED ((SYM_RECOVERED << LBM_VAL_SHIFT) | LBM_TYPE_SYMBOL)
#define ENC_SYM_TRUE ((SYM_TRUE << LBM_VAL_SHIFT) | LBM_TYPE_SYMBOL)
#define ENC_SYM_ARRAY_TYPE ((SYM_ARRAY_TYPE << LBM_VAL_SHIFT) | LBM_TYPE_SYMBOL)
@ -308,6 +309,12 @@
#define ENC_SYM_WAIT ((SYM_WAIT << LBM_VAL_SHIFT) | LBM_TYPE_SYMBOL)
#define ENC_SYM_SEND ((SYM_SEND << LBM_VAL_SHIFT) | LBM_TYPE_SYMBOL)
#define ENC_SYM_CONS ((SYM_CONS << LBM_VAL_SHIFT) | LBM_TYPE_SYMBOL)
#define ENC_SYM_CAR ((SYM_CAR << LBM_VAL_SHIFT) | LBM_TYPE_SYMBOL)
#define ENC_SYM_CDR ((SYM_CDR << LBM_VAL_SHIFT) | LBM_TYPE_SYMBOL)
#define ENC_SYM_LIST ((SYM_LIST << LBM_VAL_SHIFT) | LBM_TYPE_SYMBOL)
#define ENC_SYM_APPEND ((SYM_APPEND << LBM_VAL_SHIFT) | LBM_TYPE_SYMBOL)
#define ENC_SYM_QUOTE ((SYM_QUOTE << LBM_VAL_SHIFT) | LBM_TYPE_SYMBOL)
#define ENC_SYM_COMMA ((SYM_COMMA << LBM_VAL_SHIFT) | LBM_TYPE_SYMBOL)
#define ENC_SYM_COMMAAT ((SYM_COMMAAT << LBM_VAL_SHIFT) | LBM_TYPE_SYMBOL)

14
lispBM/lispBM/src/env.c
View File

@ -25,7 +25,7 @@
lbm_value env_global;
int lbm_init_env(void) {
env_global = lbm_enc_sym(SYM_NIL);
env_global = ENC_SYM_NIL;
return 1;
}
@ -41,7 +41,7 @@ lbm_value lbm_get_env(void) {
// The new "copy" will have pointers to the original key-val bindings.
lbm_value lbm_env_copy_shallow(lbm_value env) {
lbm_value res = lbm_enc_sym(SYM_NIL);
lbm_value res = ENC_SYM_NIL;
lbm_value curr = env;
while (lbm_type_of(curr) == LBM_TYPE_CONS) {
@ -94,7 +94,7 @@ lbm_value lbm_env_lookup(lbm_value sym, lbm_value env) {
}
curr = lbm_cdr(curr);
}
return lbm_enc_sym(SYM_NOT_FOUND);
return ENC_SYM_NOT_FOUND;
}
lbm_value lbm_env_set(lbm_value env, lbm_value key, lbm_value val) {
@ -136,7 +136,7 @@ lbm_value lbm_env_modify_binding(lbm_value env, lbm_value key, lbm_value val) {
curr = lbm_cdr(curr);
}
return lbm_enc_sym(SYM_NOT_FOUND);
return ENC_SYM_NOT_FOUND;
}
lbm_value lbm_env_build_params_args(lbm_value params,
@ -148,7 +148,7 @@ lbm_value lbm_env_build_params_args(lbm_value params,
// TODO: This should be checked outside of this function.
//
if (lbm_list_length(params) != lbm_list_length(args)) { // programmer error
return lbm_enc_sym(SYM_FATAL_ERROR);
return ENC_SYM_FATAL_ERROR;
}
lbm_value env = env0;
@ -157,13 +157,13 @@ lbm_value lbm_env_build_params_args(lbm_value params,
lbm_value entry = lbm_cons(lbm_car(curr_param), lbm_car(curr_arg));
if (lbm_type_of(entry) == LBM_TYPE_SYMBOL &&
lbm_dec_sym(entry) == SYM_MERROR)
return lbm_enc_sym(SYM_MERROR);
return ENC_SYM_MERROR;
env = lbm_cons(entry,env);
if (lbm_type_of(env) == LBM_TYPE_SYMBOL &&
lbm_dec_sym(env) == SYM_MERROR)
return lbm_enc_sym(SYM_MERROR);
return ENC_SYM_MERROR;
curr_param = lbm_cdr(curr_param);
curr_arg = lbm_cdr(curr_arg);

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

@ -731,9 +731,10 @@ void lbm_block_ctx_from_extension(void) {
lbm_value lbm_find_receiver_and_send(lbm_cid cid, lbm_value msg) {
eval_context_t *found = NULL;
bool found_sleeping = false;
bool found_blocked = false;
found = lookup_ctx(&blocked, cid);
if (found) found_blocked = true;
if (found == NULL) {
found = lookup_ctx(&queue, cid);
@ -741,7 +742,6 @@ lbm_value lbm_find_receiver_and_send(lbm_cid cid, lbm_value msg) {
if (found == NULL) {
found = lookup_ctx(&sleeping, cid);
found_sleeping = true;
}
if (found) {
@ -753,7 +753,7 @@ lbm_value lbm_find_receiver_and_send(lbm_cid cid, lbm_value msg) {
found->mailbox = new_mailbox;
if (!found_sleeping){
if (found_blocked){
drop_ctx(&blocked,found);
drop_ctx(&queue,found);
@ -1118,10 +1118,9 @@ static inline bool eval_symbol(eval_context_t *ctx, lbm_value *value) {
if (lbm_env_lookup_b(value, ctx->curr_exp, ctx->curr_env)) {
return true;
} else if (lbm_env_lookup_b(value, ctx->curr_exp, *lbm_get_env_ptr())) {
return true;
} else {
return lbm_env_lookup_b(value, ctx->curr_exp, *lbm_get_env_ptr());
}
return false;
}
static inline void dynamic_load(eval_context_t *ctx) {

2
lispBM/lispBM/src/extensions.c
View File

@ -31,7 +31,7 @@ static extension_fptr *extension_table = NULL;
lbm_value lbm_extensions_default(lbm_value *args, lbm_uint argn) {
(void)args;
(void)argn;
return lbm_enc_sym(SYM_EERROR);
return ENC_SYM_EERROR;
}
int lbm_extensions_init(extension_fptr *extension_storage, int extension_storage_size) {

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

@ -33,9 +33,6 @@
lbm_heap_state_t lbm_heap_state;
static lbm_value NIL;
static lbm_value RECOVERED;
char *lbm_dec_str(lbm_value val) {
char *res = 0;
@ -274,13 +271,13 @@ static int generate_freelist(size_t num_cells) {
// Add all cells to free list
for (i = 1; i < num_cells; i ++) {
t = lbm_ref_cell(lbm_enc_cons_ptr(i-1));
set_car_(t, RECOVERED); // all cars in free list are "RECOVERED"
set_car_(t, ENC_SYM_RECOVERED); // all cars in free list are "RECOVERED"
set_cdr_(t, lbm_enc_cons_ptr(i));
}
// Replace the incorrect pointer at the last cell.
t = lbm_ref_cell(lbm_enc_cons_ptr(num_cells-1));
set_cdr_(t, NIL);
set_cdr_(t, ENC_SYM_NIL);
return 1;
}
@ -325,9 +322,6 @@ void lbm_heap_new_freelist_length(void) {
int lbm_heap_init(lbm_cons_t *addr, lbm_uint num_cells,
lbm_uint *gc_stack_storage, lbm_uint gc_stack_size) {
NIL = lbm_enc_sym(SYM_NIL);
RECOVERED = lbm_enc_sym(SYM_RECOVERED);
if (((uintptr_t)addr % 8) != 0) return 0;
memset(addr,0, sizeof(lbm_cons_t) * num_cells);
@ -351,10 +345,10 @@ lbm_value lbm_heap_allocate_cell(lbm_type ptr_type) {
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 lbm_enc_sym(SYM_MERROR);
return ENC_SYM_MERROR;
} else {
// something is most likely very wrong
return lbm_enc_sym(SYM_FATAL_ERROR);
return ENC_SYM_FATAL_ERROR;
}
}
@ -362,7 +356,7 @@ lbm_value lbm_heap_allocate_cell(lbm_type ptr_type) {
res = lbm_heap_state.freelist;
if (lbm_type_of(res) != LBM_TYPE_CONS) {
return lbm_enc_sym(SYM_FATAL_ERROR);
return ENC_SYM_FATAL_ERROR;
}
lbm_heap_state.freelist = lbm_cdr(lbm_heap_state.freelist);
@ -370,8 +364,8 @@ lbm_value lbm_heap_allocate_cell(lbm_type ptr_type) {
lbm_heap_state.num_alloc++;
// set some ok initial values (nil . nil)
set_car_(lbm_ref_cell(res), NIL);
set_cdr_(lbm_ref_cell(res), NIL);
set_car_(lbm_ref_cell(res), ENC_SYM_NIL);
set_cdr_(lbm_ref_cell(res), ENC_SYM_NIL);
// clear GC bit on allocated cell
clr_gc_mark(lbm_ref_cell(res));
@ -448,7 +442,7 @@ int lbm_gc_mark_freelist() {
if (!lbm_is_ptr(fl)) {
if (lbm_type_of(fl) == LBM_TYPE_SYMBOL &&
fl == NIL){
fl == ENC_SYM_NIL){
return 1; // Nothing to mark here
} else {
return 0;
@ -533,7 +527,7 @@ int lbm_gc_sweep_phase(void) {
lbm_uint addr = lbm_enc_cons_ptr(i);
// Clear the "freed" cell.
heap[i].car = RECOVERED;
heap[i].car = ENC_SYM_RECOVERED;
heap[i].cdr = lbm_heap_state.freelist;
lbm_heap_state.freelist = addr;
lbm_heap_state.num_alloc --;
@ -566,14 +560,14 @@ lbm_value lbm_car(lbm_value c){
if (lbm_type_of(c) == LBM_TYPE_SYMBOL &&
lbm_dec_sym(c) == SYM_NIL) {
return lbm_enc_sym(SYM_NIL); // if nil, return nil.
return ENC_SYM_NIL; // if nil, return nil.
}
if (lbm_is_ptr(c) ){
lbm_cons_t *cell = lbm_ref_cell(c);
return read_car(cell);
}
return lbm_enc_sym(SYM_TERROR);
return ENC_SYM_TERROR;
}
lbm_value lbm_cadr(lbm_value c) {
@ -591,21 +585,21 @@ lbm_value lbm_cadr(lbm_value c) {
} else if (lbm_is_symbol(c) && lbm_dec_sym(c) == SYM_NIL) {
return c;
}
return lbm_enc_sym(SYM_TERROR);
return ENC_SYM_TERROR;
}
lbm_value lbm_cdr(lbm_value c){
if (lbm_type_of(c) == LBM_TYPE_SYMBOL &&
lbm_dec_sym(c) == SYM_NIL) {
return lbm_enc_sym(SYM_NIL); // if nil, return nil.
return ENC_SYM_NIL; // if nil, return nil.
}
if (lbm_is_ptr(c)) {
lbm_cons_t *cell = lbm_ref_cell(c);
return read_cdr(cell);
}
return lbm_enc_sym(SYM_TERROR);
return ENC_SYM_TERROR;
}
int lbm_set_car(lbm_value c, lbm_value v) {
@ -647,12 +641,12 @@ lbm_value lbm_list_reverse(lbm_value list) {
lbm_value curr = list;
lbm_value new_list = NIL;
lbm_value new_list = ENC_SYM_NIL;
while (lbm_type_of(curr) == LBM_TYPE_CONS) {
new_list = lbm_cons(lbm_car(curr), new_list);
if (lbm_type_of(new_list) == LBM_TYPE_SYMBOL) {
return lbm_enc_sym(SYM_MERROR);
return ENC_SYM_MERROR;
}
curr = lbm_cdr(curr);
}
@ -664,7 +658,7 @@ lbm_value lbm_list_destructive_reverse(lbm_value list) {
return list;
}
lbm_value curr = list;
lbm_value last_cell = lbm_enc_sym(SYM_NIL);
lbm_value last_cell = ENC_SYM_NIL;
while (lbm_type_of(curr) == LBM_TYPE_CONS) {
lbm_value next = lbm_cdr(curr);
@ -678,14 +672,14 @@ lbm_value lbm_list_destructive_reverse(lbm_value list) {
lbm_value lbm_list_copy(lbm_value list) {
// TODO: a more efficient approach
lbm_value res = NIL;
lbm_value res = ENC_SYM_NIL;
lbm_value curr = list;
while (lbm_type_of(curr) == LBM_TYPE_CONS) {
lbm_value c = lbm_cons (lbm_car(curr), res);
if (lbm_type_of(c) == LBM_TYPE_SYMBOL) {
return lbm_enc_sym(SYM_MERROR);
return ENC_SYM_MERROR;
}
res = c;
curr = lbm_cdr(curr);
@ -757,7 +751,7 @@ int lbm_heap_allocate_array(lbm_value *res, lbm_uint size, lbm_type type){
array = (lbm_array_header_t*)lbm_memory_allocate(sizeof(lbm_array_header_t) / sizeof(lbm_uint));
if (array == NULL) {
*res = lbm_enc_sym(SYM_MERROR);
*res = ENC_SYM_MERROR;
return 0;
}
@ -766,7 +760,7 @@ int lbm_heap_allocate_array(lbm_value *res, lbm_uint size, lbm_type type){
if (array->data == NULL) {
lbm_memory_free((lbm_uint*)array);
*res = lbm_enc_sym(SYM_MERROR);
*res = ENC_SYM_MERROR;
return 0;
}
@ -814,8 +808,8 @@ int lbm_heap_explicit_free_array(lbm_value arr) {
lbm_memory_free((lbm_uint*)header);
arr = lbm_set_ptr_type(arr, LBM_TYPE_CONS);
lbm_set_car(arr, lbm_enc_sym(SYM_NIL));
lbm_set_cdr(arr, lbm_enc_sym(SYM_NIL));
lbm_set_car(arr, ENC_SYM_NIL);
lbm_set_cdr(arr, ENC_SYM_NIL);
r = 1;
}

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

@ -31,7 +31,7 @@ int lbm_variables_init(lbm_value *variable_storage, int variable_storage_size) {
variable_table = variable_storage;
variable_table_size = variable_storage_size;
for (int i = 0; i < variable_table_size; i ++) {
variable_table[i] = lbm_enc_sym(SYM_NIL);
variable_table[i] = ENC_SYM_NIL;
}
return 1;
}
@ -52,7 +52,7 @@ lbm_value lbm_get_variable_by_index(int i) {
i < variable_table_size) {
return variable_table[i];
} else {
return lbm_enc_sym(SYM_NIL);
return ENC_SYM_NIL;
}
}
@ -73,7 +73,7 @@ lbm_value lbm_set_var(lbm_uint index, lbm_value value) {
i < variable_table_size) {
variable_table[i] = value;
} else {
return lbm_enc_sym(SYM_NIL);
return ENC_SYM_NIL;
}
return value;
}

26
lispBM/lispBM/src/qq_expand.c
View File

@ -32,16 +32,16 @@
lbm_value gen_cons(lbm_value a, lbm_value b) {
return lbm_cons(lbm_enc_sym(SYM_CONS),
return lbm_cons(ENC_SYM_CONS,
lbm_cons(a,
lbm_cons(b, lbm_enc_sym(SYM_NIL))));
lbm_cons(b, ENC_SYM_NIL)));
}
lbm_value append(lbm_value front, lbm_value back) {
return lbm_cons (lbm_enc_sym(SYM_APPEND),
return lbm_cons (ENC_SYM_APPEND,
lbm_cons(front,
lbm_cons(back, lbm_enc_sym(SYM_NIL))));
lbm_cons(back, ENC_SYM_NIL)));
}
/* Bawden's qq-expand-list implementation
@ -62,7 +62,7 @@ lbm_value append(lbm_value front, lbm_value back) {
*/
lbm_value qq_expand_list(lbm_value l) {
lbm_value res = lbm_enc_sym(SYM_NIL);
lbm_value res = ENC_SYM_NIL;
lbm_value car_val;
lbm_value cdr_val;
@ -72,22 +72,22 @@ lbm_value qq_expand_list(lbm_value l) {
cdr_val = lbm_cdr(l);
if (lbm_type_of(car_val) == LBM_TYPE_SYMBOL &&
lbm_dec_sym(car_val) == SYM_COMMA) {
res = lbm_cons(lbm_enc_sym(SYM_LIST),
lbm_cons(lbm_car(cdr_val), res));
res = lbm_cons(ENC_SYM_LIST,
lbm_cons(lbm_car(cdr_val), res));
} else if (lbm_type_of(car_val) == LBM_TYPE_SYMBOL &&
lbm_dec_sym(car_val) == SYM_COMMAAT) {
res = lbm_car(cdr_val);
} else {
lbm_value expand_car = qq_expand_list(car_val);
lbm_value expand_cdr = lbm_qq_expand(cdr_val);
res = lbm_cons(lbm_enc_sym(SYM_LIST),
lbm_cons(append(expand_car, expand_cdr), lbm_enc_sym(SYM_NIL)));
res = lbm_cons(ENC_SYM_LIST,
lbm_cons(append(expand_car, expand_cdr), ENC_SYM_NIL));
}
break;
default: {
lbm_value a_list = lbm_cons(l, lbm_enc_sym(SYM_NIL));
lbm_value a_list = lbm_cons(l, ENC_SYM_NIL);
res =
lbm_cons(lbm_enc_sym(SYM_QUOTE), lbm_cons (a_list, lbm_enc_sym(SYM_NIL)));
lbm_cons(ENC_SYM_QUOTE, lbm_cons (a_list, ENC_SYM_NIL));
}
}
return res;
@ -124,7 +124,7 @@ lbm_value lbm_qq_expand(lbm_value qquoted) {
res = lbm_car(cdr_val);
} else if (lbm_type_of(car_val) == LBM_TYPE_SYMBOL &&
lbm_dec_sym(car_val) == SYM_COMMAAT) {
res = lbm_enc_sym(SYM_RERROR); // should have a more specific error here.
res = ENC_SYM_RERROR; // should have a more specific error here.
} else {
lbm_value expand_car = qq_expand_list(car_val);
lbm_value expand_cdr = lbm_qq_expand(cdr_val);
@ -132,7 +132,7 @@ lbm_value lbm_qq_expand(lbm_value qquoted) {
}
break;
default:
res = lbm_cons(lbm_enc_sym(SYM_QUOTE), lbm_cons(qquoted, lbm_enc_sym(SYM_NIL)));
res = lbm_cons(ENC_SYM_QUOTE, lbm_cons(qquoted, ENC_SYM_NIL));
break;
}
return res;

10
lispBM/lispBM/src/tokpar.c
View File

@ -322,7 +322,7 @@ int tok_D(lbm_char_channel_t *chan, token_float *result) {
else if (res == CHANNEL_END) return TOKENIZER_NO_TOKEN;
if (c == '-') {
n = 1;
fbuf[0] = 0;
fbuf[0] = '-';
result->negative = true;
}
@ -453,6 +453,8 @@ int tok_integer(lbm_char_channel_t *chan, token_int *result ) {
bool valid_num = false;
char c;
int res;
result->type = TOKTYPEI;
result-> negative = false;
res = lbm_channel_peek(chan, 0, &c);
if (res == CHANNEL_MORE) {
@ -518,15 +520,11 @@ int tok_integer(lbm_char_channel_t *chan, token_int *result ) {
if (n == 0) return 0;
result->type = TOKTYPEI;
uint32_t tok_res;
int type_len = tok_match_fixed_size_tokens(chan, type_qual_table, n, NUM_TYPE_QUALIFIERS, &tok_res);
if (type_len == TOKENIZER_NEED_MORE) return type_len;
if (type_len == TOKENIZER_NO_TOKEN) {
result->type = TOKTYPEI;
} else {
if (type_len != TOKENIZER_NO_TOKEN) {
result->type = tok_res;
}

3
lispBM/lispBM/tests/test_float_0.lisp Normal file
View File

@ -0,0 +1,3 @@
(eq (type-of 1.0e3) type-float)

2
lispBM/lispBM/tests/test_float_1.lisp Normal file
View File

@ -0,0 +1,2 @@
(eq (type-of 1.0e3f64) type-double)

2
lispBM/lispBM/tests/test_float_2.lisp Normal file
View File

@ -0,0 +1,2 @@
(eq (type-of 1.0e3f32) type-float)

108
lispBM/lispBM/zephyr-examples/repl-zephyr/src/main.c
View File

@ -31,6 +31,9 @@
#define EVAL_CPS_STACK_SIZE 256
#define GC_STACK_SIZE 256
#define PRINT_STACK_SIZE 256
#define VARIABLE_STORAGE_SIZE 256
#define EXTENSION_STORAGE_SIZE 256
#define WAIT_TIMEOUT 2500
static char str[LISPBM_INPUT_BUFFER_SIZE];
static char outbuf[LISPBM_OUTPUT_BUFFER_SIZE];
@ -41,10 +44,11 @@ static uint32_t bitmap[LBM_MEMORY_BITMAP_SIZE_8K];
static lbm_cons_t heap[LISPBM_HEAP_SIZE];
static uint32_t gc_stack_storage[GC_STACK_SIZE];
static uint32_t print_stack_storage[PRINT_STACK_SIZE];
static lbm_value variable_storage[VARIABLE_STORAGE_SIZE];
extension_fptr extension_storage[EXTENSION_STORAGE_SIZE];
static lbm_tokenizer_string_state_t string_tok_state;
static lbm_tokenizer_char_stream_t string_tok;
static lbm_string_channel_state_t string_tok_state;
static lbm_char_channel_t string_tok;
void done_callback(eval_context_t *ctx) {
@ -72,6 +76,78 @@ void sleep_callback(uint32_t us) {
k_sleep(K_USEC(us));
}
bool dyn_load(const char *str, const char **code) {
bool res = false;
if (strlen(str) == 5 && strncmp(str, "defun", 5) == 0) {
*code = "(define defun (macro (name args body) `(define ,name (lambda ,args ,body))))";
res = true;
} else if (strlen(str) == 7 && strncmp(str, "reverse", 7) == 0) {
*code = "(define reverse (lambda (xs)"
"(let ((revacc (lambda (acc xs)"
"(if (eq nil xs) acc"
"(revacc (cons (car xs) acc) (cdr xs))))))"
"(revacc nil xs))))";
res = true;
} else if (strlen(str) == 4 && strncmp(str, "iota", 4) == 0) {
*code = "(define iota (lambda (n)"
"(let ((iacc (lambda (acc i)"
"(if (< i 0) acc"
"(iacc (cons i acc) (- i 1))))))"
"(iacc nil (- n 1)))))";
res = true;
} else if (strlen(str) == 6 && strncmp(str, "length", 6) == 0) {
*code = "(define length (lambda (xs)"
"(let ((len (lambda (l xs)"
"(if (eq xs nil) l"
"(len (+ l 1) (cdr xs))))))"
"(len 0 xs))))";
res = true;
} else if (strlen(str) == 4 && strncmp(str, "take", 4) == 0) {
*code = "(define take (lambda (n xs)"
"(let ((take-tail (lambda (acc n xs)"
"(if (= n 0) acc"
"(take-tail (cons (car xs) acc) (- n 1) (cdr xs))))))"
"(reverse (take-tail nil n xs)))))";
res = true;
} else if (strlen(str) == 4 && strncmp(str, "drop", 4) == 0) {
*code = "(define drop (lambda (n xs)"
"(if (= n 0) xs"
"(if (eq xs nil) nil"
"(drop (- n 1) (cdr xs))))))";
res = true;
} else if (strlen(str) == 3 && strncmp(str, "zip", 3) == 0) {
*code = "(define zip (lambda (xs ys)"
"(if (eq xs nil) nil"
"(if (eq ys nil) nil"
"(cons (cons (car xs) (car ys)) (zip (cdr xs) (cdr ys)))))))";
res = true;
} else if (strlen(str) == 3 && strncmp(str, "map", 3) == 0) {
*code = "(define map (lambda (f xs)"
"(if (eq xs nil) nil"
"(cons (f (car xs)) (map f (cdr xs))))))";
res = true;
} else if (strlen(str) == 6 && strncmp(str, "lookup", 6) == 0) {
*code = "(define lookup (lambda (x xs)"
"(if (eq xs nil) nil"
"(if (eq (car (car xs)) x)"
"(car (cdr (car xs)))"
"(lookup x (cdr xs))))))";
res = true;
} else if (strlen(str) == 5 && strncmp(str, "foldr", 5) == 0) {
*code = "(define foldr (lambda (f i xs)"
"(if (eq xs nil) i"
"(f (car xs) (foldr f i (cdr xs))))))";
res = true;
} else if (strlen(str) == 5 && strncmp(str, "foldl", 5) == 0) {
*code = "(define foldl (lambda (f i xs)"
"(if (eq xs nil) i (foldl f (f i (car xs)) (cdr xs)))))";
res = true;
}
return res;
}
void main(void)
{
@ -86,25 +162,17 @@ void main(void)
gc_stack_storage, GC_STACK_SIZE,
memory, LBM_MEMORY_SIZE_8K,
bitmap, LBM_MEMORY_BITMAP_SIZE_8K,
print_stack_storage, PRINT_STACK_SIZE
print_stack_storage, PRINT_STACK_SIZE,
extension_storage, EXTENSION_STORAGE_SIZE
);
lbm_set_ctx_done_callback(done_callback);
lbm_set_timestamp_us_callback(timestamp_callback);
lbm_set_usleep_callback(sleep_callback);
lbm_set_printf_callback(usb_printf);
lbm_set_dynamic_load_callback(dyn_load);
lbm_pause_eval();
while(lbm_get_eval_state() != EVAL_CPS_STATE_PAUSED) {
k_sleep(K_MSEC(1));
}
prelude_load(&string_tok_state,
&string_tok);
lbm_cid cid = lbm_load_and_eval_program(&string_tok);
lbm_continue_eval();
lbm_wait_ctx((lbm_cid)cid);
lbm_variables_init(variable_storage, VARIABLE_STORAGE_SIZE);
usb_printf("Lisp REPL started (ZephyrOS)!\r\n");
@ -149,15 +217,15 @@ void main(void)
while(lbm_get_eval_state() != EVAL_CPS_STATE_PAUSED) {
k_sleep(K_MSEC(1));
}
lbm_create_char_stream_from_string(&string_tok_state,
&string_tok,
str);
lbm_create_string_char_channel(&string_tok_state,
&string_tok,
str);
lbm_cid cid = lbm_load_and_eval_expression(&string_tok);
lbm_continue_eval();
lbm_wait_ctx((lbm_cid)cid);
lbm_wait_ctx((lbm_cid)cid, WAIT_TIMEOUT);
}
}
}