Merge commit 'cfb5e8b522dfa9acb3987bb2be194095bca02797'

lispBM/lispBM/examples/profile.sh

@@ -0,0 +1,11 @@
+#!/bin/bash
+
+
+valgrind --tool=callgrind --callgrind-out-file=cg.out ${*:1}
+
+gprof2dot -f callgrind cg.out -o cg.dot
+
+dot -Tpdf cg.dot -o cg.pdf
+
+rm cg.out
+rm cg.dot

lispBM/lispBM/include/symrepr.h

@@ -242,6 +242,14 @@ extern int lbm_add_variable_symbol(char *name, lbm_uint* id);
  * \return 1 for success and 0 for failure.
  */
 extern int lbm_add_symbol_const(char *name, lbm_uint *id);
+/** Add an extension symbol to the symbol table.
+ *  The name is assumed is dynamically allocated on lbm_memory
+ *
+ * \param name Name of the symbol.
+ * \param id Resulting id is returned through this argument.
+ * \return 1 for success and 0 for failure.
+ */
+extern int lbm_add_extension_symbol(char *name, lbm_uint* id);
 /** Add an extension symbol to the symbol table.
  *  The name is assumed to be statically allocated.
  *

lispBM/lispBM/src/heap.c

@@ -254,22 +254,6 @@ static inline bool get_gc_mark(lbm_cons_t* cell) {
   return lbm_get_gc_mark(cdr);
 }
 
-static inline void set_gc_flag(lbm_cons_t *cell) {
-  lbm_value v = read_car(cell);
-  set_car_(cell, lbm_set_gc_mark(v));
-}
-
-static inline void clr_gc_flag(lbm_cons_t *cell) {
-  lbm_value v = read_car(cell);
-  set_car_(cell, lbm_clr_gc_mark(v));
-}
-
-static inline bool get_gc_flag(lbm_cons_t* cell) {
-  lbm_value v = read_car(cell);
-  return lbm_get_gc_mark(v);
-}
-
-
 static int generate_freelist(size_t num_cells) {
   size_t i = 0;
 

lispBM/lispBM/src/symrepr.c

@@ -396,6 +396,53 @@ int lbm_add_symbol_const(char *name, lbm_uint* id) {
   return 1;
 }
 
+int lbm_add_extension_symbol(char *name, lbm_uint* id) {
+  size_t  n = 0;
+  n = strlen(name) + 1;
+
+  if (n == 1) return 0; // failure if empty symbol
+  if (next_extension_symbol_id >= EXTENSION_SYMBOLS_END) return 0;
+
+  lbm_uint *m = lbm_memory_allocate(3);
+
+  if (m == NULL) {
+    return 0;
+  }
+
+  char *symbol_name_storage = NULL;
+  lbm_uint alloc_size;
+  if (n % sizeof(lbm_uint) == 0) {
+    alloc_size = n/(sizeof(lbm_uint));
+  } else {
+    alloc_size = (n/(sizeof(lbm_uint))) + 1;
+  }
+
+  symbol_name_storage = (char *)lbm_memory_allocate(alloc_size);
+
+  if (symbol_name_storage == NULL) {
+    lbm_memory_free(m);
+    return 0;
+  }
+
+  symbol_table_size_list += 3;
+  symbol_table_size_strings += alloc_size;
+
+  strcpy(symbol_name_storage, name);
+
+  m[NAME] = (lbm_uint)symbol_name_storage;
+
+  if (symlist == NULL) {
+    m[NEXT] = (lbm_uint) NULL;
+    symlist = m;
+  } else {
+    m[NEXT] = (lbm_uint) symlist;
+    symlist = m;
+  }
+  m[ID] = next_extension_symbol_id++;
+  *id = m[ID];
+  return 1;
+}
+
 int lbm_add_extension_symbol_const(char *name, lbm_uint* id) {
   if (strlen(name) == 0) return 0; // failure if empty symbol
   if (next_extension_symbol_id >= EXTENSION_SYMBOLS_END) return 0;
@@ -422,7 +469,6 @@ int lbm_add_extension_symbol_const(char *name, lbm_uint* id) {
   return 1;
 }
 
-
 lbm_uint lbm_get_symbol_table_size(void) {
   return (symbol_table_size_list +
           symbol_table_size_strings) * sizeof(lbm_uint);

lispBM/lispBM/src/tokpar.c

@@ -709,7 +709,9 @@ lbm_value lbm_get_next_token(lbm_tokenizer_char_stream_t *str) {
     }
     else {
       int r = 0;
-      if (sym_str[0] == '#') {
+      if (strncmp(sym_str,"ext",3) == 0) {
+        r = lbm_add_extension_symbol(sym_str, &symbol_id);
+      } else if (sym_str[0] == '#') {
         r = lbm_add_variable_symbol(sym_str, &symbol_id);
       } else {
         r = lbm_add_symbol(sym_str, &symbol_id);