remove empty dir

[ghc-hetmet.git] / ghc / rts / MBlock.c

diff --git a/ghc/rts/MBlock.c b/ghc/rts/MBlock.c
index 57d113a..fa8fd49 100644 (file)
--- a/ghc/rts/MBlock.c
+++ b/ghc/rts/MBlock.c
@@ -1,5 +1,4 @@
 /* -----------------------------------------------------------------------------
 /* -----------------------------------------------------------------------------

- * $Id: MBlock.c,v 1.38 2002/11/07 14:42:25 simonmar Exp $

  *
  * (c) The GHC Team 1998-1999
  *
  *
  * (c) The GHC Team 1998-1999
  *

@@ -21,13 +20,16 @@
 #ifdef HAVE_STDLIB_H
 #include <stdlib.h>
 #endif
 #ifdef HAVE_STDLIB_H
 #include <stdlib.h>
 #endif

+#ifdef HAVE_STRING_H
+#include <string.h>
+#endif

 #ifdef HAVE_UNISTD_H
 #include <unistd.h>
 #endif
 #ifdef HAVE_SYS_TYPES_H
 #include <sys/types.h>
 #endif
 #ifdef HAVE_UNISTD_H
 #include <unistd.h>
 #endif
 #ifdef HAVE_SYS_TYPES_H
 #include <sys/types.h>
 #endif

-#ifndef mingw32_TARGET_OS
+#ifndef mingw32_HOST_OS

 # ifdef HAVE_SYS_MMAN_H
 # include <sys/mman.h>
 # endif
 # ifdef HAVE_SYS_MMAN_H
 # include <sys/mman.h>
 # endif

@@ -38,7 +40,7 @@
 #if HAVE_WINDOWS_H
 #include <windows.h>
 #endif
 #if HAVE_WINDOWS_H
 #include <windows.h>
 #endif

-#if darwin_TARGET_OS
+#if darwin_HOST_OS

 #include <mach/vm_map.h>
 #endif
 
 #include <mach/vm_map.h>
 #endif
 

@@ -50,12 +52,61 @@ lnat mblocks_allocated = 0;
    The MBlock Map: provides our implementation of HEAP_ALLOCED()
    -------------------------------------------------------------------------- */
 
    The MBlock Map: provides our implementation of HEAP_ALLOCED()
    -------------------------------------------------------------------------- */
 

-StgWord8 mblock_map[4096]; // initially all zeros
+#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
 
 static void

