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