ghc/rts/MBlock.c

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