ghc/rts/MBlock.c

   1 /* -----------------------------------------------------------------------------
   2  * $Id: MBlock.c,v 1.34 2002/10/27 21:46:27 wolfgang 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               belch("out of memory (requested %d bytes)", n * BLOCK_SIZE);
 188               stg_exit(EXIT_FAILURE);
 189           } else {
 190               barf("getMBlock: mmap failed");
 191           }
 192       }
 193
 194       if (((W_)ret & MBLOCK_MASK) != 0) {
 195           // misaligned block!
 196 #ifdef DEBUG
 197           belch("getMBlock: misaligned block %p returned when allocating %d megablock(s) at %p", ret, n, next_request);
 198 #endif
 199
 200           // unmap this block...
 201           if (munmap(ret, size) == -1) {
 202               barf("getMBlock: munmap failed");
 203           }
 204           // and do it the hard way
 205           ret = gen_map_mblocks(size);
 206       }
 207   }
 208
 209   // Next time, we'll try to allocate right after the block we just got.
 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