Squashed 'lispBM/lispBM/' changes from 82dd1b77..1be203ec

1be203ec added is_symbol_true
fbdbbc54 added is_byte_array and renamed lbm_is_list to lbm_is_cons, then created a new lbm_is_list which is also true for nil

git-subtree-dir: lispBM/lispBM
git-subtree-split: 1be203ecb48333c872f9056142d74a6f3c99b9c6

include/heap.h

@@ -655,7 +655,7 @@ static inline bool lbm_is_ptr(lbm_value x) {
   return (x & LBM_PTR_MASK);
 }
 
-static inline bool lbm_is_list(lbm_value x) {
+static inline bool lbm_is_cons(lbm_value x) {
   return (lbm_type_of(x) == LBM_TYPE_CONS);
 }
 
@@ -670,6 +670,13 @@ static inline bool lbm_is_array(lbm_value x) {
           lbm_type_of(lbm_cdr(x)) == LBM_TYPE_SYMBOL &&
           lbm_dec_sym(lbm_cdr(x)) == SYM_ARRAY_TYPE);
 }
+
+/** Check if a value represents a byte array.
+ * \param x Value to check.
+ * \return true if x represents a byte array and false otherwise.
+ */
+extern bool lbm_is_byte_array(lbm_value x);
+
 static inline bool lbm_is_channel(lbm_value x) {
   return (lbm_type_of(x) == LBM_TYPE_CHANNEL &&
           lbm_type_of(lbm_cdr(x)) == LBM_TYPE_SYMBOL &&
@@ -724,7 +731,7 @@ static inline bool lbm_is_match_binder(lbm_value exp) {
 }
 
 static inline bool lbm_is_comma_qualified_symbol(lbm_value exp) {
-  return (lbm_is_list(exp) &&
+  return (lbm_is_cons(exp) &&
           (lbm_type_of(lbm_car(exp)) == LBM_TYPE_SYMBOL) &&
           (lbm_dec_sym(lbm_car(exp)) == SYM_COMMA) &&
           (lbm_type_of(lbm_car(lbm_cdr(exp))) == LBM_TYPE_SYMBOL));
@@ -738,6 +745,10 @@ static inline bool lbm_is_symbol_nil(lbm_value exp) {
   return (lbm_is_symbol(exp) && lbm_dec_sym(exp) == SYM_NIL);
 }
 
+static inline bool lbm_is_symbol_true(lbm_value exp) {
+  return (lbm_is_symbol(exp) && lbm_dec_sym(exp) == SYM_TRUE);
+}
+
 static inline bool lbm_is_symbol_eval(lbm_value exp) {
   return (lbm_is_symbol(exp) && lbm_dec_sym(exp) == SYM_EVAL);
 }
@@ -746,6 +757,9 @@ static inline bool lbm_is_symbol_merror(lbm_value exp) {
   return (lbm_is_symbol(exp) && lbm_dec_sym(exp) == SYM_MERROR);
 }
 
+static inline bool lbm_is_list(lbm_value x) {
+  return (lbm_is_cons(x) || lbm_is_symbol_nil(x));
+}
 
 #ifndef LBM64
 #define ERROR_SYMBOL_MASK 0xFFFFFF20

src/eval_cps.c

@@ -1310,7 +1310,7 @@ static void eval_progn(eval_context_t *ctx) {
   lbm_value exps = lbm_cdr(ctx->curr_exp);
   lbm_value env  = ctx->curr_env;
 
-  if (lbm_is_list(exps)) {
+  if (lbm_is_cons(exps)) {
     lbm_uint *sptr = lbm_stack_reserve(&ctx->K, 3);
     if (!sptr) {
       error_ctx(ENC_SYM_STACK_ERROR);
@@ -1944,7 +1944,7 @@ static void cont_closure_application_args(eval_context_t *ctx) {
   lbm_value params  = (lbm_value)sptr[3];
   lbm_value args    = (lbm_value)sptr[4];
 
-  if (lbm_is_list(params)) {
+  if (lbm_is_cons(params)) {
     lbm_value entry;
     WITH_GC(entry,lbm_cons(lbm_car(params),ctx->r), ENC_SYM_NIL, ENC_SYM_NIL);
 
@@ -2000,7 +2000,7 @@ static void cont_application_args(eval_context_t *ctx) {
     sptr[1] = count;
     lbm_stack_drop(&ctx->K, 1);
     cont_application(ctx);
-  } else if (lbm_is_list(rest)) {
+  } else if (lbm_is_cons(rest)) {
     sptr[1] = env;
     sptr[2] = lbm_enc_u(lbm_dec_u(count) + 1);
     CHECK_STACK(lbm_push_2(&ctx->K,lbm_cdr(rest), APPLICATION_ARGS));
@@ -2064,7 +2064,7 @@ static void cont_bind_to_key_rest(eval_context_t *ctx) {
 
   lbm_env_modify_binding(env, key, arg);
 
-  if (lbm_is_list(rest)) {
+  if (lbm_is_cons(rest)) {
     lbm_value keyn = lbm_car(lbm_car(rest));
     lbm_value valn_exp = lbm_cadr(lbm_car(rest));
 
@@ -2144,7 +2144,7 @@ static void cont_match(eval_context_t *ctx) {
     /* no more patterns */
     ctx->r = ENC_SYM_NO_MATCH;
     ctx->app_cont = true;
-  } else if (lbm_is_list(patterns)) {
+  } else if (lbm_is_cons(patterns)) {
     lbm_value pattern = lbm_car(lbm_car(patterns));
     lbm_value body    = lbm_cadr(lbm_car(patterns));
 

src/fundamental.c

@@ -908,7 +908,7 @@ static lbm_value fundamental_undefine(lbm_value *args, lbm_uint nargs, eval_cont
   if (nargs == 1 && lbm_is_symbol(args[0])) {
     result = lbm_env_drop_binding(env, args[0]);
     *lbm_get_env_ptr() = result;
-  } else if (nargs == 1 && lbm_is_list(args[0])) {
+  } 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);
@@ -1066,7 +1066,7 @@ static lbm_value fundamental_set_ix(lbm_value *args, lbm_uint nargs, eval_contex
   (void) ctx;
   lbm_value result = ENC_SYM_EERROR;
   if (nargs == 3) {
-    if (lbm_is_list(args[0]) &&
+    if (lbm_is_cons(args[0]) &&
         lbm_is_number(args[1])) {
       lbm_value curr = args[0];
       lbm_uint i = 0;
@@ -1092,7 +1092,7 @@ static lbm_value fundamental_assoc(lbm_value *args, lbm_uint nargs, eval_context
   (void) ctx;
   lbm_value result = ENC_SYM_EERROR;
   if (nargs == 2) {
-    if (lbm_is_list(args[0])) {
+    if (lbm_is_cons(args[0])) {
       lbm_value r = assoc_lookup(args[1], args[0]);
       if (lbm_is_symbol(r) &&
           lbm_dec_sym(r) == SYM_NO_MATCH) {
@@ -1131,7 +1131,7 @@ static lbm_value fundamental_set_assoc(lbm_value *args, lbm_uint nargs, eval_con
   lbm_value result = ENC_SYM_EERROR;
   if (nargs == 3) {
     result = lbm_env_set(args[0], args[1], args[2]);
-  } else if (nargs == 2 && lbm_is_list(args[1])) {
+  } else if (nargs == 2 && lbm_is_cons(args[1])) {
     lbm_value x = lbm_car(args[1]);
     lbm_value xs = lbm_cdr(args[1]);
     result = lbm_env_set(args[0], x, xs);
@@ -1143,7 +1143,7 @@ static lbm_value fundamental_cossa(lbm_value *args, lbm_uint nargs, eval_context
   (void) ctx;
   lbm_value result = ENC_SYM_EERROR;
   if (nargs == 2) {
-    if (lbm_is_list(args[0])) {
+    if (lbm_is_cons(args[0])) {
       lbm_value r = cossa_lookup(args[1], args[0]);
       if (lbm_is_symbol(r) &&
           lbm_dec_sym(r) == SYM_NO_MATCH) {

src/heap.c

@@ -402,6 +402,15 @@ bool lbm_is_number(lbm_value x) {
 }
 
 
+bool lbm_is_byte_array(lbm_value x) {
+  if (lbm_is_array(x)) {
+    lbm_array_header_t *header = (lbm_array_header_t*)lbm_car(x);
+    return (header != NULL && header->elt_type == LBM_TYPE_BYTE);
+  }
+  return false;
+}
+
+
 
 /****************************************************/
 /* HEAP MANAGEMENT                                  */