remove empty dir

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

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

- * $Id: MBlock.c,v 1.45 2003/05/14 09:11:06 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,10 +52,63 @@ lnat mblocks_allocated = 0;
    The MBlock Map: provides our implementation of HEAP_ALLOCED()
    -------------------------------------------------------------------------- */
 
    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
 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
 
 #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)
    -------------------------------------------------------------------------- */
 /* -----------------------------------------------------------------------------
    Allocate new mblock(s)
    -------------------------------------------------------------------------- */

@@ -79,9 +134,19 @@ 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.
 
 // A wrapper around mmap(), to abstract away from OS differences in
 // the mmap() interface.

@@ -91,16 +156,16 @@ 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

@@ -116,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 %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
     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);

@@ -130,10 +199,10 @@ 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).
            (errno == EINVAL && sizeof(void*)==4 && size >= 0xc0000000)) {
            // If we request more than 3Gig, then we get EINVAL
            // instead of ENOMEM (at least on Linux).

-           prog_belch("out of memory (requested %d bytes)", size);
+           errorBelch("out of memory (requested %lu bytes)", size);

            stg_exit(EXIT_FAILURE);
        } else {
            stg_exit(EXIT_FAILURE);
        } else {

-           barf("getMBlock: mmap: %s", sys_errlist[errno]);
+           barf("getMBlock: mmap: %s", strerror(errno));

        }
     }
 
        }
     }
 

@@ -202,7 +271,7 @@ getMBlocks(nat n)
       if (((W_)ret & MBLOCK_MASK) != 0) {
          // misaligned block!
 #if 0 // defined(DEBUG)
       if (((W_)ret & MBLOCK_MASK) != 0) {
          // misaligned block!
 #if 0 // defined(DEBUG)

-         belch("warning: getMBlock: misaligned block %p returned when allocating %d megablock(s) at %p", ret, n, next_request);
+         errorBelch("warning: getMBlock: misaligned block %p returned when allocating %d megablock(s) at %p", ret, n, next_request);

 #endif
 
          // unmap this block...
 #endif
 
          // unmap this block...

@@ -218,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++) {

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

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

@@ -230,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

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

@@ -262,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;

@@ -281,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;

@@ -305,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;
      }
   }

@@ -318,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++) {

-      MARK_HEAP_ALLOCED ( 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.

@@ -347,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
   }