From b637d13783762b06d1358d0ee14dde29aefd420e Mon Sep 17 00:00:00 2001
From: Justin Ethier <justin.ethier@gmail.com>
Date: Tue, 24 Jan 2017 21:52:12 -0500
Subject: [PATCH 01/17] Merge or the worthwhile changes from gc-opt3-dev

---
 gc.c                    | 68 +++++++++++++++++++++++------------------
 include/cyclone/types.h |  4 +--
 2 files changed, 40 insertions(+), 32 deletions(-)

diff --git a/gc.c b/gc.c
index 4455dca2..375e4381 100644
--- a/gc.c
+++ b/gc.c
@@ -59,8 +59,8 @@ static int mark_stack_i = 0;
 static pthread_mutex_t heap_lock;
 
 // Cached heap statistics
-static int cached_heap_free_sizes[7] = { 0, 0, 0, 0, 0, 0, 0 };
-static int cached_heap_total_sizes[7] = { 0, 0, 0, 0, 0, 0, 0 };
+static uint64_t cached_heap_free_sizes[7] = { 0, 0, 0, 0, 0, 0, 0 };
+static uint64_t cached_heap_total_sizes[7] = { 0, 0, 0, 0, 0, 0, 0 };
 
 // Data for each individual mutator thread
 ck_array_t Cyc_mutators, old_mutators;
@@ -222,12 +222,12 @@ gc_heap *gc_heap_create(int heap_type, size_t size, size_t max_size,
     return NULL;
   h->type = heap_type;
   h->size = size;
-  h->newly_created = 1;
+  h->ttl = 10;
   h->next_free = h;
   h->last_alloc_size = 0;
   //h->free_size = size;
-  cached_heap_total_sizes[heap_type] += size;
-  cached_heap_free_sizes[heap_type] += size;
+  ck_pr_add_64(&(cached_heap_total_sizes[heap_type]), size);
+  ck_pr_add_64(&(cached_heap_free_sizes[heap_type]), size);
   h->chunk_size = chunk_size;
   h->max_size = max_size;
   h->data = (char *)gc_heap_align(sizeof(h->data) + (uintptr_t) & (h->data));
@@ -493,6 +493,9 @@ int gc_grow_heap(gc_heap * h, int heap_type, size_t size, size_t chunk_size)
       if (new_size < HEAP_SIZE) {
         new_size = prev_size + h_last->size;
         prev_size = h_last->size;
+        if (new_size > HEAP_SIZE) {
+            new_size = HEAP_SIZE;
+        }
       } else {
         new_size = HEAP_SIZE;
       }
@@ -557,8 +560,8 @@ void *gc_try_alloc(gc_heap * h, int heap_type, size_t size, char *obj,
           // Copy object into heap now to avoid any uninitialized memory issues
           gc_copy_obj(f2, obj, thd);
           //h->free_size -= gc_allocated_bytes(obj, NULL, NULL);
-          cached_heap_free_sizes[heap_type] -=
-              gc_allocated_bytes(obj, NULL, NULL);
+          ck_pr_sub_64(&(cached_heap_free_sizes[heap_type]),
+                       gc_allocated_bytes(obj, NULL, NULL));
         }
         h_passed->next_free = h;
         h_passed->last_alloc_size = size;
@@ -612,6 +615,10 @@ void *gc_alloc(gc_heap_root * hrt, size_t size, char *obj, gc_thread_data * thd,
     result = gc_try_alloc(h, heap_type, size, obj, thd);
     if (!result) {
       fprintf(stderr, "out of memory error allocating %zu bytes\n", size);
+      fprintf(stderr, "Heap type %d diagnostics:\n", heap_type);
+      pthread_mutex_lock(&heap_lock);
+      gc_print_stats(h);
+      pthread_mutex_unlock(&heap_lock); // why not
       exit(1);                  // could throw error, but OOM is a major issue, so...
     }
   }
@@ -840,7 +847,7 @@ size_t gc_sweep(gc_heap * h, int heap_type, size_t * sum_freed_ptr)
       }
     }
     //h->free_size += heap_freed;
-    cached_heap_free_sizes[heap_type] += heap_freed;
+    ck_pr_add_64(&(cached_heap_free_sizes[heap_type]), heap_freed);
     // Free the heap page if possible.
     //
     // With huge heaps, this becomes more important. one of the huge
@@ -855,13 +862,14 @@ size_t gc_sweep(gc_heap * h, int heap_type, size_t * sum_freed_ptr)
     // remaining without them.
     //
     // Experimenting with only freeing huge heaps
-    if (h->type == HEAP_HUGE && gc_is_heap_empty(h) && !h->newly_created){
+    if (gc_is_heap_empty(h) && 
+          (h->type == HEAP_HUGE || !(h->ttl--))) {
         unsigned int h_size = h->size;
         h = gc_heap_free(h, prev_h);
-        cached_heap_free_sizes[heap_type] -= h_size;
-        cached_heap_total_sizes[heap_type] -= h_size;
+        ck_pr_sub_64(&(cached_heap_free_sizes[heap_type] ), h_size);
+        ck_pr_sub_64(&(cached_heap_total_sizes[heap_type]), h_size);
+
     }
-    h->newly_created = 0;
     sum_freed += heap_freed;
     heap_freed = 0;
   }
