ghc/rts/MBlock.c

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