X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=rts%2Fsm%2FBlockAlloc.c;h=bf7a55e7a96d9d52a418d6495168b7a35c5481e5;hp=daf9fb0ba166efe16ecbbb8a0368e42025ce5e3d;hb=a2a67cd520b9841114d69a87a423dabcb3b4368e;hpb=43a120b706a5eece6624ca4907af89fc9a480c5e

diff --git a/rts/sm/BlockAlloc.c b/rts/sm/BlockAlloc.c
index daf9fb0..bf7a55e 100644
--- a/rts/sm/BlockAlloc.c
+++ b/rts/sm/BlockAlloc.c
@@ -17,11 +17,10 @@
 
 #include "PosixSource.h"
 #include "Rts.h"
-#include "RtsFlags.h"
+
+#include "Storage.h"
 #include "RtsUtils.h"
 #include "BlockAlloc.h"
-#include "MBlock.h"
-#include "Storage.h"
 
 #include <string.h>
 
@@ -284,7 +283,7 @@ alloc_mega_group (nat mblocks)
     {
         // we take our chunk off the end here.
         nat best_mblocks  = BLOCKS_TO_MBLOCKS(best->blocks);
-        bd = FIRST_BDESCR(MBLOCK_ROUND_DOWN(best) + 
+        bd = FIRST_BDESCR((StgWord8*)MBLOCK_ROUND_DOWN(best) + 
                           (best_mblocks-mblocks)*MBLOCK_SIZE);
 
         best->blocks = MBLOCK_GROUP_BLOCKS(best_mblocks - mblocks);
@@ -415,7 +414,8 @@ coalesce_mblocks (bdescr *p)
     q = p->link;
     if (q != NULL && 
         MBLOCK_ROUND_DOWN(q) == 
-        MBLOCK_ROUND_DOWN(p) + BLOCKS_TO_MBLOCKS(p->blocks) * MBLOCK_SIZE) {
+        (StgWord8*)MBLOCK_ROUND_DOWN(p) + 
+        BLOCKS_TO_MBLOCKS(p->blocks) * MBLOCK_SIZE) {
         // can coalesce
         p->blocks  = MBLOCK_GROUP_BLOCKS(BLOCKS_TO_MBLOCKS(p->blocks) +
                                          BLOCKS_TO_MBLOCKS(q->blocks));
@@ -565,6 +565,9 @@ freeChain_lock(bdescr *bd)
     RELEASE_SM_LOCK;
 }
 
+// splitBlockGroup(bd,B) splits bd in two.  Afterward, bd will have B
+// blocks, and a new block descriptor pointing to the remainder is
+// returned.
 bdescr *
 splitBlockGroup (bdescr *bd, nat blocks)
 {
@@ -575,16 +578,21 @@ splitBlockGroup (bdescr *bd, nat blocks)
     }
 
     if (bd->blocks > BLOCKS_PER_MBLOCK) {
-        nat mblocks;
+        nat low_mblocks, high_mblocks;
         void *new_mblock;
         if ((blocks - BLOCKS_PER_MBLOCK) % (MBLOCK_SIZE / BLOCK_SIZE) != 0) {
             barf("splitLargeBlock: not a multiple of a megablock");
         }
-        mblocks = 1 + (blocks - BLOCKS_PER_MBLOCK) / (MBLOCK_SIZE / BLOCK_SIZE);
-        new_mblock = (void *) ((P_)MBLOCK_ROUND_DOWN(bd) + mblocks * MBLOCK_SIZE_W);
+        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);
         initMBlock(new_mblock);
         new_bd = FIRST_BDESCR(new_mblock);
-        new_bd->blocks = MBLOCK_GROUP_BLOCKS(mblocks);
+        new_bd->blocks = MBLOCK_GROUP_BLOCKS(high_mblocks);
+
+        ASSERT(blocks + new_bd->blocks == 
+               bd->blocks + BLOCKS_PER_MBLOCK - MBLOCK_SIZE/BLOCK_SIZE);
     }
     else
     {
@@ -602,20 +610,21 @@ splitBlockGroup (bdescr *bd, nat blocks)
 static void
 initMBlock(void *mblock)
 {
-  bdescr *bd;
-  void *block;
-
-  /* the first few Bdescr's in a block are unused, so we don't want to
-   * put them all on the free list.
-   */
-  block = FIRST_BLOCK(mblock);
-  bd    = FIRST_BDESCR(mblock);
-
-  /* Initialise the start field of each block descriptor
-   */
-  for (; block <= LAST_BLOCK(mblock); bd += 1, block += BLOCK_SIZE) {
-    bd->start = block;
-  }
+    bdescr *bd;
+    StgWord8 *block;
+
+    /* the first few Bdescr's in a block are unused, so we don't want to
+     * put them all on the free list.
+     */
+    block = FIRST_BLOCK(mblock);
+    bd    = FIRST_BDESCR(mblock);
+    
+    /* Initialise the start field of each block descriptor
+     */
+    for (; block <= (StgWord8*)LAST_BLOCK(mblock); bd += 1, 
+             block += BLOCK_SIZE) {
+        bd->start = (void*)block;
+    }
 }
 
 /* -----------------------------------------------------------------------------
@@ -700,7 +709,7 @@ checkFreeListSanity(void)
         if (bd->link != NULL)
         {
             ASSERT (MBLOCK_ROUND_DOWN(bd->link) != 
-                    MBLOCK_ROUND_DOWN(bd) + 
+                    (StgWord8*)MBLOCK_ROUND_DOWN(bd) + 
                     BLOCKS_TO_MBLOCKS(bd->blocks) * MBLOCK_SIZE);
         }
     }
@@ -750,7 +759,8 @@ reportUnmarkedBlocks (void)
                 debugBelch("  %p\n",bd);
             }
             if (bd->blocks >= BLOCKS_PER_MBLOCK) {
-                mblock += (BLOCKS_TO_MBLOCKS(bd->blocks) - 1) * MBLOCK_SIZE;
+                mblock = (StgWord8*)mblock +
+                    (BLOCKS_TO_MBLOCKS(bd->blocks) - 1) * MBLOCK_SIZE;
                 break;
             } else {
                 bd += bd->blocks;