ghc/rts/MBlock.c

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