Merge commit 'ce6914364acff0f3667908a9c55966f05619c984'

lispBM/lispBM/include/eval_cps.h

@@ -154,11 +154,6 @@ bool lbm_event(lbm_flat_value_t *fv);
  */
 bool lbm_event_unboxed(lbm_value unboxed);
 
-/** Trigger a flag to wake up all tasks waiting on that flag.
- * \param wait_for_flags Flags to trigger.
- */
-void lbm_trigger_flags(uint32_t wait_for_flags);
-
 /** Remove a context that has finished executing and free up its associated memory.
  *
  * \param cid Context id of context to free.
@@ -236,9 +231,10 @@ int lbm_set_error_reason(char *error_str);
  * \param program The program to evaluate in the context.
  * \param env An initial environment.
  * \param stack_size Stack size for the context.
+ * \param name Name of thread or NULL.
  * \return
  */
-lbm_cid lbm_create_ctx(lbm_value program, lbm_value env, lbm_uint stack_size);
+lbm_cid lbm_create_ctx(lbm_value program, lbm_value env, lbm_uint stack_size, char *name);
 /** Block a context from an extension
  */
 void lbm_block_ctx_from_extension(void);

lispBM/lispBM/include/heap.h

@@ -887,9 +887,9 @@ static inline bool lbm_is_quoted_list(lbm_value x) {
 }
 
 #ifndef LBM64
-#define ERROR_SYMBOL_MASK 0xFFFFFF20
+#define ERROR_SYMBOL_MASK 0xFFFFFFF0
 #else
-#define ERROR_SYMBOL_MASK 0xFFFFFFFFFFFFFF20
+#define ERROR_SYMBOL_MASK 0xFFFFFFFFFFFFFFF0
 #endif
 
 /* all error signaling symbols are in the range 0x20 - 0x2F */

lispBM/lispBM/include/lbm_c_interop.h

