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

@@ -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;
 }

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;

tests/test_def_0.lisp

@@ -0,0 +1,3 @@
+(def apa 10)
+
+(= apa 10)

tests/test_first_0.lisp

@@ -0,0 +1 @@
+(= (first '(1 . 2)) 1) 

tests/test_fn_0.lisp

@@ -0,0 +1 @@
+(= ((fn (x) (+ x 1)) 2) 3)

tests/test_rest_0.lisp

@@ -0,0 +1 @@
+(= (rest '(1 . 2)) 2)

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)