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 7bd15759..04346b95 

04346b95 str_eq used for string equality comparisons.
9676c4f5 clean out some dead code after symtable allocation consolidation
21bf30ea combining allocations in addition of symbols. could be small speedup for reader
47cb01e2 small refactorings
14f2eeae streamlining eval _let a small amount
32200943 streamlining eval_setq a small amount
4447af66 streamlining eval_define a bit
1ee660bb streamlining eval_if a small bit

git-subtree-dir: lispBM/lispBM
git-subtree-split: 04346b95438b8b8da8714f9c62c18c636e21bd5c
This commit is contained in:
Benjamin Vedder 2024-04-07 19:59:06 +02:00
parent df2034b2cb
commit ef5982bcee
4 changed files with 96 additions and 100 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
include/lbm_utils.h
View File

@ -39,6 +39,17 @@ extern "C" {
#define CMP(a,b) (((a) > (b)) - ((a) < (b)));
static inline bool str_eq(char *str1, char *str2) {
if (*str1 != *str2) return false;
if (*str1 == 0) return true;
for (;;) {
++str1; ++str2;
if (*str1 != *str2) return false;
if (*str1 == 0) return true;
}
}
#ifdef __cplusplus
}
#endif

102
src/eval_cps.c
View File

@ -491,7 +491,7 @@ static void lift_array_flash(lbm_value flash_cell, char *data, lbm_uint num_elt)
handle_flash_status(write_const_cdr(flash_cell, ENC_SYM_ARRAY_TYPE));
}
static void stack_push(lbm_stack_t *s, lbm_uint val) {
static inline void stack_push(lbm_stack_t *s, lbm_uint val) {
if (s->sp < s->size) {
s->data[s->sp++] = val;
if (s->sp > s->max_sp) s->max_sp = s->sp;
@ -500,7 +500,7 @@ static void stack_push(lbm_stack_t *s, lbm_uint val) {
error_ctx(ENC_SYM_STACK_ERROR);
}
static void stack_push_2(lbm_stack_t *s, lbm_uint v1, lbm_uint v2) {
static inline void stack_push_2(lbm_stack_t *s, lbm_uint v1, lbm_uint v2) {
if (s->sp + 1 < s->size) {
lbm_uint *t = &s->data[s->sp];
t[0] = v1;
@ -512,7 +512,7 @@ static void stack_push_2(lbm_stack_t *s, lbm_uint v1, lbm_uint v2) {
error_ctx(ENC_SYM_STACK_ERROR);
}
static void stack_push_3(lbm_stack_t *s, lbm_uint v1, lbm_uint v2, lbm_uint v3) {
static inline void stack_push_3(lbm_stack_t *s, lbm_uint v1, lbm_uint v2, lbm_uint v3) {
if (s->sp + 2 < s->size) {
lbm_uint *t = &s->data[s->sp];
t[0] = v1;
@ -525,7 +525,7 @@ static void stack_push_3(lbm_stack_t *s, lbm_uint v1, lbm_uint v2, lbm_uint v3)
error_ctx(ENC_SYM_STACK_ERROR);
}
static void stack_push_4(lbm_stack_t *s, lbm_uint v1, lbm_uint v2, lbm_uint v3, lbm_uint v4) {
static inline void stack_push_4(lbm_stack_t *s, lbm_uint v1, lbm_uint v2, lbm_uint v3, lbm_uint v4) {
if (s->sp + 3 < s->size) {
lbm_uint *t = &s->data[s->sp];
t[0] = v1;
@ -539,7 +539,7 @@ static void stack_push_4(lbm_stack_t *s, lbm_uint v1, lbm_uint v2, lbm_uint v3,
error_ctx(ENC_SYM_STACK_ERROR);
}
static void stack_push_5(lbm_stack_t *s, lbm_uint v1, lbm_uint v2, lbm_uint v3, lbm_uint v4, lbm_uint v5) {
static inline void stack_push_5(lbm_stack_t *s, lbm_uint v1, lbm_uint v2, lbm_uint v3, lbm_uint v4, lbm_uint v5) {
if (s->sp + 4 < s->size) {
lbm_uint *t = &s->data[s->sp];
t[0] = v1;
@ -554,7 +554,7 @@ static void stack_push_5(lbm_stack_t *s, lbm_uint v1, lbm_uint v2, lbm_uint v3,
error_ctx(ENC_SYM_STACK_ERROR);
}
static void stack_push_6(lbm_stack_t *s, lbm_uint v1, lbm_uint v2, lbm_uint v3, lbm_uint v4, lbm_uint v5, lbm_uint v6) {
static inline void stack_push_6(lbm_stack_t *s, lbm_uint v1, lbm_uint v2, lbm_uint v3, lbm_uint v4, lbm_uint v5, lbm_uint v6) {
if (s->sp + 5 < s->size) {
lbm_uint *t = &s->data[s->sp];
t[0] = v1;
@ -720,8 +720,8 @@ static lbm_value allocate_binding(lbm_value key, lbm_value val, lbm_value the_cd
#define LOOP_COND 1
#define LOOP_BODY 2
// (closure params exp env) -> [params, exp, env])
static void extract_n(lbm_value curr, lbm_value *res, unsigned int n) {
// (a b c) -> [a b c]
static lbm_value extract_n(lbm_value curr, lbm_value *res, unsigned int n) {
for (unsigned int i = 0; i < n; i ++) {
if (lbm_is_ptr(curr)) {
lbm_cons_t *cell = lbm_ref_cell(curr);
@ -731,6 +731,7 @@ static void extract_n(lbm_value curr, lbm_value *res, unsigned int n) {
error_ctx(ENC_SYM_TERROR);
}
}
return curr; // Rest of list is returned here.
}
static void call_fundamental(lbm_uint fundamental, lbm_value *args, lbm_uint arg_count, eval_context_t *ctx) {
@ -1741,25 +1742,21 @@ static void eval_callcc(eval_context_t *ctx) {
}
// (define sym exp)
#define KEY 1
#define VAL 2
static void eval_define(eval_context_t *ctx) {
lbm_value args = get_cdr(ctx->curr_exp);
lbm_value key, rest_args;
get_car_and_cdr(args, &key, &rest_args);
lbm_value val_exp, rest_val;
get_car_and_cdr(rest_args, &val_exp, &rest_val);
lbm_value parts[3];
lbm_value rest = extract_n(ctx->curr_exp, parts, 3);
lbm_uint *sptr = stack_reserve(ctx, 2);
if (lbm_is_symbol(key) && lbm_is_symbol_nil(rest_val)) {
lbm_uint sym_val = lbm_dec_sym(key);
sptr[0] = key;
if (lbm_is_symbol(parts[KEY]) && lbm_is_symbol_nil(rest)) {
lbm_uint sym_val = lbm_dec_sym(parts[KEY]);
sptr[0] = parts[KEY];
if (sym_val >= RUNTIME_SYMBOLS_START) {
sptr[1] = SET_GLOBAL_ENV;
if (ctx->flags & EVAL_CPS_CONTEXT_FLAG_CONST) {
stack_push(&ctx->K, MOVE_VAL_TO_FLASH_DISPATCH);
}
ctx->curr_exp = val_exp;
ctx->curr_exp = parts[VAL];
return;
}
}
@ -1802,17 +1799,9 @@ static void eval_lambda(eval_context_t *ctx) {
// (if cond-expr then-expr else-expr)
static void eval_if(eval_context_t *ctx) {
lbm_value cdr = get_cdr(ctx->curr_exp);
lbm_value exp, cddr;
get_car_and_cdr(cdr, &exp, &cddr);
lbm_uint *sptr = stack_reserve(ctx, 4);
sptr[0] = get_cadr(cddr); // else_branch
sptr[1] = get_car(cddr); // then_branch
sptr[2] = ctx->curr_env;
sptr[3] = IF;
ctx->curr_exp = exp;
stack_push_3(&ctx->K, get_cdr(cdr), ctx->curr_env, IF);
ctx->curr_exp = get_car(cdr);
}
// (cond (cond-expr-1 expr-1)
@ -1833,12 +1822,11 @@ static void eval_cond(eval_context_t *ctx) {
lbm_value condition = get_car(cond1);
lbm_value body = get_cadr(cond1);
lbm_value rest;
rest = cons_with_gc(ENC_SYM_COND, get_cddr(ctx->curr_exp), ENC_SYM_NIL);
lbm_uint *sptr = stack_reserve(ctx, 4);
sptr[0] = rest;
sptr[1] = body;
sptr[2] = ctx->curr_env;
sptr[3] = IF;
WITH_GC(rest, lbm_heap_allocate_list_init(2,
body, // Then branch
cons_with_gc(ENC_SYM_COND, get_cddr(ctx->curr_exp), ENC_SYM_NIL)));
stack_push_3(&ctx->K, rest, ctx->curr_env, IF);
ctx->curr_exp = condition;
}
}
@ -1962,7 +1950,12 @@ static void eval_var(eval_context_t *ctx) {
lbm_value v_exp = get_cadr(args);
stack_push_3(&ctx->K, new_env, key, PROGN_VAR);
ctx->curr_env = new_env; // So binding body knows binding (enables recursion)
// Activating the new environment before the evaluation of the value to be bound,
// means that other variables with same name will be shadowed already in the value
// body.
// The way closures work, the var-variable needs to be in scope during val evaluation
// for a recursive closure to be possible.
ctx->curr_env = new_env;
ctx->curr_exp = v_exp;
return;
}
@ -1973,11 +1966,10 @@ static void eval_var(eval_context_t *ctx) {
// (setq x (...)) - same as (set 'x (...)) or (setvar 'x (...))
static void eval_setq(eval_context_t *ctx) {
lbm_value args = get_cdr(ctx->curr_exp);
lbm_value sym = get_car(args);
lbm_value v_exp = get_cadr(args);
stack_push_3(&ctx->K, ctx->curr_env, sym, SETQ);
ctx->curr_exp = v_exp;
lbm_value parts[3];
extract_n(ctx->curr_exp, parts, 3);
stack_push_3(&ctx->K, ctx->curr_env, parts[1], SETQ);
ctx->curr_exp = parts[2];
}
static void eval_move_to_flash(eval_context_t *ctx) {
@ -2001,9 +1993,9 @@ static void eval_loop(eval_context_t *ctx) {
// body-exp)
static void eval_let(eval_context_t *ctx) {
lbm_value env = ctx->curr_env;
lbm_value binds = get_cadr(ctx->curr_exp); // key value pairs.
lbm_value exp = get_cadr(get_cdr(ctx->curr_exp)); // exp to evaluate in the new env.
let_bind_values_eval(binds, exp, env, ctx);
lbm_value parts[3];
extract_n(ctx->curr_exp, parts, 3);
let_bind_values_eval(parts[1], parts[2], env, ctx);
}
// (and exp0 ... expN)
@ -2162,11 +2154,7 @@ static void cont_set_global_env(eval_context_t *ctx){
}
static void cont_resume(eval_context_t *ctx) {
lbm_value exp;
lbm_value env;
lbm_pop_2(&ctx->K, &env, &exp);
ctx->curr_exp = exp;
ctx->curr_env = env;
lbm_pop_2(&ctx->K, &ctx->curr_env, &ctx->curr_exp);
}
static void cont_progn_rest(eval_context_t *ctx) {
@ -2177,16 +2165,14 @@ static void cont_progn_rest(eval_context_t *ctx) {
lbm_value rest_car, rest_cdr;
get_car_and_cdr(rest, &rest_car, &rest_cdr);
ctx->curr_exp = rest_car;
ctx->curr_env = env;
if (lbm_is_symbol_nil(rest_cdr)) {
// allow for tail recursion
ctx->curr_exp = rest_car;
ctx->curr_env = env;
lbm_stack_drop(&ctx->K, 3);
} else {
sptr[2] = rest_cdr;
stack_push(&ctx->K, PROGN_REST);
ctx->curr_exp = rest_car;
ctx->curr_env = env;
}
}
@ -3166,13 +3152,13 @@ static void cont_if(eval_context_t *ctx) {
lbm_value arg = ctx->r;
lbm_value *sptr = pop_stack_ptr(ctx, 3);
lbm_value *sptr = pop_stack_ptr(ctx, 2);
ctx->curr_env = sptr[2];
ctx->curr_env = sptr[1];
if (lbm_is_symbol_nil(arg)) {
ctx->curr_exp = sptr[0]; // else branch
ctx->curr_exp = get_cadr(sptr[0]); // else branch
} else {
ctx->curr_exp = sptr[1]; // then branch
ctx->curr_exp = get_car(sptr[0]); // then branch
}
}

5
src/extensions.c
View File

@ -24,6 +24,7 @@
#include <eval_cps.h>
#include "extensions.h"
#include "lbm_utils.h"
static lbm_uint ext_max = 0;
static lbm_uint ext_num = 0;
@ -83,7 +84,7 @@ bool lbm_clr_extension(lbm_uint sym_id) {
bool lbm_lookup_extension_id(char *sym_str, lbm_uint *ix) {
for (lbm_uint i = 0; i < ext_max; i ++) {
if(extension_table[i].name) {
if (strcmp(extension_table[i].name, sym_str) == 0) {
if (str_eq(extension_table[i].name, sym_str)) {
*ix = i + EXTENSION_SYMBOLS_START;
return true;
}
@ -99,7 +100,7 @@ bool lbm_add_extension(char *sym_str, extension_fptr ext) {
if (lbm_get_symbol_by_name(sym_str, &symbol)) {
if (lbm_is_extension(lbm_enc_sym(symbol))) {
// update the extension entry.
if (strcmp(extension_table[symbol - EXTENSION_SYMBOLS_START].name, sym_str) == 0) {
if (str_eq(extension_table[symbol - EXTENSION_SYMBOLS_START].name, sym_str)) {
// Do not replace name ptr.
extension_table[symbol - EXTENSION_SYMBOLS_START].fptr = ext;
return true;

78
src/symrepr.c
View File

@ -21,10 +21,12 @@
#include <stdlib.h>
#include <inttypes.h>
#include <lbm_memory.h>
#include <heap.h>
#include "symrepr.h"
#include "extensions.h"
#include "lbm_utils.h"
#define NUM_SPECIAL_SYMBOLS (sizeof(special_symbols) / sizeof(special_sym))
#define NAME 0
@ -305,7 +307,7 @@ lbm_uint *lbm_get_symbol_list_entry_by_name(char *name) {
lbm_uint *curr = symlist;
while (curr) {
char *str = (char*)curr[NAME];
if (strcmp(name, str) == 0) {
if (str_eq(name, str)) {
return (lbm_uint *)curr;
}
curr = (lbm_uint*)curr[NEXT];
@ -318,7 +320,7 @@ int lbm_get_symbol_by_name(char *name, lbm_uint* id) {
// loop through special symbols
for (unsigned int i = 0; i < NUM_SPECIAL_SYMBOLS; i ++) {
if (strcmp(name, special_symbols[i].name) == 0) {
if (str_eq(name, (char *)special_symbols[i].name)) {
*id = special_symbols[i].id;
return 1;
}
@ -326,7 +328,7 @@ int lbm_get_symbol_by_name(char *name, lbm_uint* id) {
// loop through extensions
for (unsigned int i = 0; i < lbm_get_max_extensions(); i ++) {
if (extension_table[i].name && strcmp(name, extension_table[i].name) == 0) {
if (extension_table[i].name && str_eq(name, extension_table[i].name)) {
*id = EXTENSION_SYMBOLS_START + i;
return 1;
}
@ -335,7 +337,7 @@ int lbm_get_symbol_by_name(char *name, lbm_uint* id) {
lbm_uint *curr = symlist;
while (curr) {
char *str = (char*)curr[NAME];
if (strcmp(name, str) == 0) {
if (str_eq(name, str)) {
*id = curr[ID];
return 1;
}
@ -346,51 +348,48 @@ int lbm_get_symbol_by_name(char *name, lbm_uint* id) {
extern lbm_flash_status lbm_write_const_array_padded(uint8_t *data, lbm_uint n, lbm_uint *res);
static bool store_symbol_name_base(char *name, lbm_uint *res, bool flash) {
static bool store_symbol_name_flash(char *name, lbm_uint *res) {
size_t n = strlen(name) + 1;
if (n == 1) return 0; // failure if empty symbol
char *symbol_name_storage = NULL;
lbm_uint alloc_size;
if (n % sizeof(lbm_uint) == 0) {
alloc_size = n/(sizeof(lbm_uint));
} else {
alloc_size = (n/(sizeof(lbm_uint))) + 1;
}
if (flash) {
lbm_uint symbol_addr = 0;
lbm_flash_status s = lbm_write_const_array_padded((uint8_t*)name, n, &symbol_addr);
if (s != LBM_FLASH_WRITE_OK || symbol_addr == 0) {
return false;
}
symbol_table_size_strings_flash += alloc_size;
*res = symbol_addr;
return true;
} else {
symbol_name_storage = (char *)lbm_memory_allocate(alloc_size);
if (symbol_name_storage == NULL) return false;
symbol_table_size_strings += alloc_size;
strcpy(symbol_name_storage, name);
*res = (lbm_uint)symbol_name_storage;
return true;
lbm_uint symbol_addr = 0;
lbm_flash_status s = lbm_write_const_array_padded((uint8_t*)name, n, &symbol_addr);
if (s != LBM_FLASH_WRITE_OK || symbol_addr == 0) {
return false;
}
symbol_table_size_strings_flash += alloc_size;
*res = symbol_addr;
return true;
}
static bool store_symbol_name(char *name, lbm_uint *res) {
return store_symbol_name_base(name, res, false);
}
static bool add_symbol_to_symtab(char* name, lbm_uint id) {
size_t n = strlen(name) + 1;
if (n == 1) return 0; // failure if empty symbol
static bool store_symbol_name_flash(char *name, lbm_uint *res) {
return store_symbol_name_base(name, res, true);
}
lbm_uint alloc_size;
if (n % sizeof(lbm_uint) == 0) {
alloc_size = n/(sizeof(lbm_uint));
} else {
alloc_size = (n/(sizeof(lbm_uint))) + 1;
}
static bool add_symbol_to_symtab(lbm_uint name, lbm_uint id) {
lbm_uint *m = lbm_memory_allocate(3);
lbm_uint *storage = lbm_memory_allocate(alloc_size + 3);
if (storage == NULL) return false;
strncpy(((char*)storage) + 12, name, n);
lbm_uint *m = storage;
if (m == NULL) return false;
symbol_table_size_list += 3;
m[NAME] = name;
m[NAME] = (lbm_uint)&storage[3];
m[NEXT] = (lbm_uint) symlist;
symlist = m;
m[ID] =id;
@ -417,9 +416,7 @@ static int lbm_add_symbol_base(char *name, lbm_uint *id, bool flash) {
if (!store_symbol_name_flash(name, &symbol_name_storage)) return 0;
if (!add_symbol_to_symtab_flash(symbol_name_storage, next_symbol_id)) return 0;
} else {
if (!store_symbol_name(name, &symbol_name_storage)) return 0;
if (!add_symbol_to_symtab(symbol_name_storage, next_symbol_id)) {
lbm_memory_free((lbm_uint*)symbol_name_storage);
if (!add_symbol_to_symtab(name, next_symbol_id)) {
return 0;
}
}
@ -436,13 +433,14 @@ int lbm_add_symbol_flash(char *name, lbm_uint* id) {
}
int lbm_add_symbol_const(char *name, lbm_uint* id) {
if (!add_symbol_to_symtab((lbm_uint)name, next_symbol_id)) {
return 0;
}
lbm_uint *m = lbm_memory_allocate(3);
if (m == NULL) return 0;
symbol_table_size_list += 3;
m[NAME] = (lbm_uint) name;
m[NEXT] = (lbm_uint) symlist;
symlist = m;
m[ID] = next_symbol_id;
*id = next_symbol_id ++;
return 1;
}