Return memory to the OS; trac #698

8 files changed, 130 insertions, 39 deletions

diff --git a/rts/Stats.c b/rts/Stats.c
index f1e6e332d7..ed21ec5e88 100644
--- a/rts/Stats.c
+++ b/rts/Stats.c
@@ -741,7 +741,7 @@ stat_exit(int alloc)
 		        AvgResidency*sizeof(W_)/ResidencySamples, 
 		    MaxResidency*sizeof(W_), 
 		    ResidencySamples,
-		    (unsigned long)(mblocks_allocated * MBLOCK_SIZE / (1024L * 1024L)),
+		    (unsigned long)(peak_mblocks_allocated * MBLOCK_SIZE / (1024L * 1024L)),
 		    TICK_TO_DBL(InitUserTime), TICK_TO_DBL(InitElapsedTime),
 		    TICK_TO_DBL(MutUserTime), TICK_TO_DBL(MutElapsedTime),
 		    TICK_TO_DBL(GC_tot_time), TICK_TO_DBL(GCe_tot_time));
diff --git a/rts/posix/OSMem.c b/rts/posix/OSMem.c
index f8e484f982..9993da3123 100644
--- a/rts/posix/OSMem.c
+++ b/rts/posix/OSMem.c
@@ -37,16 +37,7 @@
 #include <mach/vm_map.h>
 #endif
 
-/* keep track of maps returned by my_mmap */
-typedef struct _map_rec {
-    char* base;              /* base addr */
-    int size;                /* map size */
-    struct _map_rec* next; /* next pointer */
-} map_rec;
-
-
 static caddr_t next_request = 0;
-static map_rec* mmap_rec = NULL;
 
 void osMemInit(void)
 {
@@ -187,7 +178,6 @@ osGetMBlocks(nat n)
 {
   caddr_t ret;
   lnat size = MBLOCK_SIZE * (lnat)n;
-  map_rec* rec;
 
   if (next_request == 0) {
       // use gen_map_mblocks the first time.
@@ -209,11 +199,6 @@ osGetMBlocks(nat n)
 	  ret = gen_map_mblocks(size);
       }
   }
-  rec = (map_rec*)stgMallocBytes(sizeof(map_rec),"OSMem: osGetMBlocks");
-  rec->size = size;
-  rec->base = ret;
-  rec->next = mmap_rec;
-  mmap_rec = rec;
   // Next time, we'll try to allocate right after the block we just got.
   // ToDo: check that we haven't already grabbed the memory at next_request
   next_request = ret + size;
@@ -221,18 +206,19 @@ osGetMBlocks(nat n)
   return ret;
 }
 
-void osFreeAllMBlocks(void)
+void osFreeMBlocks(char *addr, nat n)
 {
-    map_rec* tmp  = mmap_rec;
-    map_rec* next = NULL;
+    munmap(addr, n * MBLOCK_SIZE);
+}
 
-    for(; tmp!=NULL;) {
-        if(munmap(tmp->base,tmp->size))
-            barf("osFreeAllMBlocks: munmap failed!");
+void osFreeAllMBlocks(void)
+{
+    void *mblock;
 
-        next = tmp->next;
-        stgFree(tmp);
-        tmp = next;
+    for (mblock = getFirstMBlock();
+         mblock != NULL;
+         mblock = getNextMBlock(mblock)) {
+        munmap(mblock, MBLOCK_SIZE);
     }
 }
 
diff --git a/rts/sm/BlockAlloc.c b/rts/sm/BlockAlloc.c
index ba9220ac42..8eaba72b72 100644
--- a/rts/sm/BlockAlloc.c
+++ b/rts/sm/BlockAlloc.c
@@ -21,6 +21,7 @@
 #include "Storage.h"
 #include "RtsUtils.h"
 #include "BlockAlloc.h"
+#include "OSMem.h"
 
 #include <string.h>
 
@@ -671,6 +672,39 @@ countAllocdBlocks(bdescr *bd)
     return n;
 }
 
