ghc/rts/MBlock.c

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