@@ -38,15 +38,17 @@ extern "C" {
 /** Load and schedule a program for execution.
  *
  * \param tokenizer The tokenizer to read the program from.
+ * \param name Name of thread (or NULL) thread doing the load and eval.
  * \return A context id on success or 0 on failure.
  */
-lbm_cid lbm_load_and_eval_program(lbm_char_channel_t *tokenizer);
+  lbm_cid lbm_load_and_eval_program(lbm_char_channel_t *tokenizer, char *name);
 /** Load a program while evaluating incrementally.
  *
  * \param tokenizer The tokenizer to read the program from.
+ * \param name Name of the thread (or NULL) that performs the incremental load.
  * \return A context id on success or 0 on failure.
  */
-lbm_cid lbm_load_and_eval_program_incremental(lbm_char_channel_t *tokenizer);
+  lbm_cid lbm_load_and_eval_program_incremental(lbm_char_channel_t *tokenizer, char *name);
 /** Load and schedule an expression for execution.
  *
  * \param tokenizer The tokenizer to read the expression from.

lispBM/lispBM/include/lbm_defines.h

@@ -212,11 +212,10 @@
 #define SYM_EXIT_ERROR            0x15C
 #define SYM_MAP                   0x15D
 #define SYM_REVERSE               0x15E
-#define SYM_WAIT_FOR              0x15F
-#define SYM_FLATTEN               0x160
-#define SYM_UNFLATTEN             0x161
-#define SYM_KILL                  0x162
-#define APPLY_FUNS_END            0x162
+#define SYM_FLATTEN               0x15F
+#define SYM_UNFLATTEN             0x160
+#define SYM_KILL                  0x161
+#define APPLY_FUNS_END            0x161
 
 #define FUNDAMENTALS_START 0x20E
 #define SYM_ADD           0x20E
@@ -393,7 +392,6 @@
 #define ENC_SYM_EXIT_ERROR            ENC_SYM(SYM_EXIT_ERROR)
 #define ENC_SYM_MAP                   ENC_SYM(SYM_MAP)
 #define ENC_SYM_REVERSE               ENC_SYM(SYM_REVERSE)
-#define ENC_SYM_WAIT_FOR              ENC_SYM(SYM_WAIT_FOR)
 #define ENC_SYM_FLATTEN               ENC_SYM(SYM_FLATTEN)
 #define ENC_SYM_UNFLATTEN             ENC_SYM(SYM_UNFLATTEN)
 #define ENC_SYM_KILL                  ENC_SYM(SYM_KILL)

lispBM/lispBM/include/lbm_version.h

@@ -27,12 +27,16 @@ extern "C" {
 /** LBM major version */
 #define LBM_MAJOR_VERSION 0
 /** LBM minor version */
-#define LBM_MINOR_VERSION 17
+#define LBM_MINOR_VERSION 18
 /** LBM patch revision */
 #define LBM_PATCH_VERSION 0
 
 /*! \page changelog Changelog
 
+AUG 26 2023: Version 0.18.0
+  - Removed wait-for flags
+  - Fix bug in unblock_unboxed when unblocking with error value.
+
 JUL 29 2023: Version 0.17.0
   - Addition of a timeout functionality to blocked contexts.
   - recv-to special form added for receives with a timeout.

lispBM/lispBM/repl/repl.c

@@ -329,34 +329,34 @@ lbm_value ext_unflatten(lbm_value *args, lbm_uint argn) {
   array[9] = 'l';
   array[10] = 'd';
   array[11] = 0;
-    
-  
+
+
   lbm_flat_value_t v;
-  
+
   if (lbm_start_flatten(&v, 100)) {
-    //  ((1 2 3 {3.000000} {51539607556} "hello world") . t)    
+    //  ((1 2 3 {3.000000} {51539607556} "hello world") . t)
+    f_cons(&v);
     f_cons(&v);
-    f_cons(&v); 
     f_i(&v, 1);
-    f_cons(&v); 
+    f_cons(&v);
     f_i(&v, 2);
-    f_cons(&v); 
+    f_cons(&v);
     f_i(&v, 3);
-    f_cons(&v); 
+    f_cons(&v);
     f_float(&v, 3.14f);
-    f_cons(&v); 
+    f_cons(&v);
     f_u64(&v, 0xFFFF0000FFFF0000);
     f_cons(&v);
     f_lbm_array(&v, 12, (uint8_t*)array);
     f_sym(&v, SYM_NIL);
     f_sym(&v, SYM_TRUE);
     lbm_finish_flatten(&v);
-    
-    
+
+
     v.buf_pos = 0;
     lbm_value res;
     lbm_unflatten_value(&v, &res);
-    return res; 
+    return res;
   } else {
     return ENC_SYM_NIL;
   }
@@ -370,15 +370,6 @@ static bool test_destruct(lbm_uint value) {
   return true;
 }
 
-static lbm_value ext_trigger(lbm_value *args, lbm_uint argn) {
-  if (argn == 1 && lbm_is_number(args[0])) {
-    lbm_trigger_flags(lbm_dec_as_u32(args[0]));
-    return ENC_SYM_TRUE;
-  } else {
-    return ENC_SYM_EERROR;
-  }
-}
-
 static lbm_value ext_custom(lbm_value *args, lbm_uint argn) {
 
   lbm_uint *mem = (lbm_uint*)malloc(1000*sizeof(lbm_uint));
@@ -502,7 +493,7 @@ int main(int argc, char **argv) {
   int res = 0;
 
   pthread_t lispbm_thd;
-  
+
   lbm_heap_state_t heap_state;
   unsigned int heap_size = 2048;
   lbm_cons_t *heap_storage = NULL;
@@ -544,7 +535,7 @@ int main(int argc, char **argv) {
   } else {
     printf("Constants memory initialized\n");
   }
-  
+
   lbm_set_ctx_done_callback(done_callback);
   lbm_set_timestamp_us_callback(timestamp_callback);
   lbm_set_usleep_callback(sleep_callback);
@@ -601,13 +592,6 @@ int main(int argc, char **argv) {
   else
     printf("Error adding extension.\n");
 
-  res = lbm_add_extension("trigger", ext_trigger);
-  if (res)
-    printf("Extension added.\n");
-  else
-    printf("Error adding extension.\n");
-
-
   /* Start evaluator thread */
   if (pthread_create(&lispbm_thd, NULL, eval_thd_wrapper, NULL)) {
     printf("Error creating evaluation thread\n");
@@ -722,7 +706,7 @@ int main(int argc, char **argv) {
           sleep_callback(10);
         }
 
-        (void)lbm_load_and_eval_program_incremental(&string_tok);
+        (void)lbm_load_and_eval_program_incremental(&string_tok, NULL);
         lbm_continue_eval();
 
         //printf("started ctx: %"PRI_UINT"\n", cid);
@@ -779,7 +763,7 @@ int main(int argc, char **argv) {
         } else {
           printf("Constants memory initialized\n");
         }
-  
+
         lbm_variables_init(variable_storage, VARIABLE_STORAGE_SIZE);
 
         if (lbm_array_extensions_init()) {
@@ -829,7 +813,7 @@ int main(int argc, char **argv) {
       } else {
         printf("Constants memory initialized\n");
       }
-  
+
       lbm_variables_init(variable_storage, VARIABLE_STORAGE_SIZE);
 
       if (lbm_array_extensions_init()) {
@@ -886,14 +870,6 @@ int main(int argc, char **argv) {
       else
         printf("Error adding extension.\n");
 
-      res = lbm_add_extension("trigger", ext_trigger);
-      if (res)
-        printf("Extension added.\n");
-      else
-        printf("Error adding extension.\n");
-
-
-
       lbm_add_extension("print", ext_print);
       free(str);
     } else if (strncmp(str, ":send", 5) == 0) {

lispBM/lispBM/src/eval_cps.c

@@ -327,11 +327,6 @@ static lbm_uint          blocking_extension_timeout_us = 0;
 static bool              blocking_extension_timeout = false;
 
 static uint32_t          is_atomic = 0;
-static volatile uint32_t wait_for = 0; // wake-up mask
-
-void lbm_trigger_flags(uint32_t wait_for_flags) {
-  wait_for |= wait_for_flags;
-}
 
 /* Process queues */
 static eval_context_queue_t blocked  = {NULL, NULL};
@@ -1188,14 +1183,14 @@ static lbm_cid lbm_create_ctx_parent(lbm_value program, lbm_value env, lbm_uint
   return ctx->id;
 }
 
-lbm_cid lbm_create_ctx(lbm_value program, lbm_value env, lbm_uint stack_size) {
+lbm_cid lbm_create_ctx(lbm_value program, lbm_value env, lbm_uint stack_size, char *name) {
   // Creates a parentless context.
   return lbm_create_ctx_parent(program,
                                env,
                                stack_size,
                                -1,
                                EVAL_CPS_CONTEXT_FLAG_NOTHING,
-                               NULL);
+                               name);
 }
 
 bool lbm_mailbox_change_size(eval_context_t *ctx, lbm_uint new_size) {
@@ -1271,6 +1266,12 @@ bool lbm_unblock_ctx_unboxed(lbm_cid cid, lbm_value unboxed) {
     if (found) {
       drop_ctx_nm(&blocked,found);
       found->r = unboxed;
+      if (lbm_is_error(unboxed)) {
+        lbm_value trash;
+        lbm_pop(&found->K, &trash);     // Destructively make sure there is room on stack.
+        lbm_push(&found->K, TERMINATE);
+        found->app_cont = true;
+      }
       enqueue_ctx_nm(&queue,found);
       r = true;
     }
@@ -2181,21 +2182,6 @@ static void apply_wait(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
   }
 }
 
-static void apply_wait_for(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
-  if (nargs == 1 && lbm_is_number(args[0])) {
-    uint32_t w = lbm_dec_as_u32(args[0]);
-    lbm_stack_drop(&ctx->K, nargs+1);
-    if (w != 0) {
-      block_current_ctx(LBM_THREAD_STATE_BLOCKED, 0, w, true);
-    } else {
-      ctx->r = ENC_SYM_NIL;
-      ctx->app_cont = true;
-    }
-  } else {
-    error_ctx(ENC_SYM_EERROR);
-  }
-}
-
 static void apply_eval(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
   if ( nargs == 1) {
     ctx->curr_exp = args[0];
@@ -2450,7 +2436,6 @@ static const apply_fun fun_table[] =
    apply_error,
    apply_map,
    apply_reverse,
-   apply_wait_for,
    apply_flatten,
    apply_unflatten,
    apply_kill,
@@ -4230,45 +4215,6 @@ static void process_events(void) {
   }
 }
 
-static void process_waiting_nm(void) {
-
-  uint32_t wait_flags = wait_for;   // Should ideally be atomic
-  wait_for = wait_flags ^ wait_for; //
-
-  eval_context_queue_t *q = &blocked;
-
-  eval_context_t *curr = q->first;
-  while (curr != NULL) {
-    eval_context_t *next = curr->next; // grab here
-    if (curr->wait_mask & wait_flags) {
-      eval_context_t *ctx = curr;
-      if (curr == q->last) {
-        if (curr->prev) {
-          q->last = curr->prev;
-          q->last->next = NULL;
-        } else {
-          q->first = NULL;
-          q->last = NULL;
-        }
-      } else if (curr->prev == NULL) {
-        q->first = curr->next;
-        if (q->first) {
-          q->first->prev = NULL;
-        }
-      } else {
-        curr->prev->next = curr->next;
-        if (curr->next) {
-          curr->next->prev = curr->prev;
-        }
-      }
-      ctx->wait_mask = 0;
-      ctx->r = ENC_SYM_TRUE; // woken up task receives true.
-      enqueue_ctx_nm(&queue, ctx); // changes meaning of curr->next.
-    }
-    curr = next;
-  }
-}
-
 /* eval_cps_run can be paused
    I think it would be better use a mailbox for
    communication between other threads and the run_eval
@@ -4315,9 +4261,6 @@ void lbm_run_eval(void){
           }
           process_events();
           mutex_lock(&qmutex);
-          if (wait_for) {
-            process_waiting_nm();
-          }
           if (ctx_running) {
             enqueue_ctx_nm(&queue, ctx_running);
             ctx_running = NULL;
@@ -4338,11 +4281,11 @@ void lbm_run_eval(void){
 }
 
 lbm_cid lbm_eval_program(lbm_value lisp) {
-  return lbm_create_ctx(lisp, ENC_SYM_NIL, 256);
+  return lbm_create_ctx(lisp, ENC_SYM_NIL, 256, NULL);
 }
 
 lbm_cid lbm_eval_program_ext(lbm_value lisp, unsigned int stack_size) {
-  return lbm_create_ctx(lisp, ENC_SYM_NIL, stack_size);
+  return lbm_create_ctx(lisp, ENC_SYM_NIL, stack_size, NULL);
 }
 
 int lbm_eval_init() {