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) {
 185         // don't know what the error codes mean exactly, assume it's
 186         // not our problem though.
 187         errorBelch("memory allocation failed (requested %lu bytes)", size);
 188         stg_exit(EXIT_FAILURE);
 189     } else {
 190         vm_protect(mach_task_self(),ret,size,FALSE,VM_PROT_READ|VM_PROT_WRITE);
 191     }
 192 #else
 193     ret = mmap(addr, size, PROT_READ | PROT_WRITE | PROT_EXEC,
 194                MAP_ANON | MAP_PRIVATE, -1, 0);
 195 #endif
 196
 197     if (ret == (void *)-1) {
 198         if (errno == ENOMEM ||
 199             (errno == EINVAL && sizeof(void*)==4 && size >= 0xc0000000)) {
 200             // If we request more than 3Gig, then we get EINVAL
 201             // instead of ENOMEM (at least on Linux).
 202             errorBelch("out of memory (requested %lu bytes)", size);
 203             stg_exit(EXIT_FAILURE);
 204         } else {
 205             barf("getMBlock: mmap: %s", strerror(errno));
 206         }
 207     }
 208
 209     return ret;
 210 }
 211
 212 // Implements the general case: allocate a chunk of memory of 'size'
 213 // mblocks.
 214
 215 static void *
 216 gen_map_mblocks (lnat size)
 217 {
 218     int slop;
 219     void *ret;
 220
 221     // Try to map a larger block, and take the aligned portion from
 222     // it (unmap the rest).
 223     size += MBLOCK_SIZE;
 224     ret = my_mmap(0, size);
 225
 226     // unmap the slop bits around the chunk we allocated
 227     slop = (W_)ret & MBLOCK_MASK;
 228
 229     if (munmap(ret, MBLOCK_SIZE - slop) == -1) {
 230       barf("gen_map_mblocks: munmap failed");
 231     }
 232     if (slop > 0 && munmap(ret+size-slop, slop) == -1) {
 233       barf("gen_map_mblocks: munmap failed");
 234     }
 235
 236     // ToDo: if we happened to get an aligned block, then don't
 237     // unmap the excess, just use it. For this to work, you
 238     // need to keep in mind the following:
 239     //     * Calling my_mmap() with an 'addr' arg pointing to
 240     //       already my_mmap()ed space is OK and won't fail.
 241     //     * If my_mmap() can't satisfy the request at the
 242     //       given 'next_request' address in getMBlocks(), that
 243     //       you unmap the extra mblock mmap()ed here (or simply
 244     //       satisfy yourself that the slop introduced isn't worth
 245     //       salvaging.)
 246     //
 247
 248     // next time, try after the block we just got.
 249     ret += MBLOCK_SIZE - slop;
 250     return ret;
 251 }
 252
 253
 254 // The external interface: allocate 'n' mblocks, and return the
 255 // address.
 256
 257 void *
 258 getMBlocks(nat n)
 259 {
 260   static caddr_t next_request = (caddr_t)HEAP_BASE;
 261   caddr_t ret;
 262   lnat size = MBLOCK_SIZE * n;
 263   nat i;
 264
 265   if (next_request == 0) {
 266       // use gen_map_mblocks the first time.
 267       ret = gen_map_mblocks(size);
 268   } else {
 269       ret = my_mmap(next_request, size);
 270
 271       if (((W_)ret & MBLOCK_MASK) != 0) {
 272           // misaligned block!
 273 #if 0 // defined(DEBUG)
 274           errorBelch("warning: getMBlock: misaligned block %p returned when allocating %d megablock(s) at %p", ret, n, next_request);
 275 #endif
 276
 277           // unmap this block...
 278           if (munmap(ret, size) == -1) {
 279               barf("getMBlock: munmap failed");
 280           }
 281           // and do it the hard way
 282           ret = gen_map_mblocks(size);
 283       }
 284   }
 285
 286   // Next time, we'll try to allocate right after the block we just got.
 287   // ToDo: check that we haven't already grabbed the memory at next_request
 288   next_request = ret + size;
 289
 290   IF_DEBUG(gc,debugBelch("Allocated %d megablock(s) at %p\n",n,ret));
 291
 292   // fill in the table
 293   for (i = 0; i < n; i++) {
 294       markHeapAlloced( ret + i * MBLOCK_SIZE );
 295   }
 296
 297   mblocks_allocated += n;
 298
 299   return ret;
 300 }
 301
 302 void
 303 freeAllMBlocks(void)
 304 {
 305   /* XXX Do something here */
 306 }
 307
 308 #else /* defined(mingw32_HOST_OS) || defined(cygwin32_HOST_OS) */
 309
 310 /*
 311  On Win32 platforms we make use of the two-phased virtual memory API
 312  to allocate mega blocks. We proceed as follows:
 313
 314  Reserve a large chunk of VM (256M at the time, or what the user asked
 315  for via the -M option), but don't supply a base address that's aligned on
 316  a MB boundary. Instead we round up to the nearest mblock from the chunk of
 317  VM we're handed back from the OS (at the moment we just leave the 'slop' at
 318  the beginning of the reserved chunk unused - ToDo: reuse it .)
 319
 320  Reserving memory doesn't allocate physical storage (not even in the
 321  page file), this is done later on by committing pages (or mega-blocks in
 322  our case).
 323 */
 324
 325 static char* base_non_committed = (char*)0;
 326 static char* end_non_committed = (char*)0;
 327
 328 static void *membase;
 329
 330 /* Default is to reserve 256M of VM to minimise the slop cost. */
 331 #define SIZE_RESERVED_POOL  ( 256 * 1024 * 1024 )
 332
 333 /* Number of bytes reserved */
 334 static unsigned long size_reserved_pool = SIZE_RESERVED_POOL;
 335
 336 void *
 337 getMBlocks(nat n)
 338 {
 339   static char* base_mblocks       = (char*)0;
 340   static char* next_request       = (char*)0;
 341   void* ret                       = (void*)0;
 342   nat i;
 343
 344   lnat size = MBLOCK_SIZE * n;
 345
 346   if ( (base_non_committed == 0) || (next_request + size > end_non_committed) ) {
 347     if (base_non_committed) {
 348         /* Tacky, but if no user-provided -M option is in effect,
 349          * set it to the default (==256M) in time for the heap overflow PSA.
 350          */
 351         if (RtsFlags.GcFlags.maxHeapSize == 0) {
 352             RtsFlags.GcFlags.maxHeapSize = size_reserved_pool / BLOCK_SIZE;
 353         }
 354         heapOverflow();
 355     }
 356     if (RtsFlags.GcFlags.maxHeapSize != 0) {
 357       size_reserved_pool = BLOCK_SIZE * RtsFlags.GcFlags.maxHeapSize;
 358       if (size_reserved_pool < MBLOCK_SIZE) {
 359         size_reserved_pool = 2*MBLOCK_SIZE;
 360       }
 361     }
 362     base_non_committed = VirtualAlloc ( NULL
 363                                       , size_reserved_pool
 364                                       , MEM_RESERVE
 365                                       , PAGE_READWRITE
 366                                       );
 367     membase = base_non_committed;
 368     if ( base_non_committed == 0 ) {
 369          errorBelch("getMBlocks: VirtualAlloc MEM_RESERVE %lu failed with: %ld\n", size_reserved_pool, GetLastError());
 370        ret=(void*)-1;
 371     } else {
 372       end_non_committed = (char*)base_non_committed + (unsigned long)size_reserved_pool;
 373       /* The returned pointer is not aligned on a mega-block boundary. Make it. */
 374       base_mblocks = (char*)((unsigned long)base_non_committed & (unsigned long)~MBLOCK_MASK) + MBLOCK_SIZE;
 375 #      if 0
 376        debugBelch("getMBlocks: Dropping %d bytes off of 256M chunk\n",
 377                   (unsigned)base_mblocks - (unsigned)base_non_committed);
 378 #      endif
 379
 380        if ( ((char*)base_mblocks + size) > end_non_committed ) {
 381           debugBelch("getMBlocks: oops, committed too small a region to start with.");
 382           ret=(void*)-1;
 383        } else {
 384           next_request = base_mblocks;
 385        }
 386     }
 387   }
 388   /* Commit the mega block(s) to phys mem */
 389   if ( ret != (void*)-1 ) {
 390      ret = VirtualAlloc(next_request, size, MEM_COMMIT, PAGE_READWRITE);
 391      if (ret == NULL) {
 392         debugBelch("getMBlocks: VirtualAlloc MEM_COMMIT %lu failed with: %ld\n", size, GetLastError());
 393         ret=(void*)-1;
 394      }
 395   }
 396
 397   if (((W_)ret & MBLOCK_MASK) != 0) {
 398     barf("getMBlocks: misaligned block returned");
 399   }
 400
 401   if (ret == (void*)-1) {
 402      barf("getMBlocks: unknown memory allocation failure on Win32.");
 403   }
 404
 405   IF_DEBUG(gc,debugBelch("Allocated %d megablock(s) at 0x%x\n",n,(nat)ret));
 406   next_request = (char*)next_request + size;
 407
 408   mblocks_allocated += n;
 409
 410   // fill in the table
 411   for (i = 0; i < n; i++) {
 412       markHeapAlloced( ret + i * MBLOCK_SIZE );
 413   }
 414
 415   return ret;
 416 }
 417
 418 void
 419 freeAllMBlocks(void)
 420 {
 421   BOOL rc;
 422
 423   rc = VirtualFree(membase, 0, MEM_RELEASE);
 424
 425   if (rc == FALSE) {
 426      debugBelch("freeAllMBlocks: VirtualFree failed with: %ld\n", GetLastError());
 427   }
 428 }
 429
 430 /* Hand back the physical memory that is allocated to a mega-block.
 431    ToDo: chain the released mega block onto some list so that
 432          getMBlocks() can get at it.
 433
 434    Currently unused.
 435 */
 436 #if 0
 437 void
 438 freeMBlock(void* p, nat n)
 439 {
 440   BOOL rc;
 441
 442   rc = VirtualFree(p, n * MBLOCK_SIZE , MEM_DECOMMIT );
 443
 444   if (rc == FALSE) {
 445 #    ifdef DEBUG
 446      debugBelch("freeMBlocks: VirtualFree failed with: %d\n", GetLastError());
 447 #    endif
 448   }
 449
 450 }
 451 #endif
 452
 453 #endif