X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FMBlock.c;h=b97f67b12a77938a7366bdbed8ed9659b7df4d95;hb=61ccfec175e1f51b2c89559faf91d9bee0b3b601;hp=5867c1becdd7b7a14aceccf9b5f8a9530986c65d;hpb=95ca6bff6fc9918203173b442192d9298ef9757a;p=ghc-hetmet.git

diff --git a/ghc/rts/MBlock.c b/ghc/rts/MBlock.c
index 5867c1b..b97f67b 100644
--- a/ghc/rts/MBlock.c
+++ b/ghc/rts/MBlock.c
@@ -1,5 +1,4 @@
 /* -----------------------------------------------------------------------------
- * $Id: MBlock.c,v 1.51 2004/09/03 15:28:33 simonmar Exp $
  *
  * (c) The GHC Team 1998-1999
  *
@@ -53,10 +52,63 @@ lnat mblocks_allocated = 0;
    The MBlock Map: provides our implementation of HEAP_ALLOCED()
    -------------------------------------------------------------------------- */
 
-#ifdef MBLOCK_MAP_SIZE
+#if SIZEOF_VOID_P == 4
 StgWord8 mblock_map[MBLOCK_MAP_SIZE]; // initially all zeros
+#elif SIZEOF_VOID_P == 8
+static MBlockMap dummy_mblock_map;
+MBlockMap *mblock_cache = &dummy_mblock_map;
+int mblock_map_count = 0;
+MBlockMap **mblock_maps = NULL;
+
+static MBlockMap *
+findMBlockMap(void *p)
+{
+    int i;
+    StgWord32 hi = (StgWord32) (((StgWord)p) >> 32);
+    for( i = 0; i < mblock_map_count; i++ )
+    {
+        if(mblock_maps[i]->addrHigh32 == hi)
+        {
+	    return mblock_maps[i];
+	}
+    }
+    return NULL;
+}
+
+StgBool
+slowIsHeapAlloced(void *p)
+{
+    MBlockMap *map = findMBlockMap(p);
+    if(map)
+    {
+    	mblock_cache = map;
+	return map->mblocks[MBLOCK_MAP_ENTRY(p)];
+    }
+    else
+    	return 0;
+}
 #endif
 
+static void
+markHeapAlloced(void *p)
+{
+#if SIZEOF_VOID_P == 4
+    mblock_map[MBLOCK_MAP_ENTRY(p)] = 1;
+#elif SIZEOF_VOID_P == 8
+    MBlockMap *map = findMBlockMap(p);
+    if(map == NULL)
+    {
+    	mblock_map_count++;
+    	mblock_maps = realloc(mblock_maps,
+			      sizeof(MBlockMap*) * mblock_map_count);
+	map = mblock_maps[mblock_map_count-1] = calloc(1,sizeof(MBlockMap));
+	map->addrHigh32 = (StgWord32) (((StgWord)p) >> 32);
+    }
+    map->mblocks[MBLOCK_MAP_ENTRY(p)] = 1;
+    mblock_cache = map;
+#endif
+}
+
 /* -----------------------------------------------------------------------------
    Allocate new mblock(s)
    -------------------------------------------------------------------------- */
@@ -120,7 +172,7 @@ my_mmap (void *addr, lnat size)
 	err = vm_allocate(mach_task_self(),(vm_address_t*) &ret, size, TRUE);
 	
     if(err) // don't know what the error codes mean exactly
-	barf("memory allocation failed (requested %d bytes)", size);
+	barf("memory allocation failed (requested %lu bytes)", size);
     else
 	vm_protect(mach_task_self(),ret,size,FALSE,VM_PROT_READ|VM_PROT_WRITE);
 #else
@@ -133,7 +185,7 @@ my_mmap (void *addr, lnat size)
 	    (errno == EINVAL && sizeof(void*)==4 && size >= 0xc0000000)) {
 	    // If we request more than 3Gig, then we get EINVAL
 	    // instead of ENOMEM (at least on Linux).
-	    errorBelch("out of memory (requested %d bytes)", size);
+	    errorBelch("out of memory (requested %lu bytes)", size);
 	    stg_exit(EXIT_FAILURE);
 	} else {
 	    barf("getMBlock: mmap: %s", strerror(errno));
@@ -225,7 +277,7 @@ getMBlocks(nat n)
 
   // fill in the table
   for (i = 0; i < n; i++) {
-      MARK_HEAP_ALLOCED( ret + i * MBLOCK_SIZE );
+      markHeapAlloced( ret + i * MBLOCK_SIZE );
   }
 
   mblocks_allocated += n;
@@ -334,7 +386,7 @@ getMBlocks(nat n)
   
   // fill in the table
   for (i = 0; i < n; i++) {
-      MARK_HEAP_ALLOCED ( ret + i * MBLOCK_SIZE );
+      markHeapAlloced( ret + i * MBLOCK_SIZE );
   }
 
   return ret;