From 83e82f55a771475dde0bbec83c43e9e8d897fe84 Mon Sep 17 00:00:00 2001
From: Alex Shinn <alexshinn@gmail.com>
Date: Mon, 11 May 2020 10:43:36 +0900
Subject: [PATCH] tweaks for fixed-size heaps, fix issue #632

---
 gc.c                     | 51 +++++++++++++++++++++++++++++++++++-----
 include/chibi/features.h |  5 ++++
 include/chibi/sexp.h     |  5 ++--
 sexp.c                   |  4 +++-
 4 files changed, 56 insertions(+), 9 deletions(-)

diff --git a/gc.c b/gc.c
index 942eb1b6..3ba26cc3 100644
--- a/gc.c
+++ b/gc.c
@@ -37,12 +37,14 @@ static sexp_heap sexp_heap_last (sexp_heap h) {
   return h;
 }
 
+#if !SEXP_USE_FIXED_CHUNK_SIZE_HEAPS
 static size_t sexp_heap_total_size (sexp_heap h) {
   size_t total_size = 0;
   for (; h; h=h->next)
     total_size += h->size;
   return total_size;
 }
+#endif
 
 #if ! SEXP_USE_GLOBAL_HEAP
 #if SEXP_USE_DEBUG_GC
@@ -571,26 +573,38 @@ int sexp_grow_heap (sexp ctx, size_t size, size_t chunk_size) {
 #if SEXP_USE_FIXED_CHUNK_SIZE_HEAPS
   for (tmp=sexp_context_heap(ctx); tmp; tmp=tmp->next)
     if (tmp->chunk_size == size) {
+      while (tmp->next && tmp->next->chunk_size == size)
+        tmp = tmp->next;
       h = tmp;
       chunk_size = size;
       break;
     }
 #endif
   cur_size = h->size;
-  new_size = sexp_heap_align(((cur_size > size) ? cur_size : size) * 2);
+  new_size = (size_t) ceil(SEXP_GROW_HEAP_FACTOR * (double) (sexp_heap_align(((cur_size > size) ? cur_size : size))));
   tmp = sexp_make_heap(new_size, h->max_size, chunk_size);
-  if (tmp) tmp->next = h->next;
-  h->next = tmp;
+  if (tmp) {
+    tmp->next = h->next;
+    h->next = tmp;
+  }
   return (h->next != NULL);
 }
 
 void* sexp_try_alloc (sexp ctx, size_t size) {
   sexp_free_list ls1, ls2, ls3;
   sexp_heap h;
+#if SEXP_USE_FIXED_CHUNK_SIZE_HEAPS
+  int found_fixed = 0;
+#endif
   for (h=sexp_context_heap(ctx); h; h=h->next) {
 #if SEXP_USE_FIXED_CHUNK_SIZE_HEAPS
-    if (h->chunk_size && h->chunk_size != size)
-      continue;
+    if (h->chunk_size) {
+      if (h->chunk_size != size)
+        continue;
+      found_fixed = 1;
+    } else if (found_fixed) {   /* don't use a non-fixed heap */
+      return NULL;
+    }
 #endif
     for (ls1=h->free_list, ls2=ls1->next; ls2; ls1=ls2, ls2=ls2->next) {
       if (ls2->size >= size) {
@@ -617,9 +631,30 @@ void* sexp_try_alloc (sexp ctx, size_t size) {
   return NULL;
 }
 
+#if SEXP_USE_FIXED_CHUNK_SIZE_HEAPS
+int sexp_find_fixed_chunk_heap_usage(sexp ctx, size_t size, size_t* sum_freed, size_t* total_size) {
+  sexp_heap h;
+  sexp_free_list ls;
+  size_t avail=0, total=0;
+  for (h=sexp_context_heap(ctx); h; h=h->next) {
+    if (h->chunk_size == size || !h->chunk_size) {
+      for (; h && (h->chunk_size == size || !h->chunk_size); h=h->next) {
+        total += h->size;
+        for (ls=h->free_list; ls; ls=ls->next)
+          avail += ls->size;
+      }
+      *sum_freed = avail;
+      *total_size = total;
+      return h && h->chunk_size > 0;
+    }
+  }
+  return 0;
+}
+#endif
+
 void* sexp_alloc (sexp ctx, size_t size) {
   void *res;
-  size_t max_freed, sum_freed, total_size;
+  size_t max_freed, sum_freed, total_size=0;
   sexp_heap h = sexp_context_heap(ctx);
 #if SEXP_USE_TRACK_ALLOC_SIZES
   size_t size_bucket;
@@ -637,7 +672,11 @@ void* sexp_alloc (sexp ctx, size_t size) {
   res = sexp_try_alloc(ctx, size);
   if (! res) {
     max_freed = sexp_unbox_fixnum(sexp_gc(ctx, &sum_freed));
+#if SEXP_USE_FIXED_CHUNK_SIZE_HEAPS
+    sexp_find_fixed_chunk_heap_usage(ctx, size, &sum_freed, &total_size);
+#else
     total_size = sexp_heap_total_size(sexp_context_heap(ctx));
+#endif
     if (((max_freed < size)
          || ((total_size > sum_freed)
              && (total_size - sum_freed) > (total_size*SEXP_GROW_HEAP_RATIO)))
diff --git a/include/chibi/features.h b/include/chibi/features.h
index 1f33a278..2755d76b 100644
--- a/include/chibi/features.h
+++ b/include/chibi/features.h
@@ -273,6 +273,11 @@
 #define SEXP_GROW_HEAP_RATIO 0.75
 #endif
 
+/* how much to expand the heap size by */
+#ifndef SEXP_GROW_HEAP_FACTOR
+#define SEXP_GROW_HEAP_FACTOR 2  /* 1.6180339887498948482 */
+#endif
+
 /* the default number of opcodes to run each thread for */
 #ifndef SEXP_DEFAULT_QUANTUM
 #define SEXP_DEFAULT_QUANTUM 500
diff --git a/include/chibi/sexp.h b/include/chibi/sexp.h
index 9e9385bf..242bc985 100644
--- a/include/chibi/sexp.h
+++ b/include/chibi/sexp.h
@@ -546,8 +546,9 @@ struct sexp_struct {
 #endif
       char tailp, tracep, timeoutp, waitp, errorp;
       sexp_uint_t last_fp;
+      sexp_uint_t gc_count;
 #if SEXP_USE_TIME_GC
-      sexp_uint_t gc_count, gc_usecs;
+      sexp_uint_t gc_usecs;
 #endif
 #if SEXP_USE_TRACK_ALLOC_TIMES
       sexp_uint_t alloc_count, alloc_usecs;
@@ -1311,8 +1312,8 @@ enum sexp_uniform_vector_type {
 #define sexp_context_dk(x)       (sexp_field(x, context, SEXP_CONTEXT, dk))
 #define sexp_context_params(x)   (sexp_field(x, context, SEXP_CONTEXT, params))
 #define sexp_context_last_fp(x)  (sexp_field(x, context, SEXP_CONTEXT, last_fp))
-#if SEXP_USE_TIME_GC
 #define sexp_context_gc_count(x) (sexp_field(x, context, SEXP_CONTEXT, gc_count))
+#if SEXP_USE_TIME_GC
 #define sexp_context_gc_usecs(x) (sexp_field(x, context, SEXP_CONTEXT, gc_usecs))
 #else
 #define sexp_context_gc_count(x) 0
diff --git a/sexp.c b/sexp.c
index b32aca33..a199b0c5 100644
--- a/sexp.c
+++ b/sexp.c
@@ -606,7 +606,9 @@ sexp sexp_bootstrap_context (sexp_uint_t size, sexp_uint_t max_size) {
   sexp_heap heap;
   struct sexp_struct dummy_ctx;
   if (size < SEXP_MINIMUM_HEAP_SIZE) size = SEXP_INITIAL_HEAP_SIZE;
-  heap = sexp_make_heap(sexp_heap_align(size), sexp_heap_align(max_size), 0);
+  size = sexp_heap_align(size);
+  max_size = sexp_heap_align(max_size);
+  heap = sexp_make_heap(size, max_size, 0);
   if (!heap) return 0;
   sexp_pointer_tag(&dummy_ctx) = SEXP_CONTEXT;
   sexp_context_saves(&dummy_ctx) = NULL;