diff --git a/lispBM/lispBM/benchmarks/bench_chibi/Makefile b/lispBM/lispBM/benchmarks/bench_chibi/Makefile
index f2e2e8b4..30221ccc 100644
--- a/lispBM/lispBM/benchmarks/bench_chibi/Makefile
+++ b/lispBM/lispBM/benchmarks/bench_chibi/Makefile
@@ -134,7 +134,6 @@ LBMSRC = ../../src/env.c \
../../src/tokpar.c \
../../src/lispbm.c \
../../src/lbm_c_interop.c \
- ../../src/lbm_variables.c \
../../src/lbm_custom_type.c \
../../src/lbm_channel.c \
../../src/lbm_flags.c \
diff --git a/lispBM/lispBM/benchmarks/bench_chibi/main.c b/lispBM/lispBM/benchmarks/bench_chibi/main.c
index 738bba54..be30cd3a 100644
--- a/lispBM/lispBM/benchmarks/bench_chibi/main.c
+++ b/lispBM/lispBM/benchmarks/bench_chibi/main.c
@@ -39,13 +39,11 @@
#define EVAL_CPS_STACK_SIZE 256
#define GC_STACK_SIZE 256
#define PRINT_STACK_SIZE 256
-#define HEAP_SIZE 2048
-#define VARIABLE_STORAGE_SIZE 256
+#define HEAP_SIZE 4096
#define EXTENSION_STORAGE_SIZE 256
+extension_fptr extensions[EXTENSION_STORAGE_SIZE];
uint32_t print_stack_storage[PRINT_STACK_SIZE];
-lbm_value variable_storage[VARIABLE_STORAGE_SIZE];
-extension_fptr extension_storage[EXTENSION_STORAGE_SIZE];
static lbm_cons_t heap[HEAP_SIZE] __attribute__ ((aligned (8)));
@@ -153,7 +151,8 @@ lbm_value ext_print(lbm_value *args, lbm_uint argn) {
static char str[1024];
static char outbuf[1024];
-static char file_buffer[2048];
+#define FILE_LEN 8192
+static char file_buffer[FILE_LEN];
void print_ctx_info(eval_context_t *ctx, void *arg1, void *arg2) {
(void)arg2;
@@ -198,11 +197,12 @@ int main(void) {
chThdSleepMilliseconds(2000);
if (!lbm_init(heap, HEAP_SIZE,
- GC_STACK_SIZE,
memory_array, LBM_MEMORY_SIZE_8K,
bitmap_array, LBM_MEMORY_BITMAP_SIZE_8K,
- print_stack_storage, PRINT_STACK_SIZE,
- extension_storage, EXTENSION_STORAGE_SIZE)) {
+ GC_STACK_SIZE,
+ PRINT_STACK_SIZE,
+ extensions,
+ EXTENSION_STORAGE_SIZE)) {
chprintf(chp,"LispBM Init failed.\r\n");
return 0;
@@ -212,8 +212,6 @@ int main(void) {
lbm_set_timestamp_us_callback(timestamp_callback);
lbm_set_usleep_callback(sleep_callback);
- lbm_variables_init(variable_storage, VARIABLE_STORAGE_SIZE);
-
res = lbm_add_extension("print", ext_print);
if (res)
chprintf(chp,"Extension added.\r\n");
@@ -252,13 +250,16 @@ int main(void) {
chprintf(chp,"------------------------------------------------------------\r\n");
memset(outbuf,0, 1024);
} else if (strncmp(str, ":env", 4) == 0) {
- lbm_value curr = *lbm_get_env_ptr();
- chprintf(chp,"Environment:\r\n");
- while (lbm_type_of(curr) == LBM_TYPE_CONS) {
- res = lbm_print_value(outbuf,1024, lbm_car(curr));
- curr = lbm_cdr(curr);
+ lbm_value *glob_env = lbm_get_global_env();
+ for (int i = 0; i < GLOBAL_ENV_ROOTS; i ++) {
+ lbm_value curr = glob_env[i];
+ chprintf(chp,"Global Environment [%d]:\r\n", i);
+ while (lbm_type_of(curr) == LBM_TYPE_CONS) {
+ res = lbm_print_value(outbuf,1024, lbm_car(curr));
+ curr = lbm_cdr(curr);
- chprintf(chp," %s \r\n", outbuf);
+ chprintf(chp," %s \r\n", outbuf);
+ }
}
} else if (strncmp(str, ":threads", 8) == 0) {
thread_t *tp;
@@ -300,13 +301,12 @@ int main(void) {
}
lbm_init(heap, HEAP_SIZE,
- GC_STACK_SIZE,
memory_array, LBM_MEMORY_SIZE_8K,
bitmap_array, LBM_MEMORY_BITMAP_SIZE_8K,
- print_stack_storage, PRINT_STACK_SIZE,
- extension_storage, EXTENSION_STORAGE_SIZE);
-
- lbm_variables_init(variable_storage, VARIABLE_STORAGE_SIZE);
+ GC_STACK_SIZE,
+ PRINT_STACK_SIZE,
+ extensions,
+ EXTENSION_STORAGE_SIZE);
lbm_add_extension("print", ext_print);
@@ -314,11 +314,11 @@ int main(void) {
break;
} else if (strncmp(str, ":read", 5) == 0) {
- memset(file_buffer, 0, 2048);
+ memset(file_buffer, 0, FILE_LEN);
bool done = false;
int c;
- for (int i = 0; i < 2048; i ++) {
+ for (int i = 0; i < FILE_LEN; i ++) {
c = streamGet(chp);
if (c == 4 || c == 26 || c == STM_RESET) {
diff --git a/lispBM/lispBM/benchmarks/insertionsort.lisp b/lispBM/lispBM/benchmarks/insertionsort.lisp
index 6f848872..dff6cd39 100644
--- a/lispBM/lispBM/benchmarks/insertionsort.lisp
+++ b/lispBM/lispBM/benchmarks/insertionsort.lisp
@@ -7,10 +7,10 @@
(cons l (cons a xs))
(cons a (insert l xs)))))))
-(define sort (lambda (ls)
+(define isort (lambda (ls)
(match ls
(nil nil)
( ((? a) . (? xs))
- (insert a (sort xs))))))
+ (insert a (isort xs))))))
-(sort '(4 2 0 9 1 56 2 4 7))
+(isort '(4 2 0 9 1 56 2 4 7))
diff --git a/lispBM/lispBM/benchmarks/plot_bench.py b/lispBM/lispBM/benchmarks/plot_bench.py
index cd131eee..221de4b7 100644
--- a/lispBM/lispBM/benchmarks/plot_bench.py
+++ b/lispBM/lispBM/benchmarks/plot_bench.py
@@ -1,19 +1,22 @@
from glob import glob
import pandas as pd
import matplotlib.pyplot as plt
+import numpy as np
bench_files = glob('stored_results/*')
headers = ('File','Eval time (s)')
benches = ['q2.lisp', 'fibonacci_tail.lisp', 'dec_cnt3.lisp',
'dec_cnt1.lisp', 'fibonacci.lisp', 'tak.lisp',
- 'dec_cnt2.lisp', 'insertionsort.lisp', 'tail_call_200k.lisp', 'loop_200k.lisp' ]
+ 'dec_cnt2.lisp', 'insertionsort.lisp', 'tail_call_200k.lisp',
+ 'loop_200k.lisp', 'sort500.lisp', 'env_lookup.lisp' ]
data = []
plt.figure(figsize=(10.0, 5.0)) # in inches!
-
-for bench in benches:
+cmap = plt.get_cmap('jet')
+colors = cmap(np.linspace(0, 1.0, len(benches)))
+for bench, color in zip(benches,colors):
dict = {}
for file in bench_files:
file_info = file.split('benchresult')[1]
@@ -25,12 +28,12 @@ for bench in benches:
if (bench in df.index):
row = df.loc[bench]
dict.update({date : row[1]});
- else:
- print("missing data point ", bench, file )
+ # else:
+ # print("missing data point ", bench, file )
lists = sorted(dict.items()) # sorted by key, return a list of tuples
x, y = zip(*lists) # unpack a list of pairs into two tuples
- plt.plot(x, y, label=bench)
+ plt.plot(x, y, label=bench, color=color)
lgd = plt.legend(loc='center left', bbox_to_anchor=(1, 0.5))
@@ -39,6 +42,7 @@ for tick in ax.get_xticklabels():
tick.set_rotation(90)
ax.tick_params(axis='both', which='major', labelsize=6)
ax.tick_params(axis='both', which='minor', labelsize=4)
+ax.set_facecolor("lightgray");
plt.ylabel("Sec")
plt.grid()
plt.savefig('benchresults.png', dpi=600, bbox_extra_artists=(lgd,), bbox_inches='tight')
diff --git a/lispBM/lispBM/benchmarks/sort500.lisp b/lispBM/lispBM/benchmarks/sort500.lisp
new file mode 100644
index 00000000..57db904a
--- /dev/null
+++ b/lispBM/lispBM/benchmarks/sort500.lisp
@@ -0,0 +1,13 @@
+(def random-list '(19 56 73 42 8 91 3 67 27 10 55 94 38 62 5 80 49 12 74 23 31 98 17 69 45 2 86 29 61 78 14 52 99 36 70 25 83 7 44 58 20 96 34 68 9 50 76 15 64 1 82 39 85 18 54 97 33 71 26 59 6 93 40 72 13 81 47 4 66 22 87 28 63 79 11 53 90 37 75 24 32 89 16 60 77 21 95 35 65 0 51 88 30 58 48 9 13 26 47 82 19 56 73 42 8 91 3 67 27 10 55 94 38 62 5 80 49 12 74 23 31 98 17 69 45 2 86 29 61 78 14 52 99 36 70 25 83 7 44 58 20 96 34 68 9 50 76 15 64 1 82 39 85 18 54 97 33 71 26 59 6 93 40 72 13 81 47 4 66 22 87 28 63 79 11 53 90 37 75 24 32 89 16 60 77 21 95 35 65 0 51 88 30 58 48 9 13 26 47 82 19 56 73 42 8 91 3 67 27 10 55 94 38 62 5 80 49 12 74 23 31 98 17 69 45 2 86 29 61 78 14 52 99 36 70 25 83 7 44 58 20 96 34 68 9 50 76 15 64 1 82 39 85 18 54 97 33 71 26 59 6 93 40 72 13 81 47 4 66 22 87 28 63 79 11 53 90 37 75 24 32 89 16 60 77 21 95 35 65 0 51 88 30 58 48 9 13 26 47 82 19 56 73 42 8 91 3 67 27 10 55 94 38 62 5 80 49 12 74 23 31 98 17 69 45 2 86 29 61 78 14 52 99 36 70 25 83 7 44 58 20 96 34 68 9 50 76 15 64 1 82 39 85 18 54 97 33 71 26 59 6 93 40 72 13 81 47 4 66 22 87 28 63 79 11 53 90 37 75 24 32 89 16 60 77 21 95 35 65 0 51 88 30 58 48 9 13 26 47 82 19 56 73 42 8 91 3 67 27 10 55 94 38 62 5 80 49 12 74 23 31 98 17 69 45 2 86 29 61 78 14 52 99 36 70 25 83 7 44 58 20 96 34 68 9 50 76 15 64 1 82 39 85 18 54 97 33 71 26 59 6 93 40 72 13 81 47 4 66 22 87 28 63 79 11 53 90 37 75 24 32 89 16 60 77 21 95 35 65 0 51 88 30 58 48 9 13 26 47 82 19 56 73 42 8 91 3 67 27 10 55 94 38 62 5 80 49 12 74 23 31 98 17 69 45 2 86 29 61 78 14 52 99 36 70 25 83 7 44 58 20 96 34 68 9 50 76 15 64 1 82 39 85 18 54 97 33 71 26 59 6 93 40 72 13 81 47 4 66 22 87 28 63 79 11 53 90 37 75 24 32 89 16 60 77 21 95 35 65 0 51 88 30 58 48 9 13 26 47 82 19 56 73 42 8 91 3 67 27 10 55 94 38 62 5 80 49 12 74 23 31 98 17 69 45 2 86 29 61 78 14 52 99 36 70 25 83 7 44 58 20 96 34 68 9 50 76 15 64 1 82 39 85 18 54 97 33 71 26 59 6 93 40 72 13 81 47 4 66 22 87 28 63 79 11 53 90 37 75 24 32 89 16 60 77 21 95 35 65 0 51 88 30 58 48 9 13 26 47 82 19 56 73 42 8 91 3 67 27 10 55 94 38 62 5 80 49 12 74 23 31 98 17 69 45 2 86 29 61 78 14 52 99 36 70 25 83 7 44 58 20 96 34 68 9 50 76 15 64 1 82 39 85 18 54 97 33 71 26 59 6 93 40 72 13 81 47 4 66 22 87 28 63 79 11 53 90 37 75 24 32 89 16 60 77 21 95 35 65 0 51 88 30 58 48 9 13 26 47 82 19 56 73 42 8 91 3 67 27 10 55 94 38 62 5 80 49 12 74 23 31 98 17 69 45 2 86 29 61 78 14 52 99 36 70 25 83 7 44 58 20 96 34 68 9 50 76 15 64 1 82 39 85 18 54 97 33 71 26 59 6 93 40 72 13 81 47 4 66 22 87 28 63 79 11 53 90 37 75 24 32 89 16 60 77 21 95 35 65 0 51 88 30 58 48 9 13 26 47 82 19 56 73 42 8 91 3 67 27 10 55 94 38 62 5 80 49 12 74 23 31 98 17 69 45 2 86 29 61 78 14 52 99 36 70 25 83 7 44 58 20 96 34 68 9 50 76 15 64 1 82 39 85 18 54 97 33 71 26 59 6 93 40 72 13 81 47 4 66 22 87 28 63 79 11 53 90 37 75 24 32 89 16 60 77 21 95 35 65 0 51 88 30 58 48 9 13 26 47 82 ))
+
+
+(sort < random-list)
+(sort < random-list)
+(sort < random-list)
+(sort < random-list)
+(sort < random-list)
+(sort < random-list)
+(sort < random-list)
+(sort < random-list)
+(sort < random-list)
+(sort < random-list)
diff --git a/lispBM/lispBM/examples/evaluator.c b/lispBM/lispBM/examples/evaluator.c
index f9eea097..741d6909 100644
--- a/lispBM/lispBM/examples/evaluator.c
+++ b/lispBM/lispBM/examples/evaluator.c
@@ -30,14 +30,10 @@
#define GC_STACK_SIZE 256
#define PRINT_STACK_SIZE 256
#define EXTENSION_STORAGE_SIZE 256
-#define VARIABLE_STORAGE_SIZE 256
#define WAIT_TIMEOUT 2500
-uint32_t print_stack_storage[PRINT_STACK_SIZE];
extension_fptr extension_storage[EXTENSION_STORAGE_SIZE];
-lbm_value variable_storage[VARIABLE_STORAGE_SIZE];
-
/* Tokenizer state for strings */
static lbm_string_channel_state_t string_tok_state;
@@ -221,10 +217,10 @@ int main(int argc, char **argv) {
}
lbm_init(heap_storage, heap_size,
- GC_STACK_SIZE,
memory, LBM_MEMORY_SIZE_16K,
bitmap, LBM_MEMORY_BITMAP_SIZE_16K,
- print_stack_storage, PRINT_STACK_SIZE,
+ GC_STACK_SIZE,
+ PRINT_STACK_SIZE,
extension_storage, EXTENSION_STORAGE_SIZE);
lbm_set_ctx_done_callback(done_callback);
diff --git a/lispBM/lispBM/experiment_repl/nfibs.lisp b/lispBM/lispBM/experiment_repl/nfibs.lisp
new file mode 100644
index 00000000..3154ff34
--- /dev/null
+++ b/lispBM/lispBM/experiment_repl/nfibs.lisp
@@ -0,0 +1,27 @@
+
+
+
+(define fib (lambda (n)
+ (if (< n 2) 1
+ (+ (fib (- n 2)) (fib (- n 1)) 1))))
+
+
+
+
+
+
+(def num (fib 20))
+
+(def start (time))
+
+(loop (( a 0 )) (< a 1000)
+ {
+ (fib 20)
+ (setq a (+ a 1))
+ }
+ )
+
+(def end (time))
+
+(print (/ ( * 1000 num) (/ (- end start) 1000000.0)) " fibs / seconds")
+
diff --git a/lispBM/lispBM/experiment_repl/repl.c b/lispBM/lispBM/experiment_repl/repl.c
index d43f6ec2..ed6b5b07 100644
--- a/lispBM/lispBM/experiment_repl/repl.c
+++ b/lispBM/lispBM/experiment_repl/repl.c
@@ -1,5 +1,5 @@
/*
- Copyright 2018, 2021, 2022 Joel Svensson svenssonjoel@yahoo.se
+ Copyright 2018, 2021, 2022, 2024 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
@@ -41,15 +41,12 @@
#define GC_STACK_SIZE 256
#define PRINT_STACK_SIZE 256
#define EXTENSION_STORAGE_SIZE 256
-#define VARIABLE_STORAGE_SIZE 256
#define WAIT_TIMEOUT 2500
#define STR_SIZE 1024
#define CONSTANT_MEMORY_SIZE 32*1024
#define PROF_DATA_NUM 100
-lbm_uint print_stack_storage[PRINT_STACK_SIZE];
-extension_fptr extension_storage[EXTENSION_STORAGE_SIZE];
-lbm_value variable_storage[VARIABLE_STORAGE_SIZE];
+extension_fptr extensions[EXTENSION_STORAGE_SIZE];
lbm_uint constants_memory[CONSTANT_MEMORY_SIZE];
lbm_prof_t prof_data[100];
@@ -304,7 +301,7 @@ bool dyn_load(const char *str, const char **code) {
*code = "(define looprange (macro (it start end body) (me-looprange it start end body)))";
res = true;
}
-
+
return res;
}
@@ -627,11 +624,12 @@ int main(int argc, char **argv) {
}
if (!lbm_init(heap_storage, heap_size,
- GC_STACK_SIZE,
memory, LBM_MEMORY_SIZE_1M,
bitmap, LBM_MEMORY_BITMAP_SIZE_1M,
- print_stack_storage, PRINT_STACK_SIZE,
- extension_storage, EXTENSION_STORAGE_SIZE)) {
+ GC_STACK_SIZE,
+ PRINT_STACK_SIZE,
+ extensions,
+ EXTENSION_STORAGE_SIZE)) {
printf("Failed to initialize LispBM\n");
return 0;
}
@@ -657,8 +655,6 @@ int main(int argc, char **argv) {
lbm_set_dynamic_load_callback(dyn_load);
lbm_set_printf_callback(error_print);
- lbm_variables_init(variable_storage, VARIABLE_STORAGE_SIZE);
-
if (lbm_array_extensions_init()) {
printf("Array extensions loaded\n");
} else {
@@ -724,7 +720,7 @@ int main(int argc, char **argv) {
printf("Extension added.\n");
else
printf("Error adding extension.\n");
-
+
lbm_add_symbol_const("a01", &sym_res);
lbm_add_symbol_const("a02", &sym_loop);
lbm_add_symbol_const("break", &sym_break);
@@ -815,19 +811,15 @@ int main(int argc, char **argv) {
printf("Total:\t%u samples\n", tot_samples);
free(str);
} else if (strncmp(str, ":env", 4) == 0) {
- lbm_value curr = *lbm_get_env_ptr();
- printf("Environment:\r\n");
- while (lbm_type_of(curr) == LBM_TYPE_CONS) {
- res = lbm_print_value(output,1024, lbm_car(curr));
- curr = lbm_cdr(curr);
- printf(" %s\r\n",output);
- }
- printf("Variables:\r\n");
- for (int i = 0; i < lbm_get_num_variables(); i ++) {
-
- const char *name = lbm_get_variable_name_by_index(i);
- lbm_print_value(output,1024, lbm_get_variable_by_index(i));
- printf(" %s = %s\r\n", name ? name : "error", output);
+ for (int i = 0; i < GLOBAL_ENV_ROOTS; i ++) {
+ lbm_value *env = lbm_get_global_env();
+ lbm_value curr = env[i];
+ printf("Environment [%d]:\r\n", i);
+ while (lbm_type_of(curr) == LBM_TYPE_CONS) {
+ res = lbm_print_value(output,1024, lbm_car(curr));
+ curr = lbm_cdr(curr);
+ printf(" %s\r\n",output);
+ }
}
free(str);
}else if (n >= 5 && strncmp(str, ":load", 5) == 0) {
@@ -892,11 +884,12 @@ int main(int argc, char **argv) {
}
lbm_init(heap_storage, heap_size,
- GC_STACK_SIZE,
memory, LBM_MEMORY_SIZE_1M,
bitmap, LBM_MEMORY_BITMAP_SIZE_1M,
- print_stack_storage, PRINT_STACK_SIZE,
- extension_storage, EXTENSION_STORAGE_SIZE);
+ GC_STACK_SIZE,
+ PRINT_STACK_SIZE,
+ extensions,
+ EXTENSION_STORAGE_SIZE);
if (!lbm_const_heap_init(const_heap_write,
&const_heap,constants_memory,
@@ -906,8 +899,6 @@ int main(int argc, char **argv) {
printf("Constants memory initialized\n");
}
- lbm_variables_init(variable_storage, VARIABLE_STORAGE_SIZE);
-
if (lbm_array_extensions_init()) {
printf("Array extensions loaded\n");
} else {
@@ -942,11 +933,12 @@ int main(int argc, char **argv) {
}
lbm_init(heap_storage, heap_size,
- GC_STACK_SIZE,
memory, LBM_MEMORY_SIZE_1M,
bitmap, LBM_MEMORY_BITMAP_SIZE_1M,
- print_stack_storage, PRINT_STACK_SIZE,
- extension_storage, EXTENSION_STORAGE_SIZE);
+ GC_STACK_SIZE,
+ PRINT_STACK_SIZE,
+ extensions,
+ EXTENSION_STORAGE_SIZE);
if (!lbm_const_heap_init(const_heap_write,
&const_heap,constants_memory,
@@ -956,8 +948,6 @@ int main(int argc, char **argv) {
printf("Constants memory initialized\n");
}
- lbm_variables_init(variable_storage, VARIABLE_STORAGE_SIZE);
-
if (lbm_array_extensions_init()) {
printf("Array extensions loaded\n");
} else {
diff --git a/lispBM/lispBM/include/env.h b/lispBM/lispBM/include/env.h
index 3fceee89..ae442d89 100644
--- a/lispBM/lispBM/include/env.h
+++ b/lispBM/lispBM/include/env.h
@@ -25,22 +25,20 @@
extern "C" {
#endif
+#define GLOBAL_ENV_ROOTS 32
+#define GLOBAL_ENV_MASK 0x1F
+
//environment interface
/** Initialize the global environment. This sets the global environment to NIL
*
* \return 1
*/
int lbm_init_env(void);
-/**
- * Get a pointer to the global environment.
- * \return A pointer to the global environment variable.
- */
-lbm_value *lbm_get_env_ptr(void);
/**
*
* \return the global environment
*/
-lbm_value lbm_get_env(void);
+lbm_value *lbm_get_global_env(void);
/** Copy the spine of an environment. The list structure is
* recreated but the values themselves are not copied but rather
* just referenced.
@@ -49,13 +47,20 @@ lbm_value lbm_get_env(void);
* \return Copy of environment.
*/
lbm_value lbm_env_copy_spine(lbm_value env);
-/** Lookup a value in from the global environment.
- *
+/** Lookup a value in an environment.
+ * \param res Result stored here
* \param sym The key to look for in the environment
* \param env The environment to search for the key.
- * \return The value bound to key or lbm_enc_sym(SYM_NOT_FOUND).
+ * \return True on success or false otherwise.
*/
bool lbm_env_lookup_b(lbm_value *res, lbm_value sym, lbm_value env);
+/** Lookup a value in the global environment.
+ * \param res Result stored here
+ * \param sym The key to look for in the environment
+ * \param env The environment to search for the key.
+ * \return True on success or false otherwise.
+ */
+bool lbm_global_env_lookup(lbm_value *res, lbm_value sym);
/** Lookup a value in from the global environment.
*
* \param sym The key to look for in the environment
diff --git a/lispBM/lispBM/include/extensions.h b/lispBM/lispBM/include/extensions.h
index 9267f88d..e77c6b54 100644
--- a/lispBM/lispBM/include/extensions.h
+++ b/lispBM/lispBM/include/extensions.h
@@ -1,6 +1,6 @@
/** \file extensions.h */
/*
- Copyright 2019, 2022 Joel Svensson svenssonjoel@yahoo.se
+ Copyright 2019, 2022, 2024 Joel Svensson svenssonjoel@yahoo.se
2022 Benjamin Vedder
This program is free software: you can redistribute it and/or modify
@@ -39,13 +39,12 @@ extern "C" {
*/
typedef lbm_value (*extension_fptr)(lbm_value*,lbm_uint);
-/** Initialize the extensions subsystem.
+/** Initialize the extensions subsystem. Extension storage is allocated on lbm_memory.
*
- * \param extension_storage Pointer to array of extension_fptr.
* \param extension_storage_size Size of function pointer array.
* \return 1 on success and 0 for failure
*/
-int lbm_extensions_init(extension_fptr *extension_storage, int extension_storage_size);
+ int lbm_extensions_init(extension_fptr *extension_storage, lbm_uint extension_storage_size);
/** The number of extensions that can be allocated.
* \return The maximum number of extensions that can be added.
*/
diff --git a/lispBM/lispBM/include/lbm_c_interop.h b/lispBM/lispBM/include/lbm_c_interop.h
index e004f1a8..3329a559 100644
--- a/lispBM/lispBM/include/lbm_c_interop.h
+++ b/lispBM/lispBM/include/lbm_c_interop.h
@@ -26,7 +26,6 @@
#include "heap.h"
#include "tokpar.h"
#include "lbm_memory.h"
-#include "lbm_variables.h"
#include "heap.h"
#include "lbm_types.h"
#include "lbm_channel.h"
diff --git a/lispBM/lispBM/include/lbm_defines.h b/lispBM/lispBM/include/lbm_defines.h
index 55ba720e..46cd5526 100644
--- a/lispBM/lispBM/include/lbm_defines.h
+++ b/lispBM/lispBM/include/lbm_defines.h
@@ -83,6 +83,7 @@
#define LBM_VAL_MASK (lbm_uint)0xFFFFFFFFFFFFFF00
#define LBM_VAL_TYPE_MASK (lbm_uint)0xFC
#define LBM_TYPE_MASK (lbm_uint)0xF8000000000000FC
+#define LBM_NUMBER_MASK (lbm_uint)0x0800000000000000
// gc ptr
#define LBM_TYPE_SYMBOL (lbm_uint)0x0 // 00 00 00 0 0
#define LBM_TYPE_CHAR (lbm_uint)0x4 // 00 00 01 0 0
diff --git a/lispBM/lispBM/include/lbm_flat_value.h b/lispBM/lispBM/include/lbm_flat_value.h
index 1544cd01..25e5fe67 100644
--- a/lispBM/lispBM/include/lbm_flat_value.h
+++ b/lispBM/lispBM/include/lbm_flat_value.h
@@ -57,8 +57,8 @@ typedef struct {
bool lbm_start_flatten(lbm_flat_value_t *v, size_t buffer_size);
bool lbm_finish_flatten(lbm_flat_value_t *v);
bool f_cons(lbm_flat_value_t *v);
-bool f_sym(lbm_flat_value_t *v, lbm_uint sym);
-bool f_sym_string(lbm_flat_value_t *v, lbm_uint sym);
+bool f_sym(lbm_flat_value_t *v, lbm_value sym);
+bool f_sym_string(lbm_flat_value_t *v, lbm_value sym);
bool f_i(lbm_flat_value_t *v, lbm_int i);
bool f_u(lbm_flat_value_t *v, lbm_uint u);
bool f_b(lbm_flat_value_t *v, uint8_t b);
diff --git a/lispBM/lispBM/include/lbm_types.h b/lispBM/lispBM/include/lbm_types.h
index 09f95be3..b8310fea 100644
--- a/lispBM/lispBM/include/lbm_types.h
+++ b/lispBM/lispBM/include/lbm_types.h
@@ -26,7 +26,7 @@
#ifdef __cplusplus
extern "C" {
#endif
-
+
/* Addresses that are put into lbm_values or into
* lbm_memory must have this alignment. */
#ifndef LBM64
@@ -47,6 +47,7 @@ typedef uint32_t lbm_type;
typedef uint32_t lbm_uint;
typedef int32_t lbm_int;
typedef float lbm_float;
+typedef double lbm_double;
#define PRI_VALUE PRIu32
#define PRI_TYPE PRIu32
@@ -67,7 +68,9 @@ typedef uint64_t lbm_type;
typedef uint64_t lbm_uint;
typedef int64_t lbm_int;
-typedef double lbm_float;
+
+typedef float lbm_float;
+typedef double lbm_double;
#define PRI_VALUE PRIu64
#define PRI_TYPE PRIu64
diff --git a/lispBM/lispBM/include/lbm_variables.h b/lispBM/lispBM/include/lbm_variables.h
deleted file mode 100644
index 0de942a8..00000000
--- a/lispBM/lispBM/include/lbm_variables.h
+++ /dev/null
@@ -1,75 +0,0 @@
-/** \file lbm_variables.h */
-/*
- Copyright 2022 Joel Svensson svenssonjoel@yahoo.se
- Copyright 2022 Benjamin Vedder
-
- 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 .
-*/
-
-#ifndef LBM_VARIABLES_H_
-#define LBM_VARIABLES_H_
-
-#include "lbm_types.h"
-
-#ifdef __cplusplus
-extern "C" {
-#endif
-
-/** Initialize the variable storage area
- *
- * \param variable_storage Pointer to array where variables are stored.
- * \param variable_storage_size Number of variables that can be stored in the array.
- * \return 1 on success and 0 on failure.
- */
-int lbm_variables_init(lbm_value *variable_storage, int variable_storage_size);
-/** Get a pointer to the variable storage area.
- *
- * \return Pointer to storage area or NULL on failure.
- */
-lbm_value *lbm_get_variable_table(void);
-/** Get the value of a variable index.
- *
- * \param i Index of variable to access.
- * \return Value of variable at index.
- */
-lbm_value lbm_get_variable_by_index(int i);
-/** Lookup what the name of the variable associated with a specific
- * index in the variable storage is.
- *
- * \param index Index of variable of interes.
- * \return Pointer to a string on success or null if no variable is associated with that index.
- */
-const char *lbm_get_variable_name_by_index(int index);
-
-
-/* internal use by evaluator (mostly)*/
-
-/** Get value of variable at index.
- *
- * \param index variable index to access.
- * \return Value of variable at index. This value if NIL if there is no binding.
- */
-lbm_value lbm_get_var(lbm_uint index);
-/** Set value of a variable
- *
- * \param index Index of variable to set.
- * \paran value Value to set the variable to.
- * \return Value of variable or NIL if index is out of range.
- */
-lbm_value lbm_set_var(lbm_uint index, lbm_value value);
-
-#ifdef __cplusplus
-}
-#endif
-#endif
diff --git a/lispBM/lispBM/include/lbm_version.h b/lispBM/lispBM/include/lbm_version.h
index bfe5735b..ac73fce4 100644
--- a/lispBM/lispBM/include/lbm_version.h
+++ b/lispBM/lispBM/include/lbm_version.h
@@ -27,13 +27,20 @@ extern "C" {
/** LBM major version */
#define LBM_MAJOR_VERSION 0
/** LBM minor version */
-#define LBM_MINOR_VERSION 21
+#define LBM_MINOR_VERSION 22
/** LBM patch revision */
#define LBM_PATCH_VERSION 0
-#define LBM_VERSION_STRING "0.21.0"
+#define LBM_VERSION_STRING "0.22.0"
/*! \page changelog Changelog
+DEC 26 2024: Version 0.22.0
+ - Built-in sort operation on lists.
+ - Built-in list-merge operation.
+ - Bugfix in map.
+ - Literal forms for special characters.
+
+
NOV 28 2024: Version 0.21.0
- Removed partial evaluation.
- Added a built-in loop.
diff --git a/lispBM/lispBM/include/lispbm.h b/lispBM/lispBM/include/lispbm.h
index 572a27be..f5feb186 100644
--- a/lispBM/lispBM/include/lispbm.h
+++ b/lispBM/lispBM/include/lispbm.h
@@ -1,5 +1,5 @@
/*
- Copyright 2022 Joel Svensson svenssonjoel@yahoo.se
+ Copyright 2022, 2024 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
@@ -30,7 +30,6 @@
#include "lbm_memory.h"
#include "lbm_types.h"
#include "lbm_c_interop.h"
-#include "lbm_variables.h"
#include "lbm_custom_type.h"
#include "lbm_channel.h"
@@ -53,18 +52,20 @@ extern "C" {
* \param memory_size Size of the memory array.
* \param memory_bitmap Pointer to lbm_uint 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 lbm_uint array to use as print_value stack.
+ * \param gc_stack_size Size in number of lbm_uint values to use for the GC stack.
* \param print_stack_size Size in number of lbm_uint values of the print stack.
- * \param extension_storage Pointer to array of extension_fptr.
+ * \param extension_storage Array of extension function pointers.
* \param extension_storage_size Size of extension array.
* \return 1 on success and 0 on failure.
*/
+
int lbm_init(lbm_cons_t *heap_storage, lbm_uint heap_size,
- lbm_uint gc_stack_size,
- lbm_uint *memory, lbm_uint memory_size,
- lbm_uint *memory_bitmap, lbm_uint bitmap_size,
- lbm_uint *print_stack_storage, lbm_uint print_stack_size,
- extension_fptr *extension_storage, int extension_storage_size );
+ lbm_uint *memory, lbm_uint memory_size,
+ lbm_uint *memory_bitmap, lbm_uint bitmap_size,
+ lbm_uint gc_stack_size,
+ lbm_uint print_stack_size,
+ extension_fptr *extension_storage,
+ lbm_uint extension_storage_size);
#ifdef __cplusplus
}
diff --git a/lispBM/lispBM/include/print.h b/lispBM/lispBM/include/print.h
index 5746f69b..f1ead272 100644
--- a/lispBM/lispBM/include/print.h
+++ b/lispBM/lispBM/include/print.h
@@ -1,5 +1,5 @@
/*
- Copyright 2018, 2022 Joel Svensson svenssonjoel@yahoo.se
+ Copyright 2018, 2022, 2024 Joel Svensson svenssonjoel@yahoo.se
2022 Benjamin Vedder
This program is free software: you can redistribute it and/or modify
@@ -37,11 +37,10 @@ bool lbm_value_is_printable_string(lbm_value v, char **str);
/** 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.
*/
-int lbm_print_init(lbm_uint *print_stack_storage, lbm_uint print_stack_size);
+int lbm_print_init(lbm_uint 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/qq_expand.h b/lispBM/lispBM/include/qq_expand.h
deleted file mode 100644
index 5d5957d8..00000000
--- a/lispBM/lispBM/include/qq_expand.h
+++ /dev/null
@@ -1,37 +0,0 @@
-/*
- Copyright 2020 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 qq_expand.h */
-
-#ifndef _QQ_EXPAND_H
-#define _QQ_EXPAND_H
-
-#ifdef __cplusplus
-extern "C" {
-#endif
-
-/** Expand a quasiquoted expression using a C:ified
- * version of the algorithm presented in Alan Bawden's "Quasiquotation in lisp"
- *
- * \param Quasiquoted value
- * \return value where quasiquotations have been removed and expanded.
- */
-lbm_value lbm_qq_expand(lbm_value);
-
-#ifdef __cplusplus
-}
-#endif
-#endif
diff --git a/lispBM/lispBM/include/symrepr.h b/lispBM/lispBM/include/symrepr.h
index c37eea0b..49fd4b8b 100644
--- a/lispBM/lispBM/include/symrepr.h
+++ b/lispBM/lispBM/include/symrepr.h
@@ -123,7 +123,7 @@ int lbm_get_symbol_by_name(char *name, lbm_uint *id);
*/
const char* lbm_get_name_by_symbol(lbm_uint id);
-int lbm_get_num_variables(void);
+lbm_uint lbm_get_num_variables(void);
/**
*
diff --git a/lispBM/lispBM/lispbm.mk b/lispBM/lispBM/lispbm.mk
index 9554df0a..f731a00f 100644
--- a/lispBM/lispBM/lispbm.mk
+++ b/lispBM/lispBM/lispbm.mk
@@ -12,7 +12,6 @@ LISPBM_SRC = $(LISPBM)/src/env.c \
$(LISPBM)/src/lispbm.c \
$(LISPBM)/src/eval_cps.c \
$(LISPBM)/src/lbm_c_interop.c \
- $(LISPBM)/src/lbm_variables.c \
$(LISPBM)/src/lbm_custom_type.c \
$(LISPBM)/src/lbm_channel.c \
$(LISPBM)/src/lbm_flat_value.c\
diff --git a/lispBM/lispBM/src/env.c b/lispBM/lispBM/src/env.c
index 42bab3bc..7d047def 100644
--- a/lispBM/lispBM/src/env.c
+++ b/lispBM/lispBM/src/env.c
@@ -1,5 +1,5 @@
/*
- Copyright 2018, 2020, 2021 Joel Svensson svenssonjoel@yahoo.se
+ Copyright 2018, 2020, 2021, 2024 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
@@ -21,19 +21,21 @@
#include "symrepr.h"
#include "heap.h"
#include "print.h"
+#include "env.h"
+#include "lbm_memory.h"
-static lbm_value env_global;
+static lbm_value *env_global;
int lbm_init_env(void) {
- env_global = ENC_SYM_NIL;
+ env_global = (lbm_value*)lbm_malloc(GLOBAL_ENV_ROOTS * sizeof(lbm_value));
+ if (!env_global) return 0;
+ for (int i = 0; i < GLOBAL_ENV_ROOTS; i ++) {
+ env_global[i] = ENC_SYM_NIL;
+ }
return 1;
}
-lbm_value *lbm_get_env_ptr(void) {
- return &env_global;
-}
-
-lbm_value lbm_get_env(void) {
+lbm_value *lbm_get_global_env(void) {
return env_global;
}
@@ -61,10 +63,21 @@ bool lbm_env_lookup_b(lbm_value *res, lbm_value sym, lbm_value env) {
lbm_value curr = env;
- if (lbm_is_symbol_nil(sym)) {
- *res = sym;
- return true;
+ while (lbm_is_ptr(curr)) {
+ lbm_value c = lbm_ref_cell(curr)->car;
+ if ((lbm_ref_cell(c)->car) == sym) {
+ *res = lbm_ref_cell(c)->cdr;
+ return true;
+ }
+ curr = lbm_ref_cell(curr)->cdr;
}
+ return false;
+}
+
+bool lbm_global_env_lookup(lbm_value *res, lbm_value sym) {
+ lbm_uint dec_sym = lbm_dec_sym(sym);
+ lbm_uint ix = dec_sym & GLOBAL_ENV_MASK;
+ lbm_value curr = env_global[ix];
while (lbm_is_ptr(curr)) {
lbm_value c = lbm_ref_cell(curr)->car;
@@ -80,10 +93,6 @@ bool lbm_env_lookup_b(lbm_value *res, lbm_value sym, lbm_value env) {
lbm_value lbm_env_lookup(lbm_value sym, lbm_value env) {
lbm_value curr = env;
- if(lbm_dec_sym(sym) == SYM_NIL) {
- return sym;
- }
-
while (lbm_type_of(curr) == LBM_TYPE_CONS) {
if (lbm_car(lbm_car(curr)) == sym) {
return lbm_cdr(lbm_car(curr));
diff --git a/lispBM/lispBM/src/eval_cps.c b/lispBM/lispBM/src/eval_cps.c
index 1823ffe5..ec247e36 100644
--- a/lispBM/lispBM/src/eval_cps.c
+++ b/lispBM/lispBM/src/eval_cps.c
@@ -1,5 +1,5 @@
/*
- Copyright 2018, 2020, 2021, 2022, 2023 Joel Svensson svenssonjoel@yahoo.se
+ Copyright 2018, 2020 - 2024 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,8 +26,6 @@
#include "extensions.h"
#include "exp_kind.h"
#include "tokpar.h"
-#include "qq_expand.h"
-#include "lbm_variables.h"
#include "lbm_channel.h"
#include "print.h"
#include "platform_mutex.h"
@@ -61,41 +59,40 @@ static jmp_buf critical_error_jmp_buf;
#define MATCH CONTINUATION(9)
#define APPLICATION_START CONTINUATION(10)
#define EVAL_R CONTINUATION(11)
-#define SET_VARIABLE CONTINUATION(12)
-#define RESUME CONTINUATION(13)
-#define CLOSURE_ARGS CONTINUATION(14)
-#define EXIT_ATOMIC CONTINUATION(15)
-#define READ_NEXT_TOKEN CONTINUATION(16)
-#define READ_APPEND_CONTINUE CONTINUATION(17)
-#define READ_EVAL_CONTINUE CONTINUATION(18)
-#define READ_EXPECT_CLOSEPAR CONTINUATION(19)
-#define READ_DOT_TERMINATE CONTINUATION(20)
-#define READ_DONE CONTINUATION(21)
-#define READ_QUOTE_RESULT CONTINUATION(22)
-#define READ_COMMAAT_RESULT CONTINUATION(23)
-#define READ_COMMA_RESULT CONTINUATION(24)
-#define READ_START_ARRAY CONTINUATION(25)
-#define READ_APPEND_ARRAY CONTINUATION(26)
-#define MAP CONTINUATION(27)
-#define MATCH_GUARD CONTINUATION(28)
-#define TERMINATE CONTINUATION(29)
-#define PROGN_VAR CONTINUATION(30)
-#define SETQ CONTINUATION(31)
-#define MOVE_TO_FLASH CONTINUATION(32)
-#define MOVE_VAL_TO_FLASH_DISPATCH CONTINUATION(33)
-#define MOVE_LIST_TO_FLASH CONTINUATION(34)
-#define CLOSE_LIST_IN_FLASH CONTINUATION(35)
-#define QQ_EXPAND_START CONTINUATION(36)
-#define QQ_EXPAND CONTINUATION(37)
-#define QQ_APPEND CONTINUATION(38)
-#define QQ_EXPAND_LIST CONTINUATION(39)
-#define QQ_LIST CONTINUATION(40)
-#define KILL CONTINUATION(41)
-#define LOOP CONTINUATION(42)
-#define LOOP_CONDITION CONTINUATION(43)
-#define MERGE_REST CONTINUATION(44)
-#define MERGE_LAYER CONTINUATION(45)
-#define NUM_CONTINUATIONS 46
+#define RESUME CONTINUATION(12)
+#define CLOSURE_ARGS CONTINUATION(13)
+#define EXIT_ATOMIC CONTINUATION(14)
+#define READ_NEXT_TOKEN CONTINUATION(15)
+#define READ_APPEND_CONTINUE CONTINUATION(16)
+#define READ_EVAL_CONTINUE CONTINUATION(17)
+#define READ_EXPECT_CLOSEPAR CONTINUATION(18)
+#define READ_DOT_TERMINATE CONTINUATION(19)
+#define READ_DONE CONTINUATION(20)
+#define READ_QUOTE_RESULT CONTINUATION(21)
+#define READ_COMMAAT_RESULT CONTINUATION(22)
+#define READ_COMMA_RESULT CONTINUATION(23)
+#define READ_START_ARRAY CONTINUATION(24)
+#define READ_APPEND_ARRAY CONTINUATION(25)
+#define MAP CONTINUATION(26)
+#define MATCH_GUARD CONTINUATION(27)
+#define TERMINATE CONTINUATION(28)
+#define PROGN_VAR CONTINUATION(29)
+#define SETQ CONTINUATION(30)
+#define MOVE_TO_FLASH CONTINUATION(31)
+#define MOVE_VAL_TO_FLASH_DISPATCH CONTINUATION(32)
+#define MOVE_LIST_TO_FLASH CONTINUATION(33)
+#define CLOSE_LIST_IN_FLASH CONTINUATION(34)
+#define QQ_EXPAND_START CONTINUATION(35)
+#define QQ_EXPAND CONTINUATION(36)
+#define QQ_APPEND CONTINUATION(37)
+#define QQ_EXPAND_LIST CONTINUATION(38)
+#define QQ_LIST CONTINUATION(39)
+#define KILL CONTINUATION(40)
+#define LOOP CONTINUATION(41)
+#define LOOP_CONDITION CONTINUATION(42)
+#define MERGE_REST CONTINUATION(43)
+#define MERGE_LAYER CONTINUATION(44)
+#define NUM_CONTINUATIONS 45
#define FM_NEED_GC -1
#define FM_NO_MATCH -2
@@ -637,7 +634,7 @@ static void call_fundamental(lbm_uint fundamental, lbm_value *args, lbm_uint arg
}
// block_current_ctx blocks a context until it is
-// woken up externally of a timeout period of time passes.
+// woken up externally or a timeout period of time passes.
static void block_current_ctx(uint32_t state, lbm_uint sleep_us, bool do_cont) {
ctx_running->timestamp = timestamp_us_callback();
ctx_running->sleep_us = sleep_us;
@@ -676,30 +673,30 @@ lbm_flash_status lbm_write_const_array_padded(uint8_t *data, lbm_uint n, lbm_uin
void print_environments(char *buf, unsigned int size) {
- lbm_value curr_g = lbm_get_env();
lbm_value curr_l = ctx_running->curr_env;
-
printf_callback("\tCurrent local environment:\n");
while (lbm_type_of(curr_l) == LBM_TYPE_CONS) {
-
lbm_print_value(buf, (size/2) - 1, lbm_caar(curr_l));
lbm_print_value(buf + (size/2),size/2, lbm_cdr(lbm_car(curr_l)));
printf_callback("\t%s = %s\n", buf, buf+(size/2));
curr_l = lbm_cdr(curr_l);
}
-
printf_callback("\n\n");
printf_callback("\tCurrent global environment:\n");
- while (lbm_type_of(curr_g) == LBM_TYPE_CONS) {
+ lbm_value *glob_env = lbm_get_global_env();
- lbm_print_value(buf, (size/2) - 1, lbm_caar(curr_g));
- lbm_print_value(buf + (size/2),size/2, lbm_cdr(lbm_car(curr_g)));
- printf_callback("\t%s = %s\n", buf, buf+(size/2));
- curr_g = lbm_cdr(curr_g);
+ for (int i = 0; i < GLOBAL_ENV_ROOTS; i ++) {
+ lbm_value curr_g = glob_env[i];;
+ while (lbm_type_of(curr_g) == LBM_TYPE_CONS) {
+
+ lbm_print_value(buf, (size/2) - 1, lbm_caar(curr_g));
+ lbm_print_value(buf + (size/2),size/2, lbm_cdr(lbm_car(curr_g)));
+ printf_callback("\t%s = %s\n", buf, buf+(size/2));
+ curr_g = lbm_cdr(curr_g);
+ }
}
}
-
void print_error_message(lbm_value error, bool has_at, lbm_value at, unsigned int row, unsigned int col, lbm_int row0, lbm_int row1) {
if (!printf_callback) return;
@@ -1497,15 +1494,12 @@ static int gc(void) {
gc_requested = false;
lbm_gc_state_inc();
- lbm_value *variables = lbm_get_variable_table();
- if (variables) {
- for (int i = 0; i < lbm_get_num_variables(); i ++) {
- lbm_gc_mark_phase(variables[i]);
- }
- }
// The freelist should generally be NIL when GC runs.
lbm_nil_freelist();
- lbm_gc_mark_env(lbm_get_env());
+ lbm_value *env = lbm_get_global_env();
+ for (int i = 0; i < GLOBAL_ENV_ROOTS; i ++) {
+ lbm_gc_mark_env(env[i]);
+ }
mutex_lock(&qmutex); // Lock the queues.
// Any concurrent messing with the queues
@@ -1538,28 +1532,22 @@ int lbm_perform_gc(void) {
/****************************************************/
/* Evaluation functions */
+
static void eval_symbol(eval_context_t *ctx) {
lbm_uint s = lbm_dec_sym(ctx->curr_exp);
if (s >= RUNTIME_SYMBOLS_START) {
lbm_value res;
if (lbm_env_lookup_b(&res, ctx->curr_exp, ctx->curr_env) ||
- lbm_env_lookup_b(&res, ctx->curr_exp, lbm_get_env())) {
+ lbm_global_env_lookup(&res, ctx->curr_exp)) {
ctx->r = res;
ctx->app_cont = true;
return;
}
- } else {
+ } else if (s <= EXTENSION_SYMBOLS_END) {
//special symbols and extensions can be handled the same way.
- if (s <= EXTENSION_SYMBOLS_END) {
- ctx->r = ctx->curr_exp;
- ctx->app_cont = true;
- return;
- }
- if (s <= VARIABLE_SYMBOLS_END) {
- ctx->r = lbm_get_var(s);
- ctx->app_cont = true;
- return;
- }
+ ctx->r = ctx->curr_exp;
+ ctx->app_cont = true;
+ return;
}
// Dynamic load attempt
const char *sym_str = lbm_get_name_by_symbol(s);
@@ -1668,12 +1656,7 @@ static void eval_define(eval_context_t *ctx) {
sptr[0] = key;
- if ((sym_val >= VARIABLE_SYMBOLS_START) &&
- (sym_val < VARIABLE_SYMBOLS_END)) {
- sptr[1] = SET_VARIABLE;
- ctx->curr_exp = val_exp;
- return;
- } else if (sym_val >= RUNTIME_SYMBOLS_START) {
+ if (sym_val >= RUNTIME_SYMBOLS_START) {
sptr[1] = SET_GLOBAL_ENV;
if (ctx->flags & EVAL_CPS_CONTEXT_FLAG_CONST) {
stack_push(&ctx->K, MOVE_VAL_TO_FLASH_DISPATCH);
@@ -1998,11 +1981,15 @@ static void cont_set_global_env(eval_context_t *ctx){
lbm_value val = ctx->r;
lbm_pop(&ctx->K, &key);
+ lbm_uint dec_key = lbm_dec_sym(key);
+ lbm_uint ix_key = dec_key & GLOBAL_ENV_MASK;
+ lbm_value *global_env = lbm_get_global_env();
+ lbm_uint orig_env = global_env[ix_key];
lbm_value new_env;
// A key is a symbol and should not need to be remembered.
- WITH_GC(new_env, lbm_env_set(*lbm_get_env_ptr(),key,val));
+ WITH_GC(new_env, lbm_env_set(orig_env,key,val));
- *lbm_get_env_ptr() = new_env;
+ global_env[ix_key] = new_env;
ctx->r = val;
ctx->app_cont = true;
@@ -2010,16 +1997,6 @@ static void cont_set_global_env(eval_context_t *ctx){
return;
}
-static void cont_set_var(eval_context_t *ctx) {
- lbm_value key;
- lbm_value val = ctx->r;
- lbm_pop(&ctx->K, &key);
-
- ctx->r = lbm_set_var(lbm_dec_sym(key), val);
- ctx->app_cont = true;
- return;
-}
-
static void cont_resume(eval_context_t *ctx) {
lbm_value exp;
lbm_value env;
@@ -2079,13 +2056,13 @@ static lbm_value perform_setvar(lbm_value key, lbm_value val, lbm_value env) {
lbm_uint s = lbm_dec_sym(key);
lbm_value res = val;
- if (s >= VARIABLE_SYMBOLS_START &&
- s < VARIABLE_SYMBOLS_END) {
- return lbm_set_var(s, val);
- } else if (s >= RUNTIME_SYMBOLS_START) {
+ if (s >= RUNTIME_SYMBOLS_START) {
lbm_value new_env = lbm_env_modify_binding(env, key, val);
if (lbm_is_symbol(new_env) && new_env == ENC_SYM_NOT_FOUND) {
- new_env = lbm_env_modify_binding(lbm_get_env(), key, val);
+ lbm_uint ix_key = lbm_dec_sym(key) & GLOBAL_ENV_MASK;
+ lbm_value *glob_env = lbm_get_global_env();
+ new_env = lbm_env_modify_binding(glob_env[ix_key], key, val);
+ glob_env[ix_key] = new_env;
}
if (lbm_is_symbol(new_env) && new_env == ENC_SYM_NOT_FOUND) {
lbm_set_error_reason((char*)lbm_error_str_variable_not_bound);
@@ -3580,8 +3557,6 @@ static void cont_read_next_token(eval_context_t *ctx) {
int r = 0;
if (strncmp(tokpar_sym_str,"ext-",4) == 0) {
r = lbm_add_extension_symbol(tokpar_sym_str, &symbol_id);
- } else if (tokpar_sym_str[0] == '#') {
- r = lbm_add_variable_symbol(tokpar_sym_str, &symbol_id);
} else {
if (ctx->flags & EVAL_CPS_CONTEXT_FLAG_CONST_SYMBOL_STRINGS &&
ctx->flags & EVAL_CPS_CONTEXT_FLAG_INCREMENTAL_READ) {
@@ -4101,7 +4076,7 @@ static void cont_move_to_flash(eval_context_t *ctx) {
get_car_and_cdr(args, &first_arg, &rest);
lbm_value val;
- if (lbm_is_symbol(first_arg) && lbm_env_lookup_b(&val, first_arg, lbm_get_env())) {
+ if (lbm_is_symbol(first_arg) && lbm_global_env_lookup(&val, first_arg)) {
// Prepare to copy the rest of the arguments when done with first.
stack_push_2(&ctx->K, rest, MOVE_TO_FLASH);
if (lbm_is_ptr(val) &&
@@ -4432,7 +4407,6 @@ static const cont_fun continuations[NUM_CONTINUATIONS] =
cont_match,
cont_application_start,
cont_eval_r,
- cont_set_var,
cont_resume,
cont_closure_application_args,
cont_exit_atomic,
@@ -4724,8 +4698,6 @@ lbm_cid lbm_eval_program_ext(lbm_value lisp, unsigned int stack_size) {
}
int lbm_eval_init() {
- int res = 1;
-
if (!qmutex_initialized) {
mutex_init(&qmutex);
qmutex_initialized = true;
@@ -4753,10 +4725,9 @@ int lbm_eval_init() {
mutex_unlock(&lbm_events_mutex);
mutex_unlock(&qmutex);
- *lbm_get_env_ptr() = ENC_SYM_NIL;
+ if (!lbm_init_env()) return 0;
eval_running = true;
-
- return res;
+ return 1;
}
bool lbm_eval_init_events(unsigned int num_events) {
diff --git a/lispBM/lispBM/src/extensions.c b/lispBM/lispBM/src/extensions.c
index 99ab3b49..0f1e1ea3 100644
--- a/lispBM/lispBM/src/extensions.c
+++ b/lispBM/lispBM/src/extensions.c
@@ -1,5 +1,5 @@
/*
- Copyright 2019, 2021, 2022 Joel Svensson svenssonjoel@yahoo.se
+ Copyright 2019, 2021, 2022, 2024 Joel Svensson svenssonjoel@yahoo.se
2022 Benjamin Vedder
This program is free software: you can redistribute it and/or modify
@@ -36,13 +36,13 @@ lbm_value lbm_extensions_default(lbm_value *args, lbm_uint argn) {
return ENC_SYM_EERROR;
}
-int lbm_extensions_init(extension_fptr *extension_storage, int extension_storage_size) {
- if (extension_storage == NULL || extension_storage_size <= 0) return 0;
+int lbm_extensions_init(extension_fptr *extension_storage, lbm_uint extension_storage_size) {
+ if (extension_storage == NULL || extension_storage_size == 0) return 0;
extension_table = extension_storage;
- memset(extension_table, 0, sizeof(extension_fptr) * (unsigned int)extension_storage_size);
+ memset(extension_table, 0, sizeof(extension_fptr) * extension_storage_size);
- for (int i = 0; i < extension_storage_size; i ++) {
+ for (lbm_uint i = 0; i < extension_storage_size; i ++) {
extension_storage[i] = lbm_extensions_default;
}
diff --git a/lispBM/lispBM/src/extensions/array_extensions.c b/lispBM/lispBM/src/extensions/array_extensions.c
index ae82514e..46536827 100644
--- a/lispBM/lispBM/src/extensions/array_extensions.c
+++ b/lispBM/lispBM/src/extensions/array_extensions.c
@@ -494,7 +494,7 @@ static lbm_float u_to_float(uint32_t v) {
float sig = 0.0;
if (e != 0 || sig_i != 0) {
- sig = (float)sig_i / (8388608.0 * 2.0) + 0.5;
+ sig = (float)sig_i / (8388608.0f * 2.0f) + 0.5f;
e -= 126;
}
diff --git a/lispBM/lispBM/src/extensions/runtime_extensions.c b/lispBM/lispBM/src/extensions/runtime_extensions.c
index 9f6866ee..a41f783d 100644
--- a/lispBM/lispBM/src/extensions/runtime_extensions.c
+++ b/lispBM/lispBM/src/extensions/runtime_extensions.c
@@ -118,12 +118,18 @@ lbm_value ext_lbm_heap_state(lbm_value *args, lbm_uint argn) {
lbm_value ext_env_get(lbm_value *args, lbm_uint argn) {
(void)args;
(void)argn;
- return lbm_get_env();
+ if (argn == 1 && lbm_is_number(args[0])) {
+ lbm_uint ix = lbm_dec_as_u32(args[0]) & GLOBAL_ENV_MASK;
+ return lbm_get_global_env()[ix];
+ }
+ return ENC_SYM_TERROR;
}
lbm_value ext_env_set(lbm_value *args, lbm_uint argn) {
- if (argn == 1) {
- *lbm_get_env_ptr() = args[0];
+ if (argn == 2 && lbm_is_number(args[0])) {
+ lbm_uint ix = lbm_dec_as_u32(args[0]) & GLOBAL_ENV_MASK;
+ lbm_value *glob_env = lbm_get_global_env();
+ glob_env[ix] = args[1];
return ENC_SYM_TRUE;
}
return ENC_SYM_NIL;
diff --git a/lispBM/lispBM/src/fundamental.c b/lispBM/lispBM/src/fundamental.c
index 26463add..6f6166c0 100644
--- a/lispBM/lispBM/src/fundamental.c
+++ b/lispBM/lispBM/src/fundamental.c
@@ -20,7 +20,6 @@
#include "stack.h"
#include "heap.h"
#include "eval_cps.h"
-#include "lbm_variables.h"
#include "env.h"
#include "lbm_utils.h"
#include "lbm_custom_type.h"
@@ -714,28 +713,31 @@ static lbm_value fundamental_append(lbm_value *args, lbm_uint nargs, eval_contex
static lbm_value fundamental_undefine(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
(void) ctx;
- lbm_value env = lbm_get_env();
- lbm_value new_env = env;
- lbm_value result = ENC_SYM_EERROR;
+ lbm_value *global_env = lbm_get_global_env();
if (nargs == 1 && lbm_is_symbol(args[0])) {
- result = lbm_env_drop_binding(env, args[0]);
- if (result == ENC_SYM_NOT_FOUND) {
- return env;
+ lbm_value key = args[0];
+ lbm_uint ix_key = lbm_dec_sym(key) & GLOBAL_ENV_MASK;
+ lbm_value env = global_env[ix_key];
+ lbm_value res = lbm_env_drop_binding(env, key);
+ if (res == ENC_SYM_NOT_FOUND) {
+ return ENC_SYM_NIL;
}
- *lbm_get_env_ptr() = result;
+ global_env[ix_key] = res;
+ return ENC_SYM_TRUE;
} else if (nargs == 1 && lbm_is_cons(args[0])) {
lbm_value curr = args[0];
while (lbm_type_of(curr) == LBM_TYPE_CONS) {
lbm_value key = lbm_car(curr);
- result = lbm_env_drop_binding(new_env, key);
- if (result != ENC_SYM_NOT_FOUND) {
- new_env = result;
+ lbm_uint ix_key = lbm_dec_sym(key) & GLOBAL_ENV_MASK;
+ lbm_value env = global_env[ix_key];
+ lbm_value res = lbm_env_drop_binding(env, key);
+ if (res != ENC_SYM_NOT_FOUND) {
+ global_env[ix_key] = res;
}
curr = lbm_cdr(curr);
}
- *lbm_get_env_ptr() = new_env;
}
- return new_env;
+ return ENC_SYM_TRUE;
}
static lbm_value fundamental_buf_create(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
diff --git a/lispBM/lispBM/src/heap.c b/lispBM/lispBM/src/heap.c
index 48088588..9e8e1843 100644
--- a/lispBM/lispBM/src/heap.c
+++ b/lispBM/lispBM/src/heap.c
@@ -176,7 +176,7 @@ lbm_value lbm_enc_double(double x) {
return res;
#else
lbm_uint t;
- memcpy(&t, &x, sizeof(lbm_float));
+ memcpy(&t, &x, sizeof(double));
lbm_value f = lbm_cons(t, lbm_enc_sym(SYM_RAW_F_TYPE));
if (lbm_type_of(f) == LBM_TYPE_SYMBOL) return f;
return lbm_set_ptr_type(f, LBM_TYPE_DOUBLE);
@@ -435,7 +435,11 @@ double lbm_dec_as_double(lbm_value a) {
bool lbm_is_number(lbm_value x) {
lbm_uint t = lbm_type_of(x);
+ #ifndef LBM64
return (t & 0xC || t & LBM_NUMBER_MASK);
+ #else
+ return (t & ((uint64_t)0x1C) || t & LBM_NUMBER_MASK);
+ #endif
}
/****************************************************/
@@ -718,6 +722,18 @@ void lbm_gc_mark_phase(lbm_value root) {
if (t_ptr >= LBM_NON_CONS_POINTER_TYPE_FIRST &&
t_ptr <= LBM_NON_CONS_POINTER_TYPE_LAST) continue;
+ if (cell->car == ENC_SYM_CONT) {
+ lbm_value cont = cell->cdr;
+ lbm_array_header_t *arr = (lbm_array_header_t*)lbm_car(cont);
+ lbm_value *arrdata = (lbm_value *)arr->data;
+ for (lbm_uint i = 0; i < arr->size / 4; i ++) {
+ if (lbm_is_ptr(arrdata[i])){
+ if (!lbm_push (s, arrdata[i])) {
+ lbm_critical_error();
+ }
+ }
+ }
+ }
if (lbm_is_ptr(cell->cdr)) {
if (!lbm_push(s, cell->cdr)) {
lbm_critical_error();
diff --git a/lispBM/lispBM/src/lbm_c_interop.c b/lispBM/lispBM/src/lbm_c_interop.c
index adca5b82..9bea0562 100644
--- a/lispBM/lispBM/src/lbm_c_interop.c
+++ b/lispBM/lispBM/src/lbm_c_interop.c
@@ -126,10 +126,9 @@ lbm_cid lbm_eval_defined(char *symbol, bool program) {
return 0;
}
- lbm_value binding = lbm_env_lookup(lbm_enc_sym(sym_id), *lbm_get_env_ptr());
+ lbm_value binding;
- if (lbm_type_of(binding) == LBM_TYPE_SYMBOL &&
- lbm_dec_sym(binding) == SYM_NOT_FOUND) {
+ if (!lbm_global_env_lookup(&binding, lbm_enc_sym(sym_id))) {
return 0;
}
@@ -200,22 +199,14 @@ int lbm_define(char *symbol, lbm_value value) {
lbm_uint sym_id;
if (lbm_get_eval_state() == EVAL_CPS_STATE_PAUSED) {
-
- if (strncmp(symbol, "#",1) == 0) {
- if (!lbm_get_symbol_by_name(symbol, &sym_id)) {
- if (!lbm_add_variable_symbol_const(symbol, &sym_id)) {
- return 0;
- }
+ if (!lbm_get_symbol_by_name(symbol, &sym_id)) {
+ if (!lbm_add_symbol_const(symbol, &sym_id)) {
+ return 0;
}
- lbm_set_var(sym_id, value);
- } else {
- if (!lbm_get_symbol_by_name(symbol, &sym_id)) {
- if (!lbm_add_symbol_const(symbol, &sym_id)) {
- return 0;
- }
- }
- *lbm_get_env_ptr() = lbm_env_set(lbm_get_env(), lbm_enc_sym(sym_id), value);
}
+ lbm_uint ix_key = sym_id & GLOBAL_ENV_MASK;
+ lbm_value *glob_env = lbm_get_global_env();
+ glob_env[ix_key] = lbm_env_set(glob_env[ix_key], lbm_enc_sym(sym_id), value);
}
return res;
}
@@ -225,32 +216,13 @@ int lbm_undefine(char *symbol) {
if (!lbm_get_symbol_by_name(symbol, &sym_id))
return 0;
- lbm_value *env = lbm_get_env_ptr();
-
- lbm_value curr;
- lbm_value prev = *env;
- int res = 0;
-
- while (lbm_dec_sym(lbm_car(lbm_car(prev))) == sym_id ) {
- *env =lbm_cdr(prev);
- prev = lbm_cdr(prev);
- res = 1;
- }
-
- curr = lbm_cdr(prev);
-
- while (lbm_type_of(curr) == LBM_TYPE_CONS) {
- if (lbm_dec_sym(lbm_car(lbm_car(curr))) == sym_id) {
-
- /* drop the curr mapping from the env */
- lbm_set_cdr(prev, lbm_cdr(curr));
- res = 1;
- }
- prev = curr;
- curr = lbm_cdr(curr);
- }
- return res;
+ lbm_value *glob_env = lbm_get_global_env();
+ lbm_uint ix_key = sym_id & GLOBAL_ENV_MASK;
+ lbm_value new_env = lbm_env_drop_binding(glob_env[ix_key], lbm_enc_sym(sym_id));
+ if (new_env == ENC_SYM_NOT_FOUND) return 0;
+ glob_env[ix_key] = new_env;
+ return 1;
}
int lbm_share_array(lbm_value *value, char *data, lbm_uint num_elt) {
diff --git a/lispBM/lispBM/src/lbm_flat_value.c b/lispBM/lispBM/src/lbm_flat_value.c
index e9e9e183..26a79713 100644
--- a/lispBM/lispBM/src/lbm_flat_value.c
+++ b/lispBM/lispBM/src/lbm_flat_value.c
@@ -52,8 +52,8 @@ bool lbm_finish_flatten(lbm_flat_value_t *v) {
} else {
size_words = (v->buf_pos / sizeof(lbm_uint)) + 1;
}
+ if (v->buf_size <= size_words * sizeof(lbm_uint)) return true;
v->buf_size = size_words * sizeof(lbm_uint);
-
return (lbm_memory_shrink((lbm_uint*)v->buf, size_words) >= 0);
}
@@ -100,18 +100,19 @@ bool f_cons(lbm_flat_value_t *v) {
return false;
}
-bool f_sym(lbm_flat_value_t *v, lbm_uint sym) {
+bool f_sym(lbm_flat_value_t *v, lbm_value sym) {
bool res = true;
+ lbm_uint sym_id = lbm_dec_sym(sym);
res = res && write_byte(v,S_SYM_VALUE);
#ifndef LBM64
- res = res && write_word(v,sym);
+ res = res && write_word(v,sym_id);
#else
- res = res && write_dword(v,sym);
+ res = res && write_dword(v,sym_id);
#endif
return res;
}
-bool f_sym_string(lbm_flat_value_t *v, lbm_uint sym) {
+bool f_sym_string(lbm_flat_value_t *v, lbm_value sym) {
bool res = true;
char *sym_str;
if (lbm_is_symbol(sym)) {
@@ -131,7 +132,7 @@ bool f_sym_string(lbm_flat_value_t *v, lbm_uint sym) {
return false;
}
-int f_sym_string_bytes(lbm_uint sym) {
+int f_sym_string_bytes(lbm_value sym) {
char *sym_str;
if (lbm_is_symbol(sym)) {
lbm_uint s = lbm_dec_sym(sym);
@@ -147,14 +148,22 @@ int f_sym_string_bytes(lbm_uint sym) {
bool f_i(lbm_flat_value_t *v, lbm_int i) {
bool res = true;
res = res && write_byte(v,S_I_VALUE);
+#ifndef LBM64
res = res && write_word(v,(uint32_t)i);
+#else
+ res = res && write_dword(v, (uint64_t)i);
+#endif
return res;
}
bool f_u(lbm_flat_value_t *v, lbm_uint u) {
bool res = true;
res = res && write_byte(v,S_U_VALUE);
+#ifndef LBM64
res = res && write_word(v,(uint32_t)u);
+#else
+ res = res && write_dword(v,(uint64_t)u);
+#endif
return res;
}
@@ -558,11 +567,7 @@ static int lbm_unflatten_value_internal(lbm_flat_value_t *v, lbm_value *res) {
case S_FLOAT_VALUE: {
lbm_uint tmp;
bool b;
-#ifndef LBM64
b = extract_word(v, &tmp);
-#else
- b = extract_dword(v, &tmp);
-#endif
if (b) {
lbm_float f;
memcpy(&f, &tmp, sizeof(lbm_float));
diff --git a/lispBM/lispBM/src/lbm_variables.c b/lispBM/lispBM/src/lbm_variables.c
deleted file mode 100644
index b153c3da..00000000
--- a/lispBM/lispBM/src/lbm_variables.c
+++ /dev/null
@@ -1,79 +0,0 @@
-/*
- Copyright 2022 Joel Svensson svenssonjoel@yahoo.se
- Copyright 2022 Benjamin Vedder
-
- 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 .
-*/
-
-#include "lbm_variables.h"
-#include "symrepr.h"
-#include "heap.h"
-
-lbm_value *variable_table = NULL;
-int variable_table_size = 0;
-
-int lbm_variables_init(lbm_value *variable_storage, int variable_storage_size) {
-
- if (variable_storage == NULL || variable_storage_size <= 0)
- return 0;
-
- variable_table = variable_storage;
- variable_table_size = variable_storage_size;
- for (int i = 0; i < variable_table_size; i ++) {
- variable_table[i] = ENC_SYM_NIL;
- }
- return 1;
-}
-
-lbm_value *lbm_get_variable_table(void) {
- return variable_table;
-}
-
-lbm_value lbm_get_var(lbm_uint sym_val) {
-
- int i = (int)sym_val - VARIABLE_SYMBOLS_START;
- return lbm_get_variable_by_index(i);
-}
-
-lbm_value lbm_get_variable_by_index(int i) {
- if (variable_table &&
- i >= 0 &&
- i < variable_table_size) {
- return variable_table[i];
- } else {
- return ENC_SYM_NIL;
- }
-}
-
-const char *lbm_get_variable_name_by_index(int index) {
- if (index < 0 ||
- index >= lbm_get_num_variables()) return NULL;
-
- lbm_uint sym_id = (lbm_uint)index + VARIABLE_SYMBOLS_START;
- return lbm_get_name_by_symbol(sym_id);
-}
-
-lbm_value lbm_set_var(lbm_uint index, lbm_value value) {
-
- int i = (int)index - VARIABLE_SYMBOLS_START;
-
- if (variable_table &&
- i >= 0 &&
- i < variable_table_size) {
- variable_table[i] = value;
- } else {
- return ENC_SYM_NIL;
- }
- return value;
-}
diff --git a/lispBM/lispBM/src/lispbm.c b/lispBM/lispBM/src/lispbm.c
index a77faca8..66144d6c 100644
--- a/lispBM/lispBM/src/lispbm.c
+++ b/lispBM/lispBM/src/lispbm.c
@@ -1,5 +1,5 @@
/*
- Copyright 2018, 2020 Joel Svensson svenssonjoel@yahoo.se
+ Copyright 2018, 2020, 2024 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
@@ -18,14 +18,12 @@
#include "lispbm.h"
int lbm_init(lbm_cons_t *heap_storage, lbm_uint heap_size,
- lbm_uint gc_stack_size,
lbm_uint *memory, lbm_uint memory_size,
lbm_uint *memory_bitmap, lbm_uint bitmap_size,
- lbm_uint *print_stack_storage, lbm_uint print_stack_size,
- extension_fptr *extension_storage, int extension_storage_size ) {
-
- if (lbm_print_init(print_stack_storage, print_stack_size) == 0)
- return 0;
+ lbm_uint gc_stack_size,
+ lbm_uint print_stack_size,
+ extension_fptr *extension_storage,
+ lbm_uint extension_storage_size) {
if (lbm_memory_init(memory, memory_size,
memory_bitmap, bitmap_size) == 0)
@@ -37,15 +35,18 @@ int lbm_init(lbm_cons_t *heap_storage, lbm_uint heap_size,
if (lbm_heap_init(heap_storage, heap_size, gc_stack_size) == 0)
return 0;
+ if (lbm_print_init(print_stack_size) == 0)
+ return 0;
+
+ if (lbm_extensions_init(extension_storage, extension_storage_size) == 0)
+ return 0;
+
if (lbm_init_env() == 0)
return 0;
if (lbm_eval_init() == 0)
return 0;
- if (lbm_extensions_init(extension_storage, extension_storage_size) == 0)
- return 0;
-
return 1;
}
diff --git a/lispBM/lispBM/src/print.c b/lispBM/lispBM/src/print.c
index 2ea1b1c4..39477151 100644
--- a/lispBM/lispBM/src/print.c
+++ b/lispBM/lispBM/src/print.c
@@ -1,5 +1,5 @@
/*
- Copyright 2018, 2020 - 2023 Joel Svensson svenssonjoel@yahoo.se
+ Copyright 2018, 2020 - 2024 Joel Svensson svenssonjoel@yahoo.se
2022 Benjamin Vedder
This program is free software: you can redistribute it and/or modify
@@ -74,11 +74,14 @@ bool lbm_value_is_printable_string(lbm_value v, char **str) {
}
-int lbm_print_init(lbm_uint *print_stack_storage, lbm_uint print_stack_size) {
+int lbm_print_init(lbm_uint print_stack_size) {
- if (!print_stack_storage || print_stack_size == 0)
+ if (print_stack_size == 0)
return 0;
+ lbm_uint *print_stack_storage = (lbm_uint*)lbm_malloc(print_stack_size * sizeof(lbm_uint));
+ if (!print_stack_storage) return 0;
+
if (lbm_stack_create(&print_stack, print_stack_storage, print_stack_size)) {
print_has_stack = true;
return 1;
diff --git a/lispBM/lispBM/src/symrepr.c b/lispBM/lispBM/src/symrepr.c
index 362ddff5..9e156b1e 100644
--- a/lispBM/lispBM/src/symrepr.c
+++ b/lispBM/lispBM/src/symrepr.c
@@ -424,35 +424,6 @@ int lbm_str_to_symbol(char *name, lbm_uint *sym_id) {
return 0;
}
-int lbm_add_variable_symbol(char *name, lbm_uint* id) {
-
- if (next_variable_symbol_id >= VARIABLE_SYMBOLS_END) return 0;
- lbm_uint symbol_name_storage;
- if (!store_symbol_name(name, &symbol_name_storage)) return 0;
-
- if (!add_symbol_to_symtab(symbol_name_storage, next_variable_symbol_id)) {
- lbm_memory_free((lbm_uint*)symbol_name_storage);
- return 0;
- }
-
- *id = next_variable_symbol_id ++;
-
- return 1;
-}
-
-int lbm_add_variable_symbol_const(char *name, lbm_uint* id) {
-
- if (next_variable_symbol_id >= VARIABLE_SYMBOLS_END) return 0;
-
- if (!add_symbol_to_symtab((lbm_uint)name, next_variable_symbol_id)) {
- return 0;
- }
-
- *id = next_variable_symbol_id ++;
-
- return 1;
-}
-
int lbm_add_extension_symbol(char *name, lbm_uint* id) {
if (next_extension_symbol_id >= EXTENSION_SYMBOLS_END) return 0;
@@ -500,6 +471,6 @@ lbm_uint lbm_get_symbol_table_size_names_flash(void) {
return symbol_table_size_strings_flash * sizeof(lbm_uint);
}
-int lbm_get_num_variables(void) {
- return (int)next_variable_symbol_id - VARIABLE_SYMBOLS_START;
+lbm_uint lbm_get_num_variables(void) {
+ return next_variable_symbol_id - VARIABLE_SYMBOLS_START;
}
diff --git a/lispBM/lispBM/src/tokpar.c b/lispBM/lispBM/src/tokpar.c
index adf5b883..8104055b 100644
--- a/lispBM/lispBM/src/tokpar.c
+++ b/lispBM/lispBM/src/tokpar.c
@@ -27,7 +27,6 @@
#include "tokpar.h"
#include "symrepr.h"
#include "heap.h"
-#include "qq_expand.h"
#include "env.h"
char tokpar_sym_str[TOKENIZER_MAX_SYMBOL_AND_STRING_LENGTH];
diff --git a/lispBM/lispBM/tests/test_lisp_code_cps.c b/lispBM/lispBM/tests/test_lisp_code_cps.c
index 9e674fb7..56fb458c 100644
--- a/lispBM/lispBM/tests/test_lisp_code_cps.c
+++ b/lispBM/lispBM/tests/test_lisp_code_cps.c
@@ -37,19 +37,16 @@
#define WAIT_TIMEOUT 2500
-#define GC_STACK_SIZE 256
+#define GC_STACK_SIZE 96
#define PRINT_STACK_SIZE 256
-#define EXTENSION_STORAGE_SIZE 256
-#define VARIABLE_STORAGE_SIZE 256
+#define EXTENSION_STORAGE_SIZE 100
#define CONSTANT_MEMORY_SIZE 32*1024
#define FAIL 0
#define SUCCESS 1
-lbm_uint print_stack_storage[PRINT_STACK_SIZE];
-extension_fptr extension_storage[EXTENSION_STORAGE_SIZE];
-lbm_value variable_storage[VARIABLE_STORAGE_SIZE];
+extension_fptr extensions[EXTENSION_STORAGE_SIZE];
lbm_uint constants_memory[CONSTANT_MEMORY_SIZE];
@@ -225,8 +222,8 @@ LBM_EXTENSION(ext_event_sym, args, argn) {
lbm_value res = ENC_SYM_EERROR;
if (argn == 1 && lbm_is_symbol(args[0])) {
lbm_flat_value_t v;
- if (lbm_start_flatten(&v, 1 + sizeof(lbm_uint))) {
- f_sym(&v, lbm_dec_sym(args[0]));
+ if (lbm_start_flatten(&v, 1 + sizeof(lbm_uint) + 20)) {
+ f_sym(&v, args[0]);
lbm_finish_flatten(&v);
lbm_event(&v);
res = ENC_SYM_TRUE;
@@ -240,7 +237,7 @@ LBM_EXTENSION(ext_event_float, args, argn) {
if (argn == 1 && lbm_is_number(args[0])) {
float f = lbm_dec_as_float(args[0]);
lbm_flat_value_t v;
- if (lbm_start_flatten(&v, 1 + sizeof(float))) {
+ if (lbm_start_flatten(&v, 1 + sizeof(float) + 20)) {
f_float(&v, f);
lbm_finish_flatten(&v);
lbm_event(&v);
@@ -277,7 +274,7 @@ LBM_EXTENSION(ext_event_array, args, argn) {
lbm_flat_value_t v;
if (lbm_start_flatten(&v, 100)) {
f_cons(&v);
- f_sym(&v,lbm_dec_sym(args[0]));
+ f_sym(&v,args[0]);
f_lbm_array(&v, 12, (uint8_t*)hello);
lbm_finish_flatten(&v);
lbm_event(&v);
@@ -300,8 +297,8 @@ LBM_EXTENSION(ext_unblock, args, argn) {
if (argn == 1 && lbm_is_number(args[0])) {
lbm_cid c = lbm_dec_as_i32(args[0]);
lbm_flat_value_t v;
- if (lbm_start_flatten(&v, 8)) {
- f_sym(&v, SYM_TRUE);
+ if (lbm_start_flatten(&v, 1 + sizeof(lbm_uint))) {
+ f_sym(&v, ENC_SYM_TRUE);
lbm_finish_flatten(&v);
lbm_unblock_ctx(c,&v);
res = ENC_SYM_TRUE;
@@ -315,8 +312,8 @@ LBM_EXTENSION(ext_unblock_error, args, argn) {
if (argn == 1 && lbm_is_number(args[0])) {
lbm_cid c = lbm_dec_as_i32(args[0]);
lbm_flat_value_t v;
- if (lbm_start_flatten(&v, 8)) {
- f_sym(&v, SYM_EERROR);
+ if (lbm_start_flatten(&v, 1 + sizeof(lbm_uint))) {
+ f_sym(&v, ENC_SYM_EERROR);
lbm_finish_flatten(&v);
lbm_unblock_ctx(c,&v);
res = ENC_SYM_TRUE;
@@ -447,12 +444,12 @@ int main(int argc, char **argv) {
lbm_uint *memory = NULL;
lbm_uint *bitmap = NULL;
if (sizeof(lbm_uint) == 4) {
- memory = malloc(sizeof(lbm_uint) * LBM_MEMORY_SIZE_14K);
+ memory = malloc(sizeof(lbm_uint) * LBM_MEMORY_SIZE_16K);
if (memory == NULL) return 0;
- bitmap = malloc(sizeof(lbm_uint) * LBM_MEMORY_BITMAP_SIZE_14K);
+ bitmap = malloc(sizeof(lbm_uint) * LBM_MEMORY_BITMAP_SIZE_16K);
if (bitmap == NULL) return 0;
- res = lbm_memory_init(memory, LBM_MEMORY_SIZE_14K,
- bitmap, LBM_MEMORY_BITMAP_SIZE_14K);
+ res = lbm_memory_init(memory, LBM_MEMORY_SIZE_16K,
+ bitmap, LBM_MEMORY_BITMAP_SIZE_16K);
} else {
memory = malloc(sizeof(lbm_uint) * LBM_MEMORY_SIZE_1M);
if (memory == NULL) return 0;
@@ -469,32 +466,22 @@ int main(int argc, char **argv) {
return FAIL;
}
- res = lbm_print_init(print_stack_storage, PRINT_STACK_SIZE);
- if (res)
- printf("Printing initialized.\n");
- else {
- printf("Error initializing printing!\n");
- return FAIL;
- }
-
- res = lbm_symrepr_init();
- if (res)
- printf("Symrepr initialized.\n");
- else {
- printf("Error initializing symrepr!\n");
- return FAIL;
- }
-
heap_storage = (lbm_cons_t*)malloc(sizeof(lbm_cons_t) * heap_size);
if (heap_storage == NULL) {
return FAIL;
}
- res = lbm_heap_init(heap_storage, heap_size, GC_STACK_SIZE);
- if (res)
- printf("Heap initialized. Heap size: %"PRI_FLOAT" MiB. Free cons cells: %"PRI_INT"\n", (double)lbm_heap_size_bytes() / 1024.0 / 1024.0, lbm_heap_num_free());
- else {
- printf("Error initializing heap!\n");
+ if (lbm_init(heap_storage, heap_size,
+ memory, LBM_MEMORY_SIZE_16K,
+ bitmap, LBM_MEMORY_BITMAP_SIZE_16K,
+ GC_STACK_SIZE,
+ PRINT_STACK_SIZE,
+ extensions,
+ EXTENSION_STORAGE_SIZE)
+ ) {
+ printf ("LBM Initialized\n");
+ } else {
+ printf ("FAILED to initialize LBM\n");
return FAIL;
}
@@ -506,22 +493,6 @@ int main(int argc, char **argv) {
printf("Constants memory initialized\n");
}
- res = lbm_eval_init();
- if (res)
- printf("Evaluator initialized.\n");
- else {
- printf("Error initializing evaluator.\n");
- return FAIL;
- }
-
- res = lbm_init_env();
- if (res)
- printf("Environment initialized.\n");
- else {
- printf("Error initializing environment.\n");
- return FAIL;
- }
-
res = lbm_eval_init_events(20);
if (res)
printf("Events initialized.\n");
@@ -530,14 +501,6 @@ int main(int argc, char **argv) {
return FAIL;
}
- res = lbm_extensions_init(extension_storage, EXTENSION_STORAGE_SIZE);
- if (res)
- printf("Extensions initialized.\n");
- else {
- printf("Error initializing extensions.\n");
- return FAIL;
- }
-
if (lbm_array_extensions_init()) {
printf("Array extensions initialized.\n");
} else {
@@ -688,10 +651,10 @@ int main(int argc, char **argv) {
lbm_set_usleep_callback(sleep_callback);
lbm_set_printf_callback(printf);
- lbm_variables_init(variable_storage, VARIABLE_STORAGE_SIZE);
-
lbm_set_verbose(true);
+ printf("LBM memory free: %u words, %u bytes \n", lbm_memory_num_free(), lbm_memory_num_free() * sizeof(lbm_uint));
+
if (pthread_create(&lispbm_thd, NULL, eval_thd_wrapper, NULL)) {
printf("Error creating evaluation thread\n");
return FAIL;
@@ -739,6 +702,7 @@ int main(int argc, char **argv) {
uint32_t stream_i = 0;
if (stream_source) {
+ int stuck_count = 0;
int i = 0;
while (true) {
if (code_buffer[i] == 0) {
@@ -755,6 +719,8 @@ int main(int argc, char **argv) {
} else {
if ((stream_i % 100) == 99) {
printf("stuck streaming\n");
+ stuck_count ++;
+ if (stuck_count == 10) return 0;
}
stream_i ++;
sleep_callback(2);
diff --git a/lispBM/lispBM/tests/test_read_stress.lisp b/lispBM/lispBM/tests/test_read_stress.lisp
index 6a2d02bd..650beb3e 100644
--- a/lispBM/lispBM/tests/test_read_stress.lisp
+++ b/lispBM/lispBM/tests/test_read_stress.lisp
@@ -11,7 +11,16 @@
(defun code (x) (def apa (eval `(read (str-merge "bepa" (str-from-n x))))))
+;; 4 + 1 (2 or 3) bytes per string, padded to 8 bytes
+;; 3 * 4 bytes per symtable entry
+;; tot = (3 * 4) + 8 = 20 bytes;
+;; 20bytes * 415 = 8300bytes
+;; I cannot quite remember what this test is all about.
+;; - It fills up lbm_memory with symbols.
+;; - > 415 results in a read error if 16k lbm mem is given to test_list_code_cps.
+;; Doesn't feel right.
+
; Create just enough symbols and symbols and arrays to trigger GC.
-(repeat_eval code 432)
+(repeat_eval code 415)
(check (eq apa 'bepa1))
diff --git a/lispBM/lispbm.mk b/lispBM/lispbm.mk
index 36594a56..02f900bc 100644
--- a/lispBM/lispbm.mk
+++ b/lispBM/lispbm.mk
@@ -14,7 +14,6 @@ LISPBMSRC = $(LISPBM)/src/env.c \
$(LISPBM)/platform/chibios/src/platform_mutex.c \
$(LISPBM)/src/lbm_channel.c \
$(LISPBM)/src/lbm_c_interop.c \
- $(LISPBM)/src/lbm_variables.c \
$(LISPBM)/src/lbm_custom_type.c \
$(LISPBM)/src/lbm_flags.c \
$(LISPBM)/src/lbm_flat_value.c \
diff --git a/lispBM/lispif.c b/lispBM/lispif.c
index b18ee520..93cb5fa9 100644
--- a/lispBM/lispif.c
+++ b/lispBM/lispif.c
@@ -30,8 +30,8 @@
#include "lbm_prof.h"
#include "utils.h"
-#define LBM_MEMORY_SIZE_18K LBM_MEMORY_SIZE_64BYTES_TIMES_X(256 + 32)
-#define LBM_MEMORY_BITMAP_SIZE_18K LBM_MEMORY_BITMAP_SIZE(256 + 32)
+#define LBM_MEMORY_SIZE_18K LBM_MEMORY_SIZE_64BYTES_TIMES_X(256 + 64)
+#define LBM_MEMORY_BITMAP_SIZE_18K LBM_MEMORY_BITMAP_SIZE(256 + 64)
#define HEAP_SIZE (2048 + 256 + 160)
#define LISP_MEM_SIZE LBM_MEMORY_SIZE_18K
@@ -39,16 +39,13 @@
#define GC_STACK_SIZE 160
#define PRINT_STACK_SIZE 128
#define EXTENSION_STORAGE_SIZE 285
-#define VARIABLE_STORAGE_SIZE 50
#define EXT_LOAD_CALLBACK_LEN 20
#define PROF_DATA_NUM 30
__attribute__((section(".ram4"))) static lbm_cons_t heap[HEAP_SIZE] __attribute__ ((aligned (8)));
static uint32_t memory_array[LISP_MEM_SIZE];
__attribute__((section(".ram4"))) static uint32_t bitmap_array[LISP_MEM_BITMAP_SIZE];
-__attribute__((section(".ram4"))) static uint32_t print_stack_storage[PRINT_STACK_SIZE];
__attribute__((section(".ram4"))) static extension_fptr extension_storage[EXTENSION_STORAGE_SIZE];
-__attribute__((section(".ram4"))) static lbm_value variable_storage[VARIABLE_STORAGE_SIZE];
__attribute__((section(".ram4"))) static lbm_prof_t prof_data[PROF_DATA_NUM];
static volatile bool prof_running = false;
@@ -208,39 +205,32 @@ void lispif_process_cmd(unsigned char *data, unsigned int len,
// Result. Currently unused
send_buffer_global[ind++] = '\0';
- lbm_value curr = *lbm_get_env_ptr();
- while (lbm_type_of(curr) == LBM_TYPE_CONS) {
- lbm_value key_val = lbm_car(curr);
- if (lbm_type_of(lbm_car(key_val)) == LBM_TYPE_SYMBOL && lbm_is_number(lbm_cdr(key_val))) {
- const char *name = lbm_get_name_by_symbol(lbm_dec_sym(lbm_car(key_val)));
-
- if (print_all ||
- ((name[0] == 'v' || name[0] == 'V') &&
- (name[1] == 't' || name[1] == 'T'))) {
- strcpy((char*)(send_buffer_global + ind), name);
- ind += strlen(name) + 1;
- buffer_append_float32_auto(send_buffer_global, lbm_dec_as_float(lbm_cdr(key_val)), &ind);
- }
- }
-
+ lbm_value *glob_env = lbm_get_global_env();
+ for (int i = 0; i < GLOBAL_ENV_ROOTS; i ++) {
if (ind > 300) {
break;
}
- curr = lbm_cdr(curr);
- }
+ lbm_value curr = glob_env[i];
+ while (lbm_type_of(curr) == LBM_TYPE_CONS) {
+ lbm_value key_val = lbm_car(curr);
+ if (lbm_type_of(lbm_car(key_val)) == LBM_TYPE_SYMBOL && lbm_is_number(lbm_cdr(key_val))) {
+ const char *name = lbm_get_name_by_symbol(lbm_dec_sym(lbm_car(key_val)));
- for (int i = 0; i < lbm_get_num_variables(); i ++) {
- const char *name = lbm_get_variable_name_by_index(i);
- const lbm_value var = lbm_get_variable_by_index(i);
- if (lbm_is_number(var) && name) {
- strcpy((char*)(send_buffer_global + ind), name);
- ind += strlen(name) + 1;
- buffer_append_float32_auto(send_buffer_global, lbm_dec_as_float(var), &ind);
+ if (print_all ||
+ ((name[0] == 'v' || name[0] == 'V') &&
+ (name[1] == 't' || name[1] == 'T'))) {
+ strcpy((char*)(send_buffer_global + ind), name);
+ ind += strlen(name) + 1;
+ buffer_append_float32_auto(send_buffer_global, lbm_dec_as_float(lbm_cdr(key_val)), &ind);
+ }
+ }
if (ind > 300) {
break;
}
+
+ curr = lbm_cdr(curr);
}
}
@@ -370,21 +360,16 @@ void lispif_process_cmd(unsigned char *data, unsigned int len,
commands_printf_lisp("Sleep:\t%u\t%f%%\n", num_sleep, (double)(100.0 * ((float)num_sleep / (float)tot_samples)));
commands_printf_lisp("Total:\t%u samples\n", tot_samples);
} else if (strncmp(str, ":env", 4) == 0) {
- lbm_value curr = *lbm_get_env_ptr();
+ lbm_value *glob_env = lbm_get_global_env();
char output[128];
+ for (int i = 0; i < GLOBAL_ENV_ROOTS; i ++) {
+ lbm_value curr = glob_env[i];
+ while (lbm_type_of(curr) == LBM_TYPE_CONS) {
+ lbm_print_value(output, sizeof(output), lbm_car(curr));
+ curr = lbm_cdr(curr);
- commands_printf_lisp("Environment:\n");
- while (lbm_type_of(curr) == LBM_TYPE_CONS) {
- lbm_print_value(output, sizeof(output), lbm_car(curr));
- curr = lbm_cdr(curr);
- commands_printf_lisp(" %s", output);
- }
-
- commands_printf_lisp("Variables:");
- for (int i = 0; i < lbm_get_num_variables(); i ++) {
- const char *name = lbm_get_variable_name_by_index(i);
- lbm_print_value(output, sizeof(output), lbm_get_variable_by_index(i));
- commands_printf_lisp(" %s = %s", name ? name : "error", output);
+ commands_printf_lisp(" %s", output);
+ }
}
} else if (strncmp(str, ":ctxs", 5) == 0) {
commands_printf_lisp("****** Running contexts ******");
@@ -652,12 +637,11 @@ bool lispif_restart(bool print, bool load_code) {
if (!lisp_thd_running) {
lbm_init(heap, HEAP_SIZE,
- GC_STACK_SIZE,
memory_array, LISP_MEM_SIZE,
bitmap_array, LISP_MEM_BITMAP_SIZE,
- print_stack_storage, PRINT_STACK_SIZE,
+ GC_STACK_SIZE,
+ PRINT_STACK_SIZE,
extension_storage, EXTENSION_STORAGE_SIZE);
- lbm_variables_init(variable_storage, VARIABLE_STORAGE_SIZE);
lbm_eval_init_events(20);
lbm_set_timestamp_us_callback(timestamp_callback);
@@ -675,12 +659,11 @@ bool lispif_restart(bool print, bool load_code) {
}
lbm_init(heap, HEAP_SIZE,
- GC_STACK_SIZE,
memory_array, LISP_MEM_SIZE,
bitmap_array, LISP_MEM_BITMAP_SIZE,
- print_stack_storage, PRINT_STACK_SIZE,
+ GC_STACK_SIZE,
+ PRINT_STACK_SIZE,
extension_storage, EXTENSION_STORAGE_SIZE);
- lbm_variables_init(variable_storage, VARIABLE_STORAGE_SIZE);
lbm_eval_init_events(20);
}