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

Merge branch 'vedderb:master' into master

This commit is contained in:
JohnSpintend 2023-12-05 09:16:00 +08:00 committed by GitHub
parent 51cfb6a71a 786786e0f0
commit 435d41761a
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
23 changed files with 448 additions and 169 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

94
lispBM/README.md
View File

@ -70,9 +70,11 @@ Print to the VESC Tool Lisp console. Example:
```clj
(print "Hello World")
> "Hello World"
```
Should work for all types.
Should work for all types. If multiple arguments are provided, each one will be
printed on a separate line.
---
@ -86,10 +88,18 @@ Should work for all types.
(puts str)
```
Similar to print, but only takes one string as an argument and prints it without quotes. The string extensions can be used to format the output. Example:
Similar to `print`, but only takes one string as an argument and prints it without
quotes. The string extensions can be used to format the output.
**Note**
This extension can print longer strings than `print`. `print` will trim any
output over 256 bytes, while this extension only trims strings over 400 bytes.
Example:
```clj
(puts "Hello World")
> Hello World
```
---
@ -4246,6 +4256,10 @@ Possible events to register are
(event-enable 'event-bms-reset-cnt) ; -> event-bms-reset-cnt
(event-enable 'event-bms-force-bal) ; -> (event-bms-force-bal force)
(event-enable 'event-bms-zero-ofs) ; -> event-bms-zero-ofs
; Other express only events
(event-enable 'event-ble-rx) ; -> (event-ble-rx handle data)
(event-enable 'event-wifi-disconnect) ; -> ('event-wifi-disconnect reason from-extension)
```
The CAN-frames arrive whenever data is received on the CAN-bus and data-rx is received for example when data is sent from a Qml-script in VESC Tool.
@ -4270,13 +4284,25 @@ This event is sent when the input capture unit captures a pulse. Both the pulse
**event-icu-period**
This event is sent when the input capture unit ends a period and the next pulse starts. Both the pulse width and the period are provided.
**event-ble-rx** (Express exclusive)
This event is sent when a client connected to the VESC writes a value to a
characteristic or descriptor. Read the
[BLE docs](https://github.com/vedderb/vesc_express/tree/main/main/ble#events)
for details.
**event-wifi-disconnect** (Express exclusive)
This event is sent when the VESC disconnects from the currently connected
network for any reason. Read the
[Wi-Fi docs](https://github.com/vedderb/vesc_express/tree/main/main/wifi#events)
for details.
---
## Byte Arrays
Byte arrays (and text strings) are allocated in memory as consecutive arrays of bytes (not linked lists). They can be shared with C and are more space and performance efficient than linked lists. Several of the extensions also take byte arrays as input as an alternative to lists and some of the events return byte arrays.
To allocate a byte array with 20 bytes and bind the symbol arr to it you can use
To allocate a byte array with 20 bytes and bind the symbol `arr` to it you can use
```clj
(define arr (array-create 20))
@ -4296,7 +4322,7 @@ The length of a byte array can be read with
(buflen arr)
```
Which will return 20 for the array arr above.
Which will return 20 for the array `arr` above.
---
@ -4312,7 +4338,7 @@ To clear a byte array the function bufclear can be used:
(bufclear arr optByte optStart optLen)
```
Where arr is the byte array to clear, optByte is the optional argument of what to clear with (default 0), optStart is the optional argument of which position to start clearing (default 0) and optLen is the optional argument of how many bytes to clear after start (default the entire array). Example:
Where `arr` is the byte array to clear, `optByte` is the optional argument of what to clear with (default 0), `optStart` is the optional argument of which position to start clearing (default 0) and `optLen` is the optional argument of how many bytes to clear after start (default the entire array). Example:
```clj
(bufclear arr) ; Clear all of arr
@ -4399,7 +4425,7 @@ Copy part of one array into another array.
(bufcpy arr1 ind1 arr2 ind2 len)
```
Copy len bytes from arr2 starting at ind2 to arr1 starting at ind1. Len will be truncated to ensure that nothing is read or written outside of the arrays.
Copy len bytes from `arr2` starting at `ind2` to `arr1` starting at `ind1`. `len` will be truncated to ensure that nothing is read or written outside of the arrays.
---
@ -4415,7 +4441,7 @@ Byte arrays will be de-allocated by the garbage collector on a regular basis, bu
(free arr)
```
This will clear the allocated memory for arr.
This will clear the allocated memory for `arr`.
**Note**
Strings in lispBM are treated the same as byte arrays, so all of the above can be done to the characters in strings too.
@ -4432,10 +4458,60 @@ Strings in lispBM are treated the same as byte arrays, so all of the above can b
(buf-find arr seq optOccurence)
```
Find position of seq in array arr. The optional argument optOccurence specifies which occurrence of seq to look for - if it is set to 0 or left out the position of the first occurrence will be returned. If seq is not found -1 will be returned.
Find position of `seq` in array `arr`. The optional argument optOccurence specifies which occurrence of `seq` to look for - if it is set to 0 or left out the position of the first occurrence will be returned. If `seq` is not found -1 will be returned.
**NOTE**
The last byte in seq will be ignored as that is the null-terminator if seq is a string (which is the most common use case). If the match should be done on the last byte too seq can be padded with a dummy-byte.
The last byte in `seq` will be ignored as that is the null-terminator if `seq` is a string (which is the most common use case). If the match should be done on the last byte too `seq` can be padded with a dummy-byte.
---
#### buf-resize
| Platforms | Firmware |
|---|---|
| ESC, Express | 6.05+ |
```clj
(buf-resize arr delta-size opt-absolute-size)
```
Change the length of array `arr` in bytes. A reference to `arr` is returned.
This extension can be used in two modes:
1. Relative: In this mode you set `delta-size` to the amount of bytes the length
should be changed by. Negative numbers makes the array smaller.
`opt-absolute-size` should not be passed in this mode (it is therefore an
optional argument).
2. Absolute: In this mode you set `delta-size` to be `nil` and set
`opt-absolute-size` to the new length in bytes.
Passing `nil` to `delta-size` while not passing any value for
`opt-absolute-size` will result in an `eval_error`.
When growing the length of the array a new range will be allocated and the old
data copied over. The new bytes will be initialised to zero. If the new length
of the array is smaller than the previous the allocated range will simply be
marked as smaller in an efficient manner which avoids any new allocations.
It is possible to shrink an array to a length of zero.
**Note**
The array will be resized in place. The returned reference to `arr` is just for
convenience.
Example where we remove the terminating null byte from a string buffer:
```clj
(buf-resize "hello" -1)
> [104 101 108 108 111]
```
Example where we increase the length of `buf` to 5:
```clj
(def buf [1 2 3 4])
(buf-resize buf nil 5)
(bufset-u8 buf 4 5) ; we set it to avoid LBM printing the array as a string
(print buf)
> [1 2 3 4 5]
```
---

2
lispBM/lispBM/experiment_repl/Makefile
View File

@ -6,7 +6,7 @@ include $(LISPBM)/lispbm.mk
PLATFORM_INCLUDE = -I$(LISPBM)/platform/linux/include
PLATFORM_SRC = $(LISPBM)/platform/linux/src/platform_mutex.c
CCFLAGS = -g -Wall -Wconversion -Wsign-compare -pedantic -std=c11
CCFLAGS = -O2 -Wall -Wconversion -Wsign-compare -pedantic -std=c11
PICCFLAGS = -O2 -Wall -Wconversion -pedantic -std=c11

30
lispBM/lispBM/experiment_repl/repl.c
View File

@ -500,6 +500,14 @@ static lbm_value ext_event(lbm_value *args, lbm_uint argn) {
return ENC_SYM_NIL;
}
static lbm_value ext_time(lbm_value *args, lbm_uint argn) {
uint32_t time = timestamp_callback();
return lbm_enc_u32(time);
}
/* load a file, caller is responsible for freeing the returned string */
char * load_file(char *filename) {
char *file_str = NULL;
@ -588,8 +596,8 @@ void sym_it(const char *str) {
printf("%s\n", str);
}
static lbm_uint memory[LBM_MEMORY_SIZE_8K];
static lbm_uint bitmap[LBM_MEMORY_BITMAP_SIZE_8K];
static lbm_uint memory[LBM_MEMORY_SIZE_1M];
static lbm_uint bitmap[LBM_MEMORY_BITMAP_SIZE_1M];
char char_array[1024];
lbm_uint word_array[1024];
@ -620,8 +628,8 @@ int main(int argc, char **argv) {
if (!lbm_init(heap_storage, heap_size,
GC_STACK_SIZE,
memory, LBM_MEMORY_SIZE_8K,
bitmap, LBM_MEMORY_BITMAP_SIZE_8K,
memory, LBM_MEMORY_SIZE_1M,
bitmap, LBM_MEMORY_BITMAP_SIZE_1M,
print_stack_storage, PRINT_STACK_SIZE,
extension_storage, EXTENSION_STORAGE_SIZE)) {
printf("Failed to initialize LispBM\n");
@ -710,6 +718,12 @@ int main(int argc, char **argv) {
printf("Extension added.\n");
else
printf("Error adding extension.\n");
res = lbm_add_extension("time", ext_time);
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);
@ -879,8 +893,8 @@ int main(int argc, char **argv) {
lbm_init(heap_storage, heap_size,
GC_STACK_SIZE,
memory, LBM_MEMORY_SIZE_8K,
bitmap, LBM_MEMORY_BITMAP_SIZE_8K,
memory, LBM_MEMORY_SIZE_1M,
bitmap, LBM_MEMORY_BITMAP_SIZE_1M,
print_stack_storage, PRINT_STACK_SIZE,
extension_storage, EXTENSION_STORAGE_SIZE);
@ -929,8 +943,8 @@ int main(int argc, char **argv) {
lbm_init(heap_storage, heap_size,
GC_STACK_SIZE,
memory, LBM_MEMORY_SIZE_8K,
bitmap, LBM_MEMORY_BITMAP_SIZE_8K,
memory, LBM_MEMORY_SIZE_1M,
bitmap, LBM_MEMORY_BITMAP_SIZE_1M,
print_stack_storage, PRINT_STACK_SIZE,
extension_storage, EXTENSION_STORAGE_SIZE);

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

@ -49,6 +49,8 @@
#define LBM_VAL_MASK 0xFFFFFFF0u
#define LBM_VAL_TYPE_MASK 0x0000000Cu
#define LBM_TYPE_MASK 0xFC00000Cu
#define LBM_NUMBER_MASK 0x08000000u
// gc ptr
#define LBM_TYPE_SYMBOL 0x00000000u // 00 0 0
#define LBM_TYPE_CHAR 0x00000004u // 01 0 0
@ -80,6 +82,7 @@
/* 8 - 2 free bits to encode type information into */
#define LBM_VAL_MASK (lbm_uint)0xFFFFFFFFFFFFFF00
#define LBM_VAL_TYPE_MASK (lbm_uint)0xFC
#define LBM_TYPE_MASK (lbm_uint)0xF8000000000000FC
// gc ptr
#define LBM_TYPE_SYMBOL (lbm_uint)0x0 // 00 00 00 0 0
#define LBM_TYPE_CHAR (lbm_uint)0x4 // 00 00 01 0 0

11
lispBM/lispBM/include/lbm_version.h
View File

@ -27,13 +27,20 @@ extern "C" {
/** LBM major version */
#define LBM_MAJOR_VERSION 0
/** LBM minor version */
#define LBM_MINOR_VERSION 20
#define LBM_MINOR_VERSION 21
/** LBM patch revision */
#define LBM_PATCH_VERSION 0
#define LBM_VERSION_STRING "0.20.0"
#define LBM_VERSION_STRING "0.21.0"
/*! \page changelog Changelog
NOV 28 2024: Version 0.21.0
- Removed partial evaluation.
- Added a built-in loop.
- Modification to built-in implementation of map.
- Addition of pointer-reversal garbage collector. Not on by default.
- Improved error messages.
NOV 1 2024: Version 0.20.0
- Added lbm_set_error_suspect function to enable extension authors to point out in more detail what is wrong.
- Improvement to error messages in some cases.

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

@ -63,6 +63,7 @@
#define TOKENIZER_NO_TOKEN 0
#define TOKENIZER_NEED_MORE -1
#define TOKENIZER_STRING_ERROR -2
#define TOKENIZER_CHAR_ERROR -3
#define TOKENIZER_MAX_SYMBOL_AND_STRING_LENGTH 256

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

@ -392,30 +392,33 @@ static lbm_value cons_with_gc(lbm_value head, lbm_value tail, lbm_value remember
}
static lbm_uint *get_stack_ptr(eval_context_t *ctx, unsigned int n) {
if (n > ctx->K.sp) {
error_ctx(ENC_SYM_STACK_ERROR);
if (n <= ctx->K.sp) {
lbm_uint index = ctx->K.sp - n;
return &ctx->K.data[index];
}
lbm_uint index = ctx->K.sp - n;
return &ctx->K.data[index];
error_ctx(ENC_SYM_STACK_ERROR);
return 0; // dead code cannot be reached, but C compiler doesn't realise.
}
// pop_stack_ptr is safe when no GC is performed and
// the values of the stack will be dropped.
static lbm_uint *pop_stack_ptr(eval_context_t *ctx, unsigned int n) {
if (n > ctx->K.sp) {
error_ctx(ENC_SYM_STACK_ERROR);
if (n <= ctx->K.sp) {
ctx->K.sp -= n;
return &ctx->K.data[ctx->K.sp];
}
ctx->K.sp -= n;
return &ctx->K.data[ctx->K.sp];
error_ctx(ENC_SYM_STACK_ERROR);
return 0; // dead code cannot be reached, but C compiler doesn't realise.
}
static lbm_uint *stack_reserve(eval_context_t *ctx, unsigned int n) {
if (ctx->K.sp + n >= ctx->K.size) {
error_ctx(ENC_SYM_STACK_ERROR);
if (ctx->K.sp + n < ctx->K.size) {
lbm_uint *ptr = &ctx->K.data[ctx->K.sp];
ctx->K.sp += n;
return ptr;
}
lbm_uint *ptr = &ctx->K.data[ctx->K.sp];
ctx->K.sp += n;
return ptr;
error_ctx(ENC_SYM_STACK_ERROR);
return 0; // dead code cannot be reached, but C compiler doesn't realise.
}
static void handle_flash_status(lbm_flash_status s) {
@ -567,7 +570,6 @@ static lbm_value get_cddr(lbm_value a) {
return(ENC_SYM_TERROR);
}
static lbm_value allocate_closure(lbm_value params, lbm_value body, lbm_value env) {
if (lbm_heap_num_free() < 4) {
@ -598,11 +600,20 @@ static lbm_value allocate_closure(lbm_value params, lbm_value body, lbm_value en
#define CLO_PARAMS 0
#define CLO_BODY 1
#define CLO_ENV 2
#define LOOP_BINDS 0
#define LOOP_COND 1
#define LOOP_BODY 2
// (closure params exp env) -> [params, exp, env])
static void extract_closure(lbm_value closure, lbm_value *res) {
lbm_value curr = get_cdr(closure);
for (int i = 0; i < 3; i ++) {
get_car_and_cdr(curr,&res[i],&curr);
static void 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);
res[i] = cell->car;
curr = cell->cdr;
} else {
error_ctx(ENC_SYM_TERROR);
}
}
}
@ -1827,18 +1838,14 @@ static void let_bind_values_eval(lbm_value binds, lbm_value exp, lbm_value env,
}
// (loop list-of-local-bindings
// condition
// condition-exp
// body-exp)
static void eval_loop(eval_context_t *ctx) {
lbm_value env = ctx->curr_env;
lbm_value curr_exp_cdr = get_cdr(ctx->curr_exp);
lbm_value binds = get_car(curr_exp_cdr); // key value pairs.
lbm_value curr_exp_cdr_cdr = get_cdr(curr_exp_cdr);
lbm_value cond = get_car(curr_exp_cdr_cdr); // loop condition
lbm_value body_exp = get_cadr(curr_exp_cdr_cdr); // loop body
stack_push_3(&ctx->K, body_exp, cond, LOOP_CONDITION);
let_bind_values_eval(binds, cond, env, ctx);
lbm_value parts[3];
extract_n(get_cdr(ctx->curr_exp), parts, 3);
stack_push_3(&ctx->K, parts[LOOP_BODY], parts[LOOP_COND], LOOP_CONDITION);
let_bind_values_eval(parts[LOOP_BINDS], parts[LOOP_COND], env, ctx);
}
// (let list-of-bindings
@ -2183,7 +2190,7 @@ static void apply_spawn_base(lbm_value *args, lbm_uint nargs, eval_context_t *ct
}
lbm_value cl[3];
extract_closure(args[closure_pos], cl);
extract_n(get_cdr(args[closure_pos]), cl, 3);
lbm_value curr_param = cl[CLO_PARAMS];
lbm_value clo_env = cl[CLO_ENV];
lbm_uint i = closure_pos + 1;
@ -2366,23 +2373,6 @@ static void apply_map(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
sptr[1] = ctx->curr_env;
sptr[2] = elt;
ctx->curr_exp = appli;
} else if (nargs == 1) {
// Partial application, create a closure.
lbm_uint sym;
if (lbm_str_to_symbol("x", &sym)) {
lbm_value *sptr = get_stack_ptr(ctx, 2);
// Store params and body on stack temporarily to keep them safe from gc.
sptr[0] = cons_with_gc(lbm_enc_sym(sym), ENC_SYM_NIL,ENC_SYM_NIL);
WITH_GC(sptr[1], lbm_heap_allocate_list_init(3,
ENC_SYM_MAP,
args[0],
lbm_enc_sym(sym)));
ctx->r = allocate_closure(sptr[0], sptr[1], ENC_SYM_NIL);
lbm_stack_drop(&ctx->K, 2);
ctx->app_cont = true;
} else {
error_ctx(ENC_SYM_FATAL_ERROR);
}
} else if (nargs == 2 && lbm_is_symbol_nil(args[1])) {
lbm_stack_drop(&ctx->K, 3);
ctx->r = ENC_SYM_NIL;
@ -2581,26 +2571,30 @@ static void cont_closure_application_args(eval_context_t *ctx) {
lbm_value car_params, cdr_params;
get_car_and_cdr(params, &car_params, &cdr_params);
lbm_value ls;
WITH_GC(ls, lbm_heap_allocate_list(2));
lbm_value entry = ls;
lbm_value aug_env = get_cdr(ls);
lbm_cons_t *c1 = lbm_ref_cell(entry);
c1->car = car_params;
c1->cdr = ctx->r;
lbm_cons_t *c2 = lbm_ref_cell(aug_env);
c2->car = entry;
c2->cdr = clo_env;
clo_env = aug_env;
if (lbm_heap_num_free() < 2) {
gc();
if (lbm_heap_num_free() < 2) {
error_ctx(ENC_SYM_MERROR);
}
}
lbm_value cell0 = lbm_heap_state.freelist;
lbm_cons_t *cell0_r = lbm_ref_cell(cell0);
lbm_value cell1 = cell0_r->cdr;
lbm_cons_t *cell1_r = lbm_ref_cell(cell1);
lbm_heap_state.freelist = cell1_r->cdr;
lbm_heap_state.num_alloc += 2;
bool a_nil = lbm_is_symbol_nil(args);
bool p_nil = lbm_is_symbol_nil(cdr_params);
cell0_r->car = car_params;
cell0_r->cdr = ctx->r;
cell1_r->car = cell0;
cell1_r->cdr = clo_env;
clo_env = cell1;
int ap = (a_nil ? 1 : 0) | ((p_nil ? 1 : 0) << 1);
// TODO: We are NOT going to implement a lazy sweep.
bool a_nil = args == ENC_SYM_NIL;
bool p_nil = cdr_params == ENC_SYM_NIL;
switch (ap) {
case 0: {
// evaluate the next argument.
if (!a_nil && !p_nil) {
lbm_value car_args, cdr_args;
get_car_and_cdr(args, &car_args, &cdr_args);
sptr[2] = clo_env;
@ -2609,32 +2603,18 @@ static void cont_closure_application_args(eval_context_t *ctx) {
stack_push(&ctx->K, CLOSURE_ARGS);
ctx->curr_exp = car_args;
ctx->curr_env = arg_env;
} break;
case 1: {
lbm_value new_env = lbm_list_append(arg_env,clo_env);
sptr[0] = new_env; // keep safe from GC. Overwriting arg_env (safe as subset).
ctx->r = allocate_closure(cdr_params, exp, new_env);
lbm_stack_drop(&ctx->K, 5);
ctx->app_cont = true;
} break;
case 2:
// Application with extra arguments
lbm_set_error_reason((char*)lbm_error_str_num_args);
error_ctx(ENC_SYM_EERROR);
// Ran out of arguments, but there are still parameters.
break;
case 3:
} else if (a_nil && p_nil) {
// Arguments and parameters match up in number
lbm_stack_drop(&ctx->K, 5);
ctx->curr_env = clo_env;
ctx->curr_exp = exp;
break;
default:
// impossible:
error_ctx(ENC_SYM_FATAL_ERROR);
} else {
lbm_set_error_reason((char*)lbm_error_str_num_args);
error_ctx(ENC_SYM_EERROR);
}
}
static void cont_application_args(eval_context_t *ctx) {
lbm_uint *sptr = get_stack_ptr(ctx, 3);
@ -3533,7 +3513,7 @@ static void cont_application_start(eval_context_t *ctx) {
switch (get_car(ctx->r)) {
case ENC_SYM_CLOSURE: {
lbm_value cl[3];
extract_closure(ctx->r, cl);
extract_n(get_cdr(ctx->r), cl, 3);
lbm_value arg_env = (lbm_value)sptr[0];
lbm_value arg0, arg_rest;
get_car_and_cdr(args, &arg0, &arg_rest);
@ -4142,11 +4122,11 @@ static void evaluation_step(void){
return;
}
if (exp_type == LBM_TYPE_CONS) {
lbm_value head = lbm_ref_cell(ctx->curr_exp)->car;
lbm_cons_t *cell = lbm_ref_cell(ctx->curr_exp);
if (lbm_type_of(head) == LBM_TYPE_SYMBOL) {
if ((cell->car & LBM_VAL_TYPE_MASK) == LBM_TYPE_SYMBOL) {
lbm_value eval_index = lbm_dec_sym(head) - SPECIAL_FORMS_START;
lbm_value eval_index = lbm_dec_sym(cell->car) - SPECIAL_FORMS_START;
if (eval_index <= (SPECIAL_FORMS_END - SPECIAL_FORMS_START)) {
evaluators[eval_index](ctx);
@ -4159,10 +4139,9 @@ static void evaluation_step(void){
*/
lbm_value *reserved = stack_reserve(ctx, 3);
reserved[0] = ctx->curr_env;
reserved[1] = lbm_ref_cell(ctx->curr_exp)->cdr;
reserved[1] = cell->cdr;
reserved[2] = APPLICATION_START;
ctx->curr_exp = head; // evaluate the function
ctx->curr_exp = cell->car; // evaluate the function
return;
}

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

@ -28,12 +28,27 @@
#include <stdio.h>
#include <math.h>
// TODO: Check for correctnes
#define IS_NUMBER(X) \
( (((X) & 1) && ((X) & LBM_NUMBER_MASK)) || \
((X) & 0xC))
// if (x & 1)
// (x & LBM_NUMBER_MASK)
// (x & 0xC))
// Todo: It may be possible perform some of these operations
// on encoded values followed by a "correction" of the result values
// type bits.
// But the checks required to figure out if it is possible to apply the
// operation in this way has a cost too...
static lbm_uint add2(lbm_uint a, lbm_uint b) {
lbm_uint retval = ENC_SYM_TERROR;
if (!(lbm_is_number(a) && lbm_is_number(b))) {
lbm_set_error_suspect(lbm_is_number(a) ? b : a);
if (!(IS_NUMBER(a) && IS_NUMBER(b))) {
lbm_set_error_suspect(IS_NUMBER(a) ? b : a);
return retval;
}
@ -55,8 +70,8 @@ static lbm_uint mul2(lbm_uint a, lbm_uint b) {
lbm_uint retval = ENC_SYM_TERROR;
if (!(lbm_is_number(a) && lbm_is_number(b))) {
lbm_set_error_suspect(lbm_is_number(a) ? b : a);
if (!(IS_NUMBER(a) && IS_NUMBER(b))) {
lbm_set_error_suspect(IS_NUMBER(a) ? b : a);
return retval;
}
@ -78,8 +93,8 @@ static lbm_uint div2(lbm_uint a, lbm_uint b) {
lbm_uint retval = ENC_SYM_TERROR;
if (!(lbm_is_number(a) && lbm_is_number(b))) {
lbm_set_error_suspect(lbm_is_number(a) ? b : a);
if (!(IS_NUMBER(a) && IS_NUMBER(b))) {
lbm_set_error_suspect(IS_NUMBER(a) ? b : a);
return retval;
}
@ -101,8 +116,8 @@ static lbm_uint mod2(lbm_uint a, lbm_uint b) {
lbm_uint retval = ENC_SYM_TERROR;
if (!(lbm_is_number(a) && lbm_is_number(b))) {
lbm_set_error_suspect(lbm_is_number(a) ? b : a);
if (!(IS_NUMBER(a) && IS_NUMBER(b))) {
lbm_set_error_suspect(IS_NUMBER(a) ? b : a);
return retval;
}
@ -124,7 +139,7 @@ static lbm_uint negate(lbm_uint a) {
lbm_uint retval = ENC_SYM_TERROR;
if (!lbm_is_number(a)) {
if (!IS_NUMBER(a)) {
lbm_set_error_suspect(a);
return retval;
}
@ -148,8 +163,8 @@ static lbm_uint sub2(lbm_uint a, lbm_uint b) {
lbm_uint retval = ENC_SYM_TERROR;
if (!(lbm_is_number(a) && lbm_is_number(b))) {
lbm_set_error_suspect(lbm_is_number(a) ? b : a);
if (!(IS_NUMBER(a) && IS_NUMBER(b))) {
lbm_set_error_suspect(IS_NUMBER(a) ? b : a);
return retval;
}
@ -224,8 +239,8 @@ static int compare(lbm_uint a, lbm_uint b) {
int retval = 0;
if (!(lbm_is_number(a) && lbm_is_number(b))) {
lbm_set_error_suspect(lbm_is_number(a) ? b : a);
if (!(IS_NUMBER(a) && IS_NUMBER(b))) {
lbm_set_error_suspect(IS_NUMBER(a) ? b : a);
return ENC_SYM_TERROR;
}
@ -246,7 +261,7 @@ static int compare(lbm_uint a, lbm_uint b) {
/* (array-create type size) */
static void array_create(lbm_value *args, lbm_uint nargs, lbm_value *result) {
*result = ENC_SYM_EERROR;
if (nargs == 1 && lbm_is_number(args[0])) {
if (nargs == 1 && IS_NUMBER(args[0])) {
lbm_heap_allocate_array(result, lbm_dec_as_u32(args[0]));
}
}
@ -432,12 +447,12 @@ static lbm_value fundamental_numeq(lbm_value *args, lbm_uint nargs, eval_context
bool r = true;
bool ok = true;
if (!lbm_is_number(a)) {
if (!IS_NUMBER(a)) {
return ENC_SYM_TERROR;
}
for (lbm_uint i = 1; i < nargs; i ++) {
b = args[i];
if (!lbm_is_number(b)) {
if (!IS_NUMBER(b)) {
ok = false;
break;
}
@ -473,13 +488,13 @@ static lbm_value fundamental_lt(lbm_value *args, lbm_uint nargs, eval_context_t
bool r = true;
bool ok = true;
if (!lbm_is_number(a)) {
if (!IS_NUMBER(a)) {
lbm_set_error_suspect(a);
return ENC_SYM_TERROR;
}
for (lbm_uint i = 1; i < nargs; i ++) {
b = args[i];
if (!lbm_is_number(b)) {
if (!IS_NUMBER(b)) {
ok = false;
break;
}
@ -504,13 +519,13 @@ static lbm_value fundamental_gt(lbm_value *args, lbm_uint nargs, eval_context_t
bool r = true;
bool ok = true;
if (!lbm_is_number(a)) {
if (!IS_NUMBER(a)) {
lbm_set_error_suspect(a);
return ENC_SYM_TERROR;
}
for (lbm_uint i = 1; i < nargs; i ++) {
b = args[i];
if (!lbm_is_number(b)) {
if (!IS_NUMBER(b)) {
ok = false;
break;
}
@ -535,13 +550,13 @@ static lbm_value fundamental_leq(lbm_value *args, lbm_uint nargs, eval_context_t
bool r = true;
bool ok = true;
if (!lbm_is_number(a)) {
if (!IS_NUMBER(a)) {
lbm_set_error_suspect(a);
return ENC_SYM_TERROR;
}
for (lbm_uint i = 1; i < nargs; i ++) {
b = args[i];
if (!lbm_is_number(b)) {
if (!IS_NUMBER(b)) {
ok = false;
break;
}
@ -566,13 +581,13 @@ static lbm_value fundamental_geq(lbm_value *args, lbm_uint nargs, eval_context_t
bool r = true;
bool ok = true;
if (!lbm_is_number(a)) {
if (!IS_NUMBER(a)) {
lbm_set_error_suspect(a);
return ENC_SYM_TERROR;
}
for (lbm_uint i = 1; i < nargs; i ++) {
b = args[i];
if (!lbm_is_number(b)) {
if (!IS_NUMBER(b)) {
ok = false;
break;
}
@ -620,7 +635,7 @@ static lbm_value fundamental_self(lbm_value *args, lbm_uint nargs, eval_context_
static lbm_value fundamental_set_mailbox_size(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
if (nargs == 1 && lbm_is_number(args[0])) {
if (nargs == 1 && IS_NUMBER(args[0])) {
uint32_t s = lbm_dec_as_u32(args[0]);
if (lbm_mailbox_change_size(ctx, s)) {
return ENC_SYM_TRUE;
@ -821,7 +836,7 @@ static lbm_value fundamental_set_ix(lbm_value *args, lbm_uint nargs, eval_contex
lbm_value result = ENC_SYM_EERROR;
if (nargs == 3) {
if (lbm_is_cons(args[0]) &&
lbm_is_number(args[1])) {
IS_NUMBER(args[1])) {
lbm_value curr = args[0];
lbm_uint i = 0;
lbm_uint ix = lbm_dec_as_u32(args[1]);
@ -916,7 +931,7 @@ static lbm_value fundamental_cossa(lbm_value *args, lbm_uint nargs, eval_context
static lbm_value fundamental_ix(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
(void) ctx;
lbm_value result = ENC_SYM_EERROR;
if (nargs == 2 && lbm_is_number(args[1])) {
if (nargs == 2 && IS_NUMBER(args[1])) {
result = index_list(args[0], lbm_dec_as_i32(args[1]));
}
return result;
@ -1008,7 +1023,7 @@ static lbm_value fundamental_shl(lbm_value *args, lbm_uint nargs, eval_context_t
lbm_value retval = ENC_SYM_EERROR;
if (nargs == 2) {
retval = ENC_SYM_TERROR;
if (!(lbm_is_number(args[0]) && lbm_is_number(args[1]))) {
if (!(IS_NUMBER(args[0]) && IS_NUMBER(args[1]))) {
return retval;
}
switch (lbm_type_of_functional(args[0])) {
@ -1028,7 +1043,7 @@ static lbm_value fundamental_shr(lbm_value *args, lbm_uint nargs, eval_context_t
lbm_value retval = ENC_SYM_EERROR;
if (nargs == 2) {
retval = ENC_SYM_TERROR;
if (!(lbm_is_number(args[0]) && lbm_is_number(args[1]))) {
if (!(IS_NUMBER(args[0]) && IS_NUMBER(args[1]))) {
return retval;
}
switch (lbm_type_of_functional(args[0])) {
@ -1048,7 +1063,7 @@ static lbm_value fundamental_bitwise_and(lbm_value *args, lbm_uint nargs, eval_c
lbm_value retval = ENC_SYM_EERROR;
if (nargs == 2) {
retval = ENC_SYM_TERROR;
if (!(lbm_is_number(args[0]) && lbm_is_number(args[1]))) {
if (!(IS_NUMBER(args[0]) && IS_NUMBER(args[1]))) {
return retval;
}
switch (lbm_type_of_functional(args[0])) {
@ -1068,7 +1083,7 @@ static lbm_value fundamental_bitwise_or(lbm_value *args, lbm_uint nargs, eval_co
lbm_value retval = ENC_SYM_EERROR;
if (nargs == 2) {
retval = ENC_SYM_TERROR;
if (!(lbm_is_number(args[0]) && lbm_is_number(args[1]))) {
if (!(IS_NUMBER(args[0]) && IS_NUMBER(args[1]))) {
return retval;
}
switch (lbm_type_of_functional(args[0])) {
@ -1088,7 +1103,7 @@ static lbm_value fundamental_bitwise_xor(lbm_value *args, lbm_uint nargs, eval_c
lbm_value retval = ENC_SYM_EERROR;
if (nargs == 2) {
retval = ENC_SYM_TERROR;
if (!(lbm_is_number(args[0]) && lbm_is_number(args[1]))) {
if (!(IS_NUMBER(args[0]) && IS_NUMBER(args[1]))) {
return retval;
}
switch (lbm_type_of_functional(args[0])) {
@ -1108,7 +1123,7 @@ static lbm_value fundamental_bitwise_not(lbm_value *args, lbm_uint nargs, eval_c
lbm_value retval = ENC_SYM_EERROR;
if (nargs == 1) {
retval = ENC_SYM_TERROR;
if (!(lbm_is_number(args[0]))) {
if (!(IS_NUMBER(args[0]))) {
return retval;
}
switch (lbm_type_of_functional(args[0])) {
@ -1184,12 +1199,12 @@ static lbm_value fundamental_range(lbm_value *args, lbm_uint nargs, eval_context
int32_t end;
bool rev = false;
if (nargs == 1 && lbm_is_number(args[0])) {
if (nargs == 1 && IS_NUMBER(args[0])) {
start = 0;
end = lbm_dec_as_i32(args[0]);
} else if (nargs == 2 &&
lbm_is_number(args[0]) &&
lbm_is_number(args[1])) {
IS_NUMBER(args[0]) &&
IS_NUMBER(args[1])) {
start = lbm_dec_as_i32(args[0]);
end = lbm_dec_as_i32(args[1]);
} else {
@ -1219,7 +1234,7 @@ static lbm_value fundamental_range(lbm_value *args, lbm_uint nargs, eval_context
static lbm_value fundamental_reg_event_handler(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
(void) ctx;
if (nargs != 1 || !lbm_is_number(args[0])) {
if (nargs != 1 || !IS_NUMBER(args[0])) {
return ENC_SYM_TERROR;
}
@ -1229,7 +1244,7 @@ static lbm_value fundamental_reg_event_handler(lbm_value *args, lbm_uint nargs,
static lbm_value fundamental_take(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
(void) ctx;
if (nargs != 2 || !lbm_is_number(args[1]) || !lbm_is_list(args[0]))
if (nargs != 2 || !IS_NUMBER(args[1]) || !lbm_is_list(args[0]))
return ENC_SYM_TERROR;
return lbm_list_copy(lbm_dec_as_i32(args[1]), args[0]);
@ -1237,7 +1252,7 @@ static lbm_value fundamental_take(lbm_value *args, lbm_uint nargs, eval_context_
static lbm_value fundamental_drop(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
(void) ctx;
if (nargs != 2 || !lbm_is_number(args[1]) || !lbm_is_list(args[0]))
if (nargs != 2 || !IS_NUMBER(args[1]) || !lbm_is_list(args[0]))
return ENC_SYM_TERROR;
return lbm_list_drop(lbm_dec_as_u32(args[1]), args[0]);
}

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

@ -435,11 +435,7 @@ double lbm_dec_as_double(lbm_value a) {
bool lbm_is_number(lbm_value x) {
lbm_uint t = lbm_type_of(x);
#ifndef LBM64
return (t & 0xC || t & 0x08000000);
#else
return (t & 0x1C || t & 0x0800000000000000);
#endif
return (t & 0xC || t & LBM_NUMBER_MASK);
}
/****************************************************/

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

@ -396,9 +396,15 @@ void lbm_free(void *ptr) {
}
int lbm_memory_shrink(lbm_uint *ptr, lbm_uint n) {
if (!lbm_memory_ptr_inside(ptr) || n == 0) return 0;
lbm_uint ix = address_to_bitmap_ix(ptr);
mutex_lock(&lbm_mem_mutex);
if (status(ix) == START_END) {
mutex_unlock(&lbm_mem_mutex);
return 1; // A one word arrays always succeeds at remaining at 1 word
}
if (status(ix) != START) {
mutex_unlock(&lbm_mem_mutex);
return 0; // ptr does not point to the start of an allocated range.

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

@ -42,6 +42,33 @@ typedef struct {
uint32_t len;
} matcher;
/*
\#\a -> 7 ; control-g
\#\b -> 8 ; backspace, BS
\#\t -> 9 ; tab, TAB
\#\n -> 10 ; newline
\#\v -> 11 ; vertical tab
\#\f -> 12 ; formfeed character
\#\r -> 13 ; carriage return, RET
\#\e -> 27 ; escape character, ESC
\#\s -> 32 ; space character, SPC
\#\\ -> 92 ; backslash character, \
\#\d -> 127 ; delete character, DEL
*/
#define NUM_SPECIAL_CHARS 11
const char special_chars[NUM_SPECIAL_CHARS][2] =
{{'a', '\a'},
{'b', '\b'},
{'t', '\t'},
{'n', '\n'},
{'v', '\v'},
{'f', '\f'},
{'r', '\r'},
{'e', 27},
{'s', 32},
{'\\', '\\'},
{'d', 127}};
#define NUM_FIXED_SIZE_TOKENS 16
const matcher fixed_size_tokens[NUM_FIXED_SIZE_TOKENS] = {
@ -244,6 +271,24 @@ int tok_char(lbm_char_channel_t *chan, char *res) {
if (r == CHANNEL_MORE) return TOKENIZER_NEED_MORE;
if (r == CHANNEL_END) return TOKENIZER_NO_TOKEN;
if (c == '\\') {
r = lbm_channel_peek(chan, 3, &c);
if (r == CHANNEL_MORE) return TOKENIZER_NEED_MORE;
if (r == CHANNEL_END) return TOKENIZER_NO_TOKEN;
bool ok = false;
for (int i = 0; i < NUM_SPECIAL_CHARS; i ++) {
if (c == special_chars[i][0]) {
*res = special_chars[i][1];
ok = true;
}
}
if (ok) {
return 4;
} else {
return TOKENIZER_CHAR_ERROR;
}
}
*res = c;
return 3;
}

2
lispBM/lispBM/tests/test_array_9.lisp
View File

@ -3,6 +3,6 @@
(defun extract (arr s e)
(let ((f (lambda (arr x) (bufget-u8 arr x))))
( map (f arr) (range s e))))
( map (lambda (x) (f arr x)) (range s e))))
(check (eq (extract a 0 4) '(1 2 3 4)))

2
lispBM/lispBM/tests/test_map_13.lisp
View File

@ -5,7 +5,7 @@
(+ y x)))
(def f1 (map f))
(def f1 (lambda (ls) (map f ls)))
(check (eq (f1 (list 1 2 3)) (list 101 102 103)))

2
lispBM/lispBM/tests/test_map_6.lisp
View File

@ -1,7 +1,7 @@
(defun f (x) (+ x 1))
(define myfun (map f))
(define myfun (lambda (ls) (map f ls)))
(define ls (list (list 1 2 3) (range 2 5)))
(define rs '((2 3 4) (3 4 5)))

2
lispBM/lispBM/tests/test_map_7.lisp
View File

@ -6,4 +6,4 @@
(define ls (list (list 1 2 3) (range 2 5)))
(define rs '((2 3 4) (3 4 5)))
(check (eq (map (map f) ls) rs))
(check (eq (map (lambda (xs) (map f xs)) ls) rs))

2
lispBM/lispBM/tests/test_map_8.lisp
View File

@ -4,4 +4,4 @@
(define ls (list (list (list 1 2 3) (range 2 5))))
(define rs '(((2 3 4) (3 4 5))))
(check (eq (map (map (map f)) ls) rs))
(check (eq (map (lambda (ys) (map (lambda (xs) (map f xs)) ys) ls) rs)))

4
lispBM/lispBM/tests/test_partial_0.lisp
View File

@ -1,5 +1,7 @@
;; Partial application has been removed
(define f (lambda (x y z w) (+ x y z w)))
(check (= ((f 1) 2 3 4) 10))
(check (= (f 1 2 3 4) 10))

4
lispBM/lispBM/tests/test_partial_1.lisp
View File

@ -1,3 +1,5 @@
;; partial application has been removed
(define f (lambda (x y z w) (+ x y z w)))
(check (= (((f 1) 2) 3 4) 10))
(check (= (f 1 2 3 4) 10))

4
lispBM/lispBM/tests/test_partial_2.lisp
View File

@ -1,3 +1,5 @@
;; Partial application has been removed
(define f (lambda (x y z w) (+ x y z w)))
(check (= ((((f 1) 2) 3) 4) 10))
(check (= (f 1 2 3 4) 10))

10
lispBM/lispBM/tests/test_partial_3.lisp
View File

@ -1,5 +1,9 @@
(define f (lambda (x y z w) (+ x y z w)))
;; Partial application has been removed
(define g (f 1 2))
;(define f (lambda (x y z w) (+ x y z w)))
(check (= (g 3 4) 10))
;(define g (f 1 2))
;(check (= (g 3 4) 10))
(check t)

10
lispBM/lispBM/tests/test_partial_4.lisp
View File

@ -1,5 +1,9 @@
(define f (lambda (x y z w) (+ x y z w)))
;; Partial application has been removed
(define g (f 1 2))
;;(define f (lambda (x y z w) (+ x y z w)))
(check (= ((g 3) 4) 10))
;;(define g (f 1 2))
;;(check (= ((g 3) 4) 10))
(check t)

10
lispBM/lispBM/tests/test_partial_5.lisp
View File

@ -1,4 +1,8 @@
(let ((apa 2))
(defun f (x y z w) (+ apa x y z w)))
;;Partial applciation has been removed
(check (= ((f 1) 2 3 4) 12))
;;(let ((apa 2))
;; (defun f (x y z w) (+ apa x y z w)))
;;(check (= ((f 1) 2 3 4) 12))
(check t)

119
lispBM/lispif_vesc_extensions.c
View File

@ -56,6 +56,11 @@
#include <ctype.h>
#include <stdarg.h>
/**
* Bytes per word in the LBM memory.
*/
#define LBM_WORD_SIZE 4
typedef struct {
// BMS
lbm_uint v_tot;
@ -559,6 +564,33 @@ static bool is_symbol_true_false(lbm_value v) {
return res;
}
/**
* Wrapper around lbm_memory_shrink that takes number of bytes instead of number
* of words. Shrinks the size of an pointer allocated in LBM memory to the
* smallest possible size while still having capacity for the specified amount
* of bytes.
*
* @param ptr Pointer to the allocated segment in LBM memory. Should have been
* obtained through lbm_malloc or other similar way at some point.
* @param size_bytes The new capacity of the allocation in bytes. Must be
* smaller or equal to the previous capacity.
* @return If the operation succeeded. The return value of lbm_memory_shrink is
* directly passed through, that is: false is returned either if ptr didn't
* point into the LBM memory/didn't point to the start of an allocated segment
* or if the new size was larger than the previous (note that since this
* function converts bytes to words, a larger size in bytes might not cause it
* to fail, as the size in words could still be the same). Otherwise true is
* returned.
*/
static bool lbm_memory_shrink_bytes(void *array, lbm_uint size_bytes) {
lbm_uint size_words = size_bytes / LBM_WORD_SIZE;
if (size_bytes % LBM_WORD_SIZE != 0) {
size_words += 1;
}
return lbm_memory_shrink((lbm_uint *)array, size_words) > 0;
}
// Various commands
static lbm_value ext_print(lbm_value *args, lbm_uint argn) {
@ -4520,6 +4552,92 @@ static lbm_value ext_buf_find(lbm_value *args, lbm_uint argn) {
return lbm_enc_i(res);
}
/**
* signature: (buf-resize arr:array delta-size:number|nil [new-size:number])
* -> array
*
* If delta-size is passed, this extension calculates the new size by
* adding the relative size to the current size, otherwise new-size is simply
* used for the new size.
*
* If the new size is smaller than the current size, the array is just shrunk in
* place without allocating a new buffer. Either delta-size or new-size must not
* be nil.
*
* Either way, the passed array is always resized mutably, with the returned
* reference only for convenience.
*/
static lbm_value ext_buf_resize(lbm_value *args, lbm_uint argn) {
if ((argn != 2 && argn != 3) || !lbm_is_array_rw(args[0])
|| (!lbm_is_number(args[1]) && !lbm_is_symbol_nil(args[1]))
|| (argn == 3 && !lbm_is_number(args[2]))) {
lbm_set_error_reason((char *)lbm_error_str_incorrect_arg);
return ENC_SYM_TERROR;
}
bool delta_size_passed = !lbm_is_symbol_nil(args[1]);
bool new_size_passed = argn == 3;
if (!delta_size_passed && !new_size_passed) {
lbm_set_error_reason(
"delta-size (arg 2) was nil while new-size wasn't provided (arg 3)"
);
return ENC_SYM_EERROR;
}
lbm_array_header_t *header = (lbm_array_header_t *)lbm_car(args[0]);
if (header == NULL) {
// Should be impossible, unless it contained null pointer to header.
return ENC_SYM_FATAL_ERROR;
}
uint32_t new_size;
{
int32_t new_size_signed;
if (delta_size_passed) {
new_size_signed = header->size + lbm_dec_as_i32(args[1]);
} else {
new_size_signed = lbm_dec_as_i32(args[2]);
}
if (new_size_signed < 0) {
lbm_set_error_reason("resulting size was negative");
return ENC_SYM_EERROR;
}
new_size = (uint32_t)new_size_signed;
}
if (new_size == header->size) {
return args[0];
} else if (new_size < header->size) {
uint32_t allocated_size = new_size;
if (new_size == 0) {
// arrays of size 0 still need some memory allocated for them.
allocated_size = 1;
}
// We sadly can't trust the return value, as it fails if the allocation
// was previously a single word long. So we just throw it away.
lbm_memory_shrink_bytes(header->data, allocated_size);
header->size = new_size;
return args[0];
} else {
void *buffer = lbm_malloc_reserve(new_size);
if (buffer == NULL) {
return ENC_SYM_MERROR;
}
memcpy(buffer, header->data, header->size);
memset(buffer + header->size, 0, new_size - header->size);
lbm_memory_free(header->data);
header->data = buffer;
header->size = new_size;
return args[0];
}
}
static lbm_value ext_shutdown_hold(lbm_value *args, lbm_uint argn) {
if (argn != 1) {
lbm_set_error_reason((char*)lbm_error_str_num_args);
@ -4684,6 +4802,7 @@ void lispif_load_vesc_extensions(void) {
lbm_add_extension("crc16", ext_crc16);
lbm_add_extension("crc32", ext_crc32);
lbm_add_extension("buf-find", ext_buf_find);
lbm_add_extension("buf-resize", ext_buf_resize);
lbm_add_extension("shutdown-hold", ext_shutdown_hold);
// APP commands