X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2Fsm%2FBlockAlloc.c;h=8eaba72b723275564501f6395021363a2fd6bc1f;hb=ec064b6d9d43b1655dd24df06d29b5e43940c7d6;hp=ba9220ac42638e60ccf180ecdb0e5565ef0cb7c9;hpb=7dc0cd52f216da7a46c4832da0a68f2ec1f181f0;p=ghc-hetmet.git

diff --git a/rts/sm/BlockAlloc.c b/rts/sm/BlockAlloc.c
index ba9220a..8eaba72 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
    -------------------------------------------------------------------------- */