ghc/rts/MBlock.c

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