ghc/rts/MBlock.c

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