ghc/rts/MBlock.c

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