X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2Fsm%2FBlockAlloc.c;h=429ebd03ad453cc0a485523f7b972a913f37349d;hb=7267a7862cc406e593c89e79a4d5ab064ac40120;hp=edc37620bda566dde53d17529f3c67df919243f7;hpb=214b3663d5d7598c13643f9221e43d5a7735b47f;p=ghc-hetmet.git

diff --git a/rts/sm/BlockAlloc.c b/rts/sm/BlockAlloc.c
index edc3762..429ebd0 100644
--- a/rts/sm/BlockAlloc.c
+++ b/rts/sm/BlockAlloc.c
@@ -21,14 +21,12 @@
 #include "Storage.h"
 #include "RtsUtils.h"
 #include "BlockAlloc.h"
+#include "OSMem.h"
 
 #include <string.h>
 
 static void  initMBlock(void *mblock);
 
-// The free_list is kept sorted by size, smallest first.
-// In THREADED_RTS mode, the free list is protected by sm_mutex.
-
 /* -----------------------------------------------------------------------------
 
   Implementation notes
@@ -71,7 +69,7 @@ static void  initMBlock(void *mblock);
   ~~~~~~~~~~
 
   Preliminaries:
-    - most allocations are for small blocks
+    - most allocations are for a small number of blocks
     - sometimes the OS gives us new memory backwards in the address
       space, sometimes forwards, so we should not be biased towards
       any particular layout in the address space
@@ -121,8 +119,20 @@ static void  initMBlock(void *mblock);
 
   --------------------------------------------------------------------------- */
 
+/* ---------------------------------------------------------------------------
+   WATCH OUT FOR OVERFLOW
+
+   Be very careful with integer overflow here.  If you have an
+   expression like (n_blocks * BLOCK_SIZE), and n_blocks is an int or
+   a nat, then it will very likely overflow on a 64-bit platform.
+   Always cast to StgWord (or W_ for short) first: ((W_)n_blocks * BLOCK_SIZE).
+
+  --------------------------------------------------------------------------- */
+
 #define MAX_FREE_LIST 9
 
+// In THREADED_RTS mode, the free list is protected by sm_mutex.
+
 static bdescr *free_list[MAX_FREE_LIST];
 static bdescr *free_mblock_list;
 
@@ -283,7 +293,7 @@ alloc_mega_group (nat mblocks)
     if (best)
     {
         // we take our chunk off the end here.
-        nat best_mblocks  = BLOCKS_TO_MBLOCKS(best->blocks);
+        StgWord best_mblocks  = BLOCKS_TO_MBLOCKS(best->blocks);
         bd = FIRST_BDESCR((StgWord8*)MBLOCK_ROUND_DOWN(best) + 
                           (best_mblocks-mblocks)*MBLOCK_SIZE);
 
@@ -323,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;
     }
@@ -338,7 +349,7 @@ allocGroup (nat n)
 
     if (ln == MAX_FREE_LIST) {
 #if 0
-        if ((mblocks_allocated * MBLOCK_SIZE_W - n_alloc_blocks * BLOCK_SIZE_W) > (1024*1024)/sizeof(W_)) {
+        if (((W_)mblocks_allocated * MBLOCK_SIZE_W - (W_)n_alloc_blocks * BLOCK_SIZE_W) > (1024*1024)/sizeof(W_)) {
             debugBelch("Fragmentation, wanted %d blocks:", n);
             RtsFlags.DebugFlags.block_alloc = 1;
             checkFreeListSanity();
@@ -372,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;
@@ -473,7 +485,7 @@ freeGroup(bdescr *p)
   p->gen = NULL;
   p->gen_no = 0;
   /* fill the block group with garbage if sanity checking is on */
-  IF_DEBUG(sanity,memset(p->start, 0xaa, p->blocks * BLOCK_SIZE));
+  IF_DEBUG(sanity,memset(p->start, 0xaa, (W_)p->blocks * BLOCK_SIZE));
 
   if (p->blocks == 0) barf("freeGroup: block size is zero");
 
@@ -587,7 +599,7 @@ splitBlockGroup (bdescr *bd, nat blocks)
         low_mblocks = 1 + (blocks - BLOCKS_PER_MBLOCK) / (MBLOCK_SIZE / BLOCK_SIZE);
         high_mblocks = (bd->blocks - blocks) / (MBLOCK_SIZE / BLOCK_SIZE);
 
-        new_mblock = (void *) ((P_)MBLOCK_ROUND_DOWN(bd) + low_mblocks * MBLOCK_SIZE_W);
+        new_mblock = (void *) ((P_)MBLOCK_ROUND_DOWN(bd) + (W_)low_mblocks * MBLOCK_SIZE_W);
         initMBlock(new_mblock);
         new_bd = FIRST_BDESCR(new_mblock);
         new_bd->blocks = MBLOCK_GROUP_BLOCKS(high_mblocks);
@@ -662,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
    -------------------------------------------------------------------------- */