ghc/rts/MBlock.c

   1 /* -----------------------------------------------------------------------------
   2  * $Id: MBlock.c,v 1.29 2002/07/17 09:21:50 simonmar Exp $
   3  *
   4  * (c) The GHC Team 1998-1999
   5  *
   6  * MegaBlock Allocator Interface.  This file contains all the dirty
   7  * architecture-dependent hackery required to get a chunk of aligned
   8  * memory from the operating system.
   9  *
  10  * ---------------------------------------------------------------------------*/
  11
  12 /* This is non-posix compliant. */
  13 /* #include "PosixSource.h" */
  14
  15 #include "Rts.h"
  16 #include "RtsUtils.h"
  17 #include "RtsFlags.h"
  18 #include "MBlock.h"
  19 #include "BlockAlloc.h"
  20
  21 #ifdef HAVE_UNISTD_H
  22 #include <unistd.h>
  23 #endif
  24
  25 #ifdef HAVE_SYS_TYPES_H
  26 #include <sys/types.h>
  27 #endif
  28
  29 #ifndef mingw32_TARGET_OS
  30 # ifdef HAVE_SYS_MMAN_H
  31 # include <sys/mman.h>
  32 # endif
  33 #endif
  34
  35 #ifdef HAVE_FCNTL_H
  36 #include <fcntl.h>
  37 #endif
  38
  39 #if HAVE_WINDOWS_H
  40 #include <windows.h>
  41 #endif
  42
  43 #include <errno.h>
  44
  45 lnat mblocks_allocated = 0;
  46
  47 void *
  48 getMBlock(void)
  49 {
  50   return getMBlocks(1);
  51 }
  52
  53 #if !defined(mingw32_TARGET_OS) && !defined(cygwin32_TARGET_OS)
  54 void *
  55 getMBlocks(nat n)
  56 {
  57   static caddr_t next_request = (caddr_t)HEAP_BASE;
  58   caddr_t ret;
  59   lnat size = MBLOCK_SIZE * n;
  60
  61 #ifdef solaris2_TARGET_OS
  62   {
  63       int fd = open("/dev/zero",O_RDONLY);
  64       ret = mmap(next_request, size, PROT_READ | PROT_WRITE,
  65                  MAP_FIXED | MAP_PRIVATE, fd, 0);
  66       close(fd);
  67   }
  68 #elif hpux_TARGET_OS
  69  ret = mmap(next_request, size, PROT_READ | PROT_WRITE,
  70              MAP_ANONYMOUS | MAP_PRIVATE, -1, 0);
  71 #elif darwin_TARGET_OS
  72  ret = mmap(next_request, size, PROT_READ | PROT_WRITE,
  73             MAP_FIXED | MAP_ANON | MAP_PRIVATE, -1, 0);
  74 #else
  75   ret = mmap(next_request, size, PROT_READ | PROT_WRITE,
  76              MAP_ANON | MAP_PRIVATE, -1, 0);
  77 #endif
  78
  79   if (ret == (void *)-1) {
  80     if (errno == ENOMEM) {
  81       barf("getMBlock: out of memory (blocks requested: %d)", n);
  82     } else {
  83       barf("GetMBlock: mmap failed");
  84     }
  85   }
  86
  87   if (((W_)ret & MBLOCK_MASK) != 0) {
  88     barf("GetMBlock: misaligned block %p returned when allocating %d megablock(s) at %p", ret, n, next_request);
  89   }
  90
  91   IF_DEBUG(gc,fprintf(stderr,"Allocated %d megablock(s) at %p\n",n,ret));
  92
  93   next_request += size;
  94
  95   mblocks_allocated += n;
  96
  97   return ret;
  98 }
  99
 100 #else /* defined(mingw32_TARGET_OS) || defined(cygwin32_TARGET_OS) */
 101
 102 /*
 103  On Win32 platforms we make use of the two-phased virtual memory API
 104  to allocate mega blocks. We proceed as follows:
 105
 106  Reserve a large chunk of VM (256M at the time, or what the user asked
 107  for via the -M option), but don't supply a base address that's aligned on
 108  a MB boundary. Instead we round up to the nearest mblock from the chunk of
 109  VM we're handed back from the OS (at the moment we just leave the 'slop' at
 110  the beginning of the reserved chunk unused - ToDo: reuse it .)
 111
 112  Reserving memory doesn't allocate physical storage (not even in the
 113  page file), this is done later on by committing pages (or mega-blocks in
 114  our case).
 115 */
 116
 117 char* base_non_committed = (char*)0;
 118 char* end_non_committed = (char*)0;
 119
 120 /* Default is to reserve 256M of VM to minimise the slop cost. */
 121 #define SIZE_RESERVED_POOL  ( 256 * 1024 * 1024 )
 122
 123 /* Number of bytes reserved */
 124 static unsigned long size_reserved_pool = SIZE_RESERVED_POOL;
 125
 126 /* This predicate should be inlined, really. */
 127 /* TODO: this only works for a single chunk */
 128 int
 129 is_heap_alloced(const void* x)
 130 {
 131   return (((char*)(x) >= base_non_committed) &&
 132           ((char*)(x) <= end_non_committed));
 133 }
 134
 135 void *
 136 getMBlocks(nat n)
 137 {
 138   static char* base_mblocks       = (char*)0;
 139   static char* next_request       = (char*)0;
 140   void* ret                       = (void*)0;
 141
 142   lnat size = MBLOCK_SIZE * n;
 143
 144   if ( (base_non_committed == 0) || (next_request + size > end_non_committed) ) {
 145     if (base_non_committed) {
 146       barf("RTS exhausted max heap size (%d bytes)\n", size_reserved_pool);
 147     }
 148     if (RtsFlags.GcFlags.maxHeapSize != 0) {
 149       size_reserved_pool = BLOCK_SIZE * RtsFlags.GcFlags.maxHeapSize;
 150       if (size_reserved_pool < MBLOCK_SIZE) {
 151         size_reserved_pool = 2*MBLOCK_SIZE;
 152       }
 153     }
 154     base_non_committed = VirtualAlloc ( NULL
 155                                       , size_reserved_pool
 156                                       , MEM_RESERVE
 157                                       , PAGE_READWRITE
 158                                       );
 159     if ( base_non_committed == 0 ) {
 160          fprintf(stderr, "getMBlocks: VirtualAlloc failed with: %ld\n", GetLastError());
 161          ret=(void*)-1;
 162     } else {
 163       end_non_committed = (char*)base_non_committed + (unsigned long)size_reserved_pool;
 164       /* The returned pointer is not aligned on a mega-block boundary. Make it. */
 165       base_mblocks = (char*)((unsigned long)base_non_committed & (unsigned long)0xfff00000) + MBLOCK_SIZE;
 166 #      if 0
 167        fprintf(stderr, "getMBlocks: Dropping %d bytes off of 256M chunk\n",
 168                        (unsigned)base_mblocks - (unsigned)base_non_committed);
 169 #      endif
 170
 171        if ( ((char*)base_mblocks + size) > end_non_committed ) {
 172           fprintf(stderr, "getMBlocks: oops, committed too small a region to start with.");
 173           ret=(void*)-1;
 174        } else {
 175           next_request = base_mblocks;
 176        }
 177     }
 178   }
 179   /* Commit the mega block(s) to phys mem */
 180   if ( ret != (void*)-1 ) {
 181      ret = VirtualAlloc(next_request, size, MEM_COMMIT, PAGE_READWRITE);
 182      if (ret == NULL) {
 183         fprintf(stderr, "getMBlocks: VirtualAlloc failed with: %ld\n", GetLastError());
 184         ret=(void*)-1;
 185      }
 186   }
 187
 188   if (((W_)ret & MBLOCK_MASK) != 0) {
 189     barf("getMBlocks: misaligned block returned");
 190   }
 191
 192   if (ret == (void*)-1) {
 193      barf("getMBlocks: unknown memory allocation failure on Win32.");
 194   }
 195
 196   IF_DEBUG(gc,fprintf(stderr,"Allocated %d megablock(s) at 0x%x\n",n,(nat)ret));
 197   next_request = (char*)next_request + size;
 198
 199   mblocks_allocated += n;
 200
 201   return ret;
 202 }
 203
 204 /* Hand back the physical memory that is allocated to a mega-block.
 205    ToDo: chain the released mega block onto some list so that
 206          getMBlocks() can get at it.
 207
 208    Currently unused.
 209 */
 210 #if 0
 211 void
 212 freeMBlock(void* p, nat n)
 213 {
 214   BOOL rc;
 215
 216   rc = VirtualFree(p, n * MBLOCK_SIZE , MEM_DECOMMIT );
 217
 218   if (rc == FALSE) {
 219 #    ifdef DEBUG
 220      fprintf(stderr, "freeMBlocks: VirtualFree failed with: %d\n", GetLastError());
 221 #    endif
 222   }
 223
 224 }
 225 #endif
 226
 227 #endif