ghc/rts/MBlock.c

   1 /* -----------------------------------------------------------------------------
   2  * $Id: MBlock.c,v 1.26 2002/01/08 16:38:27 sof 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_UNISTD_H
  22 #include <unistd.h>
  23 #endif
  24
  25 #ifdef HAVE_SYS_TYPES_H
  26 #include <sys/types.h>
  27 #endif
  28
  29 #ifndef mingw32_TARGET_OS
  30 # ifdef HAVE_SYS_MMAN_H
  31 # include <sys/mman.h>
  32 # endif
  33 #endif
  34
  35 #ifdef HAVE_FCNTL_H
  36 #include <fcntl.h>
  37 #endif
  38
  39 #if HAVE_WINDOWS_H
  40 #include <windows.h>
  41 #endif
  42
  43 lnat mblocks_allocated = 0;
  44
  45 void *
  46 getMBlock(void)
  47 {
  48   return getMBlocks(1);
  49 }
  50
  51 #ifndef _WIN32
  52 void *
  53 getMBlocks(nat n)
  54 {
  55   static caddr_t next_request = (caddr_t)HEAP_BASE;
  56   caddr_t ret;
  57   lnat size = MBLOCK_SIZE * n;
  58
  59 #ifdef solaris2_TARGET_OS
  60   {
  61       int fd = open("/dev/zero",O_RDONLY);
  62       ret = mmap(next_request, size, PROT_READ | PROT_WRITE,
  63                  MAP_FIXED | MAP_PRIVATE, fd, 0);
  64       close(fd);
  65   }
  66 #elif hpux_TARGET_OS
  67  ret = mmap(next_request, size, PROT_READ | PROT_WRITE,
  68              MAP_ANONYMOUS | MAP_PRIVATE, -1, 0);
  69 #elif darwin_TARGET_OS
  70  ret = mmap(next_request, size, PROT_READ | PROT_WRITE,
  71             MAP_FIXED | MAP_ANON | MAP_PRIVATE, -1, 0);
  72 #else
  73   ret = mmap(next_request, size, PROT_READ | PROT_WRITE,
  74              MAP_ANON | MAP_PRIVATE, -1, 0);
  75 #endif
  76
  77   if (ret == (void *)-1) {
  78     if (errno == ENOMEM) {
  79       barf("getMBlock: out of memory");
  80     } else {
  81       barf("GetMBlock: mmap failed");
  82     }
  83   }
  84
  85   if (((W_)ret & MBLOCK_MASK) != 0) {
  86     barf("GetMBlock: misaligned block %p returned when allocating %d megablock(s) at %p", ret, n, next_request);
  87   }
  88
  89   IF_DEBUG(gc,fprintf(stderr,"Allocated %d megablock(s) at %p\n",n,ret));
  90
  91   next_request += size;
  92
  93   mblocks_allocated += n;
  94
  95   return ret;
  96 }
  97
  98 #else /* _WIN32 */
  99
 100 /*
 101  On Win32 platforms we make use of the two-phased virtual memory API
 102  to allocate mega blocks. We proceed as follows:
 103
 104  Reserve a large chunk of VM (256M at the time, or what the user asked
 105  for via the -M option), but don't supply a base address that's aligned on
 106  a MB boundary. Instead we round up to the nearest mblock from the chunk of
 107  VM we're handed back from the OS (at the moment we just leave the 'slop' at
 108  the beginning of the reserved chunk unused - ToDo: reuse it .)
 109
 110  Reserving memory doesn't allocate physical storage (not even in the
 111  page file), this is done later on by committing pages (or mega-blocks in
 112  our case).
 113 */
 114
 115 char* base_non_committed = (char*)0;
 116 char* end_non_committed = (char*)0;
 117
 118 /* Default is to reserve 256M of VM to minimise the slop cost. */
 119 #define SIZE_RESERVED_POOL  ( 256 * 1024 * 1024 )
 120
 121 /* Number of bytes reserved */
 122 static unsigned long size_reserved_pool = SIZE_RESERVED_POOL;
 123
 124 /* This predicate should be inlined, really. */
 125 /* TODO: this only works for a single chunk */
 126 int
 127 is_heap_alloced(const void* x)
 128 {
 129   return (((char*)(x) >= base_non_committed) &&
 130           ((char*)(x) <= end_non_committed));
 131 }
 132
 133 void *
 134 getMBlocks(nat n)
 135 {
 136   static char* base_mblocks       = (char*)0;
 137   static char* next_request       = (char*)0;
 138   void* ret                       = (void*)0;
 139
 140   lnat size = MBLOCK_SIZE * n;
 141
 142   if ( (base_non_committed == 0) || (next_request + size > end_non_committed) ) {
 143     if (base_non_committed) {
 144       barf("RTS exhausted max heap size (%d bytes)\n", size_reserved_pool);
 145     }
 146     if (RtsFlags.GcFlags.maxHeapSize != 0) {
 147       size_reserved_pool = BLOCK_SIZE * RtsFlags.GcFlags.maxHeapSize;
 148       if (size_reserved_pool < MBLOCK_SIZE) {
 149         size_reserved_pool = 2*MBLOCK_SIZE;
 150       }
 151     }
 152     base_non_committed = VirtualAlloc ( NULL
 153                                       , size_reserved_pool
 154                                       , MEM_RESERVE
 155                                       , PAGE_READWRITE
 156                                       );
 157     if ( base_non_committed == 0 ) {
 158          fprintf(stderr, "getMBlocks: VirtualAlloc failed with: %ld\n", GetLastError());
 159          ret=(void*)-1;
 160     } else {
 161       end_non_committed = (char*)base_non_committed + (unsigned long)size_reserved_pool;
 162       /* The returned pointer is not aligned on a mega-block boundary. Make it. */
 163       base_mblocks = (char*)((unsigned long)base_non_committed & (unsigned long)0xfff00000) + MBLOCK_SIZE;
 164 #      if 0
 165        fprintf(stderr, "getMBlocks: Dropping %d bytes off of 256M chunk\n",
 166                        (unsigned)base_mblocks - (unsigned)base_non_committed);
 167 #      endif
 168
 169        if ( ((char*)base_mblocks + size) > end_non_committed ) {
 170           fprintf(stderr, "getMBlocks: oops, committed too small a region to start with.");
 171           ret=(void*)-1;
 172        } else {
 173           next_request = base_mblocks;
 174        }
 175     }
 176   }
 177   /* Commit the mega block(s) to phys mem */
 178   if ( ret != (void*)-1 ) {
 179      ret = VirtualAlloc(next_request, size, MEM_COMMIT, PAGE_READWRITE);
 180      if (ret == NULL) {
 181         fprintf(stderr, "getMBlocks: VirtualAlloc failed with: %ld\n", GetLastError());
 182         ret=(void*)-1;
 183      }
 184   }
 185
 186   if (((W_)ret & MBLOCK_MASK) != 0) {
 187     barf("getMBlocks: misaligned block returned");
 188   }
 189
 190   if (ret == (void*)-1) {
 191      barf("getMBlocks: unknown memory allocation failure on Win32.");
 192   }
 193
 194   IF_DEBUG(gc,fprintf(stderr,"Allocated %d megablock(s) at 0x%x\n",n,(nat)ret));
 195   next_request = (char*)next_request + size;
 196
 197   mblocks_allocated += n;
 198
 199   return ret;
 200 }
 201
 202 /* Hand back the physical memory that is allocated to a mega-block.
 203    ToDo: chain the released mega block onto some list so that
 204          getMBlocks() can get at it.
 205
 206    Currently unused.
 207 */
 208 #if 0
 209 void
 210 freeMBlock(void* p, nat n)
 211 {
 212   BOOL rc;
 213
 214   rc = VirtualFree(p, n * MBLOCK_SIZE , MEM_DECOMMIT );
 215
 216   if (rc == FALSE) {
 217 #    ifdef DEBUG
 218      fprintf(stderr, "freeMBlocks: VirtualFree failed with: %d\n", GetLastError());
 219 #    endif
 220   }
 221
 222 }
 223 #endif
 224
 225 #endif