[project @ 2002-10-15 08:56:50 by simonpj]
[ghc-hetmet.git] / ghc / rts / MBlock.c
index eeb3bde..eaf6801 100644 (file)
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: MBlock.c,v 1.13 1999/12/15 09:43:24 simonmar Exp $
+ * $Id: MBlock.c,v 1.29 2002/07/17 09:21:50 simonmar Exp $
  *
  * (c) The GHC Team 1998-1999
  *
@@ -9,7 +9,8 @@
  *
  * ---------------------------------------------------------------------------*/
 
-#define NON_POSIX_SOURCE
+/* This is non-posix compliant. */
+/* #include "PosixSource.h" */
 
 #include "Rts.h"
 #include "RtsUtils.h"
 #include <windows.h>
 #endif
 
-#if freebsd2_TARGET_OS || freebsd3_TARGET_OS
-/* Executable is loaded from      0x0
- * Shared libraries are loaded at 0x2000000
- * Stack is at the top of the address space.  The kernel probably owns
- * 0x8000000 onwards, so we'll pick 0x5000000.
- */
-#define ASK_FOR_MEM_AT 0x50000000
-
-#elif netbsd_TARGET_OS
-/* NetBSD i386 shared libs are at 0x40000000
- */
-#define ASK_FOR_MEM_AT 0x50000000
-#elif linux_TARGET_OS
-/* Any ideas?
- */
-#define ASK_FOR_MEM_AT 0x50000000
-
-#elif solaris2_TARGET_OS
-/* guess */
-#define ASK_FOR_MEM_AT 0x50000000
-
-#elif osf3_TARGET_OS
-/* guess */
-#define ASK_FOR_MEM_AT 0x50000000
-
-#elif hpux_TARGET_OS
-/* guess */
-#define ASK_FOR_MEM_AT 0x50000000
-
-#elif _WIN32
-/* doesn't matter, we use a reserve/commit algorithm */
-
-#else
-#error Dont know where to get memory from on this architecture
-/* ToDo: memory locations on other architectures */
-#endif
+#include <errno.h>
 
 lnat mblocks_allocated = 0;
 
@@ -84,11 +50,11 @@ getMBlock(void)
   return getMBlocks(1);
 }
 
-#ifndef _WIN32
+#if !defined(mingw32_TARGET_OS) && !defined(cygwin32_TARGET_OS)
 void *
 getMBlocks(nat n)
 {
-  static caddr_t next_request = (caddr_t)ASK_FOR_MEM_AT;
+  static caddr_t next_request = (caddr_t)HEAP_BASE;
   caddr_t ret;
   lnat size = MBLOCK_SIZE * n;
  
@@ -102,6 +68,9 @@ getMBlocks(nat n)
 #elif hpux_TARGET_OS
  ret = mmap(next_request, size, PROT_READ | PROT_WRITE, 
             MAP_ANONYMOUS | MAP_PRIVATE, -1, 0);
+#elif darwin_TARGET_OS
+ ret = mmap(next_request, size, PROT_READ | PROT_WRITE, 
+            MAP_FIXED | MAP_ANON | MAP_PRIVATE, -1, 0);
 #else
   ret = mmap(next_request, size, PROT_READ | PROT_WRITE, 
             MAP_ANON | MAP_PRIVATE, -1, 0);
@@ -109,17 +78,17 @@ getMBlocks(nat n)
   
   if (ret == (void *)-1) {
     if (errno == ENOMEM) {
-      barf("getMBlock: out of memory");
+      barf("getMBlock: out of memory (blocks requested: %d)", n);
     } else {
       barf("GetMBlock: mmap failed");
     }
   }
 
   if (((W_)ret & MBLOCK_MASK) != 0) {
-    barf("GetMBlock: misaligned block returned");
+    barf("GetMBlock: misaligned block %p returned when allocating %d megablock(s) at %p", ret, n, next_request);
   }
 
-  IF_DEBUG(gc,fprintf(stderr,"Allocated %d megablock(s) at %x\n",n,(nat)ret));
+  IF_DEBUG(gc,fprintf(stderr,"Allocated %d megablock(s) at %p\n",n,ret));
 
   next_request += size;
 
@@ -128,35 +97,39 @@ getMBlocks(nat n)
   return ret;
 }
 
-#else /* _WIN32 */
+#else /* defined(mingw32_TARGET_OS) || defined(cygwin32_TARGET_OS) */
 
 /*
  On Win32 platforms we make use of the two-phased virtual memory API
  to allocate mega blocks. We proceed as follows:
 
- Reserve a large chunk of VM (128M at the time), but don't supply a 
- base address that's aligned on a MB boundary. Instead we round up to the
- nearest from the chunk of VM we're given back from the OS (at the
- moment we just leave the 'slop' at the beginning of the reserved
- chunk unused - ToDo: reuse it .)
+ Reserve a large chunk of VM (256M at the time, or what the user asked
+ for via the -M option), but don't supply a base address that's aligned on
+ a MB boundary. Instead we round up to the nearest mblock from the chunk of
+ VM we're handed back from the OS (at the moment we just leave the 'slop' at
+ the beginning of the reserved chunk unused - ToDo: reuse it .)
 
  Reserving memory doesn't allocate physical storage (not even in the
- page file), this is done by committing pages (or mega-blocks in
+ page file), this is done later on by committing pages (or mega-blocks in
  our case).
-
 */
 
 char* base_non_committed = (char*)0;
