ghc/rts/MBlock.c

   1 /* -----------------------------------------------------------------------------
   2  * $Id: MBlock.c,v 1.45 2003/05/14 09:11:06 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_STDLIB_H
  22 #include <stdlib.h>
  23 #endif
  24 #ifdef HAVE_UNISTD_H
  25 #include <unistd.h>
  26 #endif
  27 #ifdef HAVE_SYS_TYPES_H
  28 #include <sys/types.h>
  29 #endif
  30 #ifndef mingw32_TARGET_OS
  31 # ifdef HAVE_SYS_MMAN_H
  32 # include <sys/mman.h>
  33 # endif
  34 #endif
  35 #ifdef HAVE_FCNTL_H
  36 #include <fcntl.h>
  37 #endif
  38 #if HAVE_WINDOWS_H
  39 #include <windows.h>
  40 #endif
  41 #if darwin_TARGET_OS
  42 #include <mach/vm_map.h>
  43 #endif
  44
  45 #include <errno.h>
  46
  47 lnat mblocks_allocated = 0;
  48
  49 /* -----------------------------------------------------------------------------
  50    The MBlock Map: provides our implementation of HEAP_ALLOCED()
  51    -------------------------------------------------------------------------- */
  52
  53 #ifdef MBLOCK_MAP_SIZE
  54 StgWord8 mblock_map[MBLOCK_MAP_SIZE]; // initially all zeros
  55 #endif
  56
  57 /* -----------------------------------------------------------------------------
  58    Allocate new mblock(s)
  59    -------------------------------------------------------------------------- */
  60
  61 void *
  62 getMBlock(void)
  63 {
  64   return getMBlocks(1);
  65 }
  66
  67 /* -----------------------------------------------------------------------------
  68    The mmap() method
  69
  70    On Unix-like systems, we use mmap() to allocate our memory.  We
  71    want memory in chunks of MBLOCK_SIZE, and aligned on an MBLOCK_SIZE
  72    boundary.  The mmap() interface doesn't give us this level of
  73    control, so we have to use some heuristics.
  74
  75    In the general case, if we want a block of n megablocks, then we
  76    allocate n+1 and trim off the slop from either side (using
  77    munmap()) to get an aligned chunk of size n.  However, the next
  78    time we'll try to allocate directly after the previously allocated
  79    chunk, on the grounds that this is aligned and likely to be free.
  80    If it turns out that we were wrong, we have to munmap() and try
  81    again using the general method.
  82    -------------------------------------------------------------------------- */
  83
  84 #if !defined(mingw32_TARGET_OS) && !defined(cygwin32_TARGET_OS)
  85
  86 // A wrapper around mmap(), to abstract away from OS differences in
  87 // the mmap() interface.
  88
  89 static void *
  90 my_mmap (void *addr, lnat size)
  91 {
  92     void *ret;
  93
  94 #ifdef solaris2_TARGET_OS
  95     {
  96         int fd = open("/dev/zero",O_RDONLY);
  97         ret = mmap(addr, size, PROT_READ | PROT_WRITE, MAP_PRIVATE, fd, 0);
  98         close(fd);
  99     }
 100 #elif hpux_TARGET_OS
 101     ret = mmap(addr, size, PROT_READ | PROT_WRITE,
 102                MAP_ANONYMOUS | MAP_PRIVATE, -1, 0);
 103 #elif darwin_TARGET_OS
 104     // Without MAP_FIXED, Apple's mmap ignores addr.
 105     // With MAP_FIXED, it overwrites already mapped regions, whic
 106     // mmap(0, ... MAP_FIXED ...) is worst of all: It unmaps the program text
 107     // and replaces it with zeroes, causing instant death.
 108     // This behaviour seems to be conformant with IEEE Std 1003.1-2001.
 109     // Let's just use the underlying Mach Microkernel calls directly,
 110     // they're much nicer.
 111
 112     kern_return_t err;
 113     ret = addr;
 114     if(addr)    // try to allocate at adress
 115         err = vm_allocate(mach_task_self(),(vm_address_t*) &ret, size, FALSE);
 116     if(!addr || err)    // try to allocate anywhere
 117         err = vm_allocate(mach_task_self(),(vm_address_t*) &ret, size, TRUE);
 118
 119     if(err) // don't know what the error codes mean exactly
 120         barf("memory allocation failed (requested %d bytes)", size);
 121     else
 122         vm_protect(mach_task_self(),ret,size,FALSE,VM_PROT_READ|VM_PROT_WRITE);
 123 #else
 124     ret = mmap(addr, size, PROT_READ | PROT_WRITE | PROT_EXEC,
 125                MAP_ANON | MAP_PRIVATE, -1, 0);
 126 #endif
 127
 128     if (ret == (void *)-1) {
 129         if (errno == ENOMEM ||
 130             (errno == EINVAL && sizeof(void*)==4 && size >= 0xc0000000)) {
 131             // If we request more than 3Gig, then we get EINVAL
 132             // instead of ENOMEM (at least on Linux).
 133             prog_belch("out of memory (requested %d bytes)", size);
 134             stg_exit(EXIT_FAILURE);
 135         } else {
 136             barf("getMBlock: mmap: %s", sys_errlist[errno]);
 137         }
 138     }
 139
 140     return ret;
 141 }
 142
 143 // Implements the general case: allocate a chunk of memory of 'size'
 144 // mblocks.
 145
 146 static void *
 147 gen_map_mblocks (lnat size)
 148 {
 149     int slop;
 150     void *ret;
 151
 152     // Try to map a larger block, and take the aligned portion from
 153     // it (unmap the rest).
 154     size += MBLOCK_SIZE;
 155     ret = my_mmap(0, size);
 156
 157     // unmap the slop bits around the chunk we allocated
 158     slop = (W_)ret & MBLOCK_MASK;
 159
 160     if (munmap(ret, MBLOCK_SIZE - slop) == -1) {
 161       barf("gen_map_mblocks: munmap failed");
 162     }
 163     if (slop > 0 && munmap(ret+size-slop, slop) == -1) {
 164       barf("gen_map_mblocks: munmap failed");
 165     }
 166
 167     // ToDo: if we happened to get an aligned block, then don't
 168     // unmap the excess, just use it. For this to work, you
 169     // need to keep in mind the following:
 170     //     * Calling my_mmap() with an 'addr' arg pointing to
 171     //       already my_mmap()ed space is OK and won't fail.
 172     //     * If my_mmap() can't satisfy the request at the
 173     //       given 'next_request' address in getMBlocks(), that
 174     //       you unmap the extra mblock mmap()ed here (or simply
 175     //       satisfy yourself that the slop introduced isn't worth
 176     //       salvaging.)
 177     //
 178
 179     // next time, try after the block we just got.
 180     ret += MBLOCK_SIZE - slop;
 181     return ret;
 182 }
 183
 184
 185 // The external interface: allocate 'n' mblocks, and return the
 186 // address.
 187
 188 void *
 189 getMBlocks(nat n)
 190 {
 191   static caddr_t next_request = (caddr_t)HEAP_BASE;
 192   caddr_t ret;
 193   lnat size = MBLOCK_SIZE * n;
 194   nat i;
 195
 196   if (next_request == 0) {
 197       // use gen_map_mblocks the first time.
 198       ret = gen_map_mblocks(size);
 199   } else {
 200       ret = my_mmap(next_request, size);
 201
 202       if (((W_)ret & MBLOCK_MASK) != 0) {
 203           // misaligned block!
 204 #if 0 // defined(DEBUG)
 205           belch("warning: getMBlock: misaligned block %p returned when allocating %d megablock(s) at %p", ret, n, next_request);
 206 #endif
 207
 208           // unmap this block...
 209           if (munmap(ret, size) == -1) {
 210               barf("getMBlock: munmap failed");
 211           }
 212           // and do it the hard way
 213           ret = gen_map_mblocks(size);
 214       }
 215   }
 216
 217   // Next time, we'll try to allocate right after the block we just got.
 218   // ToDo: check that we haven't already grabbed the memory at next_request
 219   next_request = ret + size;
 220
 221   IF_DEBUG(gc,fprintf(stderr,"Allocated %d megablock(s) at %p\n",n,ret));
 222
 223   // fill in the table
 224   for (i = 0; i < n; i++) {
 225       MARK_HEAP_ALLOCED( ret + i * MBLOCK_SIZE );
 226   }
 227
 228   mblocks_allocated += n;
 229
 230   return ret;
 231 }
 232
 233 #else /* defined(mingw32_TARGET_OS) || defined(cygwin32_TARGET_OS) */
 234
 235 /*
 236  On Win32 platforms we make use of the two-phased virtual memory API
 237  to allocate mega blocks. We proceed as follows:
 238
 239  Reserve a large chunk of VM (256M at the time, or what the user asked
 240  for via the -M option), but don't supply a base address that's aligned on
 241  a MB boundary. Instead we round up to the nearest mblock from the chunk of
 242  VM we're handed back from the OS (at the moment we just leave the 'slop' at
 243  the beginning of the reserved chunk unused - ToDo: reuse it .)
 244
 245  Reserving memory doesn't allocate physical storage (not even in the
 246  page file), this is done later on by committing pages (or mega-blocks in
 247  our case).
 248 */
 249
 250 char* base_non_committed = (char*)0;
 251 char* end_non_committed = (char*)0;
 252
 253 /* Default is to reserve 256M of VM to minimise the slop cost. */
 254 #define SIZE_RESERVED_POOL  ( 256 * 1024 * 1024 )
 255
 256 /* Number of bytes reserved */
 257 static unsigned long size_reserved_pool = SIZE_RESERVED_POOL;
 258
 259 void *
 260 getMBlocks(nat n)
 261 {
 262   static char* base_mblocks       = (char*)0;
 263   static char* next_request       = (char*)0;
 264   void* ret                       = (void*)0;
 265   int i;
 266
 267   lnat size = MBLOCK_SIZE * n;
 268
 269   if ( (base_non_committed == 0) || (next_request + size > end_non_committed) ) {
 270     if (base_non_committed) {
 271       barf("RTS exhausted max heap size (%d bytes)\n", size_reserved_pool);
 272     }
 273     if (RtsFlags.GcFlags.maxHeapSize != 0) {
 274       size_reserved_pool = BLOCK_SIZE * RtsFlags.GcFlags.maxHeapSize;
 275       if (size_reserved_pool < MBLOCK_SIZE) {
 276         size_reserved_pool = 2*MBLOCK_SIZE;
 277       }
 278     }
 279     base_non_committed = VirtualAlloc ( NULL
 280                                       , size_reserved_pool
 281                                       , MEM_RESERVE
 282                                       , PAGE_READWRITE
 283                                       );
 284     if ( base_non_committed == 0 ) {
 285          fprintf(stderr, "getMBlocks: VirtualAlloc failed with: %ld\n", GetLastError());
 286          ret=(void*)-1;
 287     } else {
 288       end_non_committed = (char*)base_non_committed + (unsigned long)size_reserved_pool;
 289       /* The returned pointer is not aligned on a mega-block boundary. Make it. */
 290       base_mblocks = (char*)((unsigned long)base_non_committed & (unsigned long)~MBLOCK_MASK) + MBLOCK_SIZE;
 291 #      if 0
 292        fprintf(stderr, "getMBlocks: Dropping %d bytes off of 256M chunk\n",
 293                        (unsigned)base_mblocks - (unsigned)base_non_committed);
 294 #      endif
 295
 296        if ( ((char*)base_mblocks + size) > end_non_committed ) {
 297           fprintf(stderr, "getMBlocks: oops, committed too small a region to start with.");
 298           ret=(void*)-1;
 299        } else {
 300           next_request = base_mblocks;
 301        }
 302     }
 303   }
 304   /* Commit the mega block(s) to phys mem */
 305   if ( ret != (void*)-1 ) {
 306      ret = VirtualAlloc(next_request, size, MEM_COMMIT, PAGE_READWRITE);
 307      if (ret == NULL) {
 308         fprintf(stderr, "getMBlocks: VirtualAlloc failed with: %ld\n", GetLastError());
 309         ret=(void*)-1;
 310      }
 311   }
 312
 313   if (((W_)ret & MBLOCK_MASK) != 0) {
 314     barf("getMBlocks: misaligned block returned");
 315   }
 316
 317   if (ret == (void*)-1) {
 318      barf("getMBlocks: unknown memory allocation failure on Win32.");
 319   }
 320
 321   IF_DEBUG(gc,fprintf(stderr,"Allocated %d megablock(s) at 0x%x\n",n,(nat)ret));
 322   next_request = (char*)next_request + size;
 323
 324   mblocks_allocated += n;
 325
 326   // fill in the table
 327   for (i = 0; i < n; i++) {
 328       MARK_HEAP_ALLOCED ( ret + i * MBLOCK_SIZE );
 329   }
 330
 331   return ret;
 332 }
 333
 334 /* Hand back the physical memory that is allocated to a mega-block.
 335    ToDo: chain the released mega block onto some list so that
 336          getMBlocks() can get at it.
 337
 338    Currently unused.
 339 */
 340 #if 0
 341 void
 342 freeMBlock(void* p, nat n)
 343 {
 344   BOOL rc;
 345
 346   rc = VirtualFree(p, n * MBLOCK_SIZE , MEM_DECOMMIT );
 347
 348   if (rc == FALSE) {
 349 #    ifdef DEBUG
 350      fprintf(stderr, "freeMBlocks: VirtualFree failed with: %d\n", GetLastError());
 351 #    endif
 352   }
 353
 354 }
 355 #endif
 356
 357 #endif