From 31103f174118c5e30087b26447cf33515627f9c4 Mon Sep 17 00:00:00 2001
From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Sat, 14 Apr 2012 11:08:45 +0300
Subject: [PATCH] gencgc: tune the recent "more aggressive GC" changes

 * Don't account fresh objects against auto_gc_trigger unless they're larger
   than bytes_consed_between_gcs: smaller objects don't mess up the logic so
   badly, and it's better not to force early promotion of fresh objects unless
   we have to.

 * Put the unqueality in setting auto_gc_trigger the right way around...

 Fixes lp#981106 (regression from 6b1b11a6c51e1c29aee947f1fde7f91651ca3763)
---
 src/runtime/gencgc.c |   14 ++++++++++++--
 tests/gc.impure.lisp |   27 +++++++++++++++++++++------
 2 files changed, 33 insertions(+), 8 deletions(-)

diff --git a/src/runtime/gencgc.c b/src/runtime/gencgc.c
index 1d143c8..e97b756 100644
--- a/src/runtime/gencgc.c
+++ b/src/runtime/gencgc.c
@@ -3847,7 +3847,7 @@ collect_garbage(generation_index_t last_gen)
 
     /* Update auto_gc_trigger. Make sure we trigger the next GC before
      * running out of heap! */
-    if (bytes_consed_between_gcs >= dynamic_space_size - bytes_allocated)
+    if (bytes_consed_between_gcs <= (dynamic_space_size - bytes_allocated))
         auto_gc_trigger = bytes_allocated + bytes_consed_between_gcs;
     else
         auto_gc_trigger = bytes_allocated + (dynamic_space_size - bytes_allocated)/2;
@@ -4125,6 +4125,7 @@ general_alloc_internal(long nbytes, int page_type_flag, struct alloc_region *reg
 #endif
     void *new_obj;
     void *new_free_pointer;
+    os_vm_size_t trigger_bytes = 0;
 
     gc_assert(nbytes>0);
 
@@ -4146,10 +4147,19 @@ general_alloc_internal(long nbytes, int page_type_flag, struct alloc_region *reg
         return(new_obj);        /* yup */
     }
 
+    /* We don't want to count nbytes against auto_gc_trigger unless we
+     * have to: it speeds up the tenuring of objects and slows down
+     * allocation. However, unless we do so when allocating _very_
+     * large objects we are in danger of exhausting the heap without
+     * running sufficient GCs.
+     */
+    if (nbytes >= bytes_consed_between_gcs)
+        trigger_bytes = nbytes;
+
     /* we have to go the long way around, it seems. Check whether we
      * should GC in the near future
      */
-    if (auto_gc_trigger && bytes_allocated+nbytes > auto_gc_trigger) {
+    if (auto_gc_trigger && (bytes_allocated+trigger_bytes > auto_gc_trigger)) {
         /* Don't flood the system with interrupts if the need to gc is
          * already noted. This can happen for example when SUB-GC
          * allocates or after a gc triggered in a WITHOUT-GCING. */
diff --git a/tests/gc.impure.lisp b/tests/gc.impure.lisp
index 2a3f9b4..d21d14a 100644
--- a/tests/gc.impure.lisp
+++ b/tests/gc.impure.lisp
@@ -70,9 +70,24 @@
 
 (with-test (:name :bug-936304)
   (gc :full t)
-  (assert (eq :ok (handler-case
-                      (progn
-                        (loop repeat 50 do (stress-gc))
-                        :ok)
-                    (storage-condition ()
-                      :oom)))))
+  (time
+   (assert (eq :ok (handler-case
+                       (progn
+                         (loop repeat 50 do (stress-gc))
+                         :ok)
+                     (storage-condition ()
+                       :oom))))))
+
+(with-test (:name :bug-981106)
+  (gc :full t)
+  (time
+   (assert (eq :ok
+               (handler-case
+                   (dotimes (runs 100 :ok)
+                     (let ((len (length
+                                 (with-output-to-string (string)
+                                   (dotimes (i 1000000)
+                                     (write-sequence "hi there!" string))))))
+                       (assert (eql len (* 1000000 (length "hi there!"))))))
+                 (storage-condition ()
+                   :oom))))))
-- 
1.7.10.4