ghc/rts/MBlock.c

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