+void returnMemoryToOS(nat n /* megablocks */)
+{
+    static bdescr *bd;
+    nat size;
+
+    bd = free_mblock_list;
+    while ((n > 0) && (bd != NULL)) {
+        size = BLOCKS_TO_MBLOCKS(bd->blocks);
+        if (size > n) {
+            nat newSize = size - n;
+            char *freeAddr = MBLOCK_ROUND_DOWN(bd->start);
+            freeAddr += newSize * MBLOCK_SIZE;
+            bd->blocks = MBLOCK_GROUP_BLOCKS(newSize);
+            freeMBlocks(freeAddr, n);
+            n = 0;
+        }
+        else {
+            char *freeAddr = MBLOCK_ROUND_DOWN(bd->start);
+            n -= size;
+            bd = bd->link;
+            freeMBlocks(freeAddr, size);
+        }
+    }
+    free_mblock_list = bd;
+
+    IF_DEBUG(gc,
+        if (n != 0) {
+            debugBelch("Wanted to free %d more MBlocks than are freeable\n",
+                       n);
+        }
+    );
+}
+
 /* -----------------------------------------------------------------------------
    Debugging
    -------------------------------------------------------------------------- */
diff --git a/rts/sm/BlockAlloc.h b/rts/sm/BlockAlloc.h
index c195baa43a..f8b4204e11 100644
--- a/rts/sm/BlockAlloc.h
+++ b/rts/sm/BlockAlloc.h
@@ -15,6 +15,7 @@
 
 extern nat countBlocks       (bdescr *bd);
 extern nat countAllocdBlocks (bdescr *bd);
+extern void returnMemoryToOS(nat n);
 
 #ifdef DEBUG
 void checkFreeListSanity(void);
diff --git a/rts/sm/GC.c b/rts/sm/GC.c
index 18a87bdbfa..191310aaca 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));
 
diff --git a/rts/sm/MBlock.c b/rts/sm/MBlock.c
index 996b2c9ae9..53172753f1 100644
--- a/rts/sm/MBlock.c
+++ b/rts/sm/MBlock.c
@@ -18,6 +18,7 @@
 
 #include <string.h>
 
+lnat peak_mblocks_allocated = 0;
 lnat mblocks_allocated = 0;
 lnat mpc_misses = 0;
 
@@ -29,9 +30,9 @@ lnat mpc_misses = 0;
 StgWord8 mblock_map[MBLOCK_MAP_SIZE]; // initially all zeros
 
 static void
-markHeapAlloced(void *p)
+setHeapAlloced(void *p, StgWord8 i)
 {
-    mblock_map[MBLOCK_MAP_ENTRY(p)] = 1;
+    mblock_map[MBLOCK_MAP_ENTRY(p)] = i;
 }
 
 #elif SIZEOF_VOID_P == 8
@@ -81,7 +82,7 @@ StgBool HEAP_ALLOCED_miss(StgWord mblock, void *p)
 }
 
 static void
-markHeapAlloced(void *p)
+setHeapAlloced(void *p, StgWord8 i)
 {
     MBlockMap *map = findMBlockMap(p);
     if(map == NULL)
@@ -95,7 +96,7 @@ markHeapAlloced(void *p)
 	map->addrHigh32 = (StgWord32) (((StgWord)p) >> 32);
     }
 
-    map->lines[MBLOCK_MAP_LINE(p)] = 1;
+    map->lines[MBLOCK_MAP_LINE(p)] = i;
 
     {
         StgWord mblock;
@@ -103,19 +104,22 @@ markHeapAlloced(void *p)
         
         mblock   = (StgWord)p >> MBLOCK_SHIFT;
         entry_no = mblock & (MBC_ENTRIES-1);
-        mblock_cache[entry_no] = (mblock << 1) + 1;
+        mblock_cache[entry_no] = (mblock << 1) + i;
     }
 }
 #endif
 
