diff --git a/flash_helper.c b/flash_helper.c
index 5057b958..3f8f67fd 100644
--- a/flash_helper.c
+++ b/flash_helper.c
@@ -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;
}
diff --git a/lispBM/README.md b/lispBM/README.md
index 8d7c0b13..a1472d37 100644
--- a/lispBM/README.md
+++ b/lispBM/README.md
@@ -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")
diff --git a/lispBM/lispBM/README.md b/lispBM/lispBM/README.md
index b23fdab4..815f2b80 100644
--- a/lispBM/lispBM/README.md
+++ b/lispBM/lispBM/README.md
@@ -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`
diff --git a/lispBM/lispBM/benchmarks/bench_chibi/Makefile b/lispBM/lispBM/benchmarks/bench_chibi/Makefile
index 69604a3d..20fe3027 100644
--- a/lispBM/lispBM/benchmarks/bench_chibi/Makefile
+++ b/lispBM/lispBM/benchmarks/bench_chibi/Makefile
@@ -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) \
diff --git a/lispBM/lispBM/benchmarks/bench_chibi/main.c b/lispBM/lispBM/benchmarks/bench_chibi/main.c
index 499221b2..98278e14 100644
--- a/lispBM/lispBM/benchmarks/bench_chibi/main.c
+++ b/lispBM/lispBM/benchmarks/bench_chibi/main.c
@@ -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,
- memory_array, LBM_MEMORY_SIZE_8K,
- bitmap_array, LBM_MEMORY_BITMAP_SIZE_8K)) {
+ 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)) {
chprintf(chp,"LispBM Init failed.\r\n");
return 0;
}
@@ -306,8 +312,10 @@ int main(void) {
}
lbm_init(heap, HEAP_SIZE,
- memory_array, LBM_MEMORY_SIZE_8K,
- bitmap_array, LBM_MEMORY_BITMAP_SIZE_8K);
+ 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_add_extension("print", ext_print);
diff --git a/lispBM/lispBM/benchmarks/benchresult22_02_04_14_29_37 b/lispBM/lispBM/benchmarks/benchresult22_02_04_14_29_37
new file mode 100644
index 00000000..231a9f30
--- /dev/null
+++ b/lispBM/lispBM/benchmarks/benchresult22_02_04_14_29_37
@@ -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
diff --git a/lispBM/lispBM/chibios-examples/repl-ChibiOS/main.c b/lispBM/lispBM/chibios-examples/repl-ChibiOS/main.c
index 6f49fbcd..f6178c98 100644
--- a/lispBM/lispBM/chibios-examples/repl-ChibiOS/main.c
+++ b/lispBM/lispBM/chibios-examples/repl-ChibiOS/main.c
@@ -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,
- memory_array, LBM_MEMORY_SIZE_8K,
- bitmap_array, LBM_MEMORY_BITMAP_SIZE_8K)) {
+ 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)) {
chprintf(chp,"LispBM Init failed.\r\n");
return 0;
}
@@ -298,8 +304,10 @@ int main(void) {
}
lbm_init(heap, HEAP_SIZE,
- memory_array, LBM_MEMORY_SIZE_8K,
- bitmap_array, LBM_MEMORY_BITMAP_SIZE_8K);
+ 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_add_extension("print", ext_print);
diff --git a/lispBM/lispBM/chibios-examples/xmas_dac/main.c b/lispBM/lispBM/chibios-examples/xmas_dac/main.c
index 23b488a2..3e119f01 100644
--- a/lispBM/lispBM/chibios-examples/xmas_dac/main.c
+++ b/lispBM/lispBM/chibios-examples/xmas_dac/main.c
@@ -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,
- memory_array, LBM_MEMORY_SIZE_8K,
- bitmap_array, LBM_MEMORY_BITMAP_SIZE_8K)) {
+ 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)) {
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,
diff --git a/lispBM/lispBM/doc/lbm.dox b/lispBM/lispBM/doc/lbm.dox
index 75d3d2ee..8bef28c6 100644
--- a/lispBM/lispBM/doc/lbm.dox
+++ b/lispBM/lispBM/doc/lbm.dox
@@ -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
+SICP course on youtube and a tiny amount of experimenting with EMACS
+lisp. I strongly recommend that you watch the SICP course, it is a lot of fun!
+
+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
*/
diff --git a/lispBM/lispBM/doc/lbmref.dox b/lispBM/lispBM/doc/lbmref.dox
index eb7b402c..3dae04e1 100644
--- a/lispBM/lispBM/doc/lbmref.dox
+++ b/lispBM/lispBM/doc/lbmref.dox
@@ -49,7 +49,7 @@ Multiplying an arbitrary number of values. The form of a * expression is
\note
Example 2pi.
\code
-(* 2 3.14)
+(* 2 3.14)
\endcode
@@ -69,16 +69,17 @@ The following example evaluates to 1.
(/ 128 2 2 2 2 2 2 2)
\endcode
+
---
mod
-Modulo operation. The form of a mod expression is (mode expr1 ... exprN).
+Modulo operation. The form of a mod expression is (mod expr1 ... exprN).
\note
Compute 5 % 3, evaluates to 2.
\code
-(mod 5 3)
+(mod 5 3)
\endcode
@@ -168,17 +169,176 @@ Example
and
+Boolean and operation between n arguments. The form
+of an and expression is (and expr1 ... exprN).
+This operation treats all non-nil values as true. Boolean and
+is "shirt-circuiting" and only evaluates until a false is encountered.
+
+\note
+The example below evaluates to t
+\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
+
+
---
or
+Boolean or operation between n arguments. The form
+of an or expression is (or expr1 ... exprN).
+This operation treats all non-nil values as true. Boolean or
+is "short-circuiting" and only evaluates until a true is encountered.
+
+\note
+The example below evaluates to t.
+\code
+(or t nil)
+\endcode
+
+
---
not
+Boolean not takes one argument. The form of a not
+expression is (not expr). All non-nil values are considered
+true.
+
+\note
+The following example evaluates to t
+\code
+(not nil)
+\endcode
+
+
---
+\section sec_bitwise Bit level operations
+
+shl
+
+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
+
+
+---
+
+
+shr
+
+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
+
+
+---
+
+
+bitwise-and
+
+Performs the bitwise and operation between two values. The type of the result
+is the same type as the first of the arguments.
+
+
+---
+
+
+bitwise-or
+
+Performs the bitwise or operation between two values. The type of the result
+is the same type as the first of the arguments.
+
+
+---
+
+
+bitwise-xor
+
+Performs the bitwise xor operation between two values. The type of the result
+is the same type as the first of the arguments.
+
+
+---
+
+bitwise-not
+
+Performs the bitwise not operations on a value. The result is of same type as
+the argument.
+
+\section sec_low_level Low level operations
+
+ encode-i32
+
+The encode-i32 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
+
+
+---
+
+ encode-u32
+
+The encode-u32 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
+
+
+---
+
+ encode-float
+
+The encode-float 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
+
+
+---
+
+ decode
+
+The decode 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
nil
@@ -203,9 +363,15 @@ explicit true makes sense.
---
-\section sec_forms Special forms
+\section sec_quote Quotes and Quasiquotation
- quote
+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.
+
+---
+
+'
Usages of the ' quote symbol in input code is replaced with the symbol quote
by the reader.
@@ -214,9 +380,154 @@ Evaluating a quoted expression, (quote a), results in a unevaluated.
The program string '(+ 1 2) gets read into the heap as the list (quote (+ 1 2)).
Evaluating the expression (quote (+ 1 2)) results in the value (+ 1 2).
+
+---
+
+`
+
+The backwards tick ` is called the quasiquote. It is similar to the ' but
+allows splicing in results of computations using the , and the ,\@
+operators.
+
+\note
+The result of '(+ 1 2) and `(+ 1 2) are similar in
+effect. Both result in the result value of (+ 1 2), that is a list containing
++, 1 and 2.
+When `(+ 1 2) is read into the heap it is expanded into the
+expression (append (quote (+)) (append (quote (1)) (append (quote (2)) (quote nil))))
+which evaluates to the list (+ 1 2).
+
---
+,
+
+The comma is used to splice the result of a computation into a quasiquotation.
+\note
+The expression `(+ 1 ,(+ 1 1)) is expanded by the reader into
+(append (quote (+)) (append (quote (1)) (append (list (+ 1 1)) (quote nil)))).
+Evaluating the expression above results in the list (+ 1 2).
+
+
+---
+
+,\@
+
+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 (9 6 5 1 2 3 4 5).
+
+
+\section sec_builtin Built-in operations
+
+
+ eval
+
+Evaluate data as an expression. The data must represent a valid expression.
+\note
+Example that evaluates to 3.
+\code
+(eval (list + 1 2))
+\endcode
+
+
+---
+
+ eval-program
+
+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.
+
+
+---
+
+ type-of
+
+The type-of function returns a symbol that indicates what type the
+argument is. The form of a type-of expression is (type-of expr).
+
+\note
+Example that evaluates to type-float.
+\code
+(type-of 3.14)
+\endcode
+
+
+---
+
+ sym-to-str
+
+The sym-to-str 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 "lambda".
+\code
+(sym-to-str 'lambda)
+\endcode
+
+
+---
+
+ str-to-sym
+
+The str-to-sym function converts a string to a symbol.
+\note
+Example that returns the symbol hello.
+\code
+(str-to-sym "hello")
+\endcode
+
+---
+
+ sym-to-u
+
+The sym-to-u 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
+
+
+---
+
+ u-to-sym
+
+The u-to-sym 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.
+
+---
+
+ is-fundamental
+
+The is-funamental function returns true for built-in functions.
+\note
+Example that returns true.
+\code
+(is-fundamental '+)
+\endcode
+
+
+---
+
+
+\section sec_forms Special forms
+
+
if
Conditionals are written as (if cond-expr then-expr else-expr).
@@ -399,38 +710,165 @@ has been extended with the binding (apa 1).
---
-\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 car and the cdr.
+There is no special meaning associated with the car and the cdr each can hold
+a \ref lbm_value. See cons and list for two ways to create structures of
+cons cells on the heap.
car
+Use car to access the car field of a cons cell. A
+car expression has the form (car expr).
+
+\note
+Taking the car of a number of symbol type is in general a type_error.
+The following program results in type_error.
+\code
+(car 1)
+\endcode
+The next example evaluates to 1.
+\code
+(car (cons 1 2))
+\endcode
+The car operation accesses the head element of a list. The following program evaluates to 9.
+\code
+(car (list 9 8 7))
+\endcode
+
+
---
cdr
+Use cdr to access the cdr field of a cons cell. A
+cdr expression has the form (cdr expr).
+
+\note
+The example below evaluates to 2.
+\code
+(cdr (cons 1 2))
+\endcode
+The cdr operation gives you the rest of a list. The example below evaluates to the list (8 7).
+\code
+(cdr (list 9 8 7))
+\endcode
+
+
---
cons
+The cons operation allocates a cons cell from the heap and populates the
+car and the cdr fields of this cell with its two arguments.
+The form of a cons expression is (cons expr1 expr2).
+
+\note
+Build the list (1 2 3) using cons. nil terminates a proper list.
+\code
+(cons 1 (cons 2 (cons 3 nil)))
+\endcode
+Construct the pair (+ . 1) using cons.
+\code
+(cons + 1)
+\endcode
+
+
+---
+
+ .
+
+The dot, ., operation creates a pair. The form of a dot expression
+is (expr1 . expr2). By default the evaluator will attempt to evaluate the
+result of (expr1 . expr2) unless it is prefixed with '.
+
+\note
+Example that creates the pair (1 . 2)
+\code
+'(1 . 2)
+\endcode
+
+
---
list
+The list function is used to create proper lists. The function
+takes n arguments and is of the form (list expr1 ... exprN).
+
+\note
+Example that creates the list (1 2 3 4).
+\code
+(list 1 2 3 4)
+\endcode
+
+
---
append
+The append function combines two lists into a longer list.
+An append expression is of the form (append expr1 expr2).
+
+\note
+Example that combines to lists.
+\code
+(append (list 1 2 3) (list 4 5 6))
+\endcode
+
+
+
---
ix
+Index into a list using the ix. the form of an ix expression
+is (ix index-expr list-expr). 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
+
+
+
---
set-car
+The set-car is a destructive update of the car field
+of a cons-cell.
+
+\note
+Define apa to be the pair (1 . 2)
+\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 apa pair is now (42 . 2).
+
---
set-cdr
+The set-cdr is a destructive update of the cdr field of a cons-cell.
+
+\note
+Define apa to be the pair (1 . 2)
+\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 apa pair is now (1 . 42).
\section sec_arrays Arrays
@@ -438,10 +876,37 @@ has been extended with the binding (apa 1).
array-read
+Read one or many elements from an array. The form of
+an array-read expression is either (array-read array-expr index-expr)
+of (array-read array-expr start-index-expr end-index-expr) 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 (\#e \#l \#l).
+
+
---
array-write
+The array-write 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
@@ -454,7 +919,7 @@ the shape of an expression to each of the pat1 ... patNexprM of the pattern that matches.
In a pattern you can use a number of match-binders or wildcards: _,
?, ?i28, ?u28, ?float,
-?cons.
+?cons.
\note
For example the match expression below evaluates to 2.
@@ -491,7 +956,7 @@ Using the ? pattern is done as (? var) and the part of the expressi
that matches is bound to var.
\note
-An example that evaluates to 19.
+An example that evaluates to 19.
\code
(match '(orange 17)
((green (? n)) (+ n 1))
@@ -499,21 +964,47 @@ An example that evaluates to 19.
((blue (? n)) (+ n 3)))
\endcode
+
---
?i28
+The ?i28 pattern matches any i28 and binds that value to a variable.
+Using the ?i28 pattern is done as (?i28 var) and the part of the expression
+that matches is bound to the var.
+
+\note
+The following example evaluates to not-an-i28.
+\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
+
+
---
?u28
+The ?u28 pattern matches any u28 and binds that value to a variable.
+Using the ?u28 pattern is done as (?u28 var) and the part of the expression
+that matches is bound to the var.
+
+
---
?float
----
+The ?float pattern matches any float and binds that value to a variable.
+Using the ?float pattern is done as (?float var) and the part of the expression
+that matches is bound to the var.
- ?cons
---
@@ -521,97 +1012,136 @@ An example that evaluates to 19.
spawn
+Use spawn to spawn a concurrent task. The concurrency implemented
+by LispBM is called cooperative concurrency and it means that processes must
+sleep using yield or they will starve out other processes.
+The form of a spawn expression is (spawn closure arg1 ... argN)
+The return value is a process ID.
+
+
---
wait
+Use wait to wait for a spawned process to finish.
+The argument to wait should be a process id.
+The wait 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.
+
+
---
yield
+To put a process to sleep, call yield. The argument to yield
+is number indicating at least how many microseconds the process should sleep.
+
---
\section sec_messages Message-passing
send
+Messages can be sent to a process by using send. The form
+of a send expression is (send pid msg). The message, msg,
+can be any LispBM value.
+
+
---
recv
+To receive a message use the recv command. A process
+will block on a recv until there is a matching message in
+the mailbox.
+The recv syntax is very similar to match.
+
+\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).
+
no_match
+The no_match symbol is returned from pattern matching if
+no case matches the expression.
+
+
---
read_error
+The read_error symbol is returned if the reader cannot
+parse the input code.
+
+
---
type_error
+The type_error symbol is returned byt built-in functions
+if the values passed in are of incompatible types.
+
---
eval_error
+The eval_error symbol is returned if evaluation could
+not proceed to evaluate the expression. This could be because the
+expression is malformed.
+
---
out_of_memory
+The out_of_memory 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.
+
---
fatal_error
+The fatal_error symbol is returned in cases where the
+LispBM runtime system cannot proceed. Something is corrupt and it is
+not safe to continue.
+
---
out_of_stack
+The out_of_stack 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.
+
--
division_by_zero
+The division_by_zero symbol is returned when dividing by zero.
+
---
variable_not_bound
-\section sec_builtin Built-in operations
+The variable_not_bound symbol is returned when evaluating a
+variable (symbol) that is neighter bound nor special (built-in function).
- eval
-
----
-
- eval-program
-
----
-
- type-of
-
----
-
- sym-to-str
-
----
-
- str-to-sym
-
----
-
- sym-to-u
-
----
-
- u-to-sym
-
----
-
- is-fundamental
-
----
-
\section sec_types Types
type-list
@@ -658,6 +1188,11 @@ An example that evaluates to 19.
---
+
+
+*/
+
+
\section sec_internal Internal symbols
sym_openpar
@@ -715,29 +1250,6 @@ An example that evaluates to 19.
---
-\section sec_low_level Low level operations
-
- encode-i32
-
----
-
- encode-u32
-
----
-
- encode-float
-
----
-
- decode
-
----
-
-
-*/
-
-
-
array-create
@@ -761,7 +1273,7 @@ An example that evaluates to 19.
stream-drop
----
+---
stream-put
diff --git a/lispBM/lispBM/doc/mainpage.dox b/lispBM/lispBM/doc/mainpage.dox
index 5acda52b..89899d2c 100644
--- a/lispBM/lispBM/doc/mainpage.dox
+++ b/lispBM/lispBM/doc/mainpage.dox
@@ -7,8 +7,13 @@
https://github.com/svenssonjoel/lispBM
+ LispBM Language
+\ref lbmdoc
+\ref lbmref
+
Implementation documentation
+C Interoperation: \ref lbm_c_interop.h
Environment: \ref env.h
Evaluator: \ref eval_cps.h
Extensions: \ref extensions.h
@@ -19,17 +24,12 @@ LispBM: \ref lispbm.h
Printing values: \ref print.h
Stacks: \ref stack.h
Streams: \ref streams.h
-Symbol and array memory: \ref lispbm_memory.h
+Symbol and array memory: \ref lbm_memory.h
Symbol table: \ref symrepr.h
-Types: \ref lispbm_types.h
+Types: \ref lbm_types.h
+Version: \ref lbm_version.h
Quasiquotation: \ref qq_expand.h
- LispBM Language
-\ref lbmdoc
-\ref lbmref
-
- LispBM integration
-
\image html lispbm_llama_small.png
diff --git a/lispBM/lispBM/include/eval_cps.h b/lispBM/lispBM/include/eval_cps.h
index 2e2e9a12..d82beeb2 100644
--- a/lispBM/lispBM/include/eval_cps.h
+++ b/lispBM/lispBM/include/eval_cps.h
@@ -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.
diff --git a/lispBM/lispBM/include/heap.h b/lispBM/lispBM/include/heap.h
index 6e32f3b5..876f5773 100644
--- a/lispBM/lispBM/include/heap.h
+++ b/lispBM/lispBM/include/heap.h
@@ -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_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.
diff --git a/lispBM/lispBM/include/lbm_c_interop.h b/lispBM/lispBM/include/lbm_c_interop.h
index 397dfc5c..a673113a 100644
--- a/lispBM/lispBM/include/lbm_c_interop.h
+++ b/lispBM/lispBM/include/lbm_c_interop.h
@@ -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);
diff --git a/lispBM/lispBM/include/lbm_version.h b/lispBM/lispBM/include/lbm_version.h
new file mode 100644
index 00000000..e57b7809
--- /dev/null
+++ b/lispBM/lispBM/include/lbm_version.h
@@ -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 .
+*/
+
+/** @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
diff --git a/lispBM/lispBM/include/lispbm.h b/lispBM/lispBM/include/lispbm.h
index 15fbfa01..551daed2 100644
--- a/lispBM/lispBM/include/lispbm.h
+++ b/lispBM/lispBM/include/lispbm.h
@@ -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
diff --git a/lispBM/lispBM/include/print.h b/lispBM/lispBM/include/print.h
index f979dfca..297a7a30 100644
--- a/lispBM/lispBM/include/print.h
+++ b/lispBM/lispBM/include/print.h
@@ -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.
*
diff --git a/lispBM/lispBM/include/symrepr.h b/lispBM/lispBM/include/symrepr.h
index bee0f70d..8f717738 100644
--- a/lispBM/lispBM/include/symrepr.h
+++ b/lispBM/lispBM/include/symrepr.h
@@ -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
diff --git a/lispBM/lispBM/repl-cps/repl.c b/lispBM/lispBM/repl-cps/repl.c
index 136d800a..a0d33bdc 100644
--- a/lispBM/lispBM/repl-cps/repl.c
+++ b/lispBM/lispBM/repl-cps/repl.c
@@ -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,
- memory, LBM_MEMORY_SIZE_8K,
- bitmap, LBM_MEMORY_BITMAP_SIZE_8K);
+ gc_stack_storage, GC_STACK_SIZE,
+ memory, LBM_MEMORY_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,
- memory, LBM_MEMORY_SIZE_8K,
- bitmap, LBM_MEMORY_BITMAP_SIZE_8K);
+ gc_stack_storage, GC_STACK_SIZE,
+ memory, LBM_MEMORY_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();
diff --git a/lispBM/lispBM/repl-cps/test_mp.lisp b/lispBM/lispBM/repl-cps/test_mp.lisp
index cd9f4990..9ce8260e 100644
--- a/lispBM/lispBM/repl-cps/test_mp.lisp
+++ b/lispBM/lispBM/repl-cps/test_mp.lisp
@@ -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)
- (send pid `(apa ,x 107))
- (yield 500000)
- (print "bella waking up" \#newline)
- (send pid '(bepa 2))
- (yield 500000)
- (bella pid (+ x 1)))))
+(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)
diff --git a/lispBM/lispBM/src/eval_cps.c b/lispBM/lispBM/src/eval_cps.c
index af08f3ef..1380b7ad 100644
--- a/lispBM/lispBM/src/eval_cps.c
+++ b/lispBM/lispBM/src/eval_cps.c
@@ -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,27 +1204,64 @@ 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);
yield_ctx(ts);
} else {
- error_ctx(lbm_enc_sym(SYM_EERROR));
+ 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,39 +1306,41 @@ 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)) {
- /* If it is not a eval_cps specific function, it may be a fundamental operation */
- 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
+ } 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_is_error(res)) {
error_ctx(res);
- } else {
- lbm_stack_drop(&ctx->K, lbm_dec_u(count)+1);
+ } else {
+ lbm_stack_drop(&ctx->K, lbm_dec_u(count)+1);
+ ctx->app_cont = true;
+ ctx->r = res;
+ }
+ break;
+ } else {
+ // It may be an extension
+ extension_fptr f = lbm_get_extension(lbm_dec_sym(fun));
+ if (f == NULL) {
+ error_ctx(lbm_enc_sym(SYM_EERROR));
+ break;
+ }
+
+ lbm_value ext_res;
+ WITH_GC(ext_res, f(&fun_args[1] , lbm_dec_u(count)), NIL, NIL);
+
+ lbm_stack_drop(&ctx->K, lbm_dec_u(count) + 1);
+
ctx->app_cont = true;
- ctx->r = res;
+ ctx->r = ext_res;
+ break;
}
- return;
+ }
}
}
- // 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;
- }
-
- lbm_value ext_res;
- WITH_GC(ext_res, f(&fun_args[1] , lbm_dec_u(count)), NIL, NIL);
-
- lbm_stack_drop(&ctx->K, lbm_dec_u(count) + 1);
-
- ctx->app_cont = true;
- ctx->r = ext_res;
- return;
}
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;
diff --git a/lispBM/lispBM/src/fundamental.c b/lispBM/lispBM/src/fundamental.c
index 965dae26..fb546eb1 100644
--- a/lispBM/lispBM/src/fundamental.c
+++ b/lispBM/lispBM/src/fundamental.c
@@ -25,6 +25,109 @@
#include
#include
+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,10 +942,39 @@ lbm_value lbm_fundamental(lbm_value* args, lbm_uint nargs, lbm_value op) {
return lbm_enc_sym(SYM_TERROR);
}
break;
- default:
-// printf("fundamental unknown\n");
- result = lbm_enc_sym(SYM_EERROR);
- 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:
+ result = lbm_enc_sym(SYM_EERROR);
+ break;
}
return result;
diff --git a/lispBM/lispBM/src/heap.c b/lispBM/lispBM/src/heap.c
index 8711be38..363d7e38 100644
--- a/lispBM/lispBM/src/heap.c
+++ b/lispBM/lispBM/src/heap.c
@@ -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;
}
diff --git a/lispBM/lispBM/src/lbm_c_interop.c b/lispBM/lispBM/src/lbm_c_interop.c
index 18af0ddd..e8f0371a 100644
--- a/lispBM/lispBM/src/lbm_c_interop.c
+++ b/lispBM/lispBM/src/lbm_c_interop.c
@@ -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;
+}
diff --git a/lispBM/lispBM/src/lispbm.c b/lispBM/lispBM/src/lispbm.c
index 6e3a2445..778aeb83 100644
--- a/lispBM/lispBM/src/lispbm.c
+++ b/lispBM/lispBM/src/lispbm.c
@@ -18,9 +18,13 @@
#include "lispbm.h"
int lbm_init(lbm_cons_t *heap_storage, uint32_t heap_size,
- uint32_t *memory, uint32_t memory_size,
- uint32_t *memory_bitmap, uint32_t bitmap_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 *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)
diff --git a/lispBM/lispBM/src/print.c b/lispBM/lispBM/src/print.c
index 41b54d85..e17094b5 100644
--- a/lispBM/lispBM/src/print.c
+++ b/lispBM/lispBM/src/print.c
@@ -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,10 +264,38 @@ int lbm_print_value(char *buf,unsigned int len, lbm_value t) {
}
offset += n;
break;
- break;
default:
- snprintf(buf, len, "Error: Array type not supported\n");
- return -1;
+ 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:
+ 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;
}
@@ -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;
}
diff --git a/lispBM/lispBM/src/symrepr.c b/lispBM/lispBM/src/symrepr.c
index 77d7d8fe..68a79e62 100644
--- a/lispBM/lispBM/src/symrepr.c
+++ b/lispBM/lispBM/src/symrepr.c
@@ -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},
diff --git a/lispBM/lispBM/src/tokpar.c b/lispBM/lispBM/src/tokpar.c
index 9ac63694..962bd90c 100644
--- a/lispBM/lispBM/src/tokpar.c
+++ b/lispBM/lispBM/src/tokpar.c
@@ -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);
diff --git a/lispBM/lispBM/tests/test_heap_alloc.c b/lispBM/lispBM/tests/test_heap_alloc.c
index a190cb08..8860377f 100644
--- a/lispBM/lispBM/tests/test_heap_alloc.c
+++ b/lispBM/lispBM/tests/test_heap_alloc.c
@@ -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;
diff --git a/lispBM/lispBM/tests/test_lisp_code_cps.c b/lispBM/lispBM/tests/test_lisp_code_cps.c
index a7a21a88..7ff18595 100644
--- a/lispBM/lispBM/tests/test_lisp_code_cps.c
+++ b/lispBM/lispBM/tests/test_lisp_code_cps.c
@@ -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 {
diff --git a/lispBM/lispBM/tests/test_read_2.lisp b/lispBM/lispBM/tests/test_read_2.lisp
index f8677700..d747a3af 100644
--- a/lispBM/lispBM/tests/test_read_2.lisp
+++ b/lispBM/lispBM/tests/test_read_2.lisp
@@ -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)
\ No newline at end of file
+(define prg "(define a 10) (define r (+ a 10))")
+
+(eval-program (read-program prg))
+
+(= r 20)
diff --git a/lispBM/lispBM/zephyr-examples/repl-zephyr/src/main.c b/lispBM/lispBM/zephyr-examples/repl-zephyr/src/main.c
index bc7489d7..5eb0cc81 100644
--- a/lispBM/lispBM/zephyr-examples/repl-zephyr/src/main.c
+++ b/lispBM/lispBM/zephyr-examples/repl-zephyr/src/main.c
@@ -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,
- memory, LBM_MEMORY_SIZE_8K,
- bitmap, LBM_MEMORY_BITMAP_SIZE_8K);
+ gc_stack_storage, GC_STACK_SIZE,
+ memory, LBM_MEMORY_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;
}
+
+ 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);
}
}
-
- symrepr_del();
}
diff --git a/lispBM/lispif.c b/lispBM/lispif.c
index 0e0a7598..41ef4bf5 100644
--- a/lispBM/lispif.c
+++ b/lispBM/lispif.c
@@ -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) {
diff --git a/lispBM/lispif_vesc_extensions.c b/lispBM/lispif_vesc_extensions.c
index 99113d07..2f4c4062 100644
--- a/lispBM/lispif_vesc_extensions.c
+++ b/lispBM/lispif_vesc_extensions.c
@@ -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);
}
}
diff --git a/mc_interface.c b/mc_interface.c
index 946e5f3d..1b7c0282 100644
--- a/mc_interface.c
+++ b/mc_interface.c
@@ -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;
diff --git a/mc_interface.h b/mc_interface.h
index 603dc727..0f7d3cc8 100644
--- a/mc_interface.h
+++ b/mc_interface.h
@@ -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);