Rejig boot

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

diff --git a/rts/sm/MBlock.c b/rts/sm/MBlock.c
index 85fe02d..1b98734 100644 (file)
--- a/rts/sm/MBlock.c
+++ b/rts/sm/MBlock.c
@@ -42,6 +42,7 @@
 #include <windows.h>
 #endif
 #if darwin_HOST_OS
+#include <mach/mach.h>
 #include <mach/vm_map.h>
 #endif
 
@@ -49,6 +50,18 @@
 
 lnat mblocks_allocated = 0;
 
+#if !defined(mingw32_HOST_OS) && !defined(cygwin32_HOST_OS)
+static caddr_t next_request = 0;
+#endif
+
+void
+initMBlocks(void)
+{
+#if !defined(mingw32_HOST_OS) && !defined(cygwin32_HOST_OS)
+    next_request = (caddr_t)RtsFlags.GcFlags.heapBase;
+#endif
+}
+
 /* -----------------------------------------------------------------------------
    The MBlock Map: provides our implementation of HEAP_ALLOCED()
    -------------------------------------------------------------------------- */
@@ -188,7 +201,7 @@ my_mmap (void *addr, lnat size)
        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(),(vm_address_t)ret,size,FALSE,VM_PROT_READ|VM_PROT_WRITE);
     }
 #else
     ret = mmap(addr, size, PROT_READ | PROT_WRITE | PROT_EXEC, 
@@ -258,7 +271,6 @@ gen_map_mblocks (lnat size)
 void *
 getMBlocks(nat n)
 {
-  static caddr_t next_request = (caddr_t)HEAP_BASE;
   caddr_t ret;
   lnat size = MBLOCK_SIZE * n;
   nat i;
@@ -337,8 +349,13 @@ allocNew(nat n) {
     if(rec->base==0) {
         stgFree((void*)rec);
         rec=0;
-        sysErrorBelch(
-            "getMBlocks: VirtualAlloc MEM_RESERVE %d blocks failed", n);
+        if (GetLastError() == ERROR_NOT_ENOUGH_MEMORY) {
+
+            errorBelch("out of memory");
+        } else {
+            sysErrorBelch(
+                "getMBlocks: VirtualAlloc MEM_RESERVE %d blocks failed", n);
+        }
     } else {
                alloc_rec temp;
                temp.base=0; temp.size=0; temp.next=allocs;