ghc/rts/MBlock.c

   1 /* -----------------------------------------------------------------------------
   2  * $Id: MBlock.c,v 1.44 2003/03/26 02:12:38 sof 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. For this to work, you
 166     // need to keep in mind the following:
 167     //     * Calling my_mmap() with an 'addr' arg pointing to
 168     //       already my_mmap()ed space is OK and won't fail.
 169     //     * If my_mmap() can't satisfy the request at the
 170     //       given 'next_request' address in getMBlocks(), that
 171     //       you unmap the extra mblock mmap()ed here (or simply
 172     //       satisfy yourself that the slop introduced isn't worth
 173     //       salvaging.)
 174     //
 175
 176     // next time, try after the block we just got.
 177     ret += MBLOCK_SIZE - slop;
 178     return ret;
 179 }
 180
 181
 182 // The external interface: allocate 'n' mblocks, and return the
 183 // address.
 184
 185 void *
 186 getMBlocks(nat n)
 187 {
 188   static caddr_t next_request = (caddr_t)HEAP_BASE;
 189   caddr_t ret;
 190   lnat size = MBLOCK_SIZE * n;
 191   nat i;
 192
 193   if (next_request == 0) {
 194       // use gen_map_mblocks the first time.
 195       ret = gen_map_mblocks(size);
 196   } else {
 197       ret = my_mmap(next_request, size);
 198
 199       if (((W_)ret & MBLOCK_MASK) != 0) {
 200           // misaligned block!
 201 #if 0 // defined(DEBUG)
 202           belch("warning: getMBlock: misaligned block %p returned when allocating %d megablock(s) at %p", ret, n, next_request);
 203 #endif
 204
 205           // unmap this block...
 206           if (munmap(ret, size) == -1) {
 207               barf("getMBlock: munmap failed");
 208           }
 209           // and do it the hard way
 210           ret = gen_map_mblocks(size);
 211       }
 212   }
 213
 214   // Next time, we'll try to allocate right after the block we just got.
 215   // ToDo: check that we haven't already grabbed the memory at next_request
 216   next_request = ret + size;
 217
 218   IF_DEBUG(gc,fprintf(stderr,"Allocated %d megablock(s) at %p\n",n,ret));
 219
 220   // fill in the table
 221   for (i = 0; i < n; i++) {
 222       MARK_HEAP_ALLOCED( ret + i * MBLOCK_SIZE );
 223   }
 224
 225   mblocks_allocated += n;
 226
 227   return ret;
 228 }
 229
 230 #else /* defined(mingw32_TARGET_OS) || defined(cygwin32_TARGET_OS) */
 231
 232 /*
 233  On Win32 platforms we make use of the two-phased virtual memory API
 234  to allocate mega blocks. We proceed as follows:
 235
 236  Reserve a large chunk of VM (256M at the time, or what the user asked
 237  for via the -M option), but don't supply a base address that's aligned on
 238  a MB boundary. Instead we round up to the nearest mblock from the chunk of
 239  VM we're handed back from the OS (at the moment we just leave the 'slop' at
 240  the beginning of the reserved chunk unused - ToDo: reuse it .)
 241
 242  Reserving memory doesn't allocate physical storage (not even in the
 243  page file), this is done later on by committing pages (or mega-blocks in
 244  our case).
 245 */
 246
 247 char* base_non_committed = (char*)0;
 248 char* end_non_committed = (char*)0;
 249
 250 /* Default is to reserve 256M of VM to minimise the slop cost. */
 251 #define SIZE_RESERVED_POOL  ( 256 * 1024 * 1024 )
 252
 253 /* Number of bytes reserved */
 254 static unsigned long size_reserved_pool = SIZE_RESERVED_POOL;
 255
 256 void *
 257 getMBlocks(nat n)
 258 {
 259   static char* base_mblocks       = (char*)0;
 260   static char* next_request       = (char*)0;
 261   void* ret                       = (void*)0;
 262   int i;
 263
 264   lnat size = MBLOCK_SIZE * n;
 265
 266   if ( (base_non_committed == 0) || (next_request + size > end_non_committed) ) {
 267     if (base_non_committed) {
 268       barf("RTS exhausted max heap size (%d bytes)\n", size_reserved_pool);
 269     }
 270     if (RtsFlags.GcFlags.maxHeapSize != 0) {
 271       size_reserved_pool = BLOCK_SIZE * RtsFlags.GcFlags.maxHeapSize;
 272       if (size_reserved_pool < MBLOCK_SIZE) {
 273         size_reserved_pool = 2*MBLOCK_SIZE;
 274       }
 275     }
 276     base_non_committed = VirtualAlloc ( NULL
 277                                       , size_reserved_pool
 278                                       , MEM_RESERVE
 279                                       , PAGE_READWRITE
 280                                       );
 281     if ( base_non_committed == 0 ) {
 282          fprintf(stderr, "getMBlocks: VirtualAlloc failed with: %ld\n", GetLastError());
 283          ret=(void*)-1;
 284     } else {
 285       end_non_committed = (char*)base_non_committed + (unsigned long)size_reserved_pool;
 286       /* The returned pointer is not aligned on a mega-block boundary. Make it. */
 287       base_mblocks = (char*)((unsigned long)base_non_committed & (unsigned long)~MBLOCK_MASK) + MBLOCK_SIZE;
 288 #      if 0
 289        fprintf(stderr, "getMBlocks: Dropping %d bytes off of 256M chunk\n",
 290                        (unsigned)base_mblocks - (unsigned)base_non_committed);
 291 #      endif
 292
 293        if ( ((char*)base_mblocks + size) > end_non_committed ) {
 294           fprintf(stderr, "getMBlocks: oops, committed too small a region to start with.");
 295           ret=(void*)-1;
 296        } else {
 297           next_request = base_mblocks;
 298        }
 299     }
 300   }
 301   /* Commit the mega block(s) to phys mem */
 302   if ( ret != (void*)-1 ) {
 303      ret = VirtualAlloc(next_request, size, MEM_COMMIT, PAGE_READWRITE);
 304      if (ret == NULL) {
 305         fprintf(stderr, "getMBlocks: VirtualAlloc failed with: %ld\n", GetLastError());
 306         ret=(void*)-1;
 307      }
 308   }
 309
 310   if (((W_)ret & MBLOCK_MASK) != 0) {
 311     barf("getMBlocks: misaligned block returned");
 312   }
 313
 314   if (ret == (void*)-1) {
 315      barf("getMBlocks: unknown memory allocation failure on Win32.");
 316   }
 317
 318   IF_DEBUG(gc,fprintf(stderr,"Allocated %d megablock(s) at 0x%x\n",n,(nat)ret));
 319   next_request = (char*)next_request + size;
 320
 321   mblocks_allocated += n;
 322
 323   // fill in the table
 324   for (i = 0; i < n; i++) {
 325       MARK_HEAP_ALLOCED ( ret + i * MBLOCK_SIZE );
 326   }
 327
 328   return ret;
 329 }
 330
 331 /* Hand back the physical memory that is allocated to a mega-block.
 332    ToDo: chain the released mega block onto some list so that
 333          getMBlocks() can get at it.
 334
 335    Currently unused.
 336 */
 337 #if 0
 338 void
 339 freeMBlock(void* p, nat n)
 340 {
 341   BOOL rc;
 342
 343   rc = VirtualFree(p, n * MBLOCK_SIZE , MEM_DECOMMIT );
 344
 345   if (rc == FALSE) {
 346 #    ifdef DEBUG
 347      fprintf(stderr, "freeMBlocks: VirtualFree failed with: %d\n", GetLastError());
 348 #    endif
 349   }
 350
 351 }
 352 #endif
 353
 354 #endif