X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FMBlock.c;h=568bff251f395eee06a3f7690e4006a88a8a346b;hb=b756fcaa083986e10a6c0282fdaf677fc01f3308;hp=96be15fe1bf2f52125d84335d8f512edfced5f0c;hpb=7f309f1c021e7583f724cce599ce2dd3c439361b;p=ghc-hetmet.git

diff --git a/ghc/rts/MBlock.c b/ghc/rts/MBlock.c
index 96be15f..568bff2 100644
--- a/ghc/rts/MBlock.c
+++ b/ghc/rts/MBlock.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: MBlock.c,v 1.9 1999/02/05 16:02:44 simonm Exp $
+ * $Id: MBlock.c,v 1.20 2000/12/16 15:20:30 panne Exp $
  *
  * (c) The GHC Team 1998-1999
  *
@@ -25,8 +25,10 @@
 #include <sys/types.h>
 #endif
 
-#ifdef HAVE_SYS_MMAN_H
-#include <sys/mman.h>
+#ifndef mingw32_TARGET_OS
+# ifdef HAVE_SYS_MMAN_H
+# include <sys/mman.h>
+# endif
 #endif
 
 #ifdef HAVE_FCNTL_H
@@ -37,35 +39,6 @@
 #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 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 _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
-
 lnat mblocks_allocated = 0;
 
 void *
@@ -78,7 +51,7 @@ getMBlock(void)
 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;
  
@@ -89,6 +62,9 @@ getMBlocks(nat n)
 		 MAP_FIXED | MAP_PRIVATE, fd, 0);
       close(fd);
   }
+#elif hpux_TARGET_OS
+ ret = mmap(next_request, size, PROT_READ | PROT_WRITE, 
+	     MAP_ANONYMOUS | MAP_PRIVATE, -1, 0);
 #else
   ret = mmap(next_request, size, PROT_READ | PROT_WRITE, 
 	     MAP_ANON | MAP_PRIVATE, -1, 0);
@@ -103,7 +79,7 @@ getMBlocks(nat n)
   }
 
   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));
@@ -133,41 +109,55 @@ getMBlocks(nat n)
 
 */
 
+char* base_non_committed = (char*)0;
+
+/* Reserve VM 128M at the time to try to minimise the slop cost. */
+#define SIZE_RESERVED_POOL  ( 128 * 1024 * 1024 )
+
+/* 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 + SIZE_RESERVED_POOL)));
+}
+
 void *
 getMBlocks(nat n)
 {
-  static char* base_non_committed = (char*)0;
   static char* base_mblocks       = (char*)0;
   static char* next_request       = (char*)0;
   void* ret                       = (void*)0;
 
   lnat size = MBLOCK_SIZE * n;
 
-  /* Reserve VM 128M at the time to try to minimise the slop cost. */
-#define SIZE_RESERVED_POOL  ( 128 * 1024 * 1024 )
-
   if ( (base_non_committed == 0) || 
        (next_request + size > base_non_committed + SIZE_RESERVED_POOL) ) {
+#ifdef ENABLE_WIN32_DLL_SUPPORT
+    if (base_non_committed)
+        barf("Windows programs can only use 128Mb of heap; sorry!");
+#endif
     base_non_committed = VirtualAlloc ( NULL
                                       , SIZE_RESERVED_POOL
 				      , MEM_RESERVE
 				      , PAGE_READWRITE
 				      );
     if ( base_non_committed == 0 ) {
-# ifdef DEBUG
+# if 1 /*def DEBUG*/
          fprintf(stderr, "getMBlocks: VirtualAlloc failed with: %d\n", GetLastError());
 # endif
          ret=(void*)-1;
     } else {
     /* The returned pointer is not aligned on a mega-block boundary. Make it. */
-       base_mblocks = (char*)((unsigned)base_non_committed & (unsigned)0xfff00000) + 0x100000;
+       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", 
 	               (unsigned)base_mblocks - (unsigned)base_non_committed);
 # endif
 
        if ( ((char*)base_mblocks + size) > ((char*)base_non_committed + SIZE_RESERVED_POOL) ) {
-# ifdef DEBUG
+# if 1 /*def DEBUG*/
           fprintf(stderr, "oops, committed too small a region to start with.");
 # endif
 	  ret=(void*)-1;
@@ -180,7 +170,7 @@ getMBlocks(nat n)
   if ( ret != (void*)-1 ) {
      ret = VirtualAlloc(next_request, size, MEM_COMMIT, PAGE_READWRITE);
      if (ret == NULL) {
-# ifdef DEBUG
+# if 1 /*def DEBUG*/
         fprintf(stderr, "getMBlocks: VirtualAlloc failed with: %d\n", GetLastError());
 # endif
         ret=(void*)-1;