From ac78672955a39f7079f89e46bf2cda9aa584115b Mon Sep 17 00:00:00 2001 From: Benjamin Vedder Date: Mon, 28 Mar 2022 16:15:10 +0200 Subject: [PATCH] Squashed 'lispBM/lispBM/' changes from 7341f811..5b3815ee 5b3815ee added aliases first, rest, fn and def for car, cdr, lambda and define 7d1bf1d5 added aliases first, rest, fn and def for car, cdr, lambda and define 3ac28d2f let the compiler keep track of the size of the special_symbols 51c84e90 update evaluator example program git-subtree-dir: lispBM/lispBM git-subtree-split: 5b3815eec0ae4b8b4fbbe96a77e71e151359ee13 --- examples/evaluator.c | 48 ++++++++++++++++++++++++++++++--------- src/symrepr.c | 13 ++++++++--- tests/test_def_0.lisp | 3 +++ tests/test_first_0.lisp | 1 + tests/test_fn_0.lisp | 1 + tests/test_rest_0.lisp | 1 + tests/test_tailrec_2.lisp | 2 +- 7 files changed, 54 insertions(+), 15 deletions(-) create mode 100644 tests/test_def_0.lisp create mode 100644 tests/test_first_0.lisp create mode 100644 tests/test_fn_0.lisp create mode 100644 tests/test_rest_0.lisp diff --git a/examples/evaluator.c b/examples/evaluator.c index 38232b87..a750514c 100644 --- a/examples/evaluator.c +++ b/examples/evaluator.c @@ -32,6 +32,8 @@ #define EXTENSION_STORAGE_SIZE 256 #define VARIABLE_STORAGE_SIZE 256 +#define WAIT_TIMEOUT 2500 + uint32_t gc_stack_storage[GC_STACK_SIZE]; uint32_t print_stack_storage[PRINT_STACK_SIZE]; extension_fptr extension_storage[EXTENSION_STORAGE_SIZE]; @@ -65,6 +67,30 @@ void *eval_thd_wrapper(void *v) { return NULL; } +void done_callback(eval_context_t *ctx) { + + char output[1024]; + + lbm_cid cid = ctx->id; + lbm_value t = ctx->r; + + int print_ret = lbm_print_value(output, 1024, t); + + if (print_ret >= 0) { + printf("<< Context %"PRI_INT" finished with value %s >>\n", cid, output); + } else { + printf("<< Context %"PRI_INT" finished with value %s >>\n", cid, output); + } + printf("stack max: %"PRI_UINT"\n", ctx->K.max_sp); + printf("stack size: %"PRI_UINT"\n", ctx->K.size); + printf("stack sp: %"PRI_INT"\n", ctx->K.sp); + + // if (!eval_cps_remove_done_ctx(cid, &t)) { + // printf("Error: done context (%d) not in list\n", cid); + //} + fflush(stdout); +} + int main(int argc, char **argv) { unsigned int heap_size = 8 * 1024 * 1024; // 8 Megabytes is standard @@ -138,6 +164,7 @@ int main(int argc, char **argv) { print_stack_storage, PRINT_STACK_SIZE, extension_storage, EXTENSION_STORAGE_SIZE); + lbm_set_ctx_done_callback(done_callback); lbm_set_timestamp_us_callback(timestamp_callback); lbm_set_usleep_callback(sleep_callback); @@ -150,7 +177,7 @@ int main(int argc, char **argv) { &string_tok); lbm_cid cid = lbm_load_and_eval_program(&string_tok); - lbm_wait_ctx(cid); + lbm_wait_ctx(cid, WAIT_TIMEOUT); lbm_value t; char *compressed_code; @@ -174,9 +201,16 @@ int main(int argc, char **argv) { code_buffer); } + lbm_pause_eval(); + while(lbm_get_eval_state() != EVAL_CPS_STATE_PAUSED) { + sleep_callback(10); + } + cid = lbm_load_and_eval_program(&string_tok); - t = lbm_wait_ctx(cid); + lbm_continue_eval(); + + t = lbm_wait_ctx(cid, WAIT_TIMEOUT); char output[1024]; @@ -184,13 +218,5 @@ int main(int argc, char **argv) { free(compressed_code); } - int v = lbm_print_value(output,1024,t); - - if (v >= 0) { - printf("> %s\n", output); - } else { - printf("> %s\n", output); - } - - return v; + return 0; } diff --git a/src/symrepr.c b/src/symrepr.c index 2d22367e..d4140599 100644 --- a/src/symrepr.c +++ b/src/symrepr.c @@ -24,7 +24,7 @@ #include "symrepr.h" -#define NUM_SPECIAL_SYMBOLS 117 +#define NUM_SPECIAL_SYMBOLS (sizeof(special_symbols) / sizeof(special_sym)) #define NAME 0 #define ID 1 #define NEXT 2 @@ -34,7 +34,7 @@ typedef struct { const lbm_uint id; } special_sym; -special_sym const special_symbols[NUM_SPECIAL_SYMBOLS] = { +special_sym const special_symbols[] = { {"nil" , SYM_NIL}, {"quote" , SYM_QUOTE}, {"t" , SYM_TRUE}, @@ -176,7 +176,14 @@ special_sym const special_symbols[NUM_SPECIAL_SYMBOLS] = { {"encode-float" , SYM_ENCODE_FLOAT}, {"decode" , SYM_DECODE}, - {"is-fundamental" , SYM_IS_FUNDAMENTAL} + {"is-fundamental" , SYM_IS_FUNDAMENTAL}, + + // aliases + {"first" , SYM_CAR}, + {"rest" , SYM_CDR}, + {"fn" , SYM_LAMBDA}, + {"def" , SYM_DEFINE} + }; static lbm_uint *symlist = NULL; diff --git a/tests/test_def_0.lisp b/tests/test_def_0.lisp new file mode 100644 index 00000000..aaf854b8 --- /dev/null +++ b/tests/test_def_0.lisp @@ -0,0 +1,3 @@ +(def apa 10) + +(= apa 10) diff --git a/tests/test_first_0.lisp b/tests/test_first_0.lisp new file mode 100644 index 00000000..2992566b --- /dev/null +++ b/tests/test_first_0.lisp @@ -0,0 +1 @@ +(= (first '(1 . 2)) 1) diff --git a/tests/test_fn_0.lisp b/tests/test_fn_0.lisp new file mode 100644 index 00000000..bc3997ae --- /dev/null +++ b/tests/test_fn_0.lisp @@ -0,0 +1 @@ +(= ((fn (x) (+ x 1)) 2) 3) diff --git a/tests/test_rest_0.lisp b/tests/test_rest_0.lisp new file mode 100644 index 00000000..c9b6388e --- /dev/null +++ b/tests/test_rest_0.lisp @@ -0,0 +1 @@ +(= (rest '(1 . 2)) 2) diff --git a/tests/test_tailrec_2.lisp b/tests/test_tailrec_2.lisp index ac8543c2..3dda799b 100644 --- a/tests/test_tailrec_2.lisp +++ b/tests/test_tailrec_2.lisp @@ -1,3 +1,3 @@ -(define sum (lambda (s rest) (if (eq rest nil) s (sum (+ s (car rest)) (cdr rest))))) +(define sum (lambda (s ls) (if (eq ls nil) s (sum (+ s (car ls)) (cdr ls))))) ( = (sum 0 (list 2.0 2.0 1.0 1.0 3.0 3.0)) 12.0)