X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=rts%2Fsm%2FGC.c;fp=rts%2Fsm%2FGC.c;h=191310aaca68801f3bab9d40cea29791d7933046;hp=18a87bdbfa927e95afd4cd9fad4bc66416ff2339;hb=3fb074b5fcfd91fe0d37af83f221450ac4734908;hpb=429dc9a048f5533143fb5c9908b09d3155496e9b

diff --git a/rts/sm/GC.c b/rts/sm/GC.c
index 18a87bd..191310a 100644
--- a/rts/sm/GC.c
+++ b/rts/sm/GC.c
@@ -746,6 +746,19 @@ SET_GCT(gc_threads[0]);
   scheduleFinalizers(cap, old_weak_ptr_list);
   ACQUIRE_SM_LOCK;
 
+  if (major_gc) {
+      nat need, got;
+      need = BLOCKS_TO_MBLOCKS(n_alloc_blocks);
+      got = mblocks_allocated;
+      /* If the amount of data remains constant, next major GC we'll
+         require (F+1)*need. We leave (F+2)*need in order to reduce
+         repeated deallocation and reallocation. */
+      need = (RtsFlags.GcFlags.oldGenFactor + 2) * need;
+      if (got > need) {
+          returnMemoryToOS(got - need);
+      }
+  }
+
   // check sanity after GC
   IF_DEBUG(sanity, checkSanity(rtsTrue));