Merge commit '346f321b9f304400b46e050fcbf75a27b391bae3'

lispBM/lispBM/include/lbm_variables.h

@@ -1,3 +1,4 @@
+/** \file lbm_variables.h */
 /*
     Copyright 2022 Joel Svensson   svenssonjoel@yahoo.se
     Copyright 2022 Benjamin Vedder
@@ -21,14 +22,47 @@
 
 #include "lbm_types.h"
 
+/** 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.
+ */
 extern 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.
+ */
 extern 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.
+ */
 extern 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.
+ */
 extern 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.
+ */
 extern 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.
+ */
 extern lbm_value lbm_set_var(lbm_uint index, lbm_value value);
 
 #endif 

lispBM/lispBM/include/lbm_version.h

@@ -27,24 +27,26 @@
 /** LBM patch revision */
 #define LBM_PATCH_VERSION 2
 
-/* Change log */
+/*! \page changelog Changelog
 
-/* Feb 28 2022: Version (0.4.2)
+Mar 02 2022: Version (0.4.2)
+ - Bug fix in initialization of contexts.
+
+Feb 28 2022: Version (0.4.2)
  - First go at human-readable error messages.
  - Finished contexts are immediately and completely removed.
  - Context ids are now set to the index into the lbm_memory
    where the context structure is stored.
 
-/* Feb 21 2022: Version (0.4.1)
+Feb 21 2022: Version (0.4.1)
  - Bug fixes in gc related to arrays
-*/
 
-/* Feb 20 2022: Version (0.4.0)
+
+Feb 20 2022: Version (0.4.0)
  - Adds support for macros.
  - Adds call-cc for escaping and abortive continuations.
-*/
 
-/* Feb 17 2022: version 0.3.0
+Feb 17 2022: version 0.3.0
  - Added lbm_undefine to c_interop.
  - Added lbm_share_array to c_interop.
  - Added lbm_create_array to c_interop.
@@ -53,17 +55,17 @@
  - Spawn optionally takes a number argument before the closure argument
    to specify stack size.
  - Extensions are stored in an array and occupy a range of dedicated symbol values.
+
+Feb 14 2022: version 0.2.0
+ - Added GEQ >= and LEQ <= comparisons.
+
+Feb 13 2022: version 0.1.1
+ - Bug fix in handling of environments in progn.
+
+Feb 11 2022: version 0.1.0
+  - First state to be given a numbered version (0.1.0)
 */
 
-/* Feb 14 2022: version 0.2.0
-   Added GEQ >= and LEQ <= comparisons.
-
-/* Feb 13 2022: version 0.1.1
-   Bug fix in handling of environments in progn. */
-
-/* Feb 11 2022: First state to be given a numbered version (0.1.0)  */
-
-
 
 
 #endif

lispBM/lispBM/include/symrepr.h

@@ -55,7 +55,6 @@
 #define SYM_CONT          0x12
 #define SYM_SETVAR        0x13
 
-
 // 0x20 - 0x2F are errors
 #define SYM_RERROR        0x20  /* READ ERROR */
 #define SYM_TERROR        0x21  /* TYPE ERROR */

lispBM/lispBM/repl-cps/Makefile

@@ -6,7 +6,7 @@ include $(LISPBM)/lispbm.mk
 PLATFORM_INCLUDE = -I$(LISPBM)/platform/linux/include
 PLATFORM_SRC     = $(LISPBM)/platform/linux/src/platform_mutex.c
 
-CCFLAGS = -m32 -O2 -Wall -Wconversion -pedantic -std=c11
+CCFLAGS = -g -m32  -Wall -Wconversion -pedantic -std=c11
 
 PICCFLAGS = -O2 -Wall -Wconversion -pedantic -std=c11
 

lispBM/lispBM/repl-cps/repl.c

@@ -144,6 +144,9 @@ void done_callback(eval_context_t *ctx) {
   } else {
     printf("<< Context %d finished with value %s >>\n", cid, output);
   }
+  printf("stack max:  %d\n", ctx->K.max_sp);
+  printf("stack size: %u\n", ctx->K.size);
+  printf("stack sp:   %d\n", ctx->K.sp);
 
   //  if (!eval_cps_remove_done_ctx(cid, &t)) {
   //   printf("Error: done context (%d)  not in list\n", cid);
