Add full support for remaining data type (box, vector, byte string).

Improve inline accessors for cases where value type is known.
Move GC stats into a single global structure to reduce proliferation of globals.

gc.c

@@ -8,25 +8,19 @@
 
 #include "gc.h"
 
-extern int gc_counter;
+gc_stats_t gc_stats;
-extern int gc_ticks;
+
+/* Helper macros to reduce duplication */
+#define VECTOR_BYTES(nelem) (sizeof(vector_t) + (sizeof(value_t) * (nelem)))
+#define BYTESTR_BYTES(size) (sizeof(byte_string_t) + (size))
 
 /* Alignment must ensure each object has enough room to hold a pair (BH . new_addr) */
 #define GC_ALIGNMENT  ((size_t)(sizeof(pair_t)))
 
-/* Pairs are a type of object, but the value representation is different */
 object_t *get_object(value_t v)
 {
   if (is_object(v))
-    return (object_t*)(v & ~(value_t)3);
+    return _get_object(v);
-  else
-    abort();
-}
-
-pair_t *get_pair(value_t v)
-{
-  if (is_pair(v))
-    return (pair_t*)(v - 2);
   else
     abort();
 }
@@ -49,6 +43,97 @@ value_t cons(value_t car, value_t cdr)
   return pair_value(p);
 }
 
+pair_t *get_pair(value_t v)
+{
+  if (is_pair(v))
+    return _get_pair(v);
+  else
+    abort();
+}
+
+value_t make_box(value_t initial_value)
+{
+  gc_root_t iv_root;
+  box_t *box;
+
+  register_gc_root(&iv_root, initial_value);
+
+  box = (box_t*)gc_alloc(sizeof(box_t));
+  box->tag = TYPE_TAG_BOX;
+  box->value = iv_root.value;
+
+  unregister_gc_root(&iv_root);
+
+  return object_value(box);
+}
+
+box_t *get_box(value_t v)
+{
+  if (is_box(v))
+    return _get_box(v);
+  else
+    abort();
+}
+
+value_t make_vector(size_t nelem, value_t initial_value)
+{
+  gc_root_t iv_root;
+  vector_t *vec;
+
+  register_gc_root(&iv_root, initial_value);
+
+  vec = (vector_t*)gc_alloc(VECTOR_BYTES(nelem));
+  vec->tag = TYPE_TAG_VECTOR;
+  vec->size = nelem;
+
+  for (int i = 0; i < nelem; ++i)
+    vec->elements[i] = iv_root.value;
+
+  unregister_gc_root(&iv_root);
+
+  return object_value(vec);
+}
+
+vector_t *get_vector(value_t v)
+{
+  if (is_vector(v))
+    return _get_vector(v);
+  else
+    abort();
+}
+
+value_t make_byte_string(size_t size, int default_value)
+{
+  const size_t nbytes = BYTESTR_BYTES(size);
+  byte_string_t *str;
+  
+  str = (byte_string_t*)gc_alloc(nbytes);
+  str->tag = TYPE_TAG_BYTESTR;
+  str->size = size;
+
+  memset(str->bytes, default_value, size);
+
+  return object_value(str);
+}
+
+byte_string_t *get_byte_string(value_t v)
+{
+  if (is_byte_string(v))
+    return _get_byte_string(v);
+  else
+    abort();
+}
+
+intptr_t get_fixnum(value_t v)
+{
+  if (is_fixnum(v))
+    return _get_fixnum(v);
+  else
+    abort();
+}
+
+/****************************************************************************/
+
 static char      *gc_ranges[2];
 static size_t     gc_min_size;
 static size_t     gc_max_size;
@@ -101,6 +186,10 @@ void gc_init(size_t min_size, size_t max_size)
   gc_max_size   = max_size;
   gc_soft_limit = gc_min_size;
   gc_free_space = gc_soft_limit;
+
+  gc_stats.collections = 0;
+  gc_stats.total_ticks = 0;
+  gc_stats.high_water  = 0;
 }
 
 void register_gc_root(gc_root_t *root, value_t v)