+char* end_non_committed = (char*)0;
 
-/* Reserve VM 128M at the time to try to minimise the slop cost. */
-#define SIZE_RESERVED_POOL  ( 128 * 1024 * 1024 )
+/* Default is to reserve 256M of VM to minimise the slop cost. */
+#define SIZE_RESERVED_POOL  ( 256 * 1024 * 1024 )
+
+/* Number of bytes reserved */
+static unsigned long size_reserved_pool = SIZE_RESERVED_POOL;
 
 /* This predicate should be inlined, really. */
+/* TODO: this only works for a single chunk */
 int
 is_heap_alloced(const void* x)
 {
   return (((char*)(x) >= base_non_committed) && 
-          ((char*)(x) <= (base_non_committed + 128 * 1024 * 1024)));
+          ((char*)(x) <= end_non_committed));
 }
 
 void *
@@ -167,31 +140,36 @@ getMBlocks(nat n)
   void* ret                       = (void*)0;
 
   lnat size = MBLOCK_SIZE * n;
-
-  if ( (base_non_committed == 0) || 
-       (next_request + size > base_non_committed + SIZE_RESERVED_POOL) ) {
+  
+  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);
+    }
+    if (RtsFlags.GcFlags.maxHeapSize != 0) {
+      size_reserved_pool = BLOCK_SIZE * RtsFlags.GcFlags.maxHeapSize;
+      if (size_reserved_pool < MBLOCK_SIZE) {
+       size_reserved_pool = 2*MBLOCK_SIZE;
+      }
+    }
     base_non_committed = VirtualAlloc ( NULL
-                                      , SIZE_RESERVED_POOL
+                                      , size_reserved_pool
                                      , MEM_RESERVE
                                      , PAGE_READWRITE
                                      );
     if ( base_non_committed == 0 ) {
-# if 1 /*def DEBUG*/
-         fprintf(stderr, "getMBlocks: VirtualAlloc failed with: %d\n", GetLastError());
-# endif
+         fprintf(stderr, "getMBlocks: VirtualAlloc failed with: %ld\n", GetLastError());
          ret=(void*)-1;
     } else {
-    /* The returned pointer is not aligned on a mega-block boundary. Make it. */
-       base_mblocks = (char*)((unsigned long)base_non_committed & (unsigned long)0xfff00000) + MBLOCK_SIZE;
-# if 0
-       fprintf(stderr, "Dropping %d bytes off of 128M chunk\n", 
+      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)0xfff00000) + MBLOCK_SIZE;
+#      if 0
+       fprintf(stderr, "getMBlocks: Dropping %d bytes off of 256M chunk\n", 
                       (unsigned)base_mblocks - (unsigned)base_non_committed);
-# endif
+#      endif
 
-       if ( ((char*)base_mblocks + size) > ((char*)base_non_committed + SIZE_RESERVED_POOL) ) {
-# if 1 /*def DEBUG*/
-          fprintf(stderr, "oops, committed too small a region to start with.");
-# endif
+       if ( ((char*)base_mblocks + size) > end_non_committed ) {
+          fprintf(stderr, "getMBlocks: oops, committed too small a region to start with.");
          ret=(void*)-1;
        } else {
           next_request = base_mblocks;
@@ -202,19 +180,20 @@ getMBlocks(nat n)
   if ( ret != (void*)-1 ) {
      ret = VirtualAlloc(next_request, size, MEM_COMMIT, PAGE_READWRITE);
      if (ret == NULL) {
-# if 1 /*def DEBUG*/
-        fprintf(stderr, "getMBlocks: VirtualAlloc failed with: %d\n", GetLastError());
-# endif
+        fprintf(stderr, "getMBlocks: VirtualAlloc failed with: %ld\n", GetLastError());
         ret=(void*)-1;
      }
   }
 
   if (((W_)ret & MBLOCK_MASK) != 0) {
-    barf("GetMBlock: misaligned block returned");
+    barf("getMBlocks: misaligned block returned");
   }
 
-  IF_DEBUG(gc,fprintf(stderr,"Allocated %d megablock(s) at %x\n",n,(nat)ret));
+  if (ret == (void*)-1) {
+     barf("getMBlocks: unknown memory allocation failure on Win32.");
+  }
 
+  IF_DEBUG(gc,fprintf(stderr,"Allocated %d megablock(s) at 0x%x\n",n,(nat)ret));
   next_request = (char*)next_request + size;
 
   mblocks_allocated += n;
@@ -237,9 +216,9 @@ freeMBlock(void* p, nat n)
   rc = VirtualFree(p, n * MBLOCK_SIZE , MEM_DECOMMIT );
   
   if (rc == FALSE) {
-# ifdef DEBUG
+#    ifdef DEBUG
      fprintf(stderr, "freeMBlocks: VirtualFree failed with: %d\n", GetLastError());
-# endif
+#    endif
   }
 
 }