fix Win32 build

[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.
    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)
    -------------------------------------------------------------------------- */
 
 #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(!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);
        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);
 #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;
 }
 
   return ret;
 }
 

+void
+freeAllMBlocks(void)
+{
+  /* XXX Do something here */
+}
+

 #else /* defined(mingw32_HOST_OS) || defined(cygwin32_HOST_OS) */
 
 /*
 #else /* defined(mingw32_HOST_OS) || defined(cygwin32_HOST_OS) */
 
 /*

@@ -302,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 )

@@ -342,9 +364,10 @@ 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 ) {

-         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. */
     } 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) {
   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;
      }
   }
         ret=(void*)-1;
      }
   }

@@ -392,6 +415,18 @@ getMBlocks(nat n)
   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.