@@ -155,59 +244,34 @@ static void transfer_object(value_t *value)
     }
     else
     {
+      size_t nbytes;
+
       switch (obj->tag)
       {
       case TYPE_TAG_VECTOR:
-        {
+        nbytes = VECTOR_BYTES(((const vector_t*)obj)->size);
-          const vector_t *vec = (const vector_t*)obj;
-          const size_t nbytes = sizeof(vector_t) + sizeof(value_t) * vec->size;
-          vector_t *newvec = (vector_t*)gc_alloc(nbytes);
-          memcpy(newvec, vec, nbytes);
-          new_value = object_value(newvec);
-        }
         break;
       case TYPE_TAG_BYTESTR:
-        {
+        nbytes = BYTESTR_BYTES(((const byte_string_t*)obj)->size);
-          const byte_string_t *str = (const byte_string_t*)obj;
-          const size_t nbytes = sizeof(byte_string_t) + str->size;
-          byte_string_t *newstr = (byte_string_t*)gc_alloc(nbytes);
-          memcpy(newstr, str, nbytes);
-          new_value = object_value(newstr);
-        }
         break;
       case TYPE_TAG_BOX:
       default: /* pair */
-        {
+        nbytes = sizeof(pair_t);
-          pair_t *p = (pair_t*)gc_alloc(sizeof(pair_t));
-          const pair_t *q = (const pair_t*)obj;
-          *p = *q;
-
-          //debug(("Moved pair from 0x%0.8X to 0x%0.8X.\n", q, p));
-
-          /* Keep the original tag bits (pair or object) */
-          new_value = pair_value(p) | (*value & 2);
-        }
         break;
       }
 
+      {
+        void *newobj = gc_alloc(nbytes);
+        memcpy(newobj, obj, nbytes);
+
+        /* Keep the original tag bits (pair or object) */
+        new_value = object_value(newobj) | (*value & 2);
+      }
+
       obj->tag = BROKEN_HEART;
       obj->payload.values[0] = new_value;
     }
 
-#if 0
-#ifndef NDEBUG
-    if (is_pair(new_value))
-    {
-      if (gc_range_of(get_pair(new_value)) != gc_current_range)
-      {
-        debug(("Invalid address after transfer: 0x%0.8X. Current GC: %d.\n",
-              get_pair(new_value), gc_current_range));
-        abort();
-      }
-    }
-#endif
-#endif
-
     *value = new_value;
   }
 }
@@ -219,19 +283,17 @@ static inline size_t transfer_children(object_t *obj)
   case TYPE_TAG_VECTOR:
     {
       vector_t *vec = (vector_t*)obj;
-      const intptr_t nelem = from_fixnum(vec->size);
 
-      for (intptr_t i = 0; i < nelem; ++i)
+      for (size_t i = 0; i < vec->size; ++i)
       {
         transfer_object(&vec->elements[i]);
       }
 
-      return sizeof(vector_t) + (nelem * sizeof(value_t));
+      return VECTOR_BYTES(vec->size);
     }
   case TYPE_TAG_BYTESTR:
     {
-      const byte_string_t *str = (const byte_string_t*)obj;
+      return BYTESTR_BYTES(((const byte_string_t*)obj)->size);
-      return sizeof(byte_string_t) + from_fixnum(str->size);
     }
   case TYPE_TAG_BOX:
   default: /* pair */
@@ -253,6 +315,9 @@ void collect_garbage(size_t min_free)
 
   //debug(("Collecting garbage...\n"));
 
+  ++gc_stats.collections;
+  gc_stats.total_ticks -= clock();
+
   /* Recursive calls to collector should never occur */
   if (collecting)
   {
@@ -262,9 +327,6 @@ void collect_garbage(size_t min_free)
   else
     collecting = true;
 
-  ++gc_counter;
-  gc_ticks -= (int)clock();
-
   /* Swap ranges; new "current" range is initially empty, old one is full */
   gc_current_range = 1 - gc_current_range;
   gc_free_ptr      = (char*)&gc_ranges[gc_current_range][0];
@@ -291,7 +353,7 @@ void collect_garbage(size_t min_free)
   {
     size_t bytes_used = gc_soft_limit - gc_free_space;
     size_t min_limit = bytes_used + min_free;
-    size_t new_limit = (3 * min_limit) / 2;
+    size_t new_limit = (5 * min_limit) / 3;
 
     if (new_limit > gc_max_size)
       new_limit = gc_max_size;
@@ -307,10 +369,15 @@ void collect_garbage(size_t min_free)
     out_of_memory();
   }
 
+  if (gc_soft_limit > gc_stats.high_water)
+  {
+    gc_stats.high_water = gc_soft_limit;
+  }
+
   /* Done collecting. */
   collecting = false;
 
-  gc_ticks += (int)clock();
+  gc_stats.total_ticks += clock();
 }
 
 /* vim:set sw=2 expandtab: */