-/* ----------------------------------------------------------------------------
-   Debugging code for traversing the allocated MBlocks
-   
-   This is used for searching for lost blocks when a memory leak is
-   detected; see Blocks.c:findUnmarkedBlock().
-   ------------------------------------------------------------------------ */
+static void
+markHeapAlloced(void *p)
+{
+    setHeapAlloced(p, 1);
+}
 
-#ifdef DEBUG
+static void
+markHeapUnalloced(void *p)
+{
+    setHeapAlloced(p, 0);
+}
 
 #if SIZEOF_VOID_P == 4
 
@@ -207,8 +211,6 @@ void * getFirstMBlock(void)
 
 #endif // SIZEOF_VOID_P
 
-#endif // DEBUG
-
 /* -----------------------------------------------------------------------------
    Allocate new mblock(s)
    -------------------------------------------------------------------------- */
@@ -238,13 +240,31 @@ getMBlocks(nat n)
     }
     
     mblocks_allocated += n;
+    peak_mblocks_allocated = stg_max(peak_mblocks_allocated, mblocks_allocated);
 
     return ret;
 }
 
 void
+freeMBlocks(void *addr, nat n)
+{
+    nat i;
+
+    debugTrace(DEBUG_gc, "freeing %d megablock(s) at %p",n,addr);
+
+    mblocks_allocated -= n;
+
+    for (i = 0; i < n; i++) {
+        markHeapUnalloced( (StgWord8*)addr + i * MBLOCK_SIZE );
+    }
+
+    osFreeMBlocks(addr, n);
+}
+
+void
 freeAllMBlocks(void)
 {
+    debugTrace(DEBUG_gc, "freeing all megablocks");
     osFreeAllMBlocks();
 }
 
diff --git a/rts/sm/OSMem.h b/rts/sm/OSMem.h
index 3349140529..d92b170ddf 100644
--- a/rts/sm/OSMem.h
+++ b/rts/sm/OSMem.h
@@ -13,6 +13,7 @@
 
 void osMemInit(void);
 void *osGetMBlocks(nat n);
+void osFreeMBlocks(char *addr, nat n);
 void osFreeAllMBlocks(void);
 lnat getPageSize (void);
 void setExecutable (void *p, lnat len, rtsBool exec);
diff --git a/rts/win32/OSMem.c b/rts/win32/OSMem.c
index f61aadc762..44286d2562 100644
--- a/rts/win32/OSMem.c
+++ b/rts/win32/OSMem.c
@@ -203,6 +203,42 @@ osGetMBlocks(nat n) {
     return ret;
 }
 
+void osFreeMBlocks(char *addr, nat n)
+{
+    alloc_rec *p;
+    lnat nBytes = (lnat)n * MBLOCK_SIZE;
+
+    insertFree(addr, nBytes);
+
+    p = allocs;
+    while ((p != NULL) && (addr >= (p->base + p->size))) {
+        p = p->next;
+    }
+    while (nBytes > 0) {
+        if ((p == NULL) || (p->base > addr)) {
+            errorBelch("Memory to be freed isn't allocated\n");
+            stg_exit(EXIT_FAILURE);
+        }
+        if (p->base + p->size >= addr + nBytes) {
+            if (!VirtualFree(addr, nBytes, MEM_DECOMMIT)) {
+                sysErrorBelch("osFreeMBlocks: VirtualFree MEM_DECOMMIT failed");
+                stg_exit(EXIT_FAILURE);
+            }
+            nBytes = 0;
+        }
+        else {
+            lnat bytesToFree = p->base + p->size - addr;
+            if (!VirtualFree(addr, bytesToFree, MEM_DECOMMIT)) {
+                sysErrorBelch("osFreeMBlocks: VirtualFree MEM_DECOMMIT failed");
+                stg_exit(EXIT_FAILURE);
+            }
+            addr += bytesToFree;
+            nBytes -= bytesToFree;
+            p = p->next;
+        }
+    }
+}
+
 void
 osFreeAllMBlocks(void)
 {