Don't build GHC with breakpoint support by default.

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

diff --git a/ghc/rts/MBlock.c b/ghc/rts/MBlock.c
index 0ce1e76..fa8fd49 100644 (file)
--- a/ghc/rts/MBlock.c
+++ b/ghc/rts/MBlock.c
@@ -134,6 +134,16 @@ 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.
+
+   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_HOST_OS) && !defined(cygwin32_HOST_OS)
@@ -171,10 +181,14 @@ my_mmap (void *addr, lnat size)
     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 %lu 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);
+    }
 #else
     ret = mmap(addr, size, PROT_READ | PROT_WRITE | PROT_EXEC, 
               MAP_ANON | MAP_PRIVATE, -1, 0);
@@ -285,6 +299,12 @@ getMBlocks(nat n)
   return ret;
 }
 
+void
+freeAllMBlocks(void)
+{
+  /* XXX Do something here */
+}
+
 #else /* defined(mingw32_HOST_OS) || defined(cygwin32_HOST_OS) */
 
 /*
@@ -302,8 +322,10 @@ getMBlocks(nat n)
  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 )
@@ -342,9 +364,10 @@ getMBlocks(nat n)
                                      , MEM_RESERVE
                                      , PAGE_READWRITE
                                      );
+    membase = base_non_committed;
     if ( base_non_committed == 0 ) {
-         errorBelch("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. */
@@ -366,7 +389,7 @@ getMBlocks(nat n)
   if ( ret != (void*)-1 ) {
      ret = VirtualAlloc(next_request, size, MEM_COMMIT, PAGE_READWRITE);
      if (ret == NULL) {
-        debugBelch("getMBlocks: VirtualAlloc failed with: %ld\n", GetLastError());
+        debugBelch("getMBlocks: VirtualAlloc MEM_COMMIT %lu failed with: %ld\n", size, GetLastError());
         ret=(void*)-1;
      }
   }
@@ -392,6 +415,18 @@ getMBlocks(nat n)
   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.