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

Updated lispbm, fixed dual motor flash motor stop

This commit is contained in:
Benjamin Vedder 2022-02-13 15:18:22 +01:00
parent 2156e67b8e 84a79f8109
commit 8cccadae6a
36 changed files with 1414 additions and 401 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
flash_helper.c
View File

@ -127,10 +127,10 @@ uint16_t flash_helper_erase_new_app(uint32_t new_app_size) {
new_app_size += flash_addr[NEW_APP_BASE];
mc_interface_release_motor_override();
mc_interface_ignore_input_both(5000);
mc_interface_release_motor_override_both();
if (!mc_interface_wait_for_motor_release(3.0)) {
if (!mc_interface_wait_for_motor_release_both(3.0)) {
return 100;
}
@ -375,10 +375,10 @@ static uint16_t erase_sector(uint32_t sector) {
FLASH_ClearFlag(FLASH_FLAG_OPERR | FLASH_FLAG_WRPERR | FLASH_FLAG_PGAERR |
FLASH_FLAG_PGPERR | FLASH_FLAG_PGSERR);
mc_interface_release_motor_override();
mc_interface_ignore_input_both(5000);
mc_interface_release_motor_override_both();
if (!mc_interface_wait_for_motor_release(3.0)) {
if (!mc_interface_wait_for_motor_release_both(3.0)) {
return 100;
}
@ -397,7 +397,7 @@ static uint16_t erase_sector(uint32_t sector) {
FLASH_Lock();
timeout_configure_IWDT();
mc_interface_ignore_input_both(5000);
mc_interface_ignore_input_both(1000);
utils_sys_unlock_cnt();
return FLASH_COMPLETE;
@ -408,10 +408,10 @@ static uint16_t write_data(uint32_t base, uint8_t *data, uint32_t len) {
FLASH_ClearFlag(FLASH_FLAG_OPERR | FLASH_FLAG_WRPERR | FLASH_FLAG_PGAERR |
FLASH_FLAG_PGPERR | FLASH_FLAG_PGSERR);
mc_interface_release_motor_override();
mc_interface_ignore_input_both(5000);
mc_interface_release_motor_override_both();
if (!mc_interface_wait_for_motor_release(3.0)) {
if (!mc_interface_wait_for_motor_release_both(3.0)) {
return 100;
}

2
lispBM/README.md
View File

@ -598,7 +598,7 @@ The following example shows how to spawn a thread that handles SID (standard-id)
)))
; Spawn the event handler thread and pass the ID it returns to C
(event-register-handler (spawn '(event-handler)))
(event-register-handler (spawn event-handler))
; Enable the CAN event for standard ID (SID) frames
(event-enable "event-can-sid")

8
lispBM/lispBM/README.md
View File

@ -67,9 +67,8 @@ There are [demonstrations on YouTube](https://youtube.com/playlist?list=PLtf_3Ta
17. (DONE) Rename files with names that may conflict with common stuff (memory.h, memory.c).
18. (DONE) It should be possible to reset the runtime system.
19. (DONE) Add messages to lisp process mailbox from C to unlock blocked proc.
20. Make uniform how to return success or failure. It is sometimes bool and sometimes int right now.
21. Spawn closures specifically instead of expressions in general.
22. Implement some looping structure for speed or just ease of use.
20. Spawn closures specifically instead of expressions in general.
21. Implement some looping structure for speed or just ease of use.
## Vague or continuosly ongoing todos
1. Doxygen?
@ -77,9 +76,8 @@ There are [demonstrations on YouTube](https://youtube.com/playlist?list=PLtf_3Ta
3. Be much more stringent on checking of error conditions etc.
4. More built in arithmetic.
5. More built in comparisons.
6. Make uniform how to return success or failure. It is sometimes bool and sometimes int right now.
## Very platform dependent TODOs
1. Save images (heap + symbol memory) to flash or sd-card.
## Compile for linux (Requires 32bit libraries. May need something like "multilib" on a 64bit linux)
1. Build the library: `make`

1
lispBM/lispBM/benchmarks/bench_chibi/Makefile
View File

@ -137,6 +137,7 @@ LBMSRC = ../../src/compression.c \
../../src/symrepr.c \
../../src/tokpar.c \
../../src/lispbm.c \
../../src/lbm_c_interop.c \
../../platform/chibios/src/platform_mutex.c
CSRC = $(ALLCSRC) \

14
lispBM/lispBM/benchmarks/bench_chibi/main.c
View File

@ -35,9 +35,13 @@
#define EVAL_WA_SIZE THD_WORKING_AREA_SIZE(1024)
#define EVAL_CPS_STACK_SIZE 256
#define GC_STACK_SIZE 256
#define PRINT_STACK_SIZE 256
#define HEAP_SIZE 2048
uint32_t gc_stack_storage[GC_STACK_SIZE];
uint32_t print_stack_storage[PRINT_STACK_SIZE];
static lbm_cons_t heap[HEAP_SIZE] __attribute__ ((aligned (8)));
static uint32_t memory_array[LBM_MEMORY_SIZE_8K];
@ -196,8 +200,10 @@ int main(void) {
chThdSleepMilliseconds(2000);
if (!lbm_init(heap, HEAP_SIZE,
gc_stack_storage, GC_STACK_SIZE,
memory_array, LBM_MEMORY_SIZE_8K,
bitmap_array, LBM_MEMORY_BITMAP_SIZE_8K)) {
bitmap_array, LBM_MEMORY_BITMAP_SIZE_8K,
print_stack_storage, PRINT_STACK_SIZE)) {
chprintf(chp,"LispBM Init failed.\r\n");
return 0;
}
@ -306,8 +312,10 @@ int main(void) {
}
lbm_init(heap, HEAP_SIZE,
gc_stack_storage, GC_STACK_SIZE,
memory_array, LBM_MEMORY_SIZE_8K,
bitmap_array, LBM_MEMORY_BITMAP_SIZE_8K);
bitmap_array, LBM_MEMORY_BITMAP_SIZE_8K,
print_stack_storage, PRINT_STACK_SIZE);
lbm_add_extension("print", ext_print);

9
lispBM/lispBM/benchmarks/benchresult22_02_04_14_29_37 Normal file
View File

@ -0,0 +1,9 @@
File, Load time (s), Eval time (s), GC avg time (us), GC min time (us), GC max time (us), GC invocations, GC least free
q2.lisp, 0.001799999, 1.817800045, 616.470581054, 600, 700, 85, 1931
dec_cnt2.lisp, 0.001099999, 3.414499998, 510.738250732, 500, 600, 149, 2011
dec_cnt1.lisp, 0.001099999, 4.270999908, 513.422790527, 500, 600, 149, 2012
fibonacci.lisp, 0.001200000, 4.533899784, 562.857116699, 500, 600, 140, 1966
dec_cnt3.lisp, 0.001399999, 1.554200053, 538.095214843, 500, 600, 21, 1994
tak.lisp, 0.001900000, 4.262000083, 641.666687011, 600, 700, 300, 1890
fibonacci_tail.lisp, 0.001900000, 0.005299999, 0.000000000, 4294967295, 0, 0, 2048
insertionsort.lisp, 0.002799999, 0.006099999, 0.000000000, 4294967295, 0, 0, 2048

14
lispBM/lispBM/chibios-examples/repl-ChibiOS/main.c
View File

@ -29,9 +29,13 @@
#define EVAL_WA_SIZE THD_WORKING_AREA_SIZE(1024)
#define EVAL_CPS_STACK_SIZE 256
#define GC_STACK_SIZE 256
#define PRINT_STACK_SIZE 256
#define HEAP_SIZE 2048
uint32_t gc_stack_storage[GC_STACK_SIZE];
uint32_t print_stack_storage[PRINT_STACK_SIZE];
static lbm_cons_t heap[HEAP_SIZE] __attribute__ ((aligned (8)));
static uint32_t memory_array[LBM_MEMORY_SIZE_8K];
@ -188,8 +192,10 @@ int main(void) {
chThdSleepMilliseconds(2000);
if (!lbm_init(heap, HEAP_SIZE,
gc_stack_storage, GC_STACK_SIZE,
memory_array, LBM_MEMORY_SIZE_8K,
bitmap_array, LBM_MEMORY_BITMAP_SIZE_8K)) {
bitmap_array, LBM_MEMORY_BITMAP_SIZE_8K,
print_stack_storage, PRINT_STACK_SIZE)) {
chprintf(chp,"LispBM Init failed.\r\n");
return 0;
}
@ -298,8 +304,10 @@ int main(void) {
}
lbm_init(heap, HEAP_SIZE,
gc_stack_storage, GC_STACK_SIZE,
memory_array, LBM_MEMORY_SIZE_8K,
bitmap_array, LBM_MEMORY_BITMAP_SIZE_8K);
bitmap_array, LBM_MEMORY_BITMAP_SIZE_8K,
print_stack_storage, PRINT_STACK_SIZE);
lbm_add_extension("print", ext_print);

11
lispBM/lispBM/chibios-examples/xmas_dac/main.c
View File

@ -30,9 +30,14 @@
#define EVAL_WA_SIZE THD_WORKING_AREA_SIZE(1024)
#define EVAL_CPS_STACK_SIZE 256
#define GC_STACK_SIZE 256
#define PRINT_STACK_SIZE 256
#define HEAP_SIZE 8192
uint32_t gc_stack_storage[256];
uint32_t print_stack_storage[256];
lbm_cons_t heap[HEAP_SIZE] __attribute__ ((aligned (8)));
static lbm_tokenizer_string_state_t string_tok_state;
@ -316,8 +321,10 @@ int main(void) {
if (!lbm_init(heap, HEAP_SIZE,
gc_stack_storage, GC_STACK_SIZE,
memory_array, LBM_MEMORY_SIZE_8K,
bitmap_array, LBM_MEMORY_BITMAP_SIZE_8K)) {
bitmap_array, LBM_MEMORY_BITMAP_SIZE_8K,
print_stack_storage, PRINT_STACK_SIZE)) {
chprintf(chp,"Initializing LispBM failed\r\n");
return 0;
}
@ -406,7 +413,7 @@ int main(void) {
chprintf(chp, "received %d bytes\r\n", strlen(file_buffer));
if (done) {
lbm_value t;
//lbm_value t;
lbm_create_char_stream_from_string(&string_tok_state,
&string_tok,

67
lispBM/lispBM/doc/lbm.dox
View File

@ -1,9 +1,74 @@
/** \page lbmdoc Introduction to LispBM programming
\tableofcontents
\section sec_intro Introduction
LispBM is a lisp-like language implemented by a non-lisper. The inspiration for LispBM came from watching the <a
href="https://www.youtube.com/watch?v=-J_xL4IGhJA&list=PLE18841CABEA24090">
SICP course on youtube </a> and a tiny amount of experimenting with EMACS
lisp. I strongly recommend that you watch the SICP course, it is a lot of fun!<br>
LispBM does not try to implement any particular Lisp or Scheme standard but may
be more scheme-like in nature.
\section sec_repl Using a REPL
\code
# :info
--(LISP HEAP)-----------------------------------------------
Heap size: 16384 Bytes
Used cons cells: 11
Free cons cells: 2037
GC counter: 0
Recovered: 0
Recovered arrays: 0
Marked: 0
--(Symbol and Array memory)---------------------------------
Memory size: 2048 Words
Memory free: 2024 Words
Allocated arrays: 0
Symbol table size: 40 Bytes
\endcode
\code
# :env
Environment:
\endcode
\code
# :ctxs
****** Running contexts ******
****** Blocked contexts ******
****** Done contexts ******
\endcode
\code
# :pause
Evaluator paused
\endcode
\code
# :step
\endcode
\code
# :step 10
\endcode
\code
# :continue
\endcode
\section sec_program A first program
\section sec_c Integration into C code
*/

636
lispBM/lispBM/doc/lbmref.dox
View File

@ -69,11 +69,12 @@ The following example evaluates to 1.
(/ 128 2 2 2 2 2 2 2)
\endcode
---
<a name="mod"> <h3>mod</h3> </a>
Modulo operation. The form of a mod expression is <code>(mode expr1 ... exprN)</code>.
Modulo operation. The form of a mod expression is <code>(mod expr1 ... exprN)</code>.
\note
Compute 5 % 3, evaluates to 2.
@ -168,17 +169,176 @@ Example
<a name="and"> <h3>and</h3> </a>
Boolean <code>and</code> operation between n arguments. The form
of an <code>and</code> expression is <code>(and expr1 ... exprN)</code>.
This operation treats all non-nil values as true. Boolean <code>and</code>
is "shirt-circuiting" and only evaluates until a false is encountered.
\note
The example below evaluates to <code>t</code>
\code
(and t t)
\endcode
The folowing example evaluates to 3
\code
(and t t (+ 1 2))
\endcode
And lastly an example that evaluates to nil (for false).
\code
(and t (< 5 3))
\endcode
---
<a name="or"> <h3>or</h3> </a>
Boolean <code>or</code> operation between n arguments. The form
of an <code>or</code> expression is <code>(or expr1 ... exprN)</code>.
This operation treats all non-nil values as true. Boolean <code>or</code>
is "short-circuiting" and only evaluates until a true is encountered.
\note
The example below evaluates to <code>t</code>.
\code
(or t nil)
\endcode
---
<a name="not"> <h3>not</h3> </a>
Boolean <code>not</code> takes one argument. The form of a <code>not</code>
expression is <code>(not expr)</code>. All non-nil values are considered
true.
\note
The following example evaluates to <code>t</code>
\code
(not nil)
\endcode
---
\section sec_bitwise Bit level operations
<a name="shl"><h3>shl</h3></a>
The shift left operation takes two arguments. The first argument is a value to shift and the
second argument is the number of bit positions to shift the value.
\note
The example below evaluates to 4.
\code
(shl 1 2)
\endcode
---
<a name="shr"><h3>shr</h3></a>
The shift right operation takes two arguments. The first argument is a value to shift and the
second argument in the number of bit positions to shift the value.
\note
The example below evaluates to 1.
\code
(shr 4 2)
\endcode
---
<a name="bitwise-and"><h3>bitwise-and</h3></a>
Performs the bitwise and operation between two values. The type of the result
is the same type as the first of the arguments.
---
<a name="bitwise-or"><h3>bitwise-or</h3></a>
Performs the bitwise or operation between two values. The type of the result
is the same type as the first of the arguments.
---
<a name="bitwise-xor"><h3>bitwise-xor</h3></a>
Performs the bitwise xor operation between two values. The type of the result
is the same type as the first of the arguments.
---
<a name="bitwise-not"><h3>bitwise-not</h3></a>
Performs the bitwise not operations on a value. The result is of same type as
the argument.
\section sec_low_level Low level operations
<a name="encode-i32"> <h3>encode-i32</h3> </a>
The <code>encode-i32</code> function converts a list of four (byte sized) values
into an i32 value.
\note
Example that evaluates to the i32 value 1024.
\code
(encode-i32 (list 0 0 4 0))
\endcode
---
<a name="encode-u32"> <h3>encode-u32</h3> </a>
The <code>encode-u32</code> function converts a list of four (byte sized) values
into an u32 value.
\note
Example that evaluates to the u32 value 1024.
\code
(encode-u32 (list 0 0 4 0))
\endcode
---
<a name="encode-float"> <h3>encode-float</h3> </a>
The <code>encode-float</code> function converts a list four (byte sized) values
into a float value.
\note
Example that evaluates to 3.14.
\code
(encode-float (list 64 72 245 195))
\endcode
---
<a name="decode"> <h3>decode</h3> </a>
The <code>decode</code> function decodes a value into a list of four (byte sized) values.
\note
Example that decodes float 3.14 into the list (64 72 245 195).
\code
(decode 3.14)
\endcode
---
\section sec_nil nil and t
<a name="nil"><h3>nil</h3></a>
@ -203,9 +363,15 @@ explicit true makes sense.
---
\section sec_forms Special forms
\section sec_quote Quotes and Quasiquotation
<a name="quote"> <h3>quote</h3> </a>
Code and data share the same representation, it is only a matter of how
you look at it. The tools for changing how your view are the quotation and
quasiquotation operations.
---
<a name="'"><h3>'</h3></a> <a name="quote"></a>
Usages of the ' quote symbol in input code is replaced with the symbol quote
by the reader. <br>
@ -217,6 +383,151 @@ Evaluating the expression <code>(quote (+ 1 2))</code> results in the value <cod
---
<a name="`"><h3>`</h3></a>
The backwards tick <code>`</code> is called the quasiquote. It is similar to the <code>'</code> but
allows splicing in results of computations using the <a href="#,">,</a> and the <a href="#commaat">,\@</a>
operators.
\note
The result of <code>'(+ 1 2)</code> and <code>`(+ 1 2)</code> are similar in
effect. Both result in the result value of <code>(+ 1 2)</code>, that is a list containing
+, 1 and 2. <br>
When <code>`(+ 1 2)</code> is read into the heap it is expanded into the
expression <code>(append (quote (+)) (append (quote (1)) (append (quote (2)) (quote nil))))</code>
which evaluates to the list <code>(+ 1 2)</code>.
---
<a name=","><h3>,</h3></a>
The comma is used to splice the result of a computation into a quasiquotation.
\note
The expression <code>`(+ 1 ,(+ 1 1))</code> is expanded by the reader into
<code>(append (quote (+)) (append (quote (1)) (append (list (+ 1 1)) (quote nil))))</code>.
Evaluating the expression above results in the list <code>(+ 1 2)</code>.
---
<a name="commaat"><h3>,\@</h3></a>
The comma-at operation is used to splice in the result of a computation (that
returns a list) into a list.
\note
Example:
\code
(define mylist (list 1 2 3 4 5)
`(9 6 5 ,@mylist)
\endcode
Evaluates to the list <code>(9 6 5 1 2 3 4 5)</code>.
\section sec_builtin Built-in operations
<a name="eval"> <h3>eval</h3> </a>
Evaluate data as an expression. The data must represent a valid expression.
\note
Example that evaluates to 3.
\code
(eval (list + 1 2))
\endcode
---
<a name="eval-program"> <h3>eval-program</h3> </a>
Evaluate a list of data where each element represents an expression.
\note
This function is quite awkward as it replaces the program in the running
context with the program provided in the list. Avoid using this
function if possible.
---
<a name="type-of"> <h3>type-of</h3> </a>
The <code>type-of</code> function returns a symbol that indicates what type the
argument is. The form of a <code>type-of</code> expression is <code>(type-of expr)</code>.
\note
Example that evaluates to <code>type-float</code>.
\code
(type-of 3.14)
\endcode
---
<a name="sym-to-str"> <h3>sym-to-str</h3> </a>
The <code>sym-to-str</code> function converts a symbol to its string representation.
The resulting string is a copy of the original so you cannot destroy built in symbols using
this function.
\note
Example that returns the string <code>"lambda"</code>.
\code
(sym-to-str 'lambda)
\endcode
---
<a name="str-to-sym"> <h3>str-to-sym</h3> </a>
The <code>str-to-sym</code> function converts a string to a symbol.
\note
Example that returns the symbol <code>hello</code>.
\code
(str-to-sym "hello")
\endcode
---
<a name="sym-to-u"> <h3>sym-to-u</h3> </a>
The <code>sym-to-u</code> function returns the numerical value used by the runtime system
for a symbol.
\note
Example that evaluates to 4.
\code
(sym-to-u 'lambda)
\endcode
---
<a name="u-to-sym"> <h3>u-to-sym</h3> </a>
The <code>u-to-sym</code> function returns the symbol associated with the
numerical value provided. This symbol may be undefined in which case you
get as result a unnamed symbol.
---
<a name="is-fundamental"> <h3>is-fundamental</h3> </a>
The <code>is-funamental</code> function returns true for built-in functions.
\note
Example that returns true.
\code
(is-fundamental '+)
\endcode
---
\section sec_forms Special forms
<a name="if"> <h3>if</h3> </a>
Conditionals are written as <code>(if cond-expr then-expr else-expr)</code>.
@ -399,38 +710,165 @@ has been extended with the binding <code>(apa 1)</code>.
---
\section sec_lists Lists
\section sec_lists Lists and cons cells
Lists are build using cons cells. A cons cell is represented by the \ref lbm_cons_t struct in the
implementation and consists of two fields named the <code>car</code> and the <code>cdr</code>.
There is no special meaning associated with the <code>car</code> and the <code>cdr</code> each can hold
a \ref lbm_value. See <a href="#cons">cons</a> and <a href="#list">list</a> for two ways to create structures of
cons cells on the heap.
<a name="car"> <h3>car</h3> </a>
Use <code>car</code> to access the <code>car</code> field of a cons cell. A
<code>car</code> expression has the form <code>(car expr)</code>.
\note
Taking the <code>car</code> of a number of symbol type is in general a <a href="#type_error">type_error</a>.
The following program results in <code>type_error</code>.
\code
(car 1)
\endcode
The next example evaluates to 1.
\code
(car (cons 1 2))
\endcode
The <code>car</code> operation accesses the head element of a list. The following program evaluates to 9.
\code
(car (list 9 8 7))
\endcode
---
<a name="cdr"> <h3>cdr</h3> </a>
Use <code>cdr</code> to access the <code>cdr</code> field of a cons cell. A
<code>cdr</code> expression has the form <code>(cdr expr)</code>.
\note
The example below evaluates to 2.
\code
(cdr (cons 1 2))
\endcode
The <code>cdr</code> operation gives you the rest of a list. The example below evaluates to the list (8 7).
\code
(cdr (list 9 8 7))
\endcode
---
<a name="cons"> <h3>cons</h3> </a>
The <code>cons</code> operation allocates a cons cell from the heap and populates the
<code>car</code> and the <code>cdr</code> fields of this cell with its two arguments.
The form of a <code>cons</code> expression is <code>(cons expr1 expr2)</code>.
\note
Build the list <code>(1 2 3)</code> using cons. <a href="#nil">nil</a> terminates a proper list.
\code
(cons 1 (cons 2 (cons 3 nil)))
\endcode
Construct the pair <code>(+ . 1)</code> using cons.
\code
(cons + 1)
\endcode
---
<a name="."> <h3>.</h3> </a>
The dot, <code>.</code>, operation creates a pair. The form of a dot expression
is <code>(expr1 . expr2)</code>. By default the evaluator will attempt to evaluate the
result of <code>(expr1 . expr2)</code> unless it is prefixed with <code>'</code>.
\note
Example that creates the pair (1 . 2)
\code
'(1 . 2)
\endcode
---
<a name="list"> <h3>list</h3> </a>
The <code>list</code> function is used to create proper lists. The function
takes n arguments and is of the form <code>(list expr1 ... exprN)</code>.
\note
Example that creates the list (1 2 3 4).
\code
(list 1 2 3 4)
\endcode
---
<a name="append"> <h3>append</h3> </a>
The <code>append</code> function combines two lists into a longer list.
An <code>append</code> expression is of the form <code>(append expr1 expr2)</code>.
\note
Example that combines to lists.
\code
(append (list 1 2 3) (list 4 5 6))
\endcode
---
<a name="ix"> <h3>ix</h3> </a>
Index into a list using the <code>ix</code>. the form of an <code>ix</code> expression
is <code>(ix index-expr list-expr)</code>. Indexing starts from 0 and if you index out of bounds the result is nil.
\note
Example that evaluates to 2.
\code
(ix 1 (list 1 2 3))
\endcode
---
<a name="set-car"> <h3>set-car</h3> </a>
The <code>set-car</code> is a destructive update of the car field
of a cons-cell.
\note
Define <code>apa</code> to be the pair <code>(1 . 2)</code>
\code
(define apa '(1 . 2))
\endcode
Now change the value in the car field of apa to 42.
\code
(set-car apa 42)
\endcode
The <code>apa</code> pair is now <code>(42 . 2)</code>.
---
<a name="set-cdr"> <h3>set-cdr</h3> </a>
The <code>set-cdr</code> is a destructive update of the cdr field of a cons-cell.
\note
Define <code>apa</code> to be the pair <code>(1 . 2)</code>
\code
(define apa '(1 . 2))
\endcode
Now change the value in the cdr field of apa to 42.
\code
(set-cdr apa 42)
\endcode
The <code>apa</code> pair is now <code>(1 . 42)</code>.
\section sec_arrays Arrays
@ -438,10 +876,37 @@ has been extended with the binding <code>(apa 1)</code>.
<a name="array-read"> <h3>array-read</h3> </a>
Read one or many elements from an array. The form of
an <code>array-read</code> expression is either <code>(array-read array-expr index-expr)</code>
of <code>(array-read array-expr start-index-expr end-index-expr)</code> for reading a range
of values into a list.
\note
Example that evaluates to the character l.
\code
(array-read "hello" 3)
\endcode
The next example reads a range values
\code
(array-read "hello" 1 3)
\endcode
and results in the list <code>(\#e \#l \#l)</code>.
---
<a name="array-write"> <h3>array-write</h3> </a>
The <code>array-write</code> function performs a destructive update
of an array.
\note
Example that turns array "hello" into "heflo"
\code
(array-write "hello" 2 \#f)
\endcode
---
\section sec_pattern Pattern-matching
@ -499,21 +964,47 @@ An example that evaluates to 19.
((blue (? n)) (+ n 3)))
\endcode
---
<a name="?i28"> <h3>?i28</h3> </a>
The ?i28 pattern matches any i28 and binds that value to a variable.
Using the ?i28 pattern is done as <code>(?i28 var)</code> and the part of the expression
that matches is bound to the <code>var</code>.
\note
The following example evaluates to <code>not-an-i28</code>.
\code
(match 3.14
( (i28 n) (+ n 1))
( _ 'not-an-i28))
\endcode
The example below evaluates to 5.
\code
(match 4
( (i28 n) (+ n 1))
( _ 'not-an-i28))
\endcode
---
<a name="?u28"> <h3>?u28</h3> </a>
The ?u28 pattern matches any u28 and binds that value to a variable.
Using the ?u28 pattern is done as <code>(?u28 var)</code> and the part of the expression
that matches is bound to the <code>var</code>.
---
<a name="?float"> <h3>?float</h3> </a>
---
The ?float pattern matches any float and binds that value to a variable.
Using the ?float pattern is done as <code>(?float var)</code> and the part of the expression
that matches is bound to the <code>var</code>.
<a name="?cons"> <h3>?cons</h3> </a>
---
@ -521,97 +1012,136 @@ An example that evaluates to 19.
<a name="spawn"> <h3>spawn</h3> </a>
Use <code>spawn</code> to spawn a concurrent task. The concurrency implemented
by LispBM is called cooperative concurrency and it means that processes must
sleep using <a href="#yield">yield</a> or they will starve out other processes.
The form of a spawn expression is <code>(spawn closure arg1 ... argN)</code>
The return value is a process ID.
---
<a name="wait"> <h3>wait</h3> </a>
Use <code>wait</code> to wait for a spawned process to finish.
The argument to <code>wait</code> should be a process id.
The <code>wait</code> blocks until the process with the given process id finishes.
\note
Be careful to only wait for processes that actually exist and do finish. Otherwise
you will wait forever.
---
<a name="yield"> <h3>yield</h3> </a>
To put a process to sleep, call <code>yield</code>. The argument to <code>yield</code>
is number indicating at least how many microseconds the process should sleep.
---
\section sec_messages Message-passing
<a name="send"> <h3>send</h3> </a>
Messages can be sent to a process by using <code>send</code>. The form
of a <code>send</code> expression is <code>(send pid msg)</code>. The message, msg,
can be any LispBM value.
---
<a name="recv"> <h3>recv</h3> </a>
To receive a message use the <code>recv</code> command. A process
will block on a <code>recv</code> until there is a matching message in
the mailbox. <br>
The <code>recv</code> syntax is very similar to <a href="#match">match</a>.
\note
Example where a process waits for an i28
\code
(recv ( (?i28 n) (+ n 1) ))
\endcode
\section sec_unparse Unparsable symbols
Unparsable symbols cannot be written into a program. The unparsable symbols
signals different kinds of error conditions that may point at something
being wrong in the code (or that it is exhausting all resources).
<a name="no_match"> <h3>no_match</h3> </a>
The <code>no_match</code> symbol is returned from pattern matching if
no case matches the expression.
---
<a name="read_error"> <h3>read_error</h3> </a>
The <code>read_error</code> symbol is returned if the reader cannot
parse the input code.
---
<a name="type_error"> <h3>type_error</h3> </a>
The <code>type_error</code> symbol is returned byt built-in functions
if the values passed in are of incompatible types.
---
<a name="eval_error"> <h3>eval_error</h3> </a>
The <code>eval_error</code> symbol is returned if evaluation could
not proceed to evaluate the expression. This could be because the
expression is malformed.
---
<a name="out_of_memory"> <h3>out_of_memory</h3> </a>
The <code>out_of_memory</code> symbol is returned if the heap is full and running
the garbage collector was not able to free any memory up. The program
uses more memory than the size of the heap. Make the heap larger.
---
<a name="fatal_error"> <h3>fatal_error</h3> </a>
The <code>fatal_error</code> symbol is returned in cases where the
LispBM runtime system cannot proceed. Something is corrupt and it is
not safe to continue.
---
<a name="out_of_stack"> <h3>out_of_stack</h3> </a>
The <code>out_of_stack</code> symbol is returned if the evaluator
runs out of continuation stack (this is its runtime-stack). You are
most likely writing a non-tail-recursive function that is exhausting all
the resources.
--
<a name="division_by_zero"> <h3>division_by_zero</h3> </a>
The <code>division_by_zero</code> symbol is returned when dividing by zero.
---
<a name="variable_not_bound"> <h3>variable_not_bound</h3> </a>
\section sec_builtin Built-in operations
The <code>variable_not_bound</code> symbol is returned when evaluating a
variable (symbol) that is neighter bound nor special (built-in function).
<a name="eval"> <h3>eval</h3> </a>
---
<a name="eval-program"> <h3>eval-program</h3> </a>
---
<a name="type-of"> <h3>type-of</h3> </a>
---
<a name="sym-to-str"> <h3>sym-to-str</h3> </a>
---
<a name="str-to-sym"> <h3>str-to-sym</h3> </a>
---
<a name="sym-to-u"> <h3>sym-to-u</h3> </a>
---
<a name="u-to-sym"> <h3>u-to-sym</h3> </a>
---
<a name="is-fundamental"> <h3>is-fundamental</h3> </a>
---
\section sec_types Types
<a name="type-list"> <h3>type-list</h3> </a>
@ -658,6 +1188,11 @@ An example that evaluates to 19.
---
*/
\section sec_internal Internal symbols
<a name="sym_openpar"> <h3>sym_openpar</h3> </a>
@ -715,29 +1250,6 @@ An example that evaluates to 19.
---
\section sec_low_level Low level operations
<a name="encode-i32"> <h3>encode-i32</h3> </a>
---
<a name="encode-u32"> <h3>encode-u32</h3> </a>
---
<a name="encode-float"> <h3>encode-float</h3> </a>
---
<a name="decode"> <h3>decode</h3> </a>
---
*/
<a name="array-create"> <h3>array-create</h3> </a>

16
lispBM/lispBM/doc/mainpage.dox
View File

@ -7,8 +7,13 @@
https://github.com/svenssonjoel/lispBM
<h2> LispBM Language </h2>
\ref lbmdoc <br>
\ref lbmref <br>
<h2> Implementation documentation </h2>
C Interoperation: \ref lbm_c_interop.h <br>
Environment: \ref env.h <br>
Evaluator: \ref eval_cps.h <br>
Extensions: \ref extensions.h <br>
@ -19,17 +24,12 @@ LispBM: \ref lispbm.h <br>
Printing values: \ref print.h <br>
Stacks: \ref stack.h <br>
Streams: \ref streams.h <br>
Symbol and array memory: \ref lispbm_memory.h <br>
Symbol and array memory: \ref lbm_memory.h <br>
Symbol table: \ref symrepr.h <br>
Types: \ref lispbm_types.h <br>
Types: \ref lbm_types.h <br>
Version: \ref lbm_version.h <br>
Quasiquotation: \ref qq_expand.h <br>
<h2> LispBM Language </h2>
\ref lbmdoc <br>
\ref lbmref <br>
<h2> LispBM integration</h2>
\image html lispbm_llama_small.png

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

@ -139,7 +139,6 @@ extern void lbm_kill_eval(void);
* \return Current state of the evaluator.
*/
extern uint32_t lbm_get_eval_state(void);
/** Create a context and enqueue it as runnable.
*
* \param program The program to evaluate in the context.
@ -148,8 +147,6 @@ extern uint32_t lbm_get_eval_state(void);
* \return
*/
extern lbm_cid lbm_create_ctx(lbm_value program, lbm_value env, uint32_t stack_size);
/* statistics interface */
/** Iterate over all ready contexts and apply function on each context.
*
* \param f Function to apply to each context.
@ -171,12 +168,6 @@ extern void lbm_blocked_iterator(ctx_fun f, void*, void*);
* \param arg2 Same as above
*/
extern void lbm_done_iterator(ctx_fun f, void*, void*);
/*
Callback routines for sleeping and timestamp generation.
Depending on target platform these will be implemented in different ways.
Todo: It may become necessary to also add a mutex callback.
*/
/** Set a usleep callback for use by the evaluator thread.
*
* \param fptr Pointer to a sleep function.

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

@ -24,6 +24,7 @@
#include "lbm_types.h"
#include "symrepr.h"
#include "streams.h"
#include "stack.h"
/*
Planning for a more space efficient heap representation.
@ -210,6 +211,7 @@ Aux bits could be used for storing vector size. Up to 30bits should be available
#define LBM_VAL_TYPE_SYMBOL 0x00000000u // 00 0 0
/// Character or byte.
#define LBM_VAL_TYPE_CHAR 0x00000004u // 01 0 0
#define LBM_VAL_TYPE_BYTE 0x00000004u
#define LBM_VAL_TYPE_U 0x00000008u // 10 0 0
#define LBM_VAL_TYPE_I 0x0000000Cu // 11 0 0
@ -222,23 +224,24 @@ typedef struct {
} lbm_cons_t;
/**
* Heap statistics struct.
* Heap state
*/
typedef struct {
lbm_cons_t *heap;
lbm_value freelist; // list of free cons cells.
lbm_stack_t gc_stack;
unsigned int heap_size; // In number of cells.
unsigned int heap_bytes; // In bytes.
uint32_t heap_size; // In number of cells.
uint32_t heap_bytes; // In bytes.
unsigned int num_alloc; // Number of cells allocated.
unsigned int num_alloc_arrays; // Number of arrays allocated.
uint32_t num_alloc; // Number of cells allocated.
uint32_t num_alloc_arrays; // Number of arrays allocated.
unsigned int gc_num; // Number of times gc has been performed.
unsigned int gc_marked; // Number of cells marked by mark phase.
unsigned int gc_recovered; // Number of cells recovered by sweep phase.
unsigned int gc_recovered_arrays;// Number of arrays recovered by sweep.
unsigned int gc_least_free; // The smallest length of the freelist.
uint32_t gc_num; // Number of times gc has been performed.
uint32_t gc_marked; // Number of cells marked by mark phase.
uint32_t gc_recovered; // Number of cells recovered by sweep phase.
uint32_t gc_recovered_arrays;// Number of arrays recovered by sweep.
uint32_t gc_least_free; // The smallest length of the freelist.
uint64_t gc_time_acc;
uint32_t gc_min_duration;
@ -255,12 +258,14 @@ typedef struct {
} lbm_array_header_t;
/** Initialize heap storage.
*
* \param addr Pointer to an array of lbm_cons_t elements. This array must at least be aligned 4.
* \param num_cells Number of lbm_cons_t elements in the array.
* \param gc_stack_storage uint32_t pointer to space to use as "recursion" stack for GC
* \param gc_stack_size Size of the gc_stack in number of words.
* \return 1 on success or 0 for failure.
*/
extern int lbm_heap_init(lbm_cons_t *addr, unsigned int num_cells);
extern int lbm_heap_init(lbm_cons_t *addr, uint32_t num_cells,
uint32_t *gc_stack_storage, uint32_t gc_stack_size);
/** Add GC time statistics to heap_stats
*
@ -428,6 +433,8 @@ extern int lbm_gc_mark_freelist(void);
* \return 1 on success and 0 if the stack used internally is full.
*/
extern int lbm_gc_mark_phase(lbm_value v);
extern int lbm_gc_mark_phase2(lbm_value env);
/** Performs lbm_gc_mark_phase on all the values of an array.
*
* \param data Array of roots to traverse from.

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

@ -87,6 +87,17 @@ extern int lbm_send_message(lbm_cid cid, lbm_value msg);
* \return 1 on success and 0 on failure.
*/
extern int lbm_define(char *symbol, lbm_value value);
/** Create a LispBM array from a C array. The array should be created while the evaluator
* is paused and the array should be bound to something before un-pausing. Send the array in
* a message with \ref lbm_send_message or define it in the global with \ref lbm_define.
* The data is stored in the array as C values (not encoded as lbm values).
*
* \param value Result array value.
* \param data Pointer to the C array
* \param type What type are the elements of the array.
* \param num_elt Number of elements in the array.
*/
extern int lbm_create_array(lbm_value *value, char *data, lbm_type type, uint32_t num_elt);

45
lispBM/lispBM/include/lbm_version.h Normal file
View File

@ -0,0 +1,45 @@
/*
Copyright 2022 Joel Svensson svenssonjoel@yahoo.se
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
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>.
*/
/** @file lbm_version.h */
#ifndef LBM_VERSION_H_
#define LBM_VERSION_H_
/* Approach to versions.
* Major version changes when there are interface breaking changes.
* Minor Backwards compatible additions.
* Patch Backwards compatible bug fixes or tweaks.
*/
/** LBM major version */
#define LBM_MAJOR_VERSION 0
/** LBM minor version */
#define LBM_MINOR_VERSION 1
/** LBM patch revision */
#define LBM_PATCH_VERSION 0
/* Change log */
/* Feb 11 2022: First state to be given a numbered version (0.1.0) */
#endif

7
lispBM/lispBM/include/lispbm.h
View File

@ -34,6 +34,7 @@
#include "lbm_c_interop.h"
/** Initialize lispBM. This function initials all subsystems by calling:
* - \ref lbm_print_init
* - \ref lbm_memory_init
* - \ref lbm_symrepr_init
* - \ref lbm_heap_init
@ -47,10 +48,14 @@
* \param memory_size Size of the memory array.
* \param memory_bitmap Pointer to uint32_t array to use for the memory subsystem meta-data.
* \param bitmap_size Size of the memory meta-data array.
* \param print_stack_storage Pointer to uint32_t array to use as print_value stack.
* \param print_stack_size Size in number of uint32_t values of the print stack.
* \return 1 on success and 0 on failure.
*/
extern int lbm_init(lbm_cons_t *heap_storage, uint32_t heap_size,
uint32_t *gc_stack_storage, uint32_t gc_stack_size,
uint32_t *memory, uint32_t memory_size,
uint32_t *memory_bitmap, uint32_t bitmap_size);
uint32_t *memory_bitmap, uint32_t bitmap_size,
uint32_t *print_stack_storage, uint32_t print_stack_size);
#endif

8
lispBM/lispBM/include/print.h
View File

@ -24,6 +24,14 @@
#include "lbm_types.h"
/** Initialize the print_value subsystem.
* print value depends on a stack and that stack is initialized here using a storage array provided by the user.
* \param print_stack_storage Array to use as storage for stack data.
* \param print_stack_size The number of uint32_t elements in the array.
* \return 1 for success and 0 for failure.
*/
extern int lbm_print_init(uint32_t *print_stack_storage, uint32_t print_stack_size);
/** Print an lbm_value into a buffer provided by the user.
* If printing fails, the buffer may contain an error message.
*

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

@ -96,6 +96,7 @@
#define SYM_COMMAAT 0x74
#define SYM_TOKENIZER_DONE 0x75
#define SYM_DOT 0x76
#define SYM_QUOTE_IT 0x77
// Fundamental Operations
#define FUNDAMENTALS_START 0x100
@ -150,6 +151,15 @@
//#define SYM_STREAM_DROP 0x163
//#define SYM_STREAM_PUT 0x164
#define SYM_SHL 0x170
#define SYM_SHR 0x171
#define SYM_BITWISE_AND 0x172
#define SYM_BITWISE_OR 0x173
#define SYM_BITWISE_XOR 0x174
#define SYM_BITWISE_NOT 0x175
#define SYM_TYPE_OF 0x200
#define FUNDAMENTALS_END 0x200

43
lispBM/lispBM/repl-cps/repl.c
View File

@ -28,6 +28,11 @@
#include "lispbm.h"
#define EVAL_CPS_STACK_SIZE 256
#define GC_STACK_SIZE 256
#define PRINT_STACK_SIZE 256
uint32_t gc_stack_storage[GC_STACK_SIZE];
uint32_t print_stack_storage[PRINT_STACK_SIZE];
static volatile bool allow_print = true;
@ -138,6 +143,9 @@ void done_callback(eval_context_t *ctx) {
//}
fflush(stdout);
// remove the state associated with the context.
lbm_wait_ctx(cid);
}
uint32_t timestamp_callback() {
@ -300,6 +308,10 @@ void ctx_exists(eval_context_t *ctx, void *arg1, void *arg2) {
static uint32_t memory[LBM_MEMORY_SIZE_8K];
static uint32_t bitmap[LBM_MEMORY_BITMAP_SIZE_8K];
char char_array[1024];
uint32_t word_array[1024];
int main(int argc, char **argv) {
char str[1024];
unsigned int len = 1024;
@ -311,6 +323,11 @@ int main(int argc, char **argv) {
unsigned int heap_size = 2048;
lbm_cons_t *heap_storage = NULL;
for (int i = 0; i < 1024; i ++) {
char_array[i] = (char)i;
word_array[i] = (uint32_t)i;
}
//setup_terminal();
heap_storage = (lbm_cons_t*)malloc(sizeof(lbm_cons_t) * heap_size);
@ -319,8 +336,10 @@ int main(int argc, char **argv) {
}
lbm_init(heap_storage, heap_size,
gc_stack_storage, GC_STACK_SIZE,
memory, LBM_MEMORY_SIZE_8K,
bitmap, LBM_MEMORY_BITMAP_SIZE_8K);
bitmap, LBM_MEMORY_BITMAP_SIZE_8K,
print_stack_storage, PRINT_STACK_SIZE);
lbm_set_ctx_done_callback(done_callback);
lbm_set_timestamp_us_callback(timestamp_callback);
@ -439,8 +458,10 @@ int main(int argc, char **argv) {
}
lbm_init(heap_storage, heap_size,
gc_stack_storage, GC_STACK_SIZE,
memory, LBM_MEMORY_SIZE_8K,
bitmap, LBM_MEMORY_BITMAP_SIZE_8K);
bitmap, LBM_MEMORY_BITMAP_SIZE_8K,
print_stack_storage, PRINT_STACK_SIZE);
lbm_add_extension("print", ext_print);
} else if (strncmp(str, ":prelude", 8) == 0) {
@ -454,7 +475,7 @@ int main(int argc, char **argv) {
&string_tok);
lbm_load_and_define_program(&string_tok, "prelude");
lbm_load_and_eval_program(&string_tok);
lbm_continue_eval();
/* Something better is needed.
@ -495,6 +516,22 @@ int main(int argc, char **argv) {
int num = atoi(str + 5);
lbm_step_n_eval((uint32_t)num);
} else if (strncmp(str, ":array", 6) == 0) {
lbm_pause_eval_with_gc(30);
while(lbm_get_eval_state() != EVAL_CPS_STATE_PAUSED) {
sleep_callback(10);
}
printf("Evaluator paused\n");
lbm_value arr_val;
lbm_create_array(&arr_val, char_array, LBM_VAL_TYPE_CHAR,1024);
lbm_define("c-arr", arr_val);
lbm_create_array(&arr_val, (char *)word_array, LBM_PTR_TYPE_BOXED_I,1024);
lbm_define("i-arr", arr_val);
lbm_continue_eval();
} else {
/* Get exclusive access to the heap */
lbm_pause_eval();

33
lispBM/lispBM/repl-cps/test_mp.lisp
View File

@ -5,16 +5,41 @@
( (bepa (?i28 x)) (print "fred received bepa " x \#newline)))
(fred))))
(define bella (lambda (pid x)
(progn (print "bella iteration" x \#newline)
(let ((apa 1000))
(define bella (lambda (pid x)
(progn (print "bella " apa " iteration" x \#newline)
(send pid `(apa ,x 107))
(yield 500000)
(print "bella waking up" \#newline)
(send pid '(bepa 2))
(yield 500000)
(bella pid (+ x 1)))))
)
(define fredpid (spawn '(fred)))
(let ((silly-greeter
(lambda ()
(progn (print "GREETINGS!" \#newline)
(yield 2500000)
(silly-greeter)))))
(spawn silly-greeter))
(spawn '(bella (car fredpid) 0))
(spawn (let ((mogwai
(lambda ()
(progn (print "GIZMO!" \#newline)
(yield 2500000)
(mogwai)))))
mogwai))
(spawn (let ((space
(lambda ()
(progn (print \#newline \#newline)
(yield 2500000)
(space)))))
space))
(define fredpid (spawn fred))
(spawn bella fredpid 0)

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

@ -45,7 +45,6 @@
#define AND 8
#define OR 9
#define WAIT 10
#define SPAWN_ALL 11
#define MATCH 12
#define MATCH_MANY 13
#define READ 14
@ -79,7 +78,7 @@ static lbm_value NONSENSE;
static void error_ctx(lbm_value);
static eval_context_t *ctx_running = NULL;
static lbm_value cons_with_gc(lbm_value head, lbm_value tail, lbm_value remember) {
static inline lbm_value cons_with_gc(lbm_value head, lbm_value tail, lbm_value remember) {
lbm_value res = lbm_cons(head, tail);
if (lbm_is_symbol_merror(res)) {
gc(remember, NIL);
@ -98,9 +97,6 @@ static lbm_value cons_with_gc(lbm_value head, lbm_value tail, lbm_value remember
return; \
}
#define ERROR
//#define ERROR printf("Line: %d\n", __LINE__);
#define DEFAULT_SLEEP_US 1000
#define EVAL_CPS_DEFAULT_STACK_SIZE 256
@ -883,7 +879,6 @@ static inline void eval_define(eval_context_t *ctx) {
if (lbm_type_of(key) != LBM_VAL_TYPE_SYMBOL ||
key == NIL) {
ERROR
error_ctx(lbm_enc_sym(SYM_EERROR));
return;
}
@ -904,7 +899,6 @@ static inline void eval_progn(eval_context_t *ctx) {
}
if (lbm_is_error(exps)) {
ERROR
error_ctx(exps);
return;
}
@ -913,23 +907,6 @@ static inline void eval_progn(eval_context_t *ctx) {
ctx->curr_env = env;
}
static inline void eval_spawn(eval_context_t *ctx) {
lbm_value prgs = lbm_cdr(ctx->curr_exp);
lbm_value env = ctx->curr_env;
if (lbm_type_of(prgs) == LBM_VAL_TYPE_SYMBOL && prgs == NIL) {
ctx->r = NIL;
ctx->app_cont = true;
return;
}
lbm_value cid_list = NIL;
CHECK_STACK(lbm_push_u32_3(&ctx->K, env, prgs, lbm_enc_u(SPAWN_ALL)));
ctx->r = cid_list;
ctx->app_cont = true;
}
static inline void eval_lambda(eval_context_t *ctx) {
lbm_value env_cpy = lbm_env_copy_shallow(ctx->curr_env);
@ -1132,7 +1109,6 @@ static inline void cont_progn_rest(eval_context_t *ctx) {
}
if (lbm_is_error(rest)) {
ERROR
error_ctx(rest);
return;
}
@ -1148,30 +1124,6 @@ static inline void cont_progn_rest(eval_context_t *ctx) {
ctx->curr_env = env;
}
static inline void cont_spawn_all(eval_context_t *ctx) {
lbm_value rest;
lbm_value env;
lbm_pop_u32_2(&ctx->K, &rest, &env);
if (lbm_type_of(rest) == LBM_VAL_TYPE_SYMBOL && rest == NIL) {
ctx->app_cont = true;
return;
}
lbm_value cid_val = lbm_enc_u((lbm_uint)next_ctx_id); /* CIDS range from 0 - 65535, so this is fine */
lbm_value cid_list;
WITH_GC(cid_list, lbm_cons(cid_val, ctx->r), rest, env);
lbm_cid cid = lbm_create_ctx(lbm_car(rest),
env,
EVAL_CPS_DEFAULT_STACK_SIZE);
if (!cid) {
lbm_set_car(cid_list, lbm_enc_sym(SYM_NIL));
}
CHECK_STACK(lbm_push_u32_3(&ctx->K, env, lbm_cdr(rest), lbm_enc_u(SPAWN_ALL)));
ctx->r = cid_list;
ctx->app_cont = true;
}
static inline void cont_wait(eval_context_t *ctx) {
lbm_value cid_val;
@ -1205,54 +1157,42 @@ static inline void cont_application(eval_context_t *ctx) {
lbm_value fun = fun_args[0];
if (lbm_type_of(fun) == LBM_PTR_TYPE_CONS) { // a closure (it better be)
lbm_value args = NIL;
for (lbm_uint i = lbm_dec_u(count); i > 0; i --) {
CONS_WITH_GC(args, fun_args[i], args, args);
lbm_value cdr_fun = lbm_cdr(fun);
lbm_value cddr_fun = lbm_cdr(cdr_fun);
lbm_value cdddr_fun = lbm_cdr(cddr_fun);
lbm_value params = lbm_car(cdr_fun);
lbm_value exp = lbm_car(cddr_fun);
lbm_value clo_env = lbm_car(cdddr_fun);
lbm_value curr_param = params;
lbm_uint i = 1;
while (lbm_type_of(curr_param) == LBM_PTR_TYPE_CONS &&
i <= lbm_dec_u(count)) {
lbm_value entry;
WITH_GC(entry,lbm_cons(lbm_car(curr_param),fun_args[i]), clo_env,NIL);
lbm_value aug_env;
WITH_GC(aug_env,lbm_cons(entry, clo_env),clo_env,entry);
clo_env = aug_env;
curr_param = lbm_cdr(curr_param);
i ++;
}
lbm_value params = lbm_car(lbm_cdr(fun));
lbm_value exp = lbm_car(lbm_cdr(lbm_cdr(fun)));
lbm_value clo_env = lbm_car(lbm_cdr(lbm_cdr(lbm_cdr(fun))));
if (lbm_list_length(params) != lbm_list_length(args)) { // programmer error
ERROR
error_ctx(lbm_enc_sym(SYM_EERROR));
return;
}
lbm_value local_env;
WITH_GC(local_env, lbm_env_build_params_args(params, args, clo_env), args, NIL);
if (lbm_dec_sym(local_env) == SYM_FATAL_ERROR) {
ctx->r = local_env;
return;
}
/* ************************************************************
Odd area! It feels like the callers environment should be
explicitly restored after an application of a closure.
However, if the callers environment is pushed onto the stack
here, it will make the stack grow proportional to the call
depth.
I am very unsure about the correctness here.
Jan 2022:
This is ok. Only if this function is part of a progn
is there a need to restore the environment after the call.
progn is responsible for this saving and restoring.
************************************************************ */
lbm_stack_drop(&ctx->K, lbm_dec_u(count)+1);
ctx->curr_exp = exp;
ctx->curr_env = local_env;
ctx->curr_env = clo_env; // local_env;
return;
} else if (lbm_type_of(fun) == LBM_VAL_TYPE_SYMBOL) {
lbm_value res;
/* eval_cps specific operations */
lbm_uint dfun = lbm_dec_sym(fun);
if (dfun == SYM_READ || dfun == SYM_READ_PROGRAM) {
switch(dfun) {
case SYM_READ: /* fall through */
case SYM_READ_PROGRAM:
if (lbm_dec_u(count) == 1) {
lbm_value stream = NIL;
if (lbm_type_of(fun_args[1]) == LBM_PTR_TYPE_ARRAY) {
@ -1264,18 +1204,55 @@ static inline void cont_application(eval_context_t *ctx) {
stream = fun_args[1];
} else {
error_ctx(lbm_enc_sym(SYM_EERROR));
return;
break;
}
lbm_stack_drop(&ctx->K, lbm_dec_u(count)+1);
CHECK_STACK(lbm_push_u32_3(&ctx->K, stream, fun, lbm_enc_u(READ)));
ctx->r = NIL;
ctx->app_cont = true;
} else {
break;
case SYM_SPAWN: {
if (!lbm_is_closure(fun_args[1]) ||
lbm_dec_u(count) < 1) {
error_ctx(lbm_enc_sym(SYM_EERROR));
}
return;
} else if (dfun == SYM_YIELD) {
lbm_value cdr_fun = lbm_cdr(fun_args[1]);
lbm_value cddr_fun = lbm_cdr(cdr_fun);
lbm_value cdddr_fun = lbm_cdr(cddr_fun);
lbm_value params = lbm_car(cdr_fun);
lbm_value exp = lbm_car(cddr_fun);
lbm_value clo_env = lbm_car(cdddr_fun);
lbm_value curr_param = params;
lbm_uint i = 2;
while (lbm_type_of(curr_param) == LBM_PTR_TYPE_CONS &&
i <= lbm_dec_u(count)) {
lbm_value entry;
WITH_GC(entry,lbm_cons(lbm_car(curr_param),fun_args[i]), clo_env,NIL);
lbm_value aug_env;
WITH_GC(aug_env,lbm_cons(entry, clo_env),clo_env,entry);
clo_env = aug_env;
curr_param = lbm_cdr(curr_param);
i ++;
}
lbm_stack_drop(&ctx->K, lbm_dec_u(count)+1);
lbm_value program = NIL;
CONS_WITH_GC(program, exp, program, clo_env);
lbm_cid cid = lbm_create_ctx(program,
clo_env,
EVAL_CPS_DEFAULT_STACK_SIZE);
ctx->r = lbm_enc_i(cid);
ctx->app_cont = true;
} break;
case SYM_YIELD:
if (lbm_dec_u(count) == 1 && lbm_is_number(fun_args[1])) {
lbm_uint ts = lbm_dec_as_u(fun_args[1]);
lbm_stack_drop(&ctx->K, lbm_dec_u(count)+1);
@ -1283,8 +1260,8 @@ static inline void cont_application(eval_context_t *ctx) {
} else {
error_ctx(lbm_enc_sym(SYM_EERROR));
}
return;
} else if (dfun == SYM_WAIT) {
break;
case SYM_WAIT:
if (lbm_type_of(fun_args[1]) == LBM_VAL_TYPE_I) {
lbm_cid cid = (lbm_cid)lbm_dec_u(fun_args[1]);
lbm_stack_drop(&ctx->K, lbm_dec_u(count)+1);
@ -1293,32 +1270,29 @@ static inline void cont_application(eval_context_t *ctx) {
ctx->app_cont = true;
yield_ctx(50000);
} else {
ERROR
error_ctx(lbm_enc_sym(SYM_EERROR));
}
return;
} else if (dfun == SYM_EVAL) {
break;
case SYM_EVAL:
ctx->curr_exp = fun_args[1];
lbm_stack_drop(&ctx->K, lbm_dec_u(count)+1);
return;
} else if (dfun == SYM_EVAL_PROGRAM) {
break;
case SYM_EVAL_PROGRAM: {
lbm_value prg = fun_args[1];
prg = lbm_list_append(prg, ctx->program);
lbm_stack_drop(&ctx->K, lbm_dec_u(count)+1);
if (lbm_type_of(prg) != LBM_PTR_TYPE_CONS) {
ctx->r = lbm_enc_sym(SYM_EERROR);
ctx->app_cont = true;
return;
error_ctx(lbm_enc_sym(SYM_EERROR));
break;
}
ctx->program = lbm_cdr(prg);
ctx->curr_exp = lbm_car(prg);
return;
} else if (dfun == SYM_SEND) {
} break;
case SYM_SEND: {
lbm_value status = lbm_enc_sym(SYM_EERROR);
if (lbm_dec_u(count) == 2) {
if (lbm_type_of(fun_args[1]) == LBM_VAL_TYPE_U) { /* CID is of U type */
@ -1332,29 +1306,27 @@ static inline void cont_application(eval_context_t *ctx) {
lbm_stack_drop(&ctx->K, lbm_dec_u(count)+1);
ctx->r = status;
ctx->app_cont = true;
return;
}
else if (lbm_is_fundamental(fun)) {
} break;
default:
if (lbm_is_fundamental(fun)) {
/* If it is not a eval_cps specific function, it may be a fundamental operation */
lbm_value res;
WITH_GC(res, lbm_fundamental(&fun_args[1], lbm_dec_u(count), fun), NIL, NIL);
if (lbm_type_of(res) == LBM_VAL_TYPE_SYMBOL &&
lbm_dec_sym(res) == SYM_EERROR) {
ERROR
lbm_is_error(res)) {
error_ctx(res);
} else {
lbm_stack_drop(&ctx->K, lbm_dec_u(count)+1);
ctx->app_cont = true;
ctx->r = res;
}
return;
}
}
break;
} else {
// It may be an extension
extension_fptr f = lbm_get_extension(lbm_dec_sym(fun));
if (f == NULL) {
ERROR
error_ctx(lbm_enc_sym(SYM_EERROR));
return;
break;
}
lbm_value ext_res;
@ -1364,7 +1336,11 @@ static inline void cont_application(eval_context_t *ctx) {
ctx->app_cont = true;
ctx->r = ext_res;
return;
break;
}
}
}
}
}
static inline void cont_application_args(eval_context_t *ctx) {
@ -1784,7 +1760,7 @@ static inline void cont_read(eval_context_t *ctx) {
lbm_enc_u(APPEND_CONTINUE)));
app_cont = false;
break;
case SYM_QUOTE:
case SYM_QUOTE_IT:
CHECK_STACK(lbm_push_u32(&ctx->K,
lbm_enc_u(QUOTE_RESULT)));
app_cont = false;
@ -1841,7 +1817,6 @@ static void evaluation_step(void){
case DONE: advance_ctx(); return;
case SET_GLOBAL_ENV: cont_set_global_env(ctx); return;
case PROGN_REST: cont_progn_rest(ctx); return;
case SPAWN_ALL: cont_spawn_all(ctx); return;
case WAIT: cont_wait(ctx); return;
case APPLICATION: cont_application(ctx); return;
case APPLICATION_ARGS: cont_application_args(ctx); return;
@ -1853,7 +1828,6 @@ static void evaluation_step(void){
case MATCH_MANY: cont_match_many(ctx); return;
case READ: cont_read(ctx); return;
default:
ERROR
error_ctx(lbm_enc_sym(SYM_EERROR));
return;
}
@ -1885,7 +1859,6 @@ static void evaluation_step(void){
case SYM_QUOTE: eval_quote(ctx); return;
case SYM_DEFINE: eval_define(ctx); return;
case SYM_PROGN: eval_progn(ctx); return;
case SYM_SPAWN: eval_spawn(ctx); return;
case SYM_LAMBDA: eval_lambda(ctx); return;
case SYM_IF: eval_if(ctx); return;
case SYM_LET: eval_let(ctx); return;
@ -1908,7 +1881,6 @@ static void evaluation_step(void){
return;
default:
// BUG No applicable case!
ERROR
error_ctx(lbm_enc_sym(SYM_EERROR));
break;
}
@ -1989,9 +1961,6 @@ void lbm_run_eval(void){
break;
}
//if (heap_size() - heap_num_allocated() < PRELIMINARY_GC_MEASURE) {
// gc(NIL, NIL);
//}
/* TODO: Logic for sleeping in case the evaluator has been using a lot of CPU
should go here */
@ -2055,12 +2024,7 @@ int lbm_eval_init() {
NIL = lbm_enc_sym(SYM_NIL);
NONSENSE = lbm_enc_sym(SYM_NONSENSE);
lbm_value nil_entry = lbm_cons(NIL, NIL);
*lbm_get_env_ptr() = lbm_cons(nil_entry, *lbm_get_env_ptr());
if (lbm_type_of(nil_entry) == LBM_VAL_TYPE_SYMBOL ||
lbm_type_of(*lbm_get_env_ptr()) == LBM_VAL_TYPE_SYMBOL) res = 0;
*lbm_get_env_ptr() = NIL;
eval_running = true;
return res;

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

@ -25,6 +25,109 @@
#include <stdio.h>
#include <math.h>
static lbm_uint shl(lbm_uint a, lbm_uint b) {
lbm_uint retval = lbm_enc_sym(SYM_TERROR);
if (!(lbm_is_number(a) && lbm_is_number(b))) {
return retval;
}
switch (lbm_type_of(a)) {
case LBM_VAL_TYPE_I: retval = lbm_enc_i(lbm_dec_i(a) << lbm_dec_as_u(b)); break;
case LBM_VAL_TYPE_U: retval = lbm_enc_u(lbm_dec_u(a) << lbm_dec_as_u(b)); break;
case LBM_PTR_TYPE_BOXED_U: retval = lbm_enc_U(lbm_dec_U(a) << lbm_dec_as_u(b)); break;
case LBM_PTR_TYPE_BOXED_I: retval = lbm_enc_I(lbm_dec_I(a) << lbm_dec_as_u(b)); break;
}
return retval;
}
static lbm_uint shr(lbm_uint a, lbm_uint b) {
lbm_uint retval = lbm_enc_sym(SYM_TERROR);
if (!(lbm_is_number(a) && lbm_is_number(b))) {
return retval;
}
switch (lbm_type_of(a)) {
case LBM_VAL_TYPE_I: retval = lbm_enc_i(lbm_dec_i(a) >> lbm_dec_as_u(b)); break;
case LBM_VAL_TYPE_U: retval = lbm_enc_u(lbm_dec_u(a) >> lbm_dec_as_u(b)); break;
case LBM_PTR_TYPE_BOXED_U: retval = lbm_enc_U(lbm_dec_U(a) >> lbm_dec_as_u(b)); break;
case LBM_PTR_TYPE_BOXED_I: retval = lbm_enc_I(lbm_dec_I(a) >> lbm_dec_as_u(b)); break;
}
return retval;
}
static lbm_uint bitwise_and(lbm_uint a, lbm_uint b) {
lbm_uint retval = lbm_enc_sym(SYM_TERROR);
if (!(lbm_is_number(a) && lbm_is_number(b))) {
return retval;
}
switch (lbm_type_of(a)) {
case LBM_VAL_TYPE_I: retval = lbm_enc_i(lbm_dec_i(a) & lbm_dec_as_i(b)); break;
case LBM_VAL_TYPE_U: retval = lbm_enc_u(lbm_dec_u(a) & lbm_dec_as_u(b)); break;
case LBM_PTR_TYPE_BOXED_U: retval = lbm_enc_U(lbm_dec_U(a) & lbm_dec_as_u(b)); break;
case LBM_PTR_TYPE_BOXED_I: retval = lbm_enc_I(lbm_dec_I(a) & lbm_dec_as_i(b)); break;
}
return retval;
}
static lbm_uint bitwise_or(lbm_uint a, lbm_uint b) {
lbm_uint retval = lbm_enc_sym(SYM_TERROR);
if (!(lbm_is_number(a) && lbm_is_number(b))) {
return retval;
}
switch (lbm_type_of(a)) {
case LBM_VAL_TYPE_I: retval = lbm_enc_i(lbm_dec_i(a) | lbm_dec_as_i(b)); break;
case LBM_VAL_TYPE_U: retval = lbm_enc_u(lbm_dec_u(a) | lbm_dec_as_u(b)); break;
case LBM_PTR_TYPE_BOXED_U: retval = lbm_enc_U(lbm_dec_U(a) | lbm_dec_as_u(b)); break;
case LBM_PTR_TYPE_BOXED_I: retval = lbm_enc_I(lbm_dec_I(a) | lbm_dec_as_i(b)); break;
}
return retval;
}
static lbm_uint bitwise_xor(lbm_uint a, lbm_uint b) {
lbm_uint retval = lbm_enc_sym(SYM_TERROR);
if (!(lbm_is_number(a) && lbm_is_number(b))) {
return retval;
}
switch (lbm_type_of(a)) {
case LBM_VAL_TYPE_I: retval = lbm_enc_i(lbm_dec_i(a) ^ lbm_dec_as_i(b)); break;
case LBM_VAL_TYPE_U: retval = lbm_enc_u(lbm_dec_u(a) ^ lbm_dec_as_u(b)); break;
case LBM_PTR_TYPE_BOXED_U: retval = lbm_enc_U(lbm_dec_U(a) ^ lbm_dec_as_u(b)); break;
case LBM_PTR_TYPE_BOXED_I: retval = lbm_enc_I(lbm_dec_I(a) ^ lbm_dec_as_i(b)); break;
}
return retval;
}
static lbm_uint bitwise_not(lbm_uint a) {
lbm_uint retval = lbm_enc_sym(SYM_TERROR);
if (!(lbm_is_number(a))) {
return retval;
}
switch (lbm_type_of(a)) {
case LBM_VAL_TYPE_I: retval = lbm_enc_i(~lbm_dec_i(a)); break;
case LBM_VAL_TYPE_U: retval = lbm_enc_u(~lbm_dec_u(a)); break;
case LBM_PTR_TYPE_BOXED_U: retval = lbm_enc_U(~lbm_dec_U(a)); break;
case LBM_PTR_TYPE_BOXED_I: retval = lbm_enc_I(~lbm_dec_I(a)); break;
}
return retval;
}
static lbm_uint add2(lbm_uint a, lbm_uint b) {
lbm_uint retval = lbm_enc_sym(SYM_TERROR);
@ -305,11 +408,8 @@ void array_read(lbm_value *args, lbm_uint nargs, lbm_uint *result) {
lbm_array_header_t *array = (lbm_array_header_t*)lbm_car(arr);
uint32_t* data = array->data;
// printf("ix: %d, ix_end: %d\n", ix, ix_end);
for (lbm_int i = (lbm_int)ix_end; i >= (lbm_int)ix; i--) {
// printf("%d\n", i);
if ((lbm_uint)i >= array->size){
// printf("hmm %d %d\n", i, array->size);
*result = lbm_enc_sym(SYM_NIL);
return;
}
@ -576,9 +676,8 @@ lbm_value lbm_fundamental(lbm_value* args, lbm_uint nargs, lbm_value op) {
if (lbm_heap_allocate_array(&v, len+1, LBM_VAL_TYPE_CHAR)) {
lbm_array_header_t *arr = (lbm_array_header_t*)lbm_car(v);
if (!arr) return lbm_enc_sym(SYM_MERROR);
char *data = (char *)arr+8;
memset(data,0,len+1);
memcpy(data,sym_str,len);
memset(arr->data,0,len+1);
memcpy(arr->data,sym_str,len);
} else {
return lbm_enc_sym(SYM_MERROR);
}
@ -593,7 +692,7 @@ lbm_value lbm_fundamental(lbm_value* args, lbm_uint nargs, lbm_value op) {
lbm_array_header_t *arr = (lbm_array_header_t *)lbm_car(args[0]);
if (arr->elt_type != LBM_VAL_TYPE_CHAR)
break;
char *str = (char *)arr+8;
char *str = (char *)arr->data;
lbm_uint sym;
if (lbm_get_symbol_by_name(str, &sym)) {
result = lbm_enc_sym(sym);
@ -843,8 +942,37 @@ lbm_value lbm_fundamental(lbm_value* args, lbm_uint nargs, lbm_value op) {
return lbm_enc_sym(SYM_TERROR);
}
break;
case SYM_SHL:
if (nargs == 2) {
result = shl(args[0],args[1]);
}
break;
case SYM_SHR:
if (nargs == 2) {
result = shr(args[0],args[1]);
}
break;
case SYM_BITWISE_AND:
if (nargs == 2) {
result = bitwise_and(args[0], args[1]);
}
break;
case SYM_BITWISE_OR:
if (nargs == 2) {
result = bitwise_or(args[0], args[1]);
}
break;
case SYM_BITWISE_XOR:
if (nargs == 2) {
result = bitwise_xor(args[0], args[1]);
}
break;
case SYM_BITWISE_NOT:
if (nargs == 1) {
result = bitwise_not(args[0]);
}
break;
default:
// printf("fundamental unknown\n");
result = lbm_enc_sym(SYM_EERROR);
break;
}

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

@ -164,6 +164,22 @@ static inline bool get_gc_mark(lbm_cons_t* cell) {
return lbm_get_gc_mark(cdr);
}
static inline void set_gc_flag(lbm_cons_t *cell) {
lbm_value v = read_car(cell);
set_car_(cell, lbm_set_gc_mark(v));
}
static inline void clr_gc_flag(lbm_cons_t *cell) {
lbm_value v = read_car(cell);
set_car_(cell, lbm_clr_gc_mark(v));
}
static inline bool get_gc_flag(lbm_cons_t* cell) {
lbm_value v = read_car(cell);
return lbm_get_gc_mark(v);
}
static int generate_freelist(size_t num_cells) {
size_t i = 0;
@ -187,11 +203,15 @@ static int generate_freelist(size_t num_cells) {
return 1;
}
static void heap_init_state(lbm_cons_t *addr, unsigned int num_cells) {
static void heap_init_state(lbm_cons_t *addr, unsigned int num_cells,
uint32_t *gc_stack_storage, unsigned int gc_stack_size) {
heap_state.heap = addr;
heap_state.heap_bytes = (unsigned int)(num_cells * sizeof(lbm_cons_t));
heap_state.heap_size = num_cells;
lbm_stack_create(&heap_state.gc_stack, gc_stack_storage, gc_stack_size);
heap_state.num_alloc = 0;
heap_state.num_alloc_arrays = 0;
heap_state.gc_num = 0;
@ -218,7 +238,8 @@ void lbm_heap_new_freelist_length(uint32_t l) {
heap_state.gc_least_free = l;
}
int lbm_heap_init(lbm_cons_t *addr, unsigned int num_cells) {
int lbm_heap_init(lbm_cons_t *addr, uint32_t num_cells,
uint32_t *gc_stack_storage, uint32_t gc_stack_size) {
NIL = lbm_enc_sym(SYM_NIL);
RECOVERED = lbm_enc_sym(SYM_RECOVERED);
@ -227,7 +248,8 @@ int lbm_heap_init(lbm_cons_t *addr, unsigned int num_cells) {
memset(addr,0, sizeof(lbm_cons_t) * num_cells);
heap_init_state(addr, num_cells);
heap_init_state(addr, num_cells,
gc_stack_storage, gc_stack_size);
return generate_freelist(num_cells);
}
@ -257,7 +279,7 @@ lbm_value lbm_heap_allocate_cell(lbm_type ptr_type) {
if (!lbm_is_ptr(heap_state.freelist)) {
// Free list not a ptr (should be Symbol NIL)
if ((lbm_type_of(heap_state.freelist) == LBM_VAL_TYPE_SYMBOL) &&
(heap_state.freelist == NIL)) {
(lbm_dec_sym(heap_state.freelist) == SYM_NIL)) {
// all is as it should be (but no free cells)
return lbm_enc_sym(SYM_MERROR);
} else {
@ -316,23 +338,20 @@ void lbm_get_heap_state(lbm_heap_state_t *res) {
res->gc_min_duration = heap_state.gc_min_duration;
}
static lbm_value stack_storage[1024];
int lbm_gc_mark_phase(lbm_value env) {
lbm_stack_t s;
lbm_stack_create(&s, stack_storage, 1024);
lbm_stack_t *s = &heap_state.gc_stack;
if (!lbm_is_ptr(env)) {
return 1; // Nothing to mark here
}
lbm_push_u32(&s, env);
lbm_push_u32(s, env);
while (!lbm_stack_is_empty(&s)) {
while (!lbm_stack_is_empty(s)) {
lbm_value curr;
int res = 1;
lbm_pop_u32(&s, &curr);
lbm_pop_u32(s, &curr);
if (!lbm_is_ptr(curr)) {
continue;
@ -357,8 +376,8 @@ int lbm_gc_mark_phase(lbm_value env) {
t_ptr == LBM_PTR_TYPE_STREAM) {
continue;
}
res &= lbm_push_u32(&s, lbm_cdr(curr));
res &= lbm_push_u32(&s, lbm_car(curr));
res &= lbm_push_u32(s, lbm_cdr(curr));
res &= lbm_push_u32(s, lbm_car(curr));
if (!res) return 0;
}
@ -478,8 +497,8 @@ lbm_value lbm_cons(lbm_value car, lbm_value cdr) {
lbm_value lbm_car(lbm_value c){
if (lbm_type_of(c) == LBM_VAL_TYPE_SYMBOL &&
c == NIL) {
return c; // if nil, return nil.
lbm_dec_sym(c) == SYM_NIL) {
return lbm_enc_sym(SYM_NIL); // if nil, return nil.
}
if (lbm_is_ptr(c) ){
@ -492,8 +511,8 @@ lbm_value lbm_car(lbm_value c){
lbm_value lbm_cdr(lbm_value c){
if (lbm_type_of(c) == LBM_VAL_TYPE_SYMBOL &&
c == NIL) {
return c; // if nil, return nil.
lbm_dec_sym(c) == SYM_NIL) {
return lbm_enc_sym(SYM_NIL); // if nil, return nil.
}
if (lbm_type_of(c) == LBM_PTR_TYPE_CONS) {
@ -537,7 +556,7 @@ unsigned int lbm_list_length(lbm_value c) {
/* reverse a proper list */
lbm_value lbm_list_reverse(lbm_value list) {
if (lbm_type_of(list) == LBM_VAL_TYPE_SYMBOL &&
list == NIL) {
lbm_dec_sym(list) == SYM_NIL) {
return list;
}

28
lispBM/lispBM/src/lbm_c_interop.c
View File

@ -172,7 +172,33 @@ int lbm_define(char *symbol, lbm_value value) {
return 0;
}
}
lbm_env_set(lbm_get_env(), lbm_enc_sym(sym_id), value);
*lbm_get_env_ptr() = lbm_env_set(lbm_get_env(), lbm_enc_sym(sym_id), value);
}
return res;
}
int lbm_create_array(lbm_value *value, char *data, lbm_type type, uint32_t num_elt) {
lbm_array_header_t *array = NULL;
lbm_value cell = lbm_heap_allocate_cell(LBM_PTR_TYPE_CONS);
if (lbm_type_of(cell) == LBM_VAL_TYPE_SYMBOL) { // Out of heap memory
*value = cell;
return 0;
}
array = (lbm_array_header_t*)lbm_memory_allocate(sizeof(lbm_array_header_t) / 4);
if (array == NULL) return 0;
array->data = (uint32_t*)data;
array->elt_type = type;
array->size = num_elt;
lbm_set_car(cell, (lbm_uint)array);
lbm_set_cdr(cell, lbm_enc_sym(SYM_ARRAY_TYPE));
cell = cell | LBM_PTR_TYPE_ARRAY;
*value = cell;
return 1;
}

8
lispBM/lispBM/src/lispbm.c
View File

@ -18,9 +18,13 @@
#include "lispbm.h"
int lbm_init(lbm_cons_t *heap_storage, uint32_t heap_size,
uint32_t *gc_stack_storage, uint32_t gc_stack_size,
uint32_t *memory, uint32_t memory_size,
uint32_t *memory_bitmap, uint32_t bitmap_size) {
uint32_t *memory_bitmap, uint32_t bitmap_size,
uint32_t *print_stack_storage, uint32_t print_stack_size) {
if (lbm_print_init(print_stack_storage, print_stack_size) == 0)
return 0;
if (lbm_memory_init(memory, memory_size,
memory_bitmap, bitmap_size) == 0)
@ -29,7 +33,7 @@ int lbm_init(lbm_cons_t *heap_storage, uint32_t heap_size,
if (lbm_symrepr_init() == 0)
return 0;
if (lbm_heap_init(heap_storage, heap_size) == 0)
if (lbm_heap_init(heap_storage, heap_size, gc_stack_storage, gc_stack_size) == 0)
return 0;
if (lbm_init_env() == 0)

110
lispBM/lispBM/src/print.c
View File

@ -26,8 +26,6 @@
#include "symrepr.h"
#include "stack.h"
#define PRINT_STACK_SIZE 128 /* 1 KB */
#define PRINT 1
#define PRINT_SPACE 2
#define START_LIST 3
@ -35,14 +33,24 @@
#define END_LIST 5
#define PRINT_DOT 6
static lbm_value stack_storage[PRINT_STACK_SIZE];
static lbm_stack_t print_stack = { NULL, 0, 0, 0};
static bool print_has_stack = false;
const char *failed_str = "Error: print failed\n";
int lbm_print_value(char *buf,unsigned int len, lbm_value t) {
int lbm_print_init(uint32_t *print_stack_storage, uint32_t print_stack_size) {
lbm_stack_t s;
lbm_stack_create(&s, stack_storage, PRINT_STACK_SIZE);
if (!print_stack_storage || print_stack_size == 0)
return 0;
if (lbm_stack_create(&print_stack, print_stack_storage, print_stack_size)) {
print_has_stack = true;
return 1;
}
return 0;
}
int lbm_print_value(char *buf,unsigned int len, lbm_value t) {
int r = 0;
unsigned int n = 0;
@ -50,19 +58,20 @@ int lbm_print_value(char *buf,unsigned int len, lbm_value t) {
const char *str_ptr;
int res;
lbm_push_u32_2(&s, t, PRINT);
lbm_stack_clear(&print_stack);
lbm_push_u32_2(&print_stack, t, PRINT);
while (!lbm_stack_is_empty(&s) && offset <= len - 5) {
while (!lbm_stack_is_empty(&print_stack) && offset <= len - 5) {
lbm_value curr;
lbm_uint instr;
lbm_pop_u32(&s, &instr);
lbm_pop_u32(&print_stack, &instr);
switch(instr) {
case START_LIST: {
res = 1;
lbm_pop_u32(&s, &curr);
lbm_pop_u32(&print_stack, &curr);
r = snprintf(buf + offset, len - offset, "(");
if ( r >= 0 ) {
@ -77,19 +86,19 @@ int lbm_print_value(char *buf,unsigned int len, lbm_value t) {
lbm_value cdr_val = lbm_cdr(curr);
if (lbm_type_of(cdr_val) == LBM_PTR_TYPE_CONS) {
res &= lbm_push_u32(&s, cdr_val);
res &= lbm_push_u32(&s, CONTINUE_LIST);
res &= lbm_push_u32(&print_stack, cdr_val);
res &= lbm_push_u32(&print_stack, CONTINUE_LIST);
} else if (lbm_type_of(cdr_val) == LBM_VAL_TYPE_SYMBOL &&
lbm_dec_sym(cdr_val) == SYM_NIL) {
res &= lbm_push_u32(&s, END_LIST);
res &= lbm_push_u32(&print_stack, END_LIST);
} else {
res &= lbm_push_u32(&s, END_LIST);
res &= lbm_push_u32(&s, cdr_val);
res &= lbm_push_u32(&s, PRINT);
res &= lbm_push_u32(&s, PRINT_DOT);
res &= lbm_push_u32(&print_stack, END_LIST);
res &= lbm_push_u32(&print_stack, cdr_val);
res &= lbm_push_u32(&print_stack, PRINT);
res &= lbm_push_u32(&print_stack, PRINT_DOT);
}
res &= lbm_push_u32(&s, car_val);
res &= lbm_push_u32(&s, PRINT);
res &= lbm_push_u32(&print_stack, car_val);
res &= lbm_push_u32(&print_stack, PRINT);
if (!res) {
snprintf(buf, len, "Error: Out of print stack\n");
@ -101,7 +110,7 @@ int lbm_print_value(char *buf,unsigned int len, lbm_value t) {
case CONTINUE_LIST: {
res = 1;
lbm_pop_u32(&s, &curr);
lbm_pop_u32(&print_stack, &curr);
if (lbm_type_of(curr) == LBM_VAL_TYPE_SYMBOL &&
lbm_dec_sym(curr) == SYM_NIL) {
@ -121,19 +130,19 @@ int lbm_print_value(char *buf,unsigned int len, lbm_value t) {
offset += n;
if (lbm_type_of(cdr_val) == LBM_PTR_TYPE_CONS) {
res &= lbm_push_u32(&s, cdr_val);
res &= lbm_push_u32(&s, CONTINUE_LIST);
res &= lbm_push_u32(&print_stack, cdr_val);
res &= lbm_push_u32(&print_stack, CONTINUE_LIST);
} else if (lbm_type_of(cdr_val) == LBM_VAL_TYPE_SYMBOL &&
lbm_dec_sym(cdr_val) == SYM_NIL) {
res &= lbm_push_u32(&s, END_LIST);
res &= lbm_push_u32(&print_stack, END_LIST);
} else {
res &= lbm_push_u32(&s, END_LIST);
res &= lbm_push_u32(&s, cdr_val);
res &= lbm_push_u32(&s, PRINT);
res &= lbm_push_u32(&s, PRINT_DOT);
res &= lbm_push_u32(&print_stack, END_LIST);
res &= lbm_push_u32(&print_stack, cdr_val);
res &= lbm_push_u32(&print_stack, PRINT);
res &= lbm_push_u32(&print_stack, PRINT_DOT);
}
res &= lbm_push_u32(&s, car_val);
res &= lbm_push_u32(&s, PRINT);
res &= lbm_push_u32(&print_stack, car_val);
res &= lbm_push_u32(&print_stack, PRINT);
if (!res) {
snprintf(buf, len, "Error: Out of print stack\n");
return -1;
@ -175,14 +184,14 @@ int lbm_print_value(char *buf,unsigned int len, lbm_value t) {
case PRINT:
lbm_pop_u32(&s, &curr);
lbm_pop_u32(&print_stack, &curr);
switch(lbm_type_of(curr)) {
case LBM_PTR_TYPE_CONS:{
res = 1;
res &= lbm_push_u32(&s, curr);
res &= lbm_push_u32(&s, START_LIST);
res &= lbm_push_u32(&print_stack, curr);
res &= lbm_push_u32(&print_stack, START_LIST);
if (!res) {
snprintf(buf, len, "Error: Out of print stack\n");
return -1;
@ -246,7 +255,7 @@ int lbm_print_value(char *buf,unsigned int len, lbm_value t) {
lbm_array_header_t *array = (lbm_array_header_t *)lbm_car(curr);
switch (array->elt_type){
case LBM_VAL_TYPE_CHAR:
r = snprintf(buf + offset, len - offset, "\"%s\"", (char *)array->data);
r = snprintf(buf + offset, len - offset, "\"%.*s\"", (int)array->size, (char *)array->data);
if ( r > 0) {
n = (unsigned int) r;
} else {
@ -255,11 +264,39 @@ int lbm_print_value(char *buf,unsigned int len, lbm_value t) {
}
offset += n;
break;
default:
r = snprintf(buf + offset, len - offset, "{");
if (r == 1) {
offset += 1;
} else {
snprintf(buf, len, "%s", failed_str);
return -1;
}
for (unsigned int i = 0; i < array->size; i ++) {
switch(array->elt_type) {
case LBM_PTR_TYPE_BOXED_I:
r = snprintf(buf+offset, len - offset, "%lu%s", (int32_t)array->data[i], i == array->size - 1 ? "" : ", ");
break;
case LBM_PTR_TYPE_BOXED_U:
r = snprintf(buf+offset, len - offset, "%lu%s", (uint32_t)array->data[i], i == array->size - 1 ? "" : ", ");
break;
case LBM_PTR_TYPE_BOXED_F:
r = snprintf(buf+offset, len - offset, "%f%s", (double)((float)array->data[i]), i == array->size - 1 ? "" : ", ");
break;
default:
snprintf(buf, len, "Error: Array type not supported\n");
break;
}
if (r > 0) {
offset += (unsigned int)r;
} else {
snprintf(buf, len, "%s", failed_str);
return -1;
}
}
snprintf(buf + offset, len - offset, "}");
offset ++;
break;
}
break;
}
case LBM_PTR_TYPE_STREAM: {
@ -337,14 +374,11 @@ int lbm_print_value(char *buf,unsigned int len, lbm_value t) {
}// Switch instruction
}//While not empty stack
if (!lbm_stack_is_empty(&s)) {
if (!lbm_stack_is_empty(&print_stack)) {
snprintf(buf + (len - 5), 4, "...");
buf[len-1] = 0;
return (int)len;
}
return (int)n;
}

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

@ -24,8 +24,7 @@
#include "symrepr.h"
#define NUM_SPECIAL_SYMBOLS 94
#define NUM_SPECIAL_SYMBOLS 101
#define NAME 0
#define ID 1
#define NEXT 2
@ -88,6 +87,7 @@ special_sym const special_symbols[NUM_SPECIAL_SYMBOLS] = {
{"sym_commaat" , SYM_COMMAAT},
{"sym_dot" , SYM_DOT},
{"sym_tok_done" , SYM_TOKENIZER_DONE},
{"sym_quote_it" , SYM_QUOTE_IT},
// special symbols with parseable names
{"type-list" , SYM_TYPE_LIST},
@ -135,6 +135,13 @@ special_sym const special_symbols[NUM_SPECIAL_SYMBOLS] = {
{"set-car" , SYM_SET_CAR},
{"set-cdr" , SYM_SET_CDR},
{"shl" , SYM_SHL},
{"shr" , SYM_SHR},
{"bitwise-and" , SYM_BITWISE_AND},
{"bitwise-or" , SYM_BITWISE_OR},
{"bitwise-xor" , SYM_BITWISE_XOR},
{"bitwise-not" , SYM_BITWISE_NOT},
// Streams
// {"stream-get" , SYM_STREAM_GET},
// {"stream-more" , SYM_STREAM_MORE},

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

@ -498,7 +498,7 @@ lbm_value lbm_get_next_token(lbm_tokenizer_char_stream_t *str) {
res = lbm_enc_sym(SYM_DONTCARE);
break;
case TOKQUOTE:
res = lbm_enc_sym(SYM_QUOTE);
res = lbm_enc_sym(SYM_QUOTE_IT);
break;
case TOKBACKQUOTE:
res = lbm_enc_sym(SYM_BACKQUOTE);

5
lispBM/lispBM/tests/test_heap_alloc.c
View File

@ -5,6 +5,9 @@
#include "heap.h"
#include "symrepr.h"
#define GC_STACK_SIZE 256
uint32_t gc_stack_storage[GC_STACK_SIZE];
int main(int argc, char **argv) {
@ -27,7 +30,7 @@ int main(int argc, char **argv) {
return 0;
}
res = lbm_heap_init(heap_storage,heap_size);
res = lbm_heap_init(heap_storage,heap_size, gc_stack_storage, GC_STACK_SIZE);
if (!res) {
printf("Error initializing heap\n");
return 0;

16
lispBM/lispBM/tests/test_lisp_code_cps.c
View File

@ -28,6 +28,11 @@
#include "lispbm.h"
#define EVAL_CPS_STACK_SIZE 256
#define GC_STACK_SIZE 256
#define PRINT_STACK_SIZE 256
uint32_t gc_stack_storage[GC_STACK_SIZE];
uint32_t print_stack_storage[PRINT_STACK_SIZE];
/* Tokenizer state for strings */
static lbm_tokenizer_string_state_t string_tok_state;
@ -165,6 +170,15 @@ int main(int argc, char **argv) {
return 0;
}
res = lbm_print_init(print_stack_storage, PRINT_STACK_SIZE);
if (res)
printf("Printing initialized.\n");
else {
printf("Error initializing printing!\n");
return 0;
}
res = lbm_symrepr_init();
if (res)
printf("Symrepr initialized.\n");
@ -178,7 +192,7 @@ int main(int argc, char **argv) {
return 0;
}
res = lbm_heap_init(heap_storage, heap_size);
res = lbm_heap_init(heap_storage, heap_size, gc_stack_storage, GC_STACK_SIZE);
if (res)
printf("Heap initialized. Heap size: %f MiB. Free cons cells: %d\n", lbm_heap_size_bytes() / 1024.0 / 1024.0, lbm_heap_num_free());
else {

8
lispBM/lispBM/tests/test_read_2.lisp
View File

@ -1,4 +1,8 @@
(define prg "(define a 10) (+ a 10)")
;; eval-program takes over the current context completely.
(= (eval-program (read-program prg)) 20)
(define prg "(define a 10) (define r (+ a 10))")
(eval-program (read-program prg))
(= r 20)

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

@ -1,5 +1,5 @@
/*
Copyright 2019,2021 Joel Svensson svenssonjoel@yahoo.se
/*
Copyright 2019 - 2022 Joel Svensson svenssonjoel@yahoo.se
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
@ -26,35 +26,40 @@
#include "usb_cdc.h"
#define LISPBM_HEAP_SIZE 2048
#define LISPBM_OUTPUT_BUFFER_SIZE 4096
#define LISPBM_ERROR_BUFFER_SIZE 1024
#define LISPBM_OUTPUT_BUFFER_SIZE 1024
#define LISPBM_INPUT_BUFFER_SIZE 1024
#define EVAL_CPS_STACK_SIZE 256
#define GC_STACK_SIZE 256
#define PRINT_STACK_SIZE 256
static char str[LISPBM_INPUT_BUFFER_SIZE];
static char outbuf[LISPBM_OUTPUT_BUFFER_SIZE];
static char error[LISPBM_ERROR_BUFFER_SIZE];
static uint32_t memory[LBM_MEMORY_SIZE_8K];
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_tokenizer_string_state_t string_tok_state;
static lbm_tokenizer_char_stream_t string_tok;
void done_callback(eval_context_t *ctx) {
static char print_output[1024];
static char error_output[1024];
lbm_cid cid = ctx->id;
lbm_value t = ctx->r;
int print_ret = lbm_print_value(print_output, 1024, error_output, 1024, t);
int print_ret = lbm_print_value(print_output, 1024, t);
if (print_ret >= 0) {
usb_printf("<< Context %d finished with value %s >>\r\n# ", cid, print_output);
} else {
usb_printf("<< Context %d finished with value %s >>\r\n# ", cid, error_output);
usb_printf("<< Context %d finished with value %s >>\r\n# ", cid, print_output);
}
}
@ -78,17 +83,28 @@ void main(void)
lbm_heap_state_t heap_state;
lbm_init(heap, LISPBM_HEAP_SIZE,
gc_stack_storage, GC_STACK_SIZE,
memory, LBM_MEMORY_SIZE_8K,
bitmap, LBM_MEMORY_BITMAP_SIZE_8K);
bitmap, LBM_MEMORY_BITMAP_SIZE_8K,
print_stack_storage, PRINT_STACK_SIZE
);
lbm_set_ctx_done_callback(done_callback);
lbm_set_timestamp_us_callback(timestamp_callback);
lbm_set_usleep_callback(sleep_callback);
lbm_value prelude = prelude_load();
eval_cps_program_nc(prelude);
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);
usb_printf("Lisp REPL started (ZephyrOS)!\r\n");
@ -108,11 +124,11 @@ void main(void)
if (strncmp(str, ":info", 5) == 0) {
usb_printf("##(REPL - ZephyrOS)#########################################\r\n");
usb_printf("Used cons cells: %lu \r\n", LISPBM_HEAP_SIZE - lbm_heap_num_free());
res = lbm_print_value(outbuf, LISPBM_OUTPUT_BUFFER_SIZE, error, LISPBM_ERROR_BUFFER_SIZE, *lbm_get_env_ptr());
res = lbm_print_value(outbuf, LISPBM_OUTPUT_BUFFER_SIZE, lbm_get_env());
if (res >= 0) {
usb_printf("ENV: %s \r\n", outbuf);
} else {
usb_printf("%s\n", error);
usb_printf("%s\n", outbuf);
}
lbm_get_heap_state(&heap_state);
usb_printf("GC counter: %lu\r\n", heap_state.gc_num);
@ -125,19 +141,23 @@ void main(void)
break;
} else {
lbm_value t;
t = tokpar_parse(str);
t = eval_cps_program_nc(t);
res = lbm_print_value(outbuf, LISPBM_OUTPUT_BUFFER_SIZE, error, LISPBM_ERROR_BUFFER_SIZE, t);
if (res >= 0) {
usb_printf("> %s\r\n", outbuf);
} else {
usb_printf("%s\r\n", error);
}
}
if (strlen(str) == 0) {
continue;
}
symrepr_del();
lbm_pause_eval();
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_cid cid = lbm_load_and_eval_expression(&string_tok);
lbm_continue_eval();
lbm_wait_ctx((lbm_cid)cid);
}
}
}

17
lispBM/lispif.c
View File

@ -37,10 +37,15 @@
#define HEAP_SIZE 1536
#define LISP_MEM_SIZE LBM_MEMORY_SIZE_8K
#define LISP_MEM_BITMAP_SIZE LBM_MEMORY_BITMAP_SIZE_8K
#define GC_STACK_SIZE 160
#define PRINT_STACK_SIZE 128
__attribute__((section(".ram4"))) static lbm_cons_t heap[HEAP_SIZE] __attribute__ ((aligned (8)));
static uint32_t memory_array[LISP_MEM_SIZE];
static uint32_t bitmap_array[LISP_MEM_BITMAP_SIZE];
static uint32_t gc_stack_storage[GC_STACK_SIZE];
static uint32_t print_stack_storage[PRINT_STACK_SIZE];
static lbm_tokenizer_string_state_t string_tok_state;
static lbm_tokenizer_char_stream_t string_tok;
@ -180,7 +185,11 @@ static bool start_lisp(bool print) {
if (code_data != 0 && code_len > 0) {
if (!lisp_thd_running) {
lbm_init(heap, HEAP_SIZE, memory_array, LISP_MEM_SIZE, bitmap_array, LISP_MEM_BITMAP_SIZE);
lbm_init(heap, HEAP_SIZE,
gc_stack_storage, GC_STACK_SIZE,
memory_array, LBM_MEMORY_SIZE_8K,
bitmap_array, LBM_MEMORY_BITMAP_SIZE_8K,
print_stack_storage, PRINT_STACK_SIZE);
lbm_set_timestamp_us_callback(timestamp_callback);
lbm_set_usleep_callback(sleep_callback);
@ -193,7 +202,11 @@ static bool start_lisp(bool print) {
chThdSleepMilliseconds(100);
}
lbm_init(heap, HEAP_SIZE, memory_array, LISP_MEM_SIZE, bitmap_array, LISP_MEM_BITMAP_SIZE);
lbm_init(heap, HEAP_SIZE,
gc_stack_storage, GC_STACK_SIZE,
memory_array, LBM_MEMORY_SIZE_8K,
bitmap_array, LBM_MEMORY_BITMAP_SIZE_8K,
print_stack_storage, PRINT_STACK_SIZE);
lbm_pause_eval();
while (lbm_get_eval_state() != EVAL_CPS_STATE_PAUSED) {

4
lispBM/lispif_vesc_extensions.c
View File

@ -560,7 +560,7 @@ static lbm_value ext_can_get_current(lbm_value *args, lbm_uint argn) {
if (stat0) {
return lbm_enc_F(stat0->current);
} else {
return lbm_enc_sym(SYM_EERROR);
return lbm_enc_F(0.0);
}
}
@ -570,7 +570,7 @@ static lbm_value ext_can_get_current_dir(lbm_value *args, lbm_uint argn) {
if (stat0) {
return lbm_enc_F(stat0->current * SIGN(stat0->duty));
} else {
return lbm_enc_sym(SYM_EERROR);
return lbm_enc_F(0.0);
}
}

27
mc_interface.c
View File

@ -1636,6 +1636,33 @@ void mc_interface_ignore_input_both(int time_ms) {
#endif
}
void mc_interface_release_motor_override_both(void) {
int motor_last = mc_interface_get_motor_thread();
mc_interface_select_motor_thread(1);
mc_interface_release_motor_override();
mc_interface_select_motor_thread(2);
mc_interface_release_motor_override();
mc_interface_select_motor_thread(motor_last);
}
bool mc_interface_wait_for_motor_release_both(float timeout) {
int motor_last = mc_interface_get_motor_thread();
mc_interface_select_motor_thread(1);
if (!mc_interface_wait_for_motor_release(timeout)) {
mc_interface_select_motor_thread(motor_last);
return false;
}
mc_interface_select_motor_thread(2);
if (!mc_interface_wait_for_motor_release(timeout)) {
mc_interface_select_motor_thread(motor_last);
return false;
}
return true;
}
void mc_interface_set_current_off_delay(float delay_sec) {
if (mc_interface_try_input()) {
return;

5
mc_interface.h
View File

@ -97,10 +97,13 @@ uint64_t mc_interface_get_odometer(void);
void mc_interface_set_odometer(uint64_t new_odometer_meters);
void mc_interface_ignore_input(int time_ms);
void mc_interface_ignore_input_both(int time_ms);
void mc_interface_set_current_off_delay(float delay_sec);
void mc_interface_ignore_input_both(int time_ms);
void mc_interface_release_motor_override_both(void);
bool mc_interface_wait_for_motor_release_both(float timeout);
// Statistics
float mc_interface_stat_speed_avg(void);
float mc_interface_stat_speed_max(void);