From cfb5e8b522dfa9acb3987bb2be194095bca02797 Mon Sep 17 00:00:00 2001
From: Benjamin Vedder <benjamin@vedder.se>
Date: Tue, 10 May 2022 16:19:07 +0200
Subject: [PATCH] Squashed 'lispBM/lispBM/' changes from 4d6badc8..748a3a97

748a3a97 added a way to make up symbols on the fly in the extensions array. Symbol names starting with ext are allocated to the extensions table
5c934bd7 added a profiling script that uses callgrind
d5c14c2a cleaning out old unused code from heap.c

git-subtree-dir: lispBM/lispBM
git-subtree-split: 748a3a974f80c47c59a1252abc4db4cfb1fb875e
---
 examples/profile.sh | 11 +++++++++++
 include/symrepr.h   |  8 ++++++++
 src/heap.c          | 16 ---------------
 src/symrepr.c       | 48 ++++++++++++++++++++++++++++++++++++++++++++-
 src/tokpar.c        |  4 +++-
 5 files changed, 69 insertions(+), 18 deletions(-)
 create mode 100755 examples/profile.sh

diff --git a/examples/profile.sh b/examples/profile.sh
new file mode 100755
index 00000000..e519d8f7
--- /dev/null
+++ b/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
diff --git a/include/symrepr.h b/include/symrepr.h
index 726c1d6a..e764452b 100644
--- a/include/symrepr.h
+++ b/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.
  *
diff --git a/src/heap.c b/src/heap.c
index d55f130e..612e67c1 100644
--- a/src/heap.c
+++ b/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;
 
diff --git a/src/symrepr.c b/src/symrepr.c
index a0a8d5ed..945c697c 100644
--- a/src/symrepr.c
+++ b/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);
diff --git a/src/tokpar.c b/src/tokpar.c
index 999fabb1..11eee96c 100644
--- a/src/tokpar.c
+++ b/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);