X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2Fsm%2FBlockAlloc.c;h=0bffa82993652afb140743197aa160cefb491a41;hb=a7f2a897bab20f05d4cf5fc8cdae328698c7fc82;hp=98afdd4caf8da6ce349ea59822d8e68e28d17ee4;hpb=30387408c5e471e8f8ff61f80754ad2c07880a7d;p=ghc-hetmet.git

diff --git a/rts/sm/BlockAlloc.c b/rts/sm/BlockAlloc.c
index 98afdd4..0bffa82 100644
--- a/rts/sm/BlockAlloc.c
+++ b/rts/sm/BlockAlloc.c
@@ -155,19 +155,18 @@ void initBlockAllocator(void)
    -------------------------------------------------------------------------- */
 
 STATIC_INLINE void
-initGroup(nat n, bdescr *head)
+initGroup(bdescr *head)
 {
   bdescr *bd;
-  nat i;
+  nat i, n;
 
-  if (n != 0) {
-    head->free   = head->start;
-    head->link   = NULL;
-    for (i=1, bd = head+1; i < n; i++, bd++) {
+  n = head->blocks;
+  head->free   = head->start;
+  head->link   = NULL;
+  for (i=1, bd = head+1; i < n; i++, bd++) {
       bd->free = 0;
       bd->blocks = 0;
       bd->link = head;
-    }
   }
 }
 
@@ -269,7 +268,7 @@ alloc_mega_group (nat mblocks)
             } else {
                 free_mblock_list = bd->link;
             }
-            initGroup(n, bd);
+            initGroup(bd);
             return bd;
         }
         else if (bd->blocks > n)
@@ -307,23 +306,30 @@ allocGroup (nat n)
     bdescr *bd, *rem;
     nat ln;
 
-    // Todo: not true in multithreaded GC, where we use allocBlock_sync().
-    // ASSERT_SM_LOCK();
-
     if (n == 0) barf("allocGroup: requested zero blocks");
     
-    n_alloc_blocks += n;
-    if (n_alloc_blocks > hw_alloc_blocks) hw_alloc_blocks = n_alloc_blocks;
-
     if (n >= BLOCKS_PER_MBLOCK)
     {
-        bd = alloc_mega_group(BLOCKS_TO_MBLOCKS(n));
+        nat mblocks;
+
+        mblocks = BLOCKS_TO_MBLOCKS(n);
+
+        // n_alloc_blocks doesn't count the extra blocks we get in a
+        // megablock group.
+        n_alloc_blocks += mblocks * BLOCKS_PER_MBLOCK;
+        if (n_alloc_blocks > hw_alloc_blocks) hw_alloc_blocks = n_alloc_blocks;
+
+        bd = alloc_mega_group(mblocks);
         // only the bdescrs of the first MB are required to be initialised
-        initGroup(BLOCKS_PER_MBLOCK, bd);
+        initGroup(bd);
+
         IF_DEBUG(sanity, checkFreeListSanity());
         return bd;
     }
     
+    n_alloc_blocks += n;
+    if (n_alloc_blocks > hw_alloc_blocks) hw_alloc_blocks = n_alloc_blocks;
+
     ln = log_2_ceil(n);
 
     while (free_list[ln] == NULL && ln < MAX_FREE_LIST) {
@@ -341,10 +347,10 @@ allocGroup (nat n)
 
         bd = alloc_mega_group(1);
         bd->blocks = n;
-        initGroup(n,bd);		         // we know the group will fit
+        initGroup(bd);		         // we know the group will fit
         rem = bd + n;
         rem->blocks = BLOCKS_PER_MBLOCK-n;
-        initGroup(BLOCKS_PER_MBLOCK-n, rem); // init the slop
+        initGroup(rem); // init the slop
         n_alloc_blocks += rem->blocks;
         freeGroup(rem);      	         // add the slop on to the free list
         IF_DEBUG(sanity, checkFreeListSanity());
@@ -365,7 +371,7 @@ allocGroup (nat n)
     {
         barf("allocGroup: free list corrupted");
     }
-    initGroup(n, bd);		// initialise it
+    initGroup(bd);		// initialise it
     IF_DEBUG(sanity, checkFreeListSanity());
     ASSERT(bd->blocks == n);
     return bd;
@@ -462,8 +468,6 @@ freeGroup(bdescr *p)
 
   ASSERT(p->free != (P_)-1);
 
-  n_alloc_blocks -= p->blocks;
-
   p->free = (void *)-1;  /* indicates that this block is free */
   p->step = NULL;
   p->gen_no = 0;
@@ -474,12 +478,21 @@ freeGroup(bdescr *p)
 
   if (p->blocks >= BLOCKS_PER_MBLOCK)
   {
+      nat mblocks;
+
+      mblocks = BLOCKS_TO_MBLOCKS(p->blocks);
       // If this is an mgroup, make sure it has the right number of blocks
-      ASSERT(p->blocks == MBLOCK_GROUP_BLOCKS(BLOCKS_TO_MBLOCKS(p->blocks)));
+      ASSERT(p->blocks == MBLOCK_GROUP_BLOCKS(mblocks));
+
+      n_alloc_blocks -= mblocks * BLOCKS_PER_MBLOCK;
+
       free_mega_group(p);
       return;
   }
 
+  ASSERT(n_alloc_blocks >= p->blocks);
+  n_alloc_blocks -= p->blocks;
+
   // coalesce forwards
   {
       bdescr *next;