sanity: fix places where we weren't filling fresh memory with 0xaa

[ghc-hetmet.git] / rts / sm / BlockAlloc.c

diff --git a/rts/sm/BlockAlloc.c b/rts/sm/BlockAlloc.c
index ba9220a..429ebd0 100644 (file)
--- 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>
 
@@ -332,6 +333,7 @@ allocGroup (nat n)
         // only the bdescrs of the first MB are required to be initialised
         initGroup(bd);
 
+        IF_DEBUG(sanity,memset(bd->start, 0xaa, bd->blocks * BLOCK_SIZE));
         IF_DEBUG(sanity, checkFreeListSanity());
         return bd;
     }
@@ -381,6 +383,7 @@ allocGroup (nat n)
         barf("allocGroup: free list corrupted");
     }
     initGroup(bd);             // initialise it
+    IF_DEBUG(sanity,memset(bd->start, 0xaa, bd->blocks * BLOCK_SIZE));
     IF_DEBUG(sanity, checkFreeListSanity());
     ASSERT(bd->blocks == n);
     return bd;
@@ -671,6 +674,41 @@ 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;
+
+    osReleaseFreeMemory();
+
+    IF_DEBUG(gc,
+        if (n != 0) {
+            debugBelch("Wanted to free %d more MBlocks than are freeable\n",
+                       n);
+        }
+    );
+}
+
 /* -----------------------------------------------------------------------------
    Debugging
    -------------------------------------------------------------------------- */