-mblockIsHeap (void *p)
+markHeapAlloced(void *p)

 {
 {

-    mblock_map[((StgWord)p & ~MBLOCK_MASK) >> MBLOCK_SHIFT] = 1;
+#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

 }
 
 /* -----------------------------------------------------------------------------
 }
 
 /* -----------------------------------------------------------------------------

@@ -83,28 +134,38 @@ getMBlock(void)
    chunk, on the grounds that this is aligned and likely to be free.
    If it turns out that we were wrong, we have to munmap() and try
    again using the general method.
    chunk, on the grounds that this is aligned and likely to be free.
    If it turns out that we were wrong, we have to munmap() and try
    again using the general method.

+
+   Note on posix_memalign(): this interface is available on recent
+   systems and appears to provide exactly what we want.  However, it
+   turns out not to be as good as our mmap() implementation, because
+   it wastes extra space (using double the address space, in a test on
+   x86_64/Linux).  The problem seems to be that posix_memalign()
+   returns memory that can be free()'d, so the library must store
+   extra information along with the allocated block, thus messing up
+   the alignment.  Hence, we don't use posix_memalign() for now.
+

    -------------------------------------------------------------------------- */
 
    -------------------------------------------------------------------------- */
 

-#if !defined(mingw32_TARGET_OS) && !defined(cygwin32_TARGET_OS)
+#if !defined(mingw32_HOST_OS) && !defined(cygwin32_HOST_OS)

 
 // A wrapper around mmap(), to abstract away from OS differences in
 // the mmap() interface.
 
 static void *
 
 // A wrapper around mmap(), to abstract away from OS differences in
 // the mmap() interface.
 
 static void *

-my_mmap (void *addr, int size)
+my_mmap (void *addr, lnat size)

 {
     void *ret;
 
 {
     void *ret;
 

-#ifdef solaris2_TARGET_OS
+#if defined(solaris2_HOST_OS) || defined(irix_HOST_OS)

     { 
        int fd = open("/dev/zero",O_RDONLY);
        ret = mmap(addr, size, PROT_READ | PROT_WRITE, MAP_PRIVATE, fd, 0);
        close(fd);
     }
     { 
        int fd = open("/dev/zero",O_RDONLY);
        ret = mmap(addr, size, PROT_READ | PROT_WRITE, MAP_PRIVATE, fd, 0);
        close(fd);
     }

-#elif hpux_TARGET_OS
+#elif hpux_HOST_OS

     ret = mmap(addr, size, PROT_READ | PROT_WRITE, 
               MAP_ANONYMOUS | MAP_PRIVATE, -1, 0);
     ret = mmap(addr, size, PROT_READ | PROT_WRITE, 
               MAP_ANONYMOUS | MAP_PRIVATE, -1, 0);

-#elif darwin_TARGET_OS
+#elif darwin_HOST_OS

     // Without MAP_FIXED, Apple's mmap ignores addr.
     // With MAP_FIXED, it overwrites already mapped regions, whic
     // mmap(0, ... MAP_FIXED ...) is worst of all: It unmaps the program text
     // Without MAP_FIXED, Apple's mmap ignores addr.
     // With MAP_FIXED, it overwrites already mapped regions, whic
     // mmap(0, ... MAP_FIXED ...) is worst of all: It unmaps the program text

@@ -120,20 +181,28 @@ my_mmap (void *addr, int size)
     if(!addr || err)   // try to allocate anywhere
        err = vm_allocate(mach_task_self(),(vm_address_t*) &ret, size, TRUE);
        
     if(!addr || err)   // try to allocate anywhere
        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);
-    else
+    if(err) {
+       // don't know what the error codes mean exactly, assume it's
+       // not our problem though.
+       errorBelch("memory allocation failed (requested %lu bytes)", size);
+       stg_exit(EXIT_FAILURE);
+    } else {

        vm_protect(mach_task_self(),ret,size,FALSE,VM_PROT_READ|VM_PROT_WRITE);
        vm_protect(mach_task_self(),ret,size,FALSE,VM_PROT_READ|VM_PROT_WRITE);

+    }

 #else
 #else

-    ret = mmap(addr, size, PROT_READ | PROT_WRITE, 
+    ret = mmap(addr, size, PROT_READ | PROT_WRITE | PROT_EXEC, 

               MAP_ANON | MAP_PRIVATE, -1, 0);
 #endif
 
     if (ret == (void *)-1) {
               MAP_ANON | MAP_PRIVATE, -1, 0);
 #endif
 
     if (ret == (void *)-1) {

-       if (errno == ENOMEM) {
-           barf("out of memory (requested %d bytes)", size);
+       if (errno == ENOMEM || 
+           (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 %lu bytes)", size);
+           stg_exit(EXIT_FAILURE);

        } else {
        } else {

-           barf("getMBlock: mmap failed");
+           barf("getMBlock: mmap: %s", strerror(errno));

        }
     }
 
        }
     }
 

@@ -144,7 +213,7 @@ my_mmap (void *addr, int size)
 // mblocks.
 
 static void *
 // mblocks.
 
 static void *

-gen_map_mblocks (int size)
+gen_map_mblocks (lnat size)

 {
     int slop;
     void *ret;
 {
     int slop;
     void *ret;

@@ -156,16 +225,25 @@ gen_map_mblocks (int size)
     
     // unmap the slop bits around the chunk we allocated
     slop = (W_)ret & MBLOCK_MASK;
     
     // unmap the slop bits around the chunk we allocated
     slop = (W_)ret & MBLOCK_MASK;

-       
+    

     if (munmap(ret, MBLOCK_SIZE - slop) == -1) {
     if (munmap(ret, MBLOCK_SIZE - slop) == -1) {

-       barf("gen_map_mblocks: munmap failed");
+      barf("gen_map_mblocks: munmap failed");

     }
     if (slop > 0 && munmap(ret+size-slop, slop) == -1) {
     }
     if (slop > 0 && munmap(ret+size-slop, slop) == -1) {

-       barf("gen_map_mblocks: munmap failed");
+      barf("gen_map_mblocks: munmap failed");

     }
     }

-    
+

     // ToDo: if we happened to get an aligned block, then don't
     // ToDo: if we happened to get an aligned block, then don't

-    // unmap the excess, just use it.
+    // unmap the excess, just use it. For this to work, you
+    // need to keep in mind the following:
+    //     * Calling my_mmap() with an 'addr' arg pointing to
+    //       already my_mmap()ed space is OK and won't fail.
+    //     * If my_mmap() can't satisfy the request at the
+    //       given 'next_request' address in getMBlocks(), that
+    //       you unmap the extra mblock mmap()ed here (or simply
+    //       satisfy yourself that the slop introduced isn't worth
+    //       salvaging.)
+    // 

 
     // next time, try after the block we just got.
     ret += MBLOCK_SIZE - slop;
 
     // next time, try after the block we just got.
     ret += MBLOCK_SIZE - slop;

@@ -192,10 +270,10 @@ getMBlocks(nat n)
 
       if (((W_)ret & MBLOCK_MASK) != 0) {
          // misaligned block!
 
       if (((W_)ret & MBLOCK_MASK) != 0) {
          // misaligned block!

-#ifdef DEBUG
-         belch("warning: getMBlock: misaligned block %p returned when allocating %d megablock(s) at %p", ret, n, next_request);
+#if 0 // defined(DEBUG)
+         errorBelch("warning: getMBlock: misaligned block %p returned when allocating %d megablock(s) at %p", ret, n, next_request);

 #endif
 #endif

-         
+

          // unmap this block...
          if (munmap(ret, size) == -1) {
              barf("getMBlock: munmap failed");
          // unmap this block...
          if (munmap(ret, size) == -1) {
              barf("getMBlock: munmap failed");

@@ -209,11 +287,11 @@ getMBlocks(nat n)
   // ToDo: check that we haven't already grabbed the memory at next_request
   next_request = ret + size;
 
   // ToDo: check that we haven't already grabbed the memory at next_request
   next_request = ret + size;
 

-  IF_DEBUG(gc,fprintf(stderr,"Allocated %d megablock(s) at %p\n",n,ret));
+  IF_DEBUG(gc,debugBelch("Allocated %d megablock(s) at %p\n",n,ret));

 
   // fill in the table
   for (i = 0; i < n; i++) {
 
   // fill in the table
   for (i = 0; i < n; i++) {

-      mblockIsHeap( ret + i * MBLOCK_SIZE );
+      markHeapAlloced( ret + i * MBLOCK_SIZE );

   }
 
   mblocks_allocated += n;
   }
 
   mblocks_allocated += n;

@@ -221,7 +299,13 @@ getMBlocks(nat n)
   return ret;
 }
 
   return ret;
 }
 

-#else /* defined(mingw32_TARGET_OS) || defined(cygwin32_TARGET_OS) */
+void
+freeAllMBlocks(void)
+{
+  /* XXX Do something here */
+}
+
+#else /* defined(mingw32_HOST_OS) || defined(cygwin32_HOST_OS) */

 
 /*
  On Win32 platforms we make use of the two-phased virtual memory API
 
 /*
  On Win32 platforms we make use of the two-phased virtual memory API

@@ -238,8 +322,10 @@ getMBlocks(nat n)
  our case).
 */
 
  our case).
 */
 

-char* base_non_committed = (char*)0;
-char* end_non_committed = (char*)0;
+static char* base_non_committed = (char*)0;
+static char* end_non_committed = (char*)0;
+
+static void *membase;

 
 /* Default is to reserve 256M of VM to minimise the slop cost. */
 #define SIZE_RESERVED_POOL  ( 256 * 1024 * 1024 )
 
 /* Default is to reserve 256M of VM to minimise the slop cost. */
 #define SIZE_RESERVED_POOL  ( 256 * 1024 * 1024 )

@@ -253,13 +339,19 @@ getMBlocks(nat n)
   static char* base_mblocks       = (char*)0;
   static char* next_request       = (char*)0;
   void* ret                       = (void*)0;
   static char* base_mblocks       = (char*)0;
   static char* next_request       = (char*)0;
   void* ret                       = (void*)0;

-  int i;
+  nat i;

 
   lnat size = MBLOCK_SIZE * n;
   
   if ( (base_non_committed == 0) || (next_request + size > end_non_committed) ) {
     if (base_non_committed) {
 
   lnat size = MBLOCK_SIZE * n;
   
   if ( (base_non_committed == 0) || (next_request + size > end_non_committed) ) {
     if (base_non_committed) {

-      barf("RTS exhausted max heap size (%d bytes)\n", size_reserved_pool);
+       /* Tacky, but if no user-provided -M option is in effect,
+        * set it to the default (==256M) in time for the heap overflow PSA.
+        */
+       if (RtsFlags.GcFlags.maxHeapSize == 0) {
+           RtsFlags.GcFlags.maxHeapSize = size_reserved_pool / BLOCK_SIZE;
+       }
+       heapOverflow();

     }
     if (RtsFlags.GcFlags.maxHeapSize != 0) {
       size_reserved_pool = BLOCK_SIZE * RtsFlags.GcFlags.maxHeapSize;
     }
     if (RtsFlags.GcFlags.maxHeapSize != 0) {
       size_reserved_pool = BLOCK_SIZE * RtsFlags.GcFlags.maxHeapSize;

@@ -272,20 +364,21 @@ getMBlocks(nat n)
                                      , MEM_RESERVE
                                      , PAGE_READWRITE
                                      );
                                      , MEM_RESERVE
                                      , PAGE_READWRITE
                                      );

+    membase = base_non_committed;

     if ( base_non_committed == 0 ) {
     if ( base_non_committed == 0 ) {

-         fprintf(stderr, "getMBlocks: VirtualAlloc failed with: %ld\n", GetLastError());
-         ret=(void*)-1;
+         errorBelch("getMBlocks: VirtualAlloc MEM_RESERVE %lu failed with: %ld\n", size_reserved_pool, GetLastError());
+       ret=(void*)-1;

     } else {
       end_non_committed = (char*)base_non_committed + (unsigned long)size_reserved_pool;
       /* The returned pointer is not aligned on a mega-block boundary. Make it. */
       base_mblocks = (char*)((unsigned long)base_non_committed & (unsigned long)~MBLOCK_MASK) + MBLOCK_SIZE;
 #      if 0
     } else {
       end_non_committed = (char*)base_non_committed + (unsigned long)size_reserved_pool;
       /* The returned pointer is not aligned on a mega-block boundary. Make it. */
       base_mblocks = (char*)((unsigned long)base_non_committed & (unsigned long)~MBLOCK_MASK) + MBLOCK_SIZE;
 #      if 0

-       fprintf(stderr, "getMBlocks: Dropping %d bytes off of 256M chunk\n", 
-                      (unsigned)base_mblocks - (unsigned)base_non_committed);
+       debugBelch("getMBlocks: Dropping %d bytes off of 256M chunk\n", 
+                 (unsigned)base_mblocks - (unsigned)base_non_committed);

 #      endif
 
        if ( ((char*)base_mblocks + size) > end_non_committed ) {
 #      endif
 
        if ( ((char*)base_mblocks + size) > end_non_committed ) {

-          fprintf(stderr, "getMBlocks: oops, committed too small a region to start with.");
+          debugBelch("getMBlocks: oops, committed too small a region to start with.");

          ret=(void*)-1;
        } else {
           next_request = base_mblocks;
          ret=(void*)-1;
        } else {
           next_request = base_mblocks;

@@ -296,7 +389,7 @@ getMBlocks(nat n)
   if ( ret != (void*)-1 ) {
      ret = VirtualAlloc(next_request, size, MEM_COMMIT, PAGE_READWRITE);
      if (ret == NULL) {
   if ( ret != (void*)-1 ) {
      ret = VirtualAlloc(next_request, size, MEM_COMMIT, PAGE_READWRITE);
      if (ret == NULL) {

-        fprintf(stderr, "getMBlocks: VirtualAlloc failed with: %ld\n", GetLastError());
+        debugBelch("getMBlocks: VirtualAlloc MEM_COMMIT %lu failed with: %ld\n", size, GetLastError());

         ret=(void*)-1;
      }
   }
         ret=(void*)-1;
      }
   }

@@ -309,19 +402,31 @@ getMBlocks(nat n)
      barf("getMBlocks: unknown memory allocation failure on Win32.");
   }
 
      barf("getMBlocks: unknown memory allocation failure on Win32.");
   }
 

-  IF_DEBUG(gc,fprintf(stderr,"Allocated %d megablock(s) at 0x%x\n",n,(nat)ret));
+  IF_DEBUG(gc,debugBelch("Allocated %d megablock(s) at 0x%x\n",n,(nat)ret));

   next_request = (char*)next_request + size;
 
   mblocks_allocated += n;
   
   // fill in the table
   for (i = 0; i < n; i++) {
   next_request = (char*)next_request + size;
 
   mblocks_allocated += n;
   
   // fill in the table
   for (i = 0; i < n; i++) {

-      mblockIsHeap( ret + i * MBLOCK_SIZE );
+      markHeapAlloced( ret + i * MBLOCK_SIZE );

   }
 
   return ret;
 }
 
   }
 
   return ret;
 }
 

+void
+freeAllMBlocks(void)
+{
+  BOOL rc;
+
+  rc = VirtualFree(membase, 0, MEM_RELEASE);
+  
+  if (rc == FALSE) {
+     debugBelch("freeAllMBlocks: VirtualFree failed with: %ld\n", GetLastError());
+  }
+}
+

 /* Hand back the physical memory that is allocated to a mega-block. 
    ToDo: chain the released mega block onto some list so that
          getMBlocks() can get at it.
 /* Hand back the physical memory that is allocated to a mega-block. 
    ToDo: chain the released mega block onto some list so that
          getMBlocks() can get at it.

@@ -338,7 +443,7 @@ freeMBlock(void* p, nat n)
   
   if (rc == FALSE) {
 #    ifdef DEBUG
   
   if (rc == FALSE) {
 #    ifdef DEBUG

-     fprintf(stderr, "freeMBlocks: VirtualFree failed with: %d\n", GetLastError());
+     debugBelch("freeMBlocks: VirtualFree failed with: %d\n", GetLastError());

 #    endif
   }
 
 #    endif
   }