@@ -1073,16 +1081,16 @@ void gc_mut_cooperate(gc_thread_data * thd, int buf_len)
   // Threshold is intentially low because we have to go through an
   // entire handshake/trace/sweep cycle, ideally without growing heap.
   if (ck_pr_load_int(&gc_stage) == STAGE_RESTING &&
-      ((cached_heap_free_sizes[HEAP_SM] <
-        cached_heap_total_sizes[HEAP_SM] * GC_COLLECTION_THRESHOLD) ||
-       (cached_heap_free_sizes[HEAP_64] <
-        cached_heap_total_sizes[HEAP_64] * GC_COLLECTION_THRESHOLD) ||
+      ((ck_pr_load_64(&(cached_heap_free_sizes[HEAP_SM])) <
+        ck_pr_load_64(&(cached_heap_total_sizes[HEAP_SM])) * GC_COLLECTION_THRESHOLD) ||
+       (ck_pr_load_64(&(cached_heap_free_sizes[HEAP_64])) <
+        ck_pr_load_64(&(cached_heap_total_sizes[HEAP_64])) * GC_COLLECTION_THRESHOLD) ||
 #if INTPTR_MAX == INT64_MAX
-       (cached_heap_free_sizes[HEAP_96] <
-        cached_heap_total_sizes[HEAP_96] * GC_COLLECTION_THRESHOLD) ||
+       (ck_pr_load_64(&(cached_heap_free_sizes[HEAP_96])) <
+        ck_pr_load_64(&(cached_heap_total_sizes[HEAP_96])) * GC_COLLECTION_THRESHOLD) ||
 #endif
-       (cached_heap_free_sizes[HEAP_REST] <
-        cached_heap_total_sizes[HEAP_REST] * GC_COLLECTION_THRESHOLD))) {
+       (ck_pr_load_64(&(cached_heap_free_sizes[HEAP_REST])) <
+        ck_pr_load_64(&(cached_heap_total_sizes[HEAP_REST])) * GC_COLLECTION_THRESHOLD))) {
 #if GC_DEBUG_TRACE
     fprintf(stderr,
             "Less than %f%% of the heap is free, initiating collector\n",
@@ -1487,8 +1495,8 @@ void gc_collector()
 
   // TODO: this loop only includes smallest 2 heaps, is that sufficient??
   for (heap_type = 0; heap_type < 2; heap_type++) {
-    while (cached_heap_free_sizes[heap_type] <
-           (cached_heap_total_sizes[heap_type] * GC_FREE_THRESHOLD)) {
+    while ( ck_pr_load_64(&(cached_heap_free_sizes[heap_type])) <
+           (ck_pr_load_64(&(cached_heap_total_sizes[heap_type])) * GC_FREE_THRESHOLD)) {
 #if GC_DEBUG_TRACE
       fprintf(stderr, "Less than %f%% of the heap %d is free, growing it\n",
               100.0 * GC_FREE_THRESHOLD, heap_type);
@@ -1503,18 +1511,18 @@ void gc_collector()
     }
   }
 #if GC_DEBUG_TRACE
-  total_size = cached_heap_total_sizes[HEAP_SM] +
-               cached_heap_total_sizes[HEAP_64] + 
+  total_size = ck_pr_load_64(&(cached_heap_total_sizes[HEAP_SM])) +
+               ck_pr_load_64(&(cached_heap_total_sizes[HEAP_64])) + 
 #if INTPTR_MAX == INT64_MAX
-               cached_heap_total_sizes[HEAP_96] + 
+               ck_pr_load_64(&(cached_heap_total_sizes[HEAP_96])) + 
 #endif
-               cached_heap_total_sizes[HEAP_REST];
-  total_free = cached_heap_free_sizes[HEAP_SM] +
-               cached_heap_free_sizes[HEAP_64] + 
+               ck_pr_load_64(&(cached_heap_total_sizes[HEAP_REST]));
+  total_free = ck_pr_load_64(&(cached_heap_free_sizes[HEAP_SM])) +
+               ck_pr_load_64(&(cached_heap_free_sizes[HEAP_64])) + 
 #if INTPTR_MAX == INT64_MAX
-               cached_heap_free_sizes[HEAP_96] + 
+               ck_pr_load_64(&(cached_heap_free_sizes[HEAP_96])) + 
 #endif
-               cached_heap_free_sizes[HEAP_REST];
+               ck_pr_load_64(&(cached_heap_free_sizes[HEAP_REST]));
   fprintf(stderr,
           "sweep done, total_size = %zu, total_free = %zu, freed = %zu, elapsed = %ld\n",
           total_size, total_free, freed,
diff --git a/include/cyclone/types.h b/include/cyclone/types.h
index e7be94fa..63da4f46 100644
--- a/include/cyclone/types.h
+++ b/include/cyclone/types.h
@@ -34,7 +34,7 @@
 // Parameters for size of a "page" on the heap (the second generation GC), in bytes.
 #define GROW_HEAP_BY_SIZE (2 * 1024 * 1024)     // Grow first page by adding this amount to it
 #define INITIAL_HEAP_SIZE (3 * 1024 * 1024)     // Size of the first page
-#define HEAP_SIZE (377 * 1024 * 1024)    // Normal size of a page
+#define HEAP_SIZE (32 * 1024 * 1024)    // Normal size of a page
 
 /////////////////////////////
 // Major GC tuning parameters
@@ -191,7 +191,7 @@ struct gc_heap_t {
   unsigned int size;
   unsigned int chunk_size;      // 0 for any size, other and heap will only alloc chunks of that size
   unsigned int max_size;
-  unsigned int newly_created;
+  unsigned int ttl; // Keep empty page alive this many times before freeing
   //
   gc_heap *next_free;
   unsigned int last_alloc_size;

From befbced21cb7f1268c872124ea3461021f5f2c51 Mon Sep 17 00:00:00 2001
From: Justin Ethier <justin.ethier@gmail.com>
Date: Tue, 24 Jan 2017 22:19:08 -0500
Subject: [PATCH 02/17] More merges from gc-opt3-dev

---
 gc.c                    | 121 ++++++++++++++++++++--------------------
 include/cyclone/types.h |   2 +-
 2 files changed, 61 insertions(+), 62 deletions(-)

diff --git a/gc.c b/gc.c
index 375e4381..8c718aca 100644
--- a/gc.c
+++ b/gc.c
@@ -1154,71 +1154,26 @@ void gc_mark_gray2(gc_thread_data * thd, object obj)
 // they should never be added to the mark stack. Which would be bad because it
 // could lead to stack corruption.
 //
+#if GC_DEBUG_VERBOSE
+static void gc_collector_mark_gray(object parent, object obj)
+{
+  if (is_object_type(obj) && mark(obj) == gc_color_clear) {
+    mark_stack = vpbuffer_add(mark_stack, &mark_stack_len, mark_stack_i++, obj);
+    fprintf(stderr, "mark gray parent = %p (%d) obj = %p\n", parent,
+            type_of(parent), obj);
+  }
+}
+#else
+//
 // Attempt to speed this up by forcing an inline
 //
 #define gc_collector_mark_gray(parent, gobj) \
   if (is_object_type(gobj) && mark(gobj) == gc_color_clear) { \
     mark_stack = vpbuffer_add(mark_stack, &mark_stack_len, mark_stack_i++, gobj); \
   }
+#endif
 
-//static void gc_collector_mark_gray(object parent, object obj)
-//{
-//  if (is_object_type(obj) && mark(obj) == gc_color_clear) {
-//    mark_stack = vpbuffer_add(mark_stack, &mark_stack_len, mark_stack_i++, obj);
-//#if GC_DEBUG_VERBOSE
-//    fprintf(stderr, "mark gray parent = %p (%d) obj = %p\n", parent,
-//            type_of(parent), obj);
-//#endif
-//  }
-//}
-
-// See full version below for debugging purposes.
-// Also sync any changes to this macro with the function version
-#define gc_mark_black(obj) \
-{ \
-  int markColor = ck_pr_load_int(&gc_color_mark); \
-  if (is_object_type(obj) && mark(obj) != markColor) { \
-    switch (type_of(obj)) { \
-    case pair_tag:{ \
-        gc_collector_mark_gray(obj, car(obj)); \
-        gc_collector_mark_gray(obj, cdr(obj)); \
-        break; \
-      } \
-    case closure1_tag: \
-      gc_collector_mark_gray(obj, ((closure1) obj)->element); \
-      break; \
-    case closureN_tag:{ \
-        int i, n = ((closureN) obj)->num_elements; \
-        for (i = 0; i < n; i++) { \
-          gc_collector_mark_gray(obj, ((closureN) obj)->elements[i]); \
-        } \
-        break; \
-      } \
-    case vector_tag:{ \
-        int i, n = ((vector) obj)->num_elements; \
-        for (i = 0; i < n; i++) { \
-          gc_collector_mark_gray(obj, ((vector) obj)->elements[i]); \
-        } \
-        break; \
-      } \
-    case cvar_tag:{ \
-        cvar_type *c = (cvar_type *) obj; \
-        object pvar = *(c->pvar); \
-        if (pvar) { \
-          gc_collector_mark_gray(obj, pvar); \
-        } \
-        break; \
-      } \
-    default: \
-      break; \
-    } \
-    if (mark(obj) != gc_color_red) { \
-      mark(obj) = markColor; \
-    } \
-  } \
-}
-
-/*
+#if GC_DEBUG_VERBOSE
 void gc_mark_black(object obj)
 {
   // TODO: is sync required to get colors? probably not on the collector
@@ -1267,16 +1222,60 @@ void gc_mark_black(object obj)
       // Only blacken objects on the heap
       mark(obj) = markColor;
     }
-#if GC_DEBUG_VERBOSE
     if (mark(obj) != gc_color_red) {
       fprintf(stderr, "marked %p %d\n", obj, markColor);
     } else {
       fprintf(stderr, "not marking stack obj %p %d\n", obj, markColor);
     }
-#endif
   }
 }
-*/
+#else
+// See full version above for debugging purposes.
+// Also sync any changes to this macro with the function version
+#define gc_mark_black(obj) \
+{ \
+  int markColor = ck_pr_load_int(&gc_color_mark); \
+  if (is_object_type(obj) && mark(obj) != markColor) { \
+    switch (type_of(obj)) { \
+    case pair_tag:{ \
+        gc_collector_mark_gray(obj, car(obj)); \
+        gc_collector_mark_gray(obj, cdr(obj)); \
+        break; \
+      } \
+    case closure1_tag: \
+      gc_collector_mark_gray(obj, ((closure1) obj)->element); \
+      break; \
+    case closureN_tag:{ \
+        int i, n = ((closureN) obj)->num_elements; \
+        for (i = 0; i < n; i++) { \
+          gc_collector_mark_gray(obj, ((closureN) obj)->elements[i]); \
+        } \
+        break; \
+      } \
+    case vector_tag:{ \
+        int i, n = ((vector) obj)->num_elements; \
+        for (i = 0; i < n; i++) { \
+          gc_collector_mark_gray(obj, ((vector) obj)->elements[i]); \
+        } \
+        break; \
+      } \
+    case cvar_tag:{ \
+        cvar_type *c = (cvar_type *) obj; \
+        object pvar = *(c->pvar); \
+        if (pvar) { \
+          gc_collector_mark_gray(obj, pvar); \
+        } \
+        break; \
+      } \
+    default: \
+      break; \
+    } \
+    if (mark(obj) != gc_color_red) { \
+      mark(obj) = markColor; \
+    } \
+  } \
+}
+#endif
 
 
 void gc_collector_trace()
diff --git a/include/cyclone/types.h b/include/cyclone/types.h
index 63da4f46..2c586a2b 100644
--- a/include/cyclone/types.h
+++ b/include/cyclone/types.h
@@ -63,7 +63,7 @@
 /* Additional runtime checking of the GC system.
    This is here because these checks should not be
    necessary if GC is working correctly. */
-#define GC_SAFETY_CHECKS 1
+#define GC_SAFETY_CHECKS 0
 
 // General constants
 #define NANOSECONDS_PER_MILLISECOND 1000000

From 0d651d4ff715eaa9f9d043b9c5fd2a381e6cfc61 Mon Sep 17 00:00:00 2001
From: Justin Ethier <justin.ethier@gmail.com>
Date: Wed, 25 Jan 2017 18:57:38 -0500
Subject: [PATCH 03/17] Starting the heap changes

This leaves everything as a mess at the moment, there are still a lot of changes that need to be made.
---
 gc.c                    | 18 ++++++++++++++++++
 include/cyclone/types.h |  4 ++++
 runtime.c               | 12 ------------
 3 files changed, 22 insertions(+), 12 deletions(-)

diff --git a/gc.c b/gc.c
index 8c718aca..a092f387 100644
--- a/gc.c
+++ b/gc.c
@@ -1648,11 +1648,29 @@ void gc_thread_data_init(gc_thread_data * thd, int mut_num, char *stack_base,
     fprintf(stderr, "Unable to initialize thread mutex\n");
     exit(1);
   }
+  thd->heap = calloc(1, sizeof(gc_heap_root));
+  thd->heap->heap = calloc(1, sizeof(gc_heap *) * NUM_HEAP_TYPES);
+  thd->heap->heap[HEAP_REST] = gc_heap_create(HEAP_REST, INITIAL_HEAP_SIZE, 0, 0);
+  thd->heap->heap[HEAP_SM] = gc_heap_create(HEAP_SM, INITIAL_HEAP_SIZE, 0, 0);
+  thd->heap->heap[HEAP_64] = gc_heap_create(HEAP_64, INITIAL_HEAP_SIZE, 0, 0);
+  if (sizeof(void *) == 8) { // Only use this heap on 64-bit platforms
+    thd->heap[HEAP_96] = gc_heap_create(HEAP_96, INITIAL_HEAP_SIZE, 0, 0);
+  }
+  thd->heap->heap[HEAP_HUGE] = gc_heap_create(HEAP_HUGE, 1024, 0, 0);
+  thd->cached_heap_free_sizes = calloc(5, sizeof(uint64_t));
+  thd->cached_heap_total_sizes = calloc(5, sizeof(uint64_t));
 }
 
 void gc_thread_data_free(gc_thread_data * thd)
 {
   if (thd) {
+//
+// !!
+// TODO: (not necessarily here, but somewhere need to roll heap pages into
+// another thread data. need to include cached heap sizes/total, too.
+// then free cached heap vars here.
+// !!
+//
     if (pthread_mutex_destroy(&thd->lock) != 0) {
       // TODO: can only destroy the lock if it is unlocked. need to make sure we
       // can guarantee that is the case prior to making this call
diff --git a/include/cyclone/types.h b/include/cyclone/types.h
index 2c586a2b..af6e6090 100644
--- a/include/cyclone/types.h
+++ b/include/cyclone/types.h
@@ -17,6 +17,7 @@
 #include <string.h>
 #include <time.h>
 #include <pthread.h>
+#include <stdint.h>
 
 // Maximum number of args that GC will accept
 #define NUM_GC_ARGS 128
@@ -141,6 +142,9 @@ struct gc_thread_data_t {
   int mark_buffer_len;
   pthread_mutex_t lock;
   pthread_t thread_id;
+  gc_heap_root *heap;
+  uint64_t *cached_heap_free_sizes;
+  uint64_t *cached_heap_total_sizes;
   // Data needed for call history
   char **stack_traces;
   int stack_trace_idx;
diff --git a/runtime.c b/runtime.c
index 76e6f8bd..55d15ad4 100644
--- a/runtime.c
+++ b/runtime.c
@@ -140,7 +140,6 @@ if (type_is_pair_prim(clo)) { \
 /*END closcall section */
 
 /* Global variables. */
-static gc_heap_root *Cyc_heap;
 object Cyc_global_variables = NULL;
 int _cyc_argc = 0;
 char **_cyc_argv = NULL;
@@ -261,17 +260,6 @@ static bool set_insert(ck_hs_t * hs, const void *value)
 
 void gc_init_heap(long heap_size)
 {
-  size_t initial_heap_size = INITIAL_HEAP_SIZE;
-  Cyc_heap = calloc(1, sizeof(gc_heap_root));
-  Cyc_heap->heap = calloc(1, sizeof(gc_heap *) * NUM_HEAP_TYPES);
-  Cyc_heap->heap[HEAP_REST] = gc_heap_create(HEAP_REST, initial_heap_size, 0, 0);
-  Cyc_heap->heap[HEAP_SM] = gc_heap_create(HEAP_SM, initial_heap_size, 0, 0);
-  Cyc_heap->heap[HEAP_64] = gc_heap_create(HEAP_64, initial_heap_size, 0, 0);
-  if (sizeof(void *) == 8) { // Only use this heap on 64-bit platforms
-    Cyc_heap->heap[HEAP_96] = gc_heap_create(HEAP_96, initial_heap_size, 0, 0);
-  }
-  Cyc_heap->heap[HEAP_HUGE] = gc_heap_create(HEAP_HUGE, 1024, 0, 0);
-
   if (!ck_hs_init(&symbol_table,
                   CK_HS_MODE_OBJECT | CK_HS_MODE_SPMC,
                   hs_hash, hs_compare,

From ce0bffb31afefb90cd19935308eacb16798ffb82 Mon Sep 17 00:00:00 2001
From: Justin Ethier <justin.ethier@gmail.com>
Date: Thu, 26 Jan 2017 23:45:46 -0500
Subject: [PATCH 04/17] WIP

---
 gc.c                    | 130 +++++++++++++++++++++++-----------------
 include/cyclone/types.h | 101 ++++++++++++++++---------------
 runtime.c               |  38 ++++++------
 srfi/18.sld             |   4 +-
 4 files changed, 144 insertions(+), 129 deletions(-)

diff --git a/gc.c b/gc.c
index a092f387..a01b8ac8 100644
--- a/gc.c
+++ b/gc.c
@@ -55,12 +55,14 @@ static void **mark_stack = NULL;
 static int mark_stack_len = 0;
 static int mark_stack_i = 0;
 
-// Lock to protect the heap from concurrent modifications
-static pthread_mutex_t heap_lock;
-
-// Cached heap statistics
-static uint64_t cached_heap_free_sizes[7] = { 0, 0, 0, 0, 0, 0, 0 };
-static uint64_t cached_heap_total_sizes[7] = { 0, 0, 0, 0, 0, 0, 0 };
+// OBSOLETE:
+//// Lock to protect the heap from concurrent modifications
+//static pthread_mutex_t heap_lock;
+//
+//// Cached heap statistics
+//static uint64_t cached_heap_free_sizes[7] = { 0, 0, 0, 0, 0, 0, 0 };
+//static uint64_t cached_heap_total_sizes[7] = { 0, 0, 0, 0, 0, 0, 0 };
+//// END OBSOLETE
 
 // Data for each individual mutator thread
 ck_array_t Cyc_mutators, old_mutators;
@@ -721,6 +723,70 @@ size_t gc_heap_total_size(gc_heap * h)
 //  return total_size;
 //}
 
+// A convenient front-end to the actual gc_sweep function.
+void gc_collector_sweep()
+{
+  ck_array_iterator_t iterator;
+  gc_thread_data *m;
+  gc_heap *h;
+  int heap_type;
+  size_t freed_tmp = 0, freed = 0;
+#if GC_DEBUG_TRACE
+  size_t total_size;
+  size_t total_free;
+  time_t gc_collector_start = time(NULL);
+#endif
+
+  CK_ARRAY_FOREACH(&Cyc_mutators, &iterator, &m) {
+    for (heap_type = 0; heap_type < NUM_HEAP_TYPES; heap_type++) {
+      h = m->heap->heap[heap_type];
+      if (h) {
+        gc_sweep(h, heap_type, &freed_tmp);
+        freed += freed_tmp;
+      }
+    }
+
+    // TODO: this loop only includes smallest 2 heaps, is that sufficient??
+    for (heap_type = 0; heap_type < 2; heap_type++) {
+      while ( ck_pr_load_64(&(m->cached_heap_free_sizes[heap_type])) <
+             (ck_pr_load_64(&(m->cached_heap_total_sizes[heap_type])) * GC_FREE_THRESHOLD)) {
+#if GC_DEBUG_TRACE
+        fprintf(stderr, "Less than %f%% of the heap %d is free, growing it\n",
+                100.0 * GC_FREE_THRESHOLD, heap_type);
+#endif
+        if (heap_type == HEAP_SM) {
+          gc_grow_heap(m->heap->heap[heap_type], heap_type, 0, 0);
+        } else if (heap_type == HEAP_64) {
+          gc_grow_heap(m->heap->heap[heap_type], heap_type, 0, 0);
+        } else if (heap_type == HEAP_REST) {
+          gc_grow_heap(m->heap->heap[heap_type], heap_type, 0, 0);
+        }
+      }
+    }
+#if GC_DEBUG_TRACE
+    total_size = ck_pr_load_64(&(m->cached_heap_total_sizes[HEAP_SM])) +
+                 ck_pr_load_64(&(m->cached_heap_total_sizes[HEAP_64])) + 
+#if INTPTR_MAX == INT64_MAX
+                 ck_pr_load_64(&(m->cached_heap_total_sizes[HEAP_96])) + 
+#endif
+                 ck_pr_load_64(&(m->cached_heap_total_sizes[HEAP_REST]));
+    total_free = ck_pr_load_64(&(m->cached_heap_free_sizes[HEAP_SM])) +
+                 ck_pr_load_64(&(m->cached_heap_free_sizes[HEAP_64])) + 
+#if INTPTR_MAX == INT64_MAX
+                 ck_pr_load_64(&(m->cached_heap_free_sizes[HEAP_96])) + 
+#endif
+                 ck_pr_load_64(&(m->cached_heap_free_sizes[HEAP_REST]));
+    fprintf(stderr,
+            "sweep done, total_size = %zu, total_free = %zu, freed = %zu, elapsed = %ld\n",
+            total_size, total_free, freed,
+            (time(NULL) - gc_collector_start));
+#endif
+  }
+#if GC_DEBUG_TRACE
+  fprintf(stderr, "all thread heap sweeps done\n");
+#endif
+}
+
 size_t gc_sweep(gc_heap * h, int heap_type, size_t * sum_freed_ptr)
 {
   size_t freed, max_freed = 0, heap_freed = 0, sum_freed = 0, size;
@@ -1432,12 +1498,8 @@ void debug_dump_globals();
 // Main collector function
 void gc_collector()
 {
-  int old_clear, old_mark, heap_type;
-  size_t freed_tmp = 0, freed = 0;
+  int old_clear, old_mark;
 #if GC_DEBUG_TRACE
-  size_t total_size;
-  size_t total_free;
-  time_t gc_collector_start = time(NULL);
   print_allocated_obj_counts();
   print_current_time();
   fprintf(stderr, " - Starting gc_collector\n");
@@ -1483,50 +1545,8 @@ void gc_collector()
   ck_pr_cas_int(&gc_stage, STAGE_TRACING, STAGE_SWEEPING);
   //
   //sweep : 
+  gc_collector_sweep();
 
-  for (heap_type = 0; heap_type < NUM_HEAP_TYPES; heap_type++) {
-    gc_heap *h = gc_get_heap()->heap[heap_type];
-    if (h) {
-      gc_sweep(h, heap_type, &freed_tmp);
-      freed += freed_tmp;
-    }
-  }
-
-  // TODO: this loop only includes smallest 2 heaps, is that sufficient??
-  for (heap_type = 0; heap_type < 2; heap_type++) {
-    while ( ck_pr_load_64(&(cached_heap_free_sizes[heap_type])) <
-           (ck_pr_load_64(&(cached_heap_total_sizes[heap_type])) * GC_FREE_THRESHOLD)) {
-#if GC_DEBUG_TRACE
-      fprintf(stderr, "Less than %f%% of the heap %d is free, growing it\n",
-              100.0 * GC_FREE_THRESHOLD, heap_type);
-#endif
-      if (heap_type == HEAP_SM) {
-        gc_grow_heap(gc_get_heap()->heap[heap_type], heap_type, 0, 0);
-      } else if (heap_type == HEAP_64) {
-        gc_grow_heap(gc_get_heap()->heap[heap_type], heap_type, 0, 0);
-      } else if (heap_type == HEAP_REST) {
-        gc_grow_heap(gc_get_heap()->heap[heap_type], heap_type, 0, 0);
-      }
-    }
-  }
-#if GC_DEBUG_TRACE
-  total_size = ck_pr_load_64(&(cached_heap_total_sizes[HEAP_SM])) +
-               ck_pr_load_64(&(cached_heap_total_sizes[HEAP_64])) + 
-#if INTPTR_MAX == INT64_MAX
-               ck_pr_load_64(&(cached_heap_total_sizes[HEAP_96])) + 
-#endif
-               ck_pr_load_64(&(cached_heap_total_sizes[HEAP_REST]));
-  total_free = ck_pr_load_64(&(cached_heap_free_sizes[HEAP_SM])) +
-               ck_pr_load_64(&(cached_heap_free_sizes[HEAP_64])) + 
-#if INTPTR_MAX == INT64_MAX
-               ck_pr_load_64(&(cached_heap_free_sizes[HEAP_96])) + 
-#endif
-               ck_pr_load_64(&(cached_heap_free_sizes[HEAP_REST]));
-  fprintf(stderr,
-          "sweep done, total_size = %zu, total_free = %zu, freed = %zu, elapsed = %ld\n",
-          total_size, total_free, freed,
-          (time(NULL) - gc_collector_start));
-#endif
 #if GC_DEBUG_TRACE
   fprintf(stderr, "cleaning up any old thread data\n");
 #endif
@@ -1654,7 +1674,7 @@ void gc_thread_data_init(gc_thread_data * thd, int mut_num, char *stack_base,
   thd->heap->heap[HEAP_SM] = gc_heap_create(HEAP_SM, INITIAL_HEAP_SIZE, 0, 0);
   thd->heap->heap[HEAP_64] = gc_heap_create(HEAP_64, INITIAL_HEAP_SIZE, 0, 0);
   if (sizeof(void *) == 8) { // Only use this heap on 64-bit platforms
-    thd->heap[HEAP_96] = gc_heap_create(HEAP_96, INITIAL_HEAP_SIZE, 0, 0);
+    thd->heap->heap[HEAP_96] = gc_heap_create(HEAP_96, INITIAL_HEAP_SIZE, 0, 0);
   }
   thd->heap->heap[HEAP_HUGE] = gc_heap_create(HEAP_HUGE, 1024, 0, 0);
   thd->cached_heap_free_sizes = calloc(5, sizeof(uint64_t));
diff --git a/include/cyclone/types.h b/include/cyclone/types.h
index af6e6090..e7e5530c 100644
--- a/include/cyclone/types.h
+++ b/include/cyclone/types.h
@@ -103,56 +103,6 @@ enum object_tag {
 // Define the size of object tags
 typedef unsigned char tag_type;
 
-/* Threading */
-typedef enum { CYC_THREAD_STATE_NEW, CYC_THREAD_STATE_RUNNABLE,
-  CYC_THREAD_STATE_BLOCKED, CYC_THREAD_STATE_BLOCKED_COOPERATING,
-  CYC_THREAD_STATE_TERMINATED
-} cyc_thread_state_type;
-
-/* Thread data structures */
-typedef struct gc_thread_data_t gc_thread_data;
-struct gc_thread_data_t {
-  // Thread object, if applicable
-  object scm_thread_obj;
-  cyc_thread_state_type thread_state;
-  // Data needed to initiate stack-based minor GC
-  char *stack_start;
-  char *stack_limit;
-  // Minor GC write barrier
-  void **mutations;
-  int mutation_buflen;
-  int mutation_count;
-  // List of objects moved to heap during minor GC
-  void **moveBuf;
-  int moveBufLen;
-  // Need the following to perform longjmp's
-  //int mutator_num;
-  jmp_buf *jmp_start;
-  // After longjmp, pick up execution using continuation/arguments
-  object gc_cont;
-  object *gc_args;
-  short gc_num_args;
-  // Data needed for heap GC
-  int gc_alloc_color;
-  int gc_status;
-  int last_write;
-  int last_read;
-  int pending_writes;
-  void **mark_buffer;
-  int mark_buffer_len;
-  pthread_mutex_t lock;
-  pthread_t thread_id;
-  gc_heap_root *heap;
-  uint64_t *cached_heap_free_sizes;
-  uint64_t *cached_heap_total_sizes;
-  // Data needed for call history
-  char **stack_traces;
-  int stack_trace_idx;
-  char *stack_prev_frame;
-  // Exception handler stack
-  object exception_handler_stack;
-};
-
 /* GC data structures */
 
 /**
@@ -233,6 +183,56 @@ typedef enum { STAGE_CLEAR_OR_MARKING, STAGE_TRACING
 #define gc_color_red  0         // Memory not to be GC'd, such as on the stack
 #define gc_color_blue 2         // Unallocated memory
 
+/* Threading */
+typedef enum { CYC_THREAD_STATE_NEW, CYC_THREAD_STATE_RUNNABLE,
+  CYC_THREAD_STATE_BLOCKED, CYC_THREAD_STATE_BLOCKED_COOPERATING,
+  CYC_THREAD_STATE_TERMINATED
+} cyc_thread_state_type;
+
+/* Thread data structures */
+typedef struct gc_thread_data_t gc_thread_data;
+struct gc_thread_data_t {
+  // Thread object, if applicable
+  object scm_thread_obj;
+  cyc_thread_state_type thread_state;
+  // Data needed to initiate stack-based minor GC
+  char *stack_start;
+  char *stack_limit;
+  // Minor GC write barrier
+  void **mutations;
+  int mutation_buflen;
+  int mutation_count;
+  // List of objects moved to heap during minor GC
+  void **moveBuf;
+  int moveBufLen;
+  // Need the following to perform longjmp's
+  //int mutator_num;
+  jmp_buf *jmp_start;
+  // After longjmp, pick up execution using continuation/arguments
+  object gc_cont;
+  object *gc_args;
+  short gc_num_args;
+  // Data needed for heap GC
+  int gc_alloc_color;
+  int gc_status;
+  int last_write;
+  int last_read;
+  int pending_writes;
+  void **mark_buffer;
+  int mark_buffer_len;
+  pthread_mutex_t lock;
+  pthread_t thread_id;
+  gc_heap_root *heap;
+  uint64_t *cached_heap_free_sizes;
+  uint64_t *cached_heap_total_sizes;
+  // Data needed for call history
+  char **stack_traces;
+  int stack_trace_idx;
+  char *stack_prev_frame;
+  // Exception handler stack
+  object exception_handler_stack;
+};
+
 // Determine if stack has overflowed
 #if STACK_GROWTH_IS_DOWNWARD
 #define stack_overflow(x,y) ((x) < (y))
@@ -707,7 +707,6 @@ void gc_mutator_thread_runnable(gc_thread_data * thd, object result);
 //  body \
 //  return_thread_runnable((data), (result));
 */
-gc_heap_root *gc_get_heap();
 int gc_minor(void *data, object low_limit, object high_limit, closure cont,
              object * args, int num_args);
 /* Mutation table to support minor GC write barrier */
diff --git a/runtime.c b/runtime.c
index 55d15ad4..32770271 100644
--- a/runtime.c
+++ b/runtime.c
@@ -273,11 +273,6 @@ void gc_init_heap(long heap_size)
   }
 }
 
-gc_heap_root *gc_get_heap()
-{
-  return Cyc_heap;
-}
-
 object cell_get(object cell)
 {
   // FUTURE: always use unsafe car here, since computed by compiler
@@ -1059,7 +1054,7 @@ object Cyc_heap_alloc_port(void *data, port_type *stack_p)
 {
   object p = NULL;
   int heap_grown;
-  p = gc_alloc(Cyc_heap, 
+  p = gc_alloc(((gc_thread_data *)data)->heap, 
                sizeof(port_type),
                (char *)stack_p,
                (gc_thread_data *)data, 
@@ -2007,7 +2002,7 @@ object Cyc_make_vector(void *data, object cont, int argc, object len, ...)
     // TODO: mark this thread as potentially blocking before doing
     //       the allocation????
     int heap_grown;
-    v = gc_alloc(Cyc_heap, 
+    v = gc_alloc(((gc_thread_data *)data)->heap, 
                  sizeof(vector_type) + element_vec_size,
                  boolean_f, // OK to populate manually over here
                  (gc_thread_data *)data, 
@@ -4027,30 +4022,31 @@ char *gc_fixup_moved_obj(gc_thread_data * thd, int *alloci, char *obj,
 
 char *gc_move(char *obj, gc_thread_data * thd, int *alloci, int *heap_grown)
 {
+  gc_heap_root *heap = thd->heap;
   if (!is_object_type(obj))
     return obj;
   switch (type_of(obj)) {
   case pair_tag:{
-      list hp = gc_alloc(Cyc_heap, sizeof(pair_type), obj, thd, heap_grown);
+      list hp = gc_alloc(heap, sizeof(pair_type), obj, thd, heap_grown);
       return gc_fixup_moved_obj(thd, alloci, obj, hp);
     }
   case macro_tag:{
       macro_type *hp =
-          gc_alloc(Cyc_heap, sizeof(macro_type), obj, thd, heap_grown);
+          gc_alloc(heap, sizeof(macro_type), obj, thd, heap_grown);
       return gc_fixup_moved_obj(thd, alloci, obj, hp);
     }
   case closure0_tag:{
       closure0_type *hp =
-          gc_alloc(Cyc_heap, sizeof(closure0_type), obj, thd, heap_grown);
+          gc_alloc(heap, sizeof(closure0_type), obj, thd, heap_grown);
       return gc_fixup_moved_obj(thd, alloci, obj, hp);
     }
   case closure1_tag:{
       closure1_type *hp =
-          gc_alloc(Cyc_heap, sizeof(closure1_type), obj, thd, heap_grown);
+          gc_alloc(heap, sizeof(closure1_type), obj, thd, heap_grown);
       return gc_fixup_moved_obj(thd, alloci, obj, hp);
     }
   case closureN_tag:{
-      closureN_type *hp = gc_alloc(Cyc_heap,
+      closureN_type *hp = gc_alloc(heap,
                                    sizeof(closureN_type) +
                                    sizeof(object) *
                                    (((closureN) obj)->num_elements),
@@ -4058,7 +4054,7 @@ char *gc_move(char *obj, gc_thread_data * thd, int *alloci, int *heap_grown)
       return gc_fixup_moved_obj(thd, alloci, obj, hp);
     }
   case vector_tag:{
-      vector_type *hp = gc_alloc(Cyc_heap,
+      vector_type *hp = gc_alloc(heap,
                                  sizeof(vector_type) +
                                  sizeof(object) *
                                  (((vector) obj)->num_elements),
@@ -4066,41 +4062,41 @@ char *gc_move(char *obj, gc_thread_data * thd, int *alloci, int *heap_grown)
       return gc_fixup_moved_obj(thd, alloci, obj, hp);
     }
   case bytevector_tag:{
-      bytevector_type *hp = gc_alloc(Cyc_heap,
+      bytevector_type *hp = gc_alloc(heap,
                                      sizeof(bytevector_type) +
                                      sizeof(char) * (((bytevector) obj)->len),
                                      obj, thd, heap_grown);
       return gc_fixup_moved_obj(thd, alloci, obj, hp);
     }
   case string_tag:{
-      string_type *hp = gc_alloc(Cyc_heap,
+      string_type *hp = gc_alloc(heap,
                                  sizeof(string_type) + ((string_len(obj) + 1)),
                                  obj, thd, heap_grown);
       return gc_fixup_moved_obj(thd, alloci, obj, hp);
     }
   case integer_tag:{
       integer_type *hp =
-          gc_alloc(Cyc_heap, sizeof(integer_type), obj, thd, heap_grown);
+          gc_alloc(heap, sizeof(integer_type), obj, thd, heap_grown);
       return gc_fixup_moved_obj(thd, alloci, obj, hp);
     }
   case double_tag:{
       double_type *hp =
-          gc_alloc(Cyc_heap, sizeof(double_type), obj, thd, heap_grown);
+          gc_alloc(heap, sizeof(double_type), obj, thd, heap_grown);
       return gc_fixup_moved_obj(thd, alloci, obj, hp);
     }
   case port_tag:{
       port_type *hp =
-          gc_alloc(Cyc_heap, sizeof(port_type), obj, thd, heap_grown);
+          gc_alloc(heap, sizeof(port_type), obj, thd, heap_grown);
       return gc_fixup_moved_obj(thd, alloci, obj, hp);
     }
   case cvar_tag:{
       cvar_type *hp =
-          gc_alloc(Cyc_heap, sizeof(cvar_type), obj, thd, heap_grown);
+          gc_alloc(heap, sizeof(cvar_type), obj, thd, heap_grown);
       return gc_fixup_moved_obj(thd, alloci, obj, hp);
     }
   case c_opaque_tag:{
       c_opaque_type *hp =
-          gc_alloc(Cyc_heap, sizeof(c_opaque_type), obj, thd, heap_grown);
+          gc_alloc(heap, sizeof(c_opaque_type), obj, thd, heap_grown);
       return gc_fixup_moved_obj(thd, alloci, obj, hp);
     }
   case forward_tag:
@@ -4820,7 +4816,7 @@ object copy2heap(void *data, object obj)
     return obj;
   }
 
-  return gc_alloc(Cyc_heap, gc_allocated_bytes(obj, NULL, NULL), obj, data,
+  return gc_alloc(((gc_thread_data *)data)->heap, gc_allocated_bytes(obj, NULL, NULL), obj, data,
                   &on_stack);
 }
 
diff --git a/srfi/18.sld b/srfi/18.sld
index 94387ddc..7353a0c9 100644
--- a/srfi/18.sld
+++ b/srfi/18.sld
@@ -161,7 +161,7 @@
         tmp.hdr.mark = gc_color_red;
         tmp.hdr.grayed = 0;
         tmp.tag = mutex_tag;
-        lock = gc_alloc(gc_get_heap(), sizeof(mutex_type), (char *)(&tmp), (gc_thread_data *)data, &heap_grown);
+        lock = gc_alloc(((gc_thread_data *)data)->heap, sizeof(mutex_type), (char *)(&tmp), (gc_thread_data *)data, &heap_grown);
         if (pthread_mutex_init(&(lock->lock), NULL) != 0) {
           fprintf(stderr, \"Unable to make mutex\\n\");
           exit(1);
@@ -214,7 +214,7 @@
         tmp.hdr.mark = gc_color_red;
         tmp.hdr.grayed = 0;
         tmp.tag = cond_var_tag;
-        cond = gc_alloc(gc_get_heap(), sizeof(cond_var_type), (char *)(&tmp), (gc_thread_data *)data, &heap_grown);
+        cond = gc_alloc(((gc_thread_data *)data)->heap, sizeof(cond_var_type), (char *)(&tmp), (gc_thread_data *)data, &heap_grown);
         if (pthread_cond_init(&(cond->cond), NULL) != 0) {
           fprintf(stderr, \"Unable to make condition variable\\n\");
           exit(1);

From 1078c5ff271959a36b8ce3d84139014ce6f03a27 Mon Sep 17 00:00:00 2001
From: Justin Ethier <justin.ethier@gmail.com>
Date: Thu, 26 Jan 2017 23:54:42 -0500
Subject: [PATCH 05/17] Removed dead code

---
 gc.c | 4 ----
 1 file changed, 4 deletions(-)

diff --git a/gc.c b/gc.c
index a01b8ac8..7e43208f 100644
--- a/gc.c
+++ b/gc.c
@@ -146,10 +146,6 @@ void gc_initialize()
   mark_stack = vpbuffer_realloc(mark_stack, &(mark_stack_len));
 
   // Here is as good a place as any to do this...
-  if (pthread_mutex_init(&(heap_lock), NULL) != 0) {
-    fprintf(stderr, "Unable to initialize heap_lock mutex\n");
-    exit(1);
-  }
   if (pthread_mutex_init(&(mutators_lock), NULL) != 0) {
     fprintf(stderr, "Unable to initialize mutators_lock mutex\n");
     exit(1);

From 54051ead860deea3a53548fef00a7ec8fdbee30a Mon Sep 17 00:00:00 2001
From: Justin Ethier <justin.ethier@gmail.com>
Date: Thu, 26 Jan 2017 18:03:15 -0500
Subject: [PATCH 06/17] Fixed up code so it builds now

---
 gc.c                    | 109 +++++++++++++++++++++-------------------
 include/cyclone/types.h |   6 +--
 runtime.c               |  27 +++++++---
 3 files changed, 80 insertions(+), 62 deletions(-)

diff --git a/gc.c b/gc.c
index 7e43208f..2f621f0f 100644
--- a/gc.c
+++ b/gc.c
@@ -209,8 +209,11 @@ void gc_free_old_thread_data()
   pthread_mutex_unlock(&mutators_lock);
 }
 
+/**
+ * Create a new heap page. The caller must hold the necessary locks.
+ */
 gc_heap *gc_heap_create(int heap_type, size_t size, size_t max_size,
-                        size_t chunk_size)
+                        size_t chunk_size, gc_thread_data *thd)
 {
   gc_free_list *free, *next;
   gc_heap *h;
@@ -224,8 +227,8 @@ gc_heap *gc_heap_create(int heap_type, size_t size, size_t max_size,
   h->next_free = h;
   h->last_alloc_size = 0;
   //h->free_size = size;
-  ck_pr_add_64(&(cached_heap_total_sizes[heap_type]), size);
-  ck_pr_add_64(&(cached_heap_free_sizes[heap_type]), size);
+  ck_pr_add_64(&(thd->cached_heap_total_sizes[heap_type]), size);
+  ck_pr_add_64(&(thd->cached_heap_free_sizes[heap_type]), size);
   h->chunk_size = chunk_size;
   h->max_size = max_size;
   h->data = (char *)gc_heap_align(sizeof(h->data) + (uintptr_t) & (h->data));
@@ -472,11 +475,11 @@ char *gc_copy_obj(object dest, char *obj, gc_thread_data * thd)
   return (char *)obj;
 }
 
-int gc_grow_heap(gc_heap * h, int heap_type, size_t size, size_t chunk_size)
+int gc_grow_heap(gc_heap * h, int heap_type, size_t size, size_t chunk_size, gc_thread_data *thd)
 {
   size_t /*cur_size,*/ new_size;
   gc_heap *h_last = h, *h_new;
-  pthread_mutex_lock(&heap_lock);
+  pthread_mutex_lock(&(thd->lock)); //heap_lock);
   // Compute size of new heap page
   if (heap_type == HEAP_HUGE) {
     new_size = gc_heap_align(size) + 128;
@@ -517,9 +520,9 @@ int gc_grow_heap(gc_heap * h, int heap_type, size_t size, size_t chunk_size)
   // allocate larger pages if size will not fit on the page
   //new_size = gc_heap_align(((cur_size > size) ? cur_size : size));
   // Done with computing new page size
-  h_new = gc_heap_create(heap_type, new_size, h_last->max_size, chunk_size);
+  h_new = gc_heap_create(heap_type, new_size, h_last->max_size, chunk_size, thd);
   h_last->next = h_new;
-  pthread_mutex_unlock(&heap_lock);
+  pthread_mutex_unlock(&(thd->lock)); //heap_lock);
 #if GC_DEBUG_TRACE
   fprintf(stderr, "DEBUG - grew heap\n");
 #endif
@@ -531,7 +534,7 @@ void *gc_try_alloc(gc_heap * h, int heap_type, size_t size, char *obj,
 {
   gc_heap *h_passed = h;
   gc_free_list *f1, *f2, *f3;
-  pthread_mutex_lock(&heap_lock);
+  pthread_mutex_lock(&(thd->lock)); //heap_lock);
   // Start searching from the last heap page we had a successful
   // allocation from, unless the current request is for a smaller
   // block in which case there may be available memory closer to
@@ -558,17 +561,17 @@ void *gc_try_alloc(gc_heap * h, int heap_type, size_t size, char *obj,
           // Copy object into heap now to avoid any uninitialized memory issues
           gc_copy_obj(f2, obj, thd);
           //h->free_size -= gc_allocated_bytes(obj, NULL, NULL);
-          ck_pr_sub_64(&(cached_heap_free_sizes[heap_type]),
+          ck_pr_sub_64(&(thd->cached_heap_free_sizes[heap_type]),
                        gc_allocated_bytes(obj, NULL, NULL));
         }
         h_passed->next_free = h;
         h_passed->last_alloc_size = size;
-        pthread_mutex_unlock(&heap_lock);
+        pthread_mutex_unlock(&(thd->lock)); //heap_lock);
         return f2;
       }
     }
   }
-  pthread_mutex_unlock(&heap_lock);
+  pthread_mutex_unlock(&(thd->lock)); //heap_lock);
   return NULL;
 }
 
@@ -608,15 +611,15 @@ void *gc_alloc(gc_heap_root * hrt, size_t size, char *obj, gc_thread_data * thd,
     // A vanilla mark&sweep collector would collect now, but unfortunately
     // we can't do that because we have to go through multiple stages, some
     // of which are asynchronous. So... no choice but to grow the heap.
-    gc_grow_heap(h, heap_type, size, 0);
+    gc_grow_heap(h, heap_type, size, 0, thd);
     *heap_grown = 1;
     result = gc_try_alloc(h, heap_type, size, obj, thd);
     if (!result) {
       fprintf(stderr, "out of memory error allocating %zu bytes\n", size);
       fprintf(stderr, "Heap type %d diagnostics:\n", heap_type);
-      pthread_mutex_lock(&heap_lock);
+      pthread_mutex_lock(&(thd->lock)); //heap_lock);
       gc_print_stats(h);
-      pthread_mutex_unlock(&heap_lock); // why not
+      pthread_mutex_unlock(&(thd->lock)); //heap_lock); // why not
       exit(1);                  // could throw error, but OOM is a major issue, so...
     }
   }
@@ -695,18 +698,18 @@ gc_heap *gc_heap_last(gc_heap * h)
   return h;
 }
 
-size_t gc_heap_total_size(gc_heap * h)
-{
-  size_t total_size = 0;
-  pthread_mutex_lock(&heap_lock);
-  while (h) {
-    total_size += h->size;
-    h = h->next;
-  }
-  pthread_mutex_unlock(&heap_lock);
-  return total_size;
-}
-
+//size_t gc_heap_total_size(gc_heap * h)
+//{
+//  size_t total_size = 0;
+//  pthread_mutex_lock(&heap_lock);
+//  while (h) {
+//    total_size += h->size;
+//    h = h->next;
+//  }
+//  pthread_mutex_unlock(&heap_lock);
+//  return total_size;
+//}
+//
 //size_t gc_heap_total_free_size(gc_heap *h)
 //{
 //  size_t total_size = 0;
@@ -737,7 +740,7 @@ void gc_collector_sweep()
     for (heap_type = 0; heap_type < NUM_HEAP_TYPES; heap_type++) {
       h = m->heap->heap[heap_type];
       if (h) {
-        gc_sweep(h, heap_type, &freed_tmp);
+        gc_sweep(h, heap_type, &freed_tmp, m);
         freed += freed_tmp;
       }
     }
@@ -751,11 +754,11 @@ void gc_collector_sweep()
                 100.0 * GC_FREE_THRESHOLD, heap_type);
 #endif
         if (heap_type == HEAP_SM) {
-          gc_grow_heap(m->heap->heap[heap_type], heap_type, 0, 0);
+          gc_grow_heap(m->heap->heap[heap_type], heap_type, 0, 0, m);
         } else if (heap_type == HEAP_64) {
-          gc_grow_heap(m->heap->heap[heap_type], heap_type, 0, 0);
+          gc_grow_heap(m->heap->heap[heap_type], heap_type, 0, 0, m);
         } else if (heap_type == HEAP_REST) {
-          gc_grow_heap(m->heap->heap[heap_type], heap_type, 0, 0);
+          gc_grow_heap(m->heap->heap[heap_type], heap_type, 0, 0, m);
         }
       }
     }
@@ -783,7 +786,7 @@ void gc_collector_sweep()
 #endif
 }
 
-size_t gc_sweep(gc_heap * h, int heap_type, size_t * sum_freed_ptr)
+size_t gc_sweep(gc_heap * h, int heap_type, size_t * sum_freed_ptr, gc_thread_data *thd)
 {
   size_t freed, max_freed = 0, heap_freed = 0, sum_freed = 0, size;
   object p, end;
@@ -801,7 +804,7 @@ size_t gc_sweep(gc_heap * h, int heap_type, size_t * sum_freed_ptr)
   // by using more fine-grained locking. Can also profile to see
   // how much time is even spent sweeping
   //
-  pthread_mutex_lock(&heap_lock);
+  pthread_mutex_lock(&(thd->lock)); //heap_lock);
   h->next_free = h;
   h->last_alloc_size = 0;
 
@@ -909,7 +912,7 @@ size_t gc_sweep(gc_heap * h, int heap_type, size_t * sum_freed_ptr)
       }
     }
     //h->free_size += heap_freed;
-    ck_pr_add_64(&(cached_heap_free_sizes[heap_type]), heap_freed);
+    ck_pr_add_64(&(thd->cached_heap_free_sizes[heap_type]), heap_freed);
     // Free the heap page if possible.
     //
     // With huge heaps, this becomes more important. one of the huge
@@ -928,8 +931,8 @@ size_t gc_sweep(gc_heap * h, int heap_type, size_t * sum_freed_ptr)
           (h->type == HEAP_HUGE || !(h->ttl--))) {
         unsigned int h_size = h->size;
         h = gc_heap_free(h, prev_h);
-        ck_pr_sub_64(&(cached_heap_free_sizes[heap_type] ), h_size);
-        ck_pr_sub_64(&(cached_heap_total_sizes[heap_type]), h_size);
+        ck_pr_sub_64(&(thd->cached_heap_free_sizes[heap_type] ), h_size);
+        ck_pr_sub_64(&(thd->cached_heap_total_sizes[heap_type]), h_size);
 
     }
     sum_freed += heap_freed;
@@ -942,7 +945,7 @@ size_t gc_sweep(gc_heap * h, int heap_type, size_t * sum_freed_ptr)
   gc_print_stats(orig_heap_ptr);
 #endif
 
-  pthread_mutex_unlock(&heap_lock);
+  pthread_mutex_unlock(&(thd->lock)); //heap_lock);
   if (sum_freed_ptr)
     *sum_freed_ptr = sum_freed;
   return max_freed;
@@ -1143,16 +1146,16 @@ void gc_mut_cooperate(gc_thread_data * thd, int buf_len)
   // Threshold is intentially low because we have to go through an
   // entire handshake/trace/sweep cycle, ideally without growing heap.
   if (ck_pr_load_int(&gc_stage) == STAGE_RESTING &&
-      ((ck_pr_load_64(&(cached_heap_free_sizes[HEAP_SM])) <
-        ck_pr_load_64(&(cached_heap_total_sizes[HEAP_SM])) * GC_COLLECTION_THRESHOLD) ||
-       (ck_pr_load_64(&(cached_heap_free_sizes[HEAP_64])) <
-        ck_pr_load_64(&(cached_heap_total_sizes[HEAP_64])) * GC_COLLECTION_THRESHOLD) ||
+      ((ck_pr_load_64(&(thd->cached_heap_free_sizes[HEAP_SM])) <
+        ck_pr_load_64(&(thd->cached_heap_total_sizes[HEAP_SM])) * GC_COLLECTION_THRESHOLD) ||
+       (ck_pr_load_64(&(thd->cached_heap_free_sizes[HEAP_64])) <
+        ck_pr_load_64(&(thd->cached_heap_total_sizes[HEAP_64])) * GC_COLLECTION_THRESHOLD) ||
 #if INTPTR_MAX == INT64_MAX
-       (ck_pr_load_64(&(cached_heap_free_sizes[HEAP_96])) <
-        ck_pr_load_64(&(cached_heap_total_sizes[HEAP_96])) * GC_COLLECTION_THRESHOLD) ||
+       (ck_pr_load_64(&(thd->cached_heap_free_sizes[HEAP_96])) <
+        ck_pr_load_64(&(thd->cached_heap_total_sizes[HEAP_96])) * GC_COLLECTION_THRESHOLD) ||
 #endif
-       (ck_pr_load_64(&(cached_heap_free_sizes[HEAP_REST])) <
-        ck_pr_load_64(&(cached_heap_total_sizes[HEAP_REST])) * GC_COLLECTION_THRESHOLD))) {
+       (ck_pr_load_64(&(thd->cached_heap_free_sizes[HEAP_REST])) <
+        ck_pr_load_64(&(thd->cached_heap_total_sizes[HEAP_REST])) * GC_COLLECTION_THRESHOLD))) {
 #if GC_DEBUG_TRACE
     fprintf(stderr,
             "Less than %f%% of the heap is free, initiating collector\n",
@@ -1664,17 +1667,17 @@ void gc_thread_data_init(gc_thread_data * thd, int mut_num, char *stack_base,
     fprintf(stderr, "Unable to initialize thread mutex\n");
     exit(1);
   }
-  thd->heap = calloc(1, sizeof(gc_heap_root));
-  thd->heap->heap = calloc(1, sizeof(gc_heap *) * NUM_HEAP_TYPES);
-  thd->heap->heap[HEAP_REST] = gc_heap_create(HEAP_REST, INITIAL_HEAP_SIZE, 0, 0);
-  thd->heap->heap[HEAP_SM] = gc_heap_create(HEAP_SM, INITIAL_HEAP_SIZE, 0, 0);
-  thd->heap->heap[HEAP_64] = gc_heap_create(HEAP_64, INITIAL_HEAP_SIZE, 0, 0);
-  if (sizeof(void *) == 8) { // Only use this heap on 64-bit platforms
-    thd->heap->heap[HEAP_96] = gc_heap_create(HEAP_96, INITIAL_HEAP_SIZE, 0, 0);
-  }
-  thd->heap->heap[HEAP_HUGE] = gc_heap_create(HEAP_HUGE, 1024, 0, 0);
   thd->cached_heap_free_sizes = calloc(5, sizeof(uint64_t));
   thd->cached_heap_total_sizes = calloc(5, sizeof(uint64_t));
+  thd->heap = calloc(1, sizeof(gc_heap_root));
+  thd->heap->heap = calloc(1, sizeof(gc_heap *) * NUM_HEAP_TYPES);
+  thd->heap->heap[HEAP_REST] = gc_heap_create(HEAP_REST, INITIAL_HEAP_SIZE, 0, 0, thd);
+  thd->heap->heap[HEAP_SM] = gc_heap_create(HEAP_SM, INITIAL_HEAP_SIZE, 0, 0, thd);
+  thd->heap->heap[HEAP_64] = gc_heap_create(HEAP_64, INITIAL_HEAP_SIZE, 0, 0, thd);
+  if (sizeof(void *) == 8) { // Only use this heap on 64-bit platforms
+    thd->heap->heap[HEAP_96] = gc_heap_create(HEAP_96, INITIAL_HEAP_SIZE, 0, 0, thd);
+  }
+  thd->heap->heap[HEAP_HUGE] = gc_heap_create(HEAP_HUGE, 1024, 0, 0, thd);
 }
 
 void gc_thread_data_free(gc_thread_data * thd)
diff --git a/include/cyclone/types.h b/include/cyclone/types.h
index e7e5530c..24bfd676 100644
--- a/include/cyclone/types.h
+++ b/include/cyclone/types.h
@@ -660,10 +660,10 @@ void gc_initialize();
 void gc_add_mutator(gc_thread_data * thd);
 void gc_remove_mutator(gc_thread_data * thd);
 gc_heap *gc_heap_create(int heap_type, size_t size, size_t max_size,
-                        size_t chunk_size);
+                        size_t chunk_size, gc_thread_data *thd);
 gc_heap *gc_heap_free(gc_heap *page, gc_heap *prev_page);
 void gc_print_stats(gc_heap * h);
-int gc_grow_heap(gc_heap * h, int heap_type, size_t size, size_t chunk_size);
+int gc_grow_heap(gc_heap * h, int heap_type, size_t size, size_t chunk_size, gc_thread_data *thd);
 char *gc_copy_obj(object hp, char *obj, gc_thread_data * thd);
 void *gc_try_alloc(gc_heap * h, int heap_type, size_t size, char *obj,
                    gc_thread_data * thd);
@@ -677,7 +677,7 @@ size_t gc_heap_total_size(gc_heap * h);
 //void gc_mark(gc_heap *h, object obj);
 void gc_request_mark_globals(void);
 void gc_mark_globals(object globals, object global_table);
-size_t gc_sweep(gc_heap * h, int heap_type, size_t * sum_freed_ptr);
+size_t gc_sweep(gc_heap * h, int heap_type, size_t * sum_freed_ptr, gc_thread_data *thd);
 void gc_thr_grow_move_buffer(gc_thread_data * d);
 void gc_thr_add_to_move_buffer(gc_thread_data * d, int *alloci, object obj);
 void gc_thread_data_init(gc_thread_data * thd, int mut_num, char *stack_base,
diff --git a/runtime.c b/runtime.c
index 32770271..e4a62420 100644
--- a/runtime.c
+++ b/runtime.c
@@ -2046,12 +2046,27 @@ object Cyc_make_bytevector(void *data, object cont, int argc, object len, ...)
   Cyc_check_num(data, len);
   length = unbox_number(len);
 
-  bv = alloca(sizeof(bytevector_type));
-  ((bytevector) bv)->hdr.mark = gc_color_red;
-  ((bytevector) bv)->hdr.grayed = 0;
-  ((bytevector) bv)->tag = bytevector_tag;
-  ((bytevector) bv)->len = length;
-  ((bytevector) bv)->data = alloca(sizeof(char) * length);
+  if (length >= MAX_STACK_OBJ) {
+    int heap_grown;
+    bv = gc_alloc(((gc_thread_data *)data)->heap,
+                  sizeof(bytevector_type) + length,
+                  boolean_f, // OK to populate manually over here
+                  (gc_thread_data *)data, 
+                  &heap_grown);
+    ((bytevector) bv)->hdr.mark = ((gc_thread_data *)data)->gc_alloc_color;
+    ((bytevector) bv)->hdr.grayed = 0;
+    ((bytevector) bv)->tag = bytevector_tag;
+    ((bytevector) bv)->len = length;
+    ((bytevector) bv)->data = (char *)(((char *)bv) + sizeof(bytevector_type));
+  } else {
+    bv = alloca(sizeof(bytevector_type));
+    ((bytevector) bv)->hdr.mark = gc_color_red;
+    ((bytevector) bv)->hdr.grayed = 0;
+    ((bytevector) bv)->tag = bytevector_tag;
+    ((bytevector) bv)->len = length;
+    ((bytevector) bv)->data = alloca(sizeof(char) * length);
+  }
+
   if (argc > 1) {
     Cyc_check_num(data, fill);
     fill_val = unbox_number(fill);

From 7b2a4991a704c66733858070d9cb76d82b1c1051 Mon Sep 17 00:00:00 2001
From: Justin Ethier <justin.ethier@gmail.com>
Date: Thu, 26 Jan 2017 18:18:59 -0500
Subject: [PATCH 07/17] Initial file

---
 examples/threading/benchmarks/ctak.scm      | 109 ++++++++
 examples/threading/benchmarks/paraffins.scm | 260 ++++++++++++++++++++
 2 files changed, 369 insertions(+)
 create mode 100644 examples/threading/benchmarks/ctak.scm
 create mode 100644 examples/threading/benchmarks/paraffins.scm

diff --git a/examples/threading/benchmarks/ctak.scm b/examples/threading/benchmarks/ctak.scm
new file mode 100644
index 00000000..3f1515ae
--- /dev/null
+++ b/examples/threading/benchmarks/ctak.scm
@@ -0,0 +1,109 @@
+;;; CTAK -- A version of the TAK procedure that uses continuations.
+
+(import (scheme base) (scheme read) (scheme write) (scheme time))
+
+(define (ctak x y z)
+  (call-with-current-continuation
+   (lambda (k) (ctak-aux k x y z))))
+
+(define (ctak-aux k x y z)
+  (if (not (< y x))
+      (k z)
+      (call-with-current-continuation
+       (lambda (k)
+         (ctak-aux
+          k
+          (call-with-current-continuation
+           (lambda (k) (ctak-aux k (- x 1) y z)))
+          (call-with-current-continuation
+           (lambda (k) (ctak-aux k (- y 1) z x)))
+          (call-with-current-continuation
+           (lambda (k) (ctak-aux k (- z 1) x y))))))))
+
+(define (main)
+  (let* ((count (read))
+         (input1 (read))
+         (input2 (read))
+         (input3 (read))
+         (output (read))
+         (s4 (number->string count))
+         (s3 (number->string input3))
+         (s2 (number->string input2))
+         (s1 (number->string input1))
+         (name "ctak"))
+    (run-r7rs-benchmark
+     (string-append name ":" s1 ":" s2 ":" s3 ":" s4)
+     count
+     (lambda ()
+       (ctak (hide count input1) (hide count input2) (hide count input3)))
+     (lambda (result) (equal? result output)))))
+
+;;; The following code is appended to all benchmarks.
+
+;;; Given an integer and an object, returns the object
+;;; without making it too easy for compilers to tell
+;;; the object will be returned.
+
+(define (hide r x)
+  (call-with-values
+   (lambda ()
+     (values (vector values (lambda (x) x))
+             (if (< r 100) 0 1)))
+   (lambda (v i)
+     ((vector-ref v i) x))))
+
+;;; Given the name of a benchmark,
+;;; the number of times it should be executed,
+;;; a thunk that runs the benchmark once,
+;;; and a unary predicate that is true of the
+;;; correct results the thunk may return,
+;;; runs the benchmark for the number of specified iterations.
+
+(define (run-r7rs-benchmark name count thunk ok?)
+
+  ;; Rounds to thousandths.
+  (define (rounded x)
+    (/ (round (* 1000 x)) 1000))
+
+  (display "Running ")
+  (display name)
+  (newline)
+  (flush-output-port (current-output-port))
+  (let* ((j/s (jiffies-per-second))
+         (t0 (current-second))
+         (j0 (current-jiffy)))
+    (let loop ((i 0)
+               (result #f))
+      (cond ((< i count)
+             (loop (+ i 1) (thunk)))
+            ((ok? result)
+             (let* ((j1 (current-jiffy))
+                    (t1 (current-second))
+                    (jifs (- j1 j0))
+                    (secs (inexact (/ jifs j/s)))
+                    (secs2 (rounded (- t1 t0))))
+               (display "Elapsed time: ")
+               (write secs)
+               (display " seconds (")
+               (write secs2)
+               (display ") for ")
+               (display name)
+               (newline)
+               (display "+!CSVLINE!+")
+               (display (this-scheme-implementation-name))
+               (display ",")
+               (display name)
+               (display ",")
+               (display secs)
+               (newline)
+               (flush-output-port (current-output-port)))
+             result)
+            (else
+             (display "ERROR: returned incorrect result: ")
+             (write result)
+             (newline)
+             (flush-output-port (current-output-port))
+             result)))))
+(define (this-scheme-implementation-name)
+  (string-append "cyclone-" (Cyc-version)))
+(main)
diff --git a/examples/threading/benchmarks/paraffins.scm b/examples/threading/benchmarks/paraffins.scm
new file mode 100644
index 00000000..3602a208
--- /dev/null
+++ b/examples/threading/benchmarks/paraffins.scm
@@ -0,0 +1,260 @@
+;;; PARAFFINS -- Compute how many paraffins exist with N carbon atoms.
+
+(import (scheme base) (scheme read) (scheme write) (scheme time))
+
+;;; This benchmark uses the following R6RS procedures.
+
+(define (div x y)
+  (quotient x y))
+
+;;; End of (faked) R6RS procedures.
+
+(define (gen n)
+  (let* ((n/2 (div n 2))
+         (radicals (make-vector (+ n/2 1) '(H))))
+
+    (define (rads-of-size n)
+      (let loop1 ((ps
+                   (three-partitions (- n 1)))
+                  (lst
+                   '()))
+        (if (null? ps)
+            lst
+            (let* ((p (car ps))
+                   (nc1 (vector-ref p 0))
+                   (nc2 (vector-ref p 1))
+                   (nc3 (vector-ref p 2)))
+              (let loop2 ((rads1
+                           (vector-ref radicals nc1))
+                          (lst
+                           (loop1 (cdr ps)
+                                  lst)))
+                (if (null? rads1)
+                    lst
+                    (let loop3 ((rads2
+                                 (if (= nc1 nc2)
+                                     rads1
+                                     (vector-ref radicals nc2)))
+                                (lst
+                                 (loop2 (cdr rads1)
+                                        lst)))
+                      (if (null? rads2)
+                          lst
+                          (let loop4 ((rads3
+                                       (if (= nc2 nc3)
+                                           rads2
+                                           (vector-ref radicals nc3)))
+                                      (lst
+                                       (loop3 (cdr rads2)
+                                              lst)))
+                            (if (null? rads3)
+                                lst
+                                (cons (vector 'C
+                                              (car rads1)
+                                              (car rads2)
+                                              (car rads3))
+                                      (loop4 (cdr rads3)
+                                             lst))))))))))))
+
+    (define (bcp-generator j)
+      (if (odd? j)
+          '()
+          (let loop1 ((rads1
+                       (vector-ref radicals (div j 2)))
+                      (lst
+                       '()))
+            (if (null? rads1)
+                lst
+                (let loop2 ((rads2
+                             rads1)
+                            (lst
+                             (loop1 (cdr rads1)
+                                    lst)))
+                  (if (null? rads2)
+                      lst
+                      (cons (vector 'BCP
+                                    (car rads1)
+                                    (car rads2))
+                            (loop2 (cdr rads2)
+                                   lst))))))))
+
+    (define (ccp-generator j)
+      (let loop1 ((ps
+                   (four-partitions (- j 1)))
+                  (lst
+                   '()))
+        (if (null? ps)
+            lst
+            (let* ((p (car ps))
+                   (nc1 (vector-ref p 0))
+                   (nc2 (vector-ref p 1))
+                   (nc3 (vector-ref p 2))
+                   (nc4 (vector-ref p 3)))
+              (let loop2 ((rads1
+                           (vector-ref radicals nc1))
+                          (lst
+                           (loop1 (cdr ps)
+                                  lst)))
+                (if (null? rads1)
+                    lst
+                    (let loop3 ((rads2
+                                 (if (= nc1 nc2)
+                                     rads1
+                                     (vector-ref radicals nc2)))
+                                (lst
+                                 (loop2 (cdr rads1)
+                                        lst)))
+                      (if (null? rads2)
+                          lst
+                          (let loop4 ((rads3
+                                       (if (= nc2 nc3)
+                                           rads2
+                                           (vector-ref radicals nc3)))
+                                      (lst
+                                       (loop3 (cdr rads2)
+                                              lst)))
+                            (if (null? rads3)
+                                lst
+                                (let loop5 ((rads4
+                                             (if (= nc3 nc4)
+                                                 rads3
+                                                 (vector-ref radicals nc4)))
+                                            (lst
+                                             (loop4 (cdr rads3)
+                                                    lst)))
+                                  (if (null? rads4)
+                                      lst
+                                      (cons (vector 'CCP
+                                                    (car rads1)
+                                                    (car rads2)
+                                                    (car rads3)
+                                                    (car rads4))
+                                            (loop5 (cdr rads4)
+                                                   lst))))))))))))))
+
+    (let loop ((i 1))
+      (if (> i n/2)
+          (vector (bcp-generator n)
+                  (ccp-generator n))
+          (begin
+            (vector-set! radicals i (rads-of-size i))
+            (loop (+ i 1)))))))
+
+(define (three-partitions m)
+  (let loop1 ((lst '())
+              (nc1 (div m 3)))
+    (if (< nc1 0)
+        lst
+        (let loop2 ((lst lst)
+                    (nc2 (div (- m nc1) 2)))
+          (if (< nc2 nc1)
+              (loop1 lst
+                     (- nc1 1))
+              (loop2 (cons (vector nc1 nc2 (- m (+ nc1 nc2))) lst)
+                     (- nc2 1)))))))
+
+(define (four-partitions m)
+  (let loop1 ((lst '())
+              (nc1 (div m 4)))
+    (if (< nc1 0)
+        lst
+        (let loop2 ((lst lst)
+                    (nc2 (div (- m nc1) 3)))
+          (if (< nc2 nc1)
+              (loop1 lst
+                     (- nc1 1))
+              (let ((start (max nc2 (- (div (+ m 1) 2) (+ nc1 nc2)))))
+                (let loop3 ((lst lst)
+                            (nc3 (div (- m (+ nc1 nc2)) 2)))
+                  (if (< nc3 start)
+                      (loop2 lst (- nc2 1))
+                      (loop3 (cons (vector nc1 nc2 nc3 (- m (+ nc1 (+ nc2 nc3)))) lst)
+                             (- nc3 1))))))))))
+
+(define (nb n)
+  (let ((x (gen n)))
+    (+ (length (vector-ref x 0))
+       (length (vector-ref x 1)))))
+
+(define (main)
+  (let* ((count (read))
+         (input1 (read))
+         (output (read))
+         (s2 (number->string count))
+         (s1 (number->string input1))
+         (name "paraffins"))
+    (run-r7rs-benchmark
+     (string-append name ":" s1 ":" s2)
+     count
+     (lambda () (nb (hide count input1)))
+     (lambda (result) (= result output)))))
+
+;;; The following code is appended to all benchmarks.
+
+;;; Given an integer and an object, returns the object
+;;; without making it too easy for compilers to tell
+;;; the object will be returned.
+
+(define (hide r x)
+  (call-with-values
+   (lambda ()
+     (values (vector values (lambda (x) x))
+             (if (< r 100) 0 1)))
+   (lambda (v i)
+     ((vector-ref v i) x))))
+
+;;; Given the name of a benchmark,
+;;; the number of times it should be executed,
+;;; a thunk that runs the benchmark once,
+;;; and a unary predicate that is true of the
+;;; correct results the thunk may return,
+;;; runs the benchmark for the number of specified iterations.
+
+(define (run-r7rs-benchmark name count thunk ok?)
+
+  ;; Rounds to thousandths.
+  (define (rounded x)
+    (/ (round (* 1000 x)) 1000))
+
+  (display "Running ")
+  (display name)
+  (newline)
+  (flush-output-port (current-output-port))
+  (let* ((j/s (jiffies-per-second))
+         (t0 (current-second))
+         (j0 (current-jiffy)))
+    (let loop ((i 0)
+               (result #f))
+      (cond ((< i count)
+             (loop (+ i 1) (thunk)))
+            ((ok? result)
+             (let* ((j1 (current-jiffy))
+                    (t1 (current-second))
+                    (jifs (- j1 j0))
+                    (secs (inexact (/ jifs j/s)))
+                    (secs2 (rounded (- t1 t0))))
+               (display "Elapsed time: ")
+               (write secs)
+               (display " seconds (")
+               (write secs2)
+               (display ") for ")
+               (display name)
+               (newline)
+               (display "+!CSVLINE!+")
+               (display (this-scheme-implementation-name))
+               (display ",")
+               (display name)
+               (display ",")
+               (display secs)
+               (newline)
+               (flush-output-port (current-output-port)))
+             result)
+            (else
+             (display "ERROR: returned incorrect result: ")
+             (write result)
+             (newline)
+             (flush-output-port (current-output-port))
+             result)))))
+(define (this-scheme-implementation-name)
+  (string-append "cyclone-" (Cyc-version)))
+(main)

From 8c6c27b3d6673bb53bfcae74d97fba1cb089c7cb Mon Sep 17 00:00:00 2001
From: Justin Ethier <justin.ethier@gmail.com>
Date: Thu, 26 Jan 2017 18:43:52 -0500
Subject: [PATCH 08/17] WIP

---
 examples/threading/benchmarks/ctak.scm      | 23 +++++++++++++++++++--
 examples/threading/benchmarks/paraffins.scm | 14 +++++++++++--
 2 files changed, 33 insertions(+), 4 deletions(-)

diff --git a/examples/threading/benchmarks/ctak.scm b/examples/threading/benchmarks/ctak.scm
index 3f1515ae..67d4a6c7 100644
--- a/examples/threading/benchmarks/ctak.scm
+++ b/examples/threading/benchmarks/ctak.scm
@@ -1,6 +1,6 @@
 ;;; CTAK -- A version of the TAK procedure that uses continuations.
 
-(import (scheme base) (scheme read) (scheme write) (scheme time))
+(import (scheme base) (scheme read) (scheme write) (scheme time) (srfi 18))
 
 (define (ctak x y z)
   (call-with-current-continuation
@@ -35,7 +35,26 @@
      (string-append name ":" s1 ":" s2 ":" s3 ":" s4)
      count
      (lambda ()
-       (ctak (hide count input1) (hide count input2) (hide count input3)))
+       (thread-start!
+         (make-thread
+           (lambda ()
+             (ctak (hide count input1) (hide count input2) (hide count input3)))))
+       (thread-start!
+         (make-thread
+           (lambda ()
+             (ctak (hide count input1) (hide count input2) (hide count input3)))))
+       (thread-start!
+         (make-thread
+           (lambda ()
+             (ctak (hide count input1) (hide count input2) (hide count input3)))))
+       (thread-start!
+         (make-thread
+           (lambda ()
+             (ctak (hide count input1) (hide count input2) (hide count input3)))))
+       (ctak (hide count input1) (hide count input2) (hide count input3))
+
+       ;; TODO: thread-join
+     )
      (lambda (result) (equal? result output)))))
 
 ;;; The following code is appended to all benchmarks.
diff --git a/examples/threading/benchmarks/paraffins.scm b/examples/threading/benchmarks/paraffins.scm
index 3602a208..1d6e0031 100644
--- a/examples/threading/benchmarks/paraffins.scm
+++ b/examples/threading/benchmarks/paraffins.scm
@@ -1,6 +1,6 @@
 ;;; PARAFFINS -- Compute how many paraffins exist with N carbon atoms.
 
-(import (scheme base) (scheme read) (scheme write) (scheme time))
+(import (scheme base) (scheme read) (scheme write) (scheme time) (srfi 18))
 
 ;;; This benchmark uses the following R6RS procedures.
 
@@ -186,7 +186,17 @@
     (run-r7rs-benchmark
      (string-append name ":" s1 ":" s2)
      count
-     (lambda () (nb (hide count input1)))
+     (lambda () 
+       #;(thread-start!
+         (make-thread
+           (lambda ()
+             (nb (hide count input1)))))
+       (thread-start!
+         (make-thread
+           (lambda ()
+             (nb (hide count input1)))))
+       (nb (hide count input1))
+     )
      (lambda (result) (= result output)))))
 
 ;;; The following code is appended to all benchmarks.

From 8b530989eef1eb6e2f5a03afa50ada4be857d1cd Mon Sep 17 00:00:00 2001
From: Justin Ethier <justin.ethier@gmail.com>
Date: Thu, 26 Jan 2017 18:55:10 -0500
Subject: [PATCH 09/17] Expose TODO for cleaning up old threads

---
 gc.c | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/gc.c b/gc.c
index 2f621f0f..3ba60508 100644
--- a/gc.c
+++ b/gc.c
@@ -1684,11 +1684,11 @@ void gc_thread_data_free(gc_thread_data * thd)
 {
   if (thd) {
 //
-// !!
-// TODO: (not necessarily here, but somewhere need to roll heap pages into
-// another thread data. need to include cached heap sizes/total, too.
-// then free cached heap vars here.
-// !!
+ !!
+ TODO: (not necessarily here, but somewhere need to roll heap pages into
+ another thread data. need to include cached heap sizes/total, too.
+ then free cached heap vars here.
+ !!
 //
     if (pthread_mutex_destroy(&thd->lock) != 0) {
       // TODO: can only destroy the lock if it is unlocked. need to make sure we

From e30ff16b3d65b9a3bee5ba1ede2a3a90022b0bf4 Mon Sep 17 00:00:00 2001
From: Justin Ethier <justin.ethier@gmail.com>
Date: Fri, 27 Jan 2017 22:37:55 -0500
Subject: [PATCH 10/17] Added heap merge functions

---
 gc.c                    | 33 ++++++++++++++++++++++++++++-----
 include/cyclone/types.h |  2 ++
 2 files changed, 30 insertions(+), 5 deletions(-)

diff --git a/gc.c b/gc.c
index 3ba60508..778f2a80 100644
--- a/gc.c
+++ b/gc.c
@@ -1684,11 +1684,11 @@ void gc_thread_data_free(gc_thread_data * thd)
 {
   if (thd) {
 //
- !!
- TODO: (not necessarily here, but somewhere need to roll heap pages into
- another thread data. need to include cached heap sizes/total, too.
- then free cached heap vars here.
- !!
+// !!
+// TODO: (not necessarily here, but somewhere need to roll heap pages into
+// another thread data. need to include cached heap sizes/total, too.
+// then free cached heap vars here.
+// !!
 //
     if (pthread_mutex_destroy(&thd->lock) != 0) {
       // TODO: can only destroy the lock if it is unlocked. need to make sure we
@@ -1714,6 +1714,29 @@ void gc_thread_data_free(gc_thread_data * thd)
   }
 }
 
+/**
+ * Merge one heap into another. Assumes appropriate locks are already held.
+ */
+void gc_heap_merge(gc_heap *hdest, gc_heap *hsrc)
+{
+  gc_heap *last = gc_heap_last(hdest);
+  last->next = hsrc;
+}
+
+void gc_heap_merge_all(gc_heap_root *dest, gc_heap_root *src)
+{
+  gc_heap *hdest, *hsrc;
+  int heap_type;
+
+  for (heap_type = 0; heap_type < NUM_HEAP_TYPES; heap_type++) {
+    hdest = dest->heap[heap_type];
+    hsrc = src->heap[heap_type];
+    if (hdest && hsrc) {
+      gc_heap_merge(hdest, hsrc);
+    }
+  }
+}
+
 /**
  * Called explicitly from a mutator thread to let the collector know
  * it (may) block for an unknown period of time.
diff --git a/include/cyclone/types.h b/include/cyclone/types.h
index 24bfd676..82253ed7 100644
--- a/include/cyclone/types.h
+++ b/include/cyclone/types.h
@@ -662,6 +662,8 @@ void gc_remove_mutator(gc_thread_data * thd);
 gc_heap *gc_heap_create(int heap_type, size_t size, size_t max_size,
                         size_t chunk_size, gc_thread_data *thd);
 gc_heap *gc_heap_free(gc_heap *page, gc_heap *prev_page);
+void gc_heap_merge(gc_heap *hdest, gc_heap *hsrc);
+void gc_heap_merge_all(gc_heap_root *dest, gc_heap_root *src);
 void gc_print_stats(gc_heap * h);
 int gc_grow_heap(gc_heap * h, int heap_type, size_t size, size_t chunk_size, gc_thread_data *thd);
 char *gc_copy_obj(object hp, char *obj, gc_thread_data * thd);

From 8fa1bccd78a58993de3c94fa55a887b561bbdd9f Mon Sep 17 00:00:00 2001
From: Justin Ethier <justin.ethier@gmail.com>
Date: Sat, 28 Jan 2017 00:01:01 -0500
Subject: [PATCH 11/17] Finish heap merging, use separate heap locks

---
 examples/threading/benchmarks/ctak.scm | 19 +++---
 gc.c                                   | 85 ++++++++++++++++----------
 include/cyclone/types.h                |  3 +-
 3 files changed, 65 insertions(+), 42 deletions(-)

diff --git a/examples/threading/benchmarks/ctak.scm b/examples/threading/benchmarks/ctak.scm
index 67d4a6c7..f98b3198 100644
--- a/examples/threading/benchmarks/ctak.scm
+++ b/examples/threading/benchmarks/ctak.scm
@@ -35,15 +35,15 @@
      (string-append name ":" s1 ":" s2 ":" s3 ":" s4)
      count
      (lambda ()
-       (thread-start!
-         (make-thread
-           (lambda ()
-             (ctak (hide count input1) (hide count input2) (hide count input3)))))
-       (thread-start!
-         (make-thread
-           (lambda ()
-             (ctak (hide count input1) (hide count input2) (hide count input3)))))
-       (thread-start!
+       #;(thread-start!
+         (make-thread
+           (lambda ()
+             (ctak (hide count input1) (hide count input2) (hide count input3)))))
+       #;(thread-start!
+         (make-thread
+           (lambda ()
+             (ctak (hide count input1) (hide count input2) (hide count input3)))))
+       #;(thread-start!
          (make-thread
            (lambda ()
              (ctak (hide count input1) (hide count input2) (hide count input3)))))
@@ -51,6 +51,7 @@
          (make-thread
            (lambda ()
              (ctak (hide count input1) (hide count input2) (hide count input3)))))
+       (thread-sleep! 10000)
        (ctak (hide count input1) (hide count input2) (hide count input3))
 
        ;; TODO: thread-join
diff --git a/gc.c b/gc.c
index 778f2a80..9da47c1e 100644
--- a/gc.c
+++ b/gc.c
@@ -55,14 +55,11 @@ static void **mark_stack = NULL;
 static int mark_stack_len = 0;
 static int mark_stack_i = 0;
 
-// OBSOLETE:
-//// Lock to protect the heap from concurrent modifications
-//static pthread_mutex_t heap_lock;
-//
-//// Cached heap statistics
-//static uint64_t cached_heap_free_sizes[7] = { 0, 0, 0, 0, 0, 0, 0 };
-//static uint64_t cached_heap_total_sizes[7] = { 0, 0, 0, 0, 0, 0, 0 };
-//// END OBSOLETE
+// Data for the "main" thread which is guaranteed to always be there.
+// Per SRFI 18:
+//    All threads are terminated when the primordial
+//    thread terminates (normally or not).
+static gc_thread_data *primordial_thread = NULL;
 
 // Data for each individual mutator thread
 ck_array_t Cyc_mutators, old_mutators;
@@ -162,6 +159,11 @@ void gc_add_mutator(gc_thread_data * thd)
   }
   ck_array_commit(&Cyc_mutators);
   pthread_mutex_unlock(&mutators_lock);
+
+  // Main thread is always the first one added
+  if (primordial_thread == NULL) {
+      primordial_thread = thd;
+  }
 }
 
 // Remove selected mutator from the mutator list.
@@ -479,7 +481,7 @@ int gc_grow_heap(gc_heap * h, int heap_type, size_t size, size_t chunk_size, gc_
 {
   size_t /*cur_size,*/ new_size;
   gc_heap *h_last = h, *h_new;
-  pthread_mutex_lock(&(thd->lock)); //heap_lock);
+  pthread_mutex_lock(&(thd->heap_lock));
   // Compute size of new heap page
   if (heap_type == HEAP_HUGE) {
     new_size = gc_heap_align(size) + 128;
@@ -522,7 +524,7 @@ int gc_grow_heap(gc_heap * h, int heap_type, size_t size, size_t chunk_size, gc_
   // Done with computing new page size
   h_new = gc_heap_create(heap_type, new_size, h_last->max_size, chunk_size, thd);
   h_last->next = h_new;
-  pthread_mutex_unlock(&(thd->lock)); //heap_lock);
+  pthread_mutex_unlock(&(thd->heap_lock));
 #if GC_DEBUG_TRACE
   fprintf(stderr, "DEBUG - grew heap\n");
 #endif
@@ -534,7 +536,7 @@ void *gc_try_alloc(gc_heap * h, int heap_type, size_t size, char *obj,
 {
   gc_heap *h_passed = h;
   gc_free_list *f1, *f2, *f3;
-  pthread_mutex_lock(&(thd->lock)); //heap_lock);
+  pthread_mutex_lock(&(thd->heap_lock));
   // Start searching from the last heap page we had a successful
   // allocation from, unless the current request is for a smaller
   // block in which case there may be available memory closer to
@@ -566,12 +568,12 @@ void *gc_try_alloc(gc_heap * h, int heap_type, size_t size, char *obj,
         }
         h_passed->next_free = h;
         h_passed->last_alloc_size = size;
-        pthread_mutex_unlock(&(thd->lock)); //heap_lock);
+        pthread_mutex_unlock(&(thd->heap_lock));
         return f2;
       }
     }
   }
-  pthread_mutex_unlock(&(thd->lock)); //heap_lock);
+  pthread_mutex_unlock(&(thd->heap_lock));
   return NULL;
 }
 
@@ -617,9 +619,9 @@ void *gc_alloc(gc_heap_root * hrt, size_t size, char *obj, gc_thread_data * thd,
     if (!result) {
       fprintf(stderr, "out of memory error allocating %zu bytes\n", size);
       fprintf(stderr, "Heap type %d diagnostics:\n", heap_type);
-      pthread_mutex_lock(&(thd->lock)); //heap_lock);
+      pthread_mutex_lock(&(thd->heap_lock));
       gc_print_stats(h);
-      pthread_mutex_unlock(&(thd->lock)); //heap_lock); // why not
+      pthread_mutex_unlock(&(thd->heap_lock)); // why not
       exit(1);                  // could throw error, but OOM is a major issue, so...
     }
   }
@@ -798,13 +800,9 @@ size_t gc_sweep(gc_heap * h, int heap_type, size_t * sum_freed_ptr, gc_thread_da
 
   //
   // Lock the heap to prevent issues with allocations during sweep
-  // It sucks to have to use a coarse-grained lock like this, but let's
-  // be safe and prevent threading issues right now. Once the new GC
-  // works we can go back and try to speed things up (if possible)
-  // by using more fine-grained locking. Can also profile to see
-  // how much time is even spent sweeping
+  // This coarse-grained lock actually performed better than a fine-grained one.
   //
-  pthread_mutex_lock(&(thd->lock)); //heap_lock);
+  pthread_mutex_lock(&(thd->heap_lock));
   h->next_free = h;
   h->last_alloc_size = 0;
 
@@ -945,7 +943,7 @@ size_t gc_sweep(gc_heap * h, int heap_type, size_t * sum_freed_ptr, gc_thread_da
   gc_print_stats(orig_heap_ptr);
 #endif
 
-  pthread_mutex_unlock(&(thd->lock)); //heap_lock);
+  pthread_mutex_unlock(&(thd->heap_lock));
   if (sum_freed_ptr)
     *sum_freed_ptr = sum_freed;
   return max_freed;
@@ -1663,6 +1661,10 @@ void gc_thread_data_init(gc_thread_data * thd, int mut_num, char *stack_base,
   thd->mark_buffer_len = 128;
   thd->mark_buffer =
       vpbuffer_realloc(thd->mark_buffer, &(thd->mark_buffer_len));
+  if (pthread_mutex_init(&(thd->heap_lock), NULL) != 0) {
+    fprintf(stderr, "Unable to initialize thread mutex\n");
+    exit(1);
+  }
   if (pthread_mutex_init(&(thd->lock), NULL) != 0) {
     fprintf(stderr, "Unable to initialize thread mutex\n");
     exit(1);
@@ -1683,13 +1685,6 @@ void gc_thread_data_init(gc_thread_data * thd, int mut_num, char *stack_base,
 void gc_thread_data_free(gc_thread_data * thd)
 {
   if (thd) {
-//
-// !!
-// TODO: (not necessarily here, but somewhere need to roll heap pages into
-// another thread data. need to include cached heap sizes/total, too.
-// then free cached heap vars here.
-// !!
-//
     if (pthread_mutex_destroy(&thd->lock) != 0) {
       // TODO: can only destroy the lock if it is unlocked. need to make sure we
       // can guarantee that is the case prior to making this call
@@ -1697,6 +1692,23 @@ void gc_thread_data_free(gc_thread_data * thd)
       fprintf(stderr, "Thread mutex is locked, unable to free\n");
       exit(1);
     }
+    if (pthread_mutex_destroy(&thd->heap_lock) != 0) {
+      fprintf(stderr, "Thread heap mutex is locked, unable to free\n");
+      exit(1);
+    }
+    // Merge heaps for the terminating thread into the main thread's heap.
+    // Eventually any data that is unused will be freed, but we need to
+    // keep the heap pages for now because they could still contain live 
+    // objects.
+    // Lock the primordial thread (hopefully will not cause any deadlocks)
+    // but don't bother locking thd since it is already done by now.
+    pthread_mutex_lock(&(primordial_thread->heap_lock));
+    gc_merge_all_heaps(primordial_thread, thd);
+    pthread_mutex_unlock(&(primordial_thread->heap_lock));
+    if (thd->cached_heap_free_sizes)
+      free(thd->cached_heap_free_sizes);
+    if (thd->cached_heap_total_sizes);
+      free(thd->cached_heap_total_sizes);
     if (thd->jmp_start)
       free(thd->jmp_start);
     if (thd->gc_args)
@@ -1723,18 +1735,27 @@ void gc_heap_merge(gc_heap *hdest, gc_heap *hsrc)
   last->next = hsrc;
 }
 
-void gc_heap_merge_all(gc_heap_root *dest, gc_heap_root *src)
+/**
+ * Merge all thread heaps into another.
+ * Assumes appropriate locks are already held.
+ */
+void gc_merge_all_heaps(gc_thread_data *dest, gc_thread_data *src)
 {
   gc_heap *hdest, *hsrc;
   int heap_type;
 
   for (heap_type = 0; heap_type < NUM_HEAP_TYPES; heap_type++) {
-    hdest = dest->heap[heap_type];
-    hsrc = src->heap[heap_type];
+    hdest = dest->heap->heap[heap_type];
+    hsrc = src->heap->heap[heap_type];
     if (hdest && hsrc) {
       gc_heap_merge(hdest, hsrc);
+      ck_pr_add_64(&(dest->cached_heap_total_sizes[heap_type]), 
+           ck_pr_load_64(&(src->cached_heap_total_sizes[heap_type])));
+      ck_pr_add_64(&(dest->cached_heap_free_sizes[heap_type]), 
+           ck_pr_load_64(&(src->cached_heap_free_sizes[heap_type])));
     }
   }
+  fprintf(stderr, "Finished merging old heap data\n");
 }
 
 /**
diff --git a/include/cyclone/types.h b/include/cyclone/types.h
index 82253ed7..f3af9504 100644
--- a/include/cyclone/types.h
+++ b/include/cyclone/types.h
@@ -221,6 +221,7 @@ struct gc_thread_data_t {
   void **mark_buffer;
   int mark_buffer_len;
   pthread_mutex_t lock;
+  pthread_mutex_t heap_lock;
   pthread_t thread_id;
   gc_heap_root *heap;
   uint64_t *cached_heap_free_sizes;
@@ -663,7 +664,7 @@ gc_heap *gc_heap_create(int heap_type, size_t size, size_t max_size,
                         size_t chunk_size, gc_thread_data *thd);
 gc_heap *gc_heap_free(gc_heap *page, gc_heap *prev_page);
 void gc_heap_merge(gc_heap *hdest, gc_heap *hsrc);
-void gc_heap_merge_all(gc_heap_root *dest, gc_heap_root *src);
+void gc_merge_all_heaps(gc_thread_data *dest, gc_thread_data *src);
 void gc_print_stats(gc_heap * h);
 int gc_grow_heap(gc_heap * h, int heap_type, size_t size, size_t chunk_size, gc_thread_data *thd);
 char *gc_copy_obj(object hp, char *obj, gc_thread_data * thd);

From 5a256119347936205b7d7a36d2328ab3f43ae80b Mon Sep 17 00:00:00 2001
From: Justin Ethier <justin.ethier@gmail.com>
Date: Sat, 28 Jan 2017 00:07:09 -0500
Subject: [PATCH 12/17] Added to trace

---
 gc.c | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/gc.c b/gc.c
index 9da47c1e..0c1fb5c7 100644
--- a/gc.c
+++ b/gc.c
@@ -1755,7 +1755,9 @@ void gc_merge_all_heaps(gc_thread_data *dest, gc_thread_data *src)
            ck_pr_load_64(&(src->cached_heap_free_sizes[heap_type])));
     }
   }
+#ifdef GC_DEBUG_TRACE
   fprintf(stderr, "Finished merging old heap data\n");
+#endif
 }
 
 /**

From 38ad580d33068ceec95b47548960cbd783173edf Mon Sep 17 00:00:00 2001
From: Justin Ethier <justin.ethier@gmail.com>
Date: Sat, 28 Jan 2017 01:29:29 -0500
Subject: [PATCH 13/17] Check return value of gc_heap_free()

---
 gc.c | 12 +++++++-----
 1 file changed, 7 insertions(+), 5 deletions(-)

diff --git a/gc.c b/gc.c
index 0c1fb5c7..8aba79b7 100644
--- a/gc.c
+++ b/gc.c
@@ -266,7 +266,7 @@ gc_heap *gc_heap_free(gc_heap *page, gc_heap *prev_page)
 {
   // At least for now, do not free first page
   if (prev_page == NULL || page == NULL) {
-    return page;
+    return NULL;
   }
 #if GC_DEBUG_TRACE
   fprintf(stderr, "DEBUG freeing heap type %d page at addr: %p\n", page->type, page);
@@ -928,10 +928,12 @@ size_t gc_sweep(gc_heap * h, int heap_type, size_t * sum_freed_ptr, gc_thread_da
     if (gc_is_heap_empty(h) && 
           (h->type == HEAP_HUGE || !(h->ttl--))) {
         unsigned int h_size = h->size;
-        h = gc_heap_free(h, prev_h);
-        ck_pr_sub_64(&(thd->cached_heap_free_sizes[heap_type] ), h_size);
-        ck_pr_sub_64(&(thd->cached_heap_total_sizes[heap_type]), h_size);
-
+        gc_heap *new_h = gc_heap_free(h, prev_h);
+        if (new_h) { // Ensure free succeeded
+          h = new_h;
+          ck_pr_sub_64(&(thd->cached_heap_free_sizes[heap_type] ), h_size);
+          ck_pr_sub_64(&(thd->cached_heap_total_sizes[heap_type]), h_size);
+        }
     }
     sum_freed += heap_freed;
     heap_freed = 0;

From 981700af3853453cf9c28d309c1f5c157f8b8d29 Mon Sep 17 00:00:00 2001
From: Justin Ethier <justin.ethier@gmail.com>
Date: Sat, 28 Jan 2017 17:54:35 -0500
Subject: [PATCH 14/17] Remove errant semicolon

---
 gc.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/gc.c b/gc.c
index 8aba79b7..d52eb5b1 100644
--- a/gc.c
+++ b/gc.c
@@ -1709,7 +1709,7 @@ void gc_thread_data_free(gc_thread_data * thd)
     pthread_mutex_unlock(&(primordial_thread->heap_lock));
     if (thd->cached_heap_free_sizes)
       free(thd->cached_heap_free_sizes);
-    if (thd->cached_heap_total_sizes);
+    if (thd->cached_heap_total_sizes)
       free(thd->cached_heap_total_sizes);
     if (thd->jmp_start)
       free(thd->jmp_start);

From 1e823c0d3f2e9473e70bea594e908a40e19d35e9 Mon Sep 17 00:00:00 2001
From: Justin Ethier <justin.ethier@gmail.com>
Date: Sat, 28 Jan 2017 18:17:56 -0500
Subject: [PATCH 15/17] Issue #162 - Use platform-independent uintptr_t

---
 gc.c                    | 60 ++++++++++++++++++++---------------------
 include/cyclone/types.h |  4 +--
 2 files changed, 32 insertions(+), 32 deletions(-)

diff --git a/gc.c b/gc.c
index d52eb5b1..c07620bb 100644
--- a/gc.c
+++ b/gc.c
@@ -229,8 +229,8 @@ gc_heap *gc_heap_create(int heap_type, size_t size, size_t max_size,
   h->next_free = h;
   h->last_alloc_size = 0;
   //h->free_size = size;
-  ck_pr_add_64(&(thd->cached_heap_total_sizes[heap_type]), size);
-  ck_pr_add_64(&(thd->cached_heap_free_sizes[heap_type]), size);
+  ck_pr_add_ptr(&(thd->cached_heap_total_sizes[heap_type]), size);
+  ck_pr_add_ptr(&(thd->cached_heap_free_sizes[heap_type]), size);
   h->chunk_size = chunk_size;
   h->max_size = max_size;
   h->data = (char *)gc_heap_align(sizeof(h->data) + (uintptr_t) & (h->data));
@@ -563,7 +563,7 @@ void *gc_try_alloc(gc_heap * h, int heap_type, size_t size, char *obj,
           // Copy object into heap now to avoid any uninitialized memory issues
           gc_copy_obj(f2, obj, thd);
           //h->free_size -= gc_allocated_bytes(obj, NULL, NULL);
-          ck_pr_sub_64(&(thd->cached_heap_free_sizes[heap_type]),
+          ck_pr_sub_ptr(&(thd->cached_heap_free_sizes[heap_type]),
                        gc_allocated_bytes(obj, NULL, NULL));
         }
         h_passed->next_free = h;
@@ -749,8 +749,8 @@ void gc_collector_sweep()
 
     // TODO: this loop only includes smallest 2 heaps, is that sufficient??
     for (heap_type = 0; heap_type < 2; heap_type++) {
-      while ( ck_pr_load_64(&(m->cached_heap_free_sizes[heap_type])) <
-             (ck_pr_load_64(&(m->cached_heap_total_sizes[heap_type])) * GC_FREE_THRESHOLD)) {
+      while ( ck_pr_load_ptr(&(m->cached_heap_free_sizes[heap_type])) <
+             (ck_pr_load_ptr(&(m->cached_heap_total_sizes[heap_type])) * GC_FREE_THRESHOLD)) {
 #if GC_DEBUG_TRACE
         fprintf(stderr, "Less than %f%% of the heap %d is free, growing it\n",
                 100.0 * GC_FREE_THRESHOLD, heap_type);
@@ -765,18 +765,18 @@ void gc_collector_sweep()
       }
     }
 #if GC_DEBUG_TRACE
-    total_size = ck_pr_load_64(&(m->cached_heap_total_sizes[HEAP_SM])) +
-                 ck_pr_load_64(&(m->cached_heap_total_sizes[HEAP_64])) + 
+    total_size = ck_pr_load_ptr(&(m->cached_heap_total_sizes[HEAP_SM])) +
+                 ck_pr_load_ptr(&(m->cached_heap_total_sizes[HEAP_64])) + 
 #if INTPTR_MAX == INT64_MAX
-                 ck_pr_load_64(&(m->cached_heap_total_sizes[HEAP_96])) + 
+                 ck_pr_load_ptr(&(m->cached_heap_total_sizes[HEAP_96])) + 
 #endif
-                 ck_pr_load_64(&(m->cached_heap_total_sizes[HEAP_REST]));
-    total_free = ck_pr_load_64(&(m->cached_heap_free_sizes[HEAP_SM])) +
-                 ck_pr_load_64(&(m->cached_heap_free_sizes[HEAP_64])) + 
+                 ck_pr_load_ptr(&(m->cached_heap_total_sizes[HEAP_REST]));
+    total_free = ck_pr_load_ptr(&(m->cached_heap_free_sizes[HEAP_SM])) +
+                 ck_pr_load_ptr(&(m->cached_heap_free_sizes[HEAP_64])) + 
 #if INTPTR_MAX == INT64_MAX
-                 ck_pr_load_64(&(m->cached_heap_free_sizes[HEAP_96])) + 
+                 ck_pr_load_ptr(&(m->cached_heap_free_sizes[HEAP_96])) + 
 #endif
-                 ck_pr_load_64(&(m->cached_heap_free_sizes[HEAP_REST]));
+                 ck_pr_load_ptr(&(m->cached_heap_free_sizes[HEAP_REST]));
     fprintf(stderr,
             "sweep done, total_size = %zu, total_free = %zu, freed = %zu, elapsed = %ld\n",
             total_size, total_free, freed,
@@ -910,7 +910,7 @@ size_t gc_sweep(gc_heap * h, int heap_type, size_t * sum_freed_ptr, gc_thread_da
       }
     }
     //h->free_size += heap_freed;
-    ck_pr_add_64(&(thd->cached_heap_free_sizes[heap_type]), heap_freed);
+    ck_pr_add_ptr(&(thd->cached_heap_free_sizes[heap_type]), heap_freed);
     // Free the heap page if possible.
     //
     // With huge heaps, this becomes more important. one of the huge
@@ -931,8 +931,8 @@ size_t gc_sweep(gc_heap * h, int heap_type, size_t * sum_freed_ptr, gc_thread_da
         gc_heap *new_h = gc_heap_free(h, prev_h);
         if (new_h) { // Ensure free succeeded
           h = new_h;
-          ck_pr_sub_64(&(thd->cached_heap_free_sizes[heap_type] ), h_size);
-          ck_pr_sub_64(&(thd->cached_heap_total_sizes[heap_type]), h_size);
+          ck_pr_sub_ptr(&(thd->cached_heap_free_sizes[heap_type] ), h_size);
+          ck_pr_sub_ptr(&(thd->cached_heap_total_sizes[heap_type]), h_size);
         }
     }
     sum_freed += heap_freed;
@@ -1146,16 +1146,16 @@ void gc_mut_cooperate(gc_thread_data * thd, int buf_len)
   // Threshold is intentially low because we have to go through an
   // entire handshake/trace/sweep cycle, ideally without growing heap.
   if (ck_pr_load_int(&gc_stage) == STAGE_RESTING &&
-      ((ck_pr_load_64(&(thd->cached_heap_free_sizes[HEAP_SM])) <
-        ck_pr_load_64(&(thd->cached_heap_total_sizes[HEAP_SM])) * GC_COLLECTION_THRESHOLD) ||
-       (ck_pr_load_64(&(thd->cached_heap_free_sizes[HEAP_64])) <
-        ck_pr_load_64(&(thd->cached_heap_total_sizes[HEAP_64])) * GC_COLLECTION_THRESHOLD) ||
+      ((ck_pr_load_ptr(&(thd->cached_heap_free_sizes[HEAP_SM])) <
+        ck_pr_load_ptr(&(thd->cached_heap_total_sizes[HEAP_SM])) * GC_COLLECTION_THRESHOLD) ||
+       (ck_pr_load_ptr(&(thd->cached_heap_free_sizes[HEAP_64])) <
+        ck_pr_load_ptr(&(thd->cached_heap_total_sizes[HEAP_64])) * GC_COLLECTION_THRESHOLD) ||
 #if INTPTR_MAX == INT64_MAX
-       (ck_pr_load_64(&(thd->cached_heap_free_sizes[HEAP_96])) <
-        ck_pr_load_64(&(thd->cached_heap_total_sizes[HEAP_96])) * GC_COLLECTION_THRESHOLD) ||
+       (ck_pr_load_ptr(&(thd->cached_heap_free_sizes[HEAP_96])) <
+        ck_pr_load_ptr(&(thd->cached_heap_total_sizes[HEAP_96])) * GC_COLLECTION_THRESHOLD) ||
 #endif
-       (ck_pr_load_64(&(thd->cached_heap_free_sizes[HEAP_REST])) <
-        ck_pr_load_64(&(thd->cached_heap_total_sizes[HEAP_REST])) * GC_COLLECTION_THRESHOLD))) {
+       (ck_pr_load_ptr(&(thd->cached_heap_free_sizes[HEAP_REST])) <
+        ck_pr_load_ptr(&(thd->cached_heap_total_sizes[HEAP_REST])) * GC_COLLECTION_THRESHOLD))) {
 #if GC_DEBUG_TRACE
     fprintf(stderr,
             "Less than %f%% of the heap is free, initiating collector\n",
@@ -1671,8 +1671,8 @@ void gc_thread_data_init(gc_thread_data * thd, int mut_num, char *stack_base,
     fprintf(stderr, "Unable to initialize thread mutex\n");
     exit(1);
   }
-  thd->cached_heap_free_sizes = calloc(5, sizeof(uint64_t));
-  thd->cached_heap_total_sizes = calloc(5, sizeof(uint64_t));
+  thd->cached_heap_free_sizes = calloc(5, sizeof(uintptr_t));
+  thd->cached_heap_total_sizes = calloc(5, sizeof(uintptr_t));
   thd->heap = calloc(1, sizeof(gc_heap_root));
   thd->heap->heap = calloc(1, sizeof(gc_heap *) * NUM_HEAP_TYPES);
   thd->heap->heap[HEAP_REST] = gc_heap_create(HEAP_REST, INITIAL_HEAP_SIZE, 0, 0, thd);
@@ -1751,10 +1751,10 @@ void gc_merge_all_heaps(gc_thread_data *dest, gc_thread_data *src)
     hsrc = src->heap->heap[heap_type];
     if (hdest && hsrc) {
       gc_heap_merge(hdest, hsrc);
-      ck_pr_add_64(&(dest->cached_heap_total_sizes[heap_type]), 
-           ck_pr_load_64(&(src->cached_heap_total_sizes[heap_type])));
-      ck_pr_add_64(&(dest->cached_heap_free_sizes[heap_type]), 
-           ck_pr_load_64(&(src->cached_heap_free_sizes[heap_type])));
+      ck_pr_add_ptr(&(dest->cached_heap_total_sizes[heap_type]), 
+           ck_pr_load_ptr(&(src->cached_heap_total_sizes[heap_type])));
+      ck_pr_add_ptr(&(dest->cached_heap_free_sizes[heap_type]), 
+           ck_pr_load_ptr(&(src->cached_heap_free_sizes[heap_type])));
     }
   }
 #ifdef GC_DEBUG_TRACE
diff --git a/include/cyclone/types.h b/include/cyclone/types.h
index f3af9504..2be404ac 100644
--- a/include/cyclone/types.h
+++ b/include/cyclone/types.h
@@ -224,8 +224,8 @@ struct gc_thread_data_t {
   pthread_mutex_t heap_lock;
   pthread_t thread_id;
   gc_heap_root *heap;
-  uint64_t *cached_heap_free_sizes;
-  uint64_t *cached_heap_total_sizes;
+  uintptr_t *cached_heap_free_sizes;
+  uintptr_t *cached_heap_total_sizes;
   // Data needed for call history
   char **stack_traces;
   int stack_trace_idx;

From 2b04c3b253067fa57feb863d6a6897d0f344ac03 Mon Sep 17 00:00:00 2001
From: Justin Ethier <justin.ethier@gmail.com>
Date: Mon, 30 Jan 2017 14:24:57 +0000
Subject: [PATCH 16/17] Set gc_cont and num args prior to blocking

This change shouldn't hurt anything and guarantees the collector thread is not trying to use gc_cont before it is set properly.
---
 gc.c | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/gc.c b/gc.c
index c07620bb..b463c323 100644
--- a/gc.c
+++ b/gc.c
@@ -1771,6 +1771,8 @@ void gc_merge_all_heaps(gc_thread_data *dest, gc_thread_data *src)
  */
 void gc_mutator_thread_blocked(gc_thread_data * thd, object cont)
 {
+  thd->gc_cont = cont;
+  thd->gc_num_args = 0;         // Will be set later, after collection
   if (!ck_pr_cas_int((int *)&(thd->thread_state),
                      CYC_THREAD_STATE_RUNNABLE, CYC_THREAD_STATE_BLOCKED)) {
     fprintf(stderr,
@@ -1778,8 +1780,6 @@ void gc_mutator_thread_blocked(gc_thread_data * thd, object cont)
             thd->thread_state);
     exit(1);
   }
-  thd->gc_cont = cont;
-  thd->gc_num_args = 0;         // Will be set later, after collection
 }
 
 void Cyc_apply_from_buf(void *data, int argc, object prim, object * buf);

From 57562071c9f0400bf5003b3a94d8147387ca5780 Mon Sep 17 00:00:00 2001
From: Justin Ethier <justin.ethier@gmail.com>
Date: Mon, 30 Jan 2017 16:54:23 +0000
Subject: [PATCH 17/17] Issue #158 - Removed make_int macro

Also removed some related code that became redundant.
---
 include/cyclone/runtime.h |  1 -
 include/cyclone/types.h   |  6 -----
 runtime.c                 | 56 ++++++++++++++-------------------------
 3 files changed, 20 insertions(+), 43 deletions(-)

diff --git a/include/cyclone/runtime.h b/include/cyclone/runtime.h
index b40e0219..d65bc7b0 100644
--- a/include/cyclone/runtime.h
+++ b/include/cyclone/runtime.h
@@ -179,7 +179,6 @@ object Cyc_set_cell(void *, object l, object val);
 object Cyc_set_car(void *, object l, object val);
 object Cyc_set_cdr(void *, object l, object val);
 object Cyc_length(void *d, object l);
-integer_type Cyc_length_as_object(void *d, object l);
 object Cyc_vector_length(void *data, object v);
 object Cyc_vector_ref(void *d, object v, object k);
 object Cyc_vector_set(void *d, object v, object k, object obj);
diff --git a/include/cyclone/types.h b/include/cyclone/types.h
index 2be404ac..8afe40ad 100644
--- a/include/cyclone/types.h
+++ b/include/cyclone/types.h
@@ -355,12 +355,6 @@ typedef struct {
   int value;
   int padding;                  // Prevent mem corruption if sizeof(int) < sizeof(ptr)
 } integer_type;
-#define make_int(n,v) \
-  integer_type n; \
-  n.hdr.mark = gc_color_red; \
-  n.hdr.grayed = 0; \
-  n.tag = integer_tag; \
-  n.value = v;
 
 typedef struct {
   gc_header_type hdr;
diff --git a/runtime.c b/runtime.c
index e4a62420..2274525d 100644
--- a/runtime.c
+++ b/runtime.c
@@ -1368,8 +1368,8 @@ object Cyc_is_procedure(void *data, object o)
         tag == closure1_tag || tag == closureN_tag || tag == primitive_tag) {
       return boolean_t;
     } else if (tag == pair_tag) {
-      integer_type l = Cyc_length_as_object(data, o);
-      if (l.value > 0 && Cyc_is_symbol(car(o)) == boolean_t) {
+      int i = obj_obj2int(Cyc_length(data, o));
+      if (i > 0 && Cyc_is_symbol(car(o)) == boolean_t) {
         if (strncmp(((symbol) car(o))->desc, "primitive", 10) == 0 ||
             strncmp(((symbol) car(o))->desc, "procedure", 10) == 0) {
           return boolean_t;
@@ -1481,19 +1481,6 @@ object Cyc_vector_ref(void *data, object v, object k)
   return ((vector) v)->elements[idx];
 }
 
-integer_type Cyc_length_as_object(void *data, object l)
-{
-  make_int(len, 0);
-  while ((l != NULL)) {
-    if (is_value_type(l) || ((list) l)->tag != pair_tag) {
-      Cyc_rt_raise2(data, "length - invalid parameter, expected list", l);
-    }
-    l = cdr(l);
-    len.value++;
-  }
-  return len;
-}
-
 object Cyc_vector_length(void *data, object v)
 {
   if ((v != NULL) && !is_value_type(v) && ((list) v)->tag == vector_tag) {
@@ -3250,30 +3237,30 @@ void _Cyc_91end_91thread_67(void *data, object cont, object args)
 
 void __87(void *data, object cont, object args)
 {
-  integer_type argc = Cyc_length_as_object(data, args);
-  dispatch(data, argc.value, (function_type) dispatch_sum, cont, cont, args);
+  int argc = obj_obj2int(Cyc_length(data, args));
+  dispatch(data, argc, (function_type) dispatch_sum, cont, cont, args);
 }
 
 void __91(void *data, object cont, object args)
 {
   Cyc_check_num_args(data, "-", 1, args);
   {
-    integer_type argc = Cyc_length_as_object(data, args);
-    dispatch(data, argc.value, (function_type) dispatch_sub, cont, cont, args);
+    int argc = obj_obj2int(Cyc_length(data, args));
+    dispatch(data, argc, (function_type) dispatch_sub, cont, cont, args);
 }}
 
 void __85(void *data, object cont, object args)
 {
-  integer_type argc = Cyc_length_as_object(data, args);
-  dispatch(data, argc.value, (function_type) dispatch_mul, cont, cont, args);
+  int argc = obj_obj2int(Cyc_length(data, args));
+  dispatch(data, argc, (function_type) dispatch_mul, cont, cont, args);
 }
 
 void __95(void *data, object cont, object args)
 {
   Cyc_check_num_args(data, "/", 1, args);
   {
-    integer_type argc = Cyc_length_as_object(data, args);
-    dispatch(data, argc.value, (function_type) dispatch_div, cont, cont, args);
+    int argc = obj_obj2int(Cyc_length(data, args));
+    dispatch(data, argc, (function_type) dispatch_div, cont, cont, args);
 }}
 
 void _Cyc_91cvar_127(void *data, object cont, object args)
@@ -3432,33 +3419,33 @@ void _cell(void *data, object cont, object args)
 
 void __123(void *data, object cont, object args)
 {
-  integer_type argc = Cyc_length_as_object(data, args);
-  dispatch(data, argc.value, (function_type) dispatch_num_eq, cont, cont, args);
+  int argc = obj_obj2int(Cyc_length(data, args));
+  dispatch(data, argc, (function_type) dispatch_num_eq, cont, cont, args);
 }
 
 void __125(void *data, object cont, object args)
 {
-  integer_type argc = Cyc_length_as_object(data, args);
-  dispatch(data, argc.value, (function_type) dispatch_num_gt, cont, cont, args);
+  int argc = obj_obj2int(Cyc_length(data, args));
+  dispatch(data, argc, (function_type) dispatch_num_gt, cont, cont, args);
 }
 
 void __121(void *data, object cont, object args)
 {
-  integer_type argc = Cyc_length_as_object(data, args);
-  dispatch(data, argc.value, (function_type) dispatch_num_lt, cont, cont, args);
+  int argc = obj_obj2int(Cyc_length(data, args));
+  dispatch(data, argc, (function_type) dispatch_num_lt, cont, cont, args);
 }
 
 void __125_123(void *data, object cont, object args)
 {
-  integer_type argc = Cyc_length_as_object(data, args);
-  dispatch(data, argc.value, (function_type) dispatch_num_gte, cont, cont,
+  int argc = obj_obj2int(Cyc_length(data, args));
+  dispatch(data, argc, (function_type) dispatch_num_gte, cont, cont,
            args);
 }
 
 void __121_123(void *data, object cont, object args)
 {
-  integer_type argc = Cyc_length_as_object(data, args);
-  dispatch(data, argc.value, (function_type) dispatch_num_lte, cont, cont,
+  int argc = obj_obj2int(Cyc_length(data, args));
+  dispatch(data, argc, (function_type) dispatch_num_lte, cont, cont,
            args);
 }
 
@@ -3581,9 +3568,6 @@ void _cyc_system(void *data, object cont, object args)
     return_closcall1(data, cont, obj);
 }}
 
-//void _error(void *data, object cont, object args) {
-//    integer_type argc = Cyc_length_as_object(args);
-//    dispatch_va(data, argc.value, dispatch_error, cont, cont, args); }
 void _Cyc_91current_91exception_91handler(void *data, object cont, object args)
 {
   object handler = Cyc_current_exception_handler(data);