gc.h

@@ -31,12 +31,6 @@ typedef uintptr_t value_t;
 #define TYPE_TAG_VECTOR  SPECIAL_VALUE(2)
 #define TYPE_TAG_BYTESTR SPECIAL_VALUE(3)
 
-typedef struct pair
-{
-  value_t car;
-  value_t cdr;
-} pair_t;
-
 typedef struct object
 {
   value_t tag;
@@ -46,6 +40,18 @@ typedef struct object
   } payload;
 } object_t;
 
+typedef struct box
+{
+  value_t tag;
+  value_t value;
+} box_t;
+
+typedef struct pair
+{
+  value_t car;
+  value_t cdr;
+} pair_t;
+
 typedef struct vector
 {
   value_t tag;
@@ -67,30 +73,50 @@ typedef struct gc_root
   struct gc_root *next;
 } gc_root_t;
 
-static inline bool is_pair(value_t v)
+typedef struct gc_stats
 {
-  return ((v & 0x3) == 2);
+  int     collections;
+  clock_t total_ticks;
+  size_t  high_water;
+} gc_stats_t;
+
+extern gc_stats_t gc_stats;
+
+object_t *get_object(value_t v);
+
+pair_t *get_pair(value_t pair);
+value_t cons(value_t car, value_t cdr);
+
+value_t make_box(value_t initial_value);
+box_t *get_box(value_t v);
+
+value_t make_vector(size_t elements, value_t default_value);
+vector_t *get_vector(value_t v);
+
+value_t make_byte_string(size_t size, int default_value);
+byte_string_t *get_byte_string(value_t v); 
+
+intptr_t get_fixnum(value_t v);
+
+/****************************************************************************/
+
+static inline value_t object_value(void *obj)
+{
+  assert((uintptr_t)obj >= 4096);
+  assert(((uintptr_t)obj & 3) == 0);
+  return (value_t)obj;
 }
 
 static inline bool is_object(value_t v)
 {
-  /* Neither pairs nor objects can exist below (void*)4096. */
+  /* Neither pairs nor other objects can exist below (void*)4096. */
   return ((v & 0x1) == 0) && (v > MAX_SPECIAL);
 }
 
-static inline bool is_fixnum(value_t v)
+/* Pairs are a type of object, but the value representation is different */
+static inline object_t *_get_object(value_t v)
 {
-  return (v & 1) != 0;
+  return (object_t*)(v & ~(value_t)3);
-}
-
-static inline value_t to_fixnum(intptr_t n)
-{
-  return (value_t)(n << 1) | 1;
-}
-
-static inline intptr_t from_fixnum(value_t n)
-{
-  return ((intptr_t)n) >> 1;
 }
 
 static inline value_t pair_value(pair_t *p)
@@ -100,17 +126,70 @@ static inline value_t pair_value(pair_t *p)
   return (value_t)p + 2;
 }
 
-static inline value_t object_value(void *obj)
+static inline bool is_pair(value_t v)
 {
-  assert((uintptr_t)obj >= 4096);
+  return ((v & 0x3) == 2);
-  assert(((uintptr_t)obj & 3) == 0);
-  return (value_t)obj;
 }
 
-object_t *get_object(value_t v);
+static inline pair_t *_get_pair(value_t v)
-pair_t *get_pair(value_t pair);
+{
-value_t get_cdr(value_t pair);
+  return (pair_t*)_get_object(v);
-value_t cons(value_t car, value_t cdr);
+}
+
+static inline bool is_box(value_t v)
+{
+  return is_object(v) && (_get_object(v)->tag == TYPE_TAG_BOX);
+}
+
+static inline box_t *_get_box(value_t v)
+{
+  return (box_t*)_get_object(v);
+}
+
+static inline bool is_vector(value_t v)
+{
+  return is_object(v) && (_get_object(v)->tag == TYPE_TAG_VECTOR);
+}
+
+static inline vector_t *_get_vector(value_t v)
+{
+  return (vector_t*)_get_object(v);
+}
+
+static inline size_t vector_size(value_t v)
+{
+  return get_vector(v)->size;
+}
+
+static inline bool is_byte_string(value_t v)
+{
+  return is_object(v) && (_get_object(v)->tag == TYPE_TAG_BYTESTR);
+}
+
+static inline byte_string_t *_get_byte_string(value_t v)
+{
+  return (byte_string_t*)_get_object(v);
+}
+
+static inline size_t byte_string_size(value_t v)
+{
+  return get_byte_string(v)->size;
+}
+
+static inline bool is_fixnum(value_t v)
+{
+  return (v & 1) != 0;
+}
+
+static inline value_t make_fixnum(intptr_t n)
+{
+  return (value_t)(n << 1) | 1;
+}
+
+static inline intptr_t _get_fixnum(value_t n)
+{
+  return ((intptr_t)n) >> 1;
+}
 
 void gc_init(size_t min_size, size_t max_size);
 void register_gc_root(gc_root_t *root, value_t v);
@@ -122,5 +201,4 @@ void collect_garbage(size_t min_free);
 void out_of_memory(void) __attribute__ ((noreturn));
 
 #endif
-
 /* vim:set sw=2 expandtab: */

gc_test.c

@@ -9,9 +9,6 @@
 
 #include "gc.h"
 
-int gc_counter;
-int gc_ticks;
-
 void out_of_memory(void)
 {
   fprintf(stderr, "Out of memory!\n");
@@ -25,9 +22,6 @@ int main(int argc, char **argv)
 
   gc_init(1024, 256*1024*1024);
 
-  gc_counter = 0;
-  gc_ticks = 0;
-
   srand((unsigned int)time(NULL));
 
   register_gc_root(&list_root, NIL);
@@ -37,27 +31,53 @@ int main(int argc, char **argv)
     int r = rand() & 0xffff;
 
     if (r == 0)
-      list_root.value = to_fixnum(rand());
+      list_root.value = make_fixnum(rand());
-    else if (r & 1)
+    else
-      list_root.value = cons(to_fixnum(rand()), list_root.value);
-    else if (r & 2)
-      list_root.value = cons(list_root.value, to_fixnum(rand()));
-    else if (r & 4)
     {
-      list_root.value = cons(list_root.value, cons(to_fixnum(-1), NIL));
+      switch (r & 7)
-      get_pair(get_pair(list_root.value)->cdr)->cdr = list_root.value;
+      {
-    }
+      case 0:
-
+        list_root.value = cons(make_fixnum(rand()), list_root.value);
-    if (gc_counter >= 1000)
-    {
-      fprintf(stderr, "%d collections in %0.3f seconds = %0.3f usec / GC\n",
-          gc_counter,
-          gc_ticks / (double)CLOCKS_PER_SEC,
-          (1000000 * (gc_ticks / (double)CLOCKS_PER_SEC)) / gc_counter);
-      gc_counter = gc_ticks = 0;
-
-      if (++count == 10)
         break;
+      case 1:
+        list_root.value = cons(list_root.value, make_byte_string(256, '\0'));
+        break;
+      case 2:
+        list_root.value = make_box(list_root.value);
+        break;
+      case 3:
+        list_root.value = cons(list_root.value, cons(make_fixnum(-1), NIL));
+        get_pair(get_pair(list_root.value)->cdr)->cdr = list_root.value;
+        ++count;
+        break;
+      case 4:
+      case 5:
+      case 6:
+      case 7:
+        {
+          value_t vec = make_vector(4, NIL);
+          _get_vector(vec)->elements[r & 3] = list_root.value;
+          list_root.value = vec;
+        }
+        break;
+      }
+    }
+    ++count;
+
+    if (count >= 10000000)
+    {
+      fprintf(stderr, "%0.3f usec / GC; max. limit was %u bytes; %0.3f seconds spent in %d GCs.\n",
+          (1000000 * (gc_stats.total_ticks / (double)CLOCKS_PER_SEC)) / gc_stats.collections,
+          gc_stats.high_water,
+          gc_stats.total_ticks / (double)CLOCKS_PER_SEC,
+          gc_stats.collections);
+
+      gc_stats.collections = 0;
+      gc_stats.total_ticks = 0;
+      gc_stats.high_water = 0;
+      count = 0;
+
+      break;
     }
   }