@@ -618,7 +621,7 @@ int main(int argc, char **argv) {
       /* Something better is needed.
          this sleep ís to ensure the string is alive until parsing
          is done */
-      sleep_callback(10000);
+      sleep_callback(250000);
     }
   }
   free(heap_storage);

lispBM/lispBM/src/eval_cps.c

@@ -711,6 +711,7 @@ lbm_cid lbm_create_ctx(lbm_value program, lbm_value env, uint32_t stack_size) {
   ctx->program = lbm_cdr(program);
   ctx->curr_exp = lbm_car(program);
   ctx->curr_env = env;
+  ctx->r = lbm_enc_sym(SYM_NIL);
   ctx->mailbox = lbm_enc_sym(SYM_NIL);
   ctx->done = false;
   ctx->app_cont = false;
@@ -1005,11 +1006,11 @@ static int gc(lbm_value remember1, lbm_value remember2) {
     curr = curr->next;
   }
 
-  curr = done.first;
-  while (curr) {
-    lbm_gc_mark_phase(curr->r);
-    curr = curr->next;
-  }
+  /* curr = done.first; */
+  /* while (curr) { */
+  /*   lbm_gc_mark_phase(curr->r); */
+  /*   curr = curr->next; */
+  /* } */
 
   curr = blocked.first;
   while (curr) {
@@ -1577,10 +1578,14 @@ static inline void cont_application(eval_context_t *ctx) {
 
     switch(dfun) {
     case SYM_SETVAR: {
-      if (lbm_dec_u(count) == 2 && lbm_is_symbol(fun_args[1])) {
+      lbm_uint cnt = lbm_dec_u(count);
+
+      if (cnt == 2 && lbm_is_symbol(fun_args[1])) {
+
         lbm_uint s = lbm_dec_sym(fun_args[1]);
         if (s >= VARIABLE_SYMBOLS_START &&
             s <  VARIABLE_SYMBOLS_END) {
+          /* #var case ignores local/global if present */
           ctx->r = lbm_set_var(s, fun_args[2]);
         } else {
           lbm_value new_env = lbm_env_modify_binding(ctx->curr_env, fun_args[1], fun_args[2]);
@@ -1590,7 +1595,8 @@ static inline void cont_application(eval_context_t *ctx) {
           }
           if (lbm_type_of(new_env) == LBM_VAL_TYPE_SYMBOL &&
               lbm_dec_sym(new_env) == SYM_NOT_FOUND) {
-            ctx->r = NIL;
+            new_env = lbm_env_set(lbm_get_env(),  fun_args[1], fun_args[2]);
+            *lbm_get_env_ptr() = new_env;
           } else {
             ctx->r = fun_args[2];
           }
@@ -1599,6 +1605,7 @@ static inline void cont_application(eval_context_t *ctx) {
         error_ctx(lbm_enc_sym(SYM_EERROR));
         return;
       }
+      ctx->r = fun_args[2];
       lbm_stack_drop(&ctx->K, lbm_dec_u(count)+1);
       ctx->app_cont = true;
     } break;
@@ -2057,6 +2064,7 @@ static inline void cont_read(eval_context_t *ctx) {
           error_ctx(lbm_enc_sym(SYM_RERROR));
           return;
         }
+        /* Go back to outer eval loop and apply continuation */
         ctx->app_cont = true;
         read_done = true;
         continue;
@@ -2091,6 +2099,7 @@ static inline void cont_read(eval_context_t *ctx) {
       } break;
       }
     } else {
+      app_cont = false;
       tok = token_stream_get(str);
 
       if (lbm_type_of(tok) == LBM_VAL_TYPE_SYMBOL) {
@@ -2390,9 +2399,6 @@ void lbm_run_eval(void){
 
   while (eval_running) {
 
-    //uint32_t prev_state = eval_cps_run_state;
-    //eval_cps_run_state = eval_cps_next_state;
-
     switch (eval_cps_next_state) {
     case EVAL_CPS_STATE_INIT:
       eval_cps_run_state = EVAL_CPS_STATE_RUNNING;

lispBM/lispBM/src/stack.c

@@ -71,8 +71,6 @@ int lbm_push_u32(lbm_stack_t *s, lbm_uint val) {
     return 0;
   }
 
-  if (!res) return res;
-
   s->data[s->sp] = val;
   s->sp++;