ghc/rts/MBlock.c

   1 /* -----------------------------------------------------------------------------
   2  * $Id: MBlock.c,v 1.25 2001/12/10 01:28:00 sebc 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 (128M at the time), but don't supply a
 105  base address that's aligned on a MB boundary. Instead we round up to the
 106  nearest from the chunk of VM we're given back from the OS (at the
 107  moment we just leave the 'slop' at the beginning of the reserved
 108  chunk unused - ToDo: reuse it .)
 109
 110  Reserving memory doesn't allocate physical storage (not even in the
 111  page file), this is done by committing pages (or mega-blocks in
 112  our case).
 113
 114 */
 115
 116 char* base_non_committed = (char*)0;
 117
 118 /* Reserve VM 256M at the time to try to minimise the slop cost. */
 119 #define SIZE_RESERVED_POOL  ( 256 * 1024 * 1024 )
 120
 121 /* This predicate should be inlined, really. */
 122 /* TODO: this only works for a single chunk */
 123 int
 124 is_heap_alloced(const void* x)
 125 {
 126   return (((char*)(x) >= base_non_committed) &&
 127           ((char*)(x) <= (base_non_committed + SIZE_RESERVED_POOL)));
 128 }
 129
 130 void *
 131 getMBlocks(nat n)
 132 {
 133   static char* base_mblocks       = (char*)0;
 134   static char* next_request       = (char*)0;
 135   void* ret                       = (void*)0;
 136
 137   lnat size = MBLOCK_SIZE * n;
 138
 139   if ( (base_non_committed == 0) ||
 140        (next_request + size > base_non_committed + SIZE_RESERVED_POOL) ) {
 141     if (base_non_committed)
 142         barf("Windows programs can only use 256Mb of heap; sorry!");
 143     base_non_committed = VirtualAlloc ( NULL
 144                                       , SIZE_RESERVED_POOL
 145                                       , MEM_RESERVE
 146                                       , PAGE_READWRITE
 147                                       );
 148     if ( base_non_committed == 0 ) {
 149          fprintf(stderr, "getMBlocks: VirtualAlloc failed with: %ld\n", GetLastError());
 150          ret=(void*)-1;
 151     } else {
 152     /* The returned pointer is not aligned on a mega-block boundary. Make it. */
 153        base_mblocks = (char*)((unsigned long)base_non_committed & (unsigned long)0xfff00000) + MBLOCK_SIZE;
 154 #      if 0
 155        fprintf(stderr, "getMBlocks: Dropping %d bytes off of 256M chunk\n",
 156                        (unsigned)base_mblocks - (unsigned)base_non_committed);
 157 #      endif
 158
 159        if ( ((char*)base_mblocks + size) > ((char*)base_non_committed + SIZE_RESERVED_POOL) ) {
 160           fprintf(stderr, "getMBlocks: oops, committed too small a region to start with.");
 161           ret=(void*)-1;
 162        } else {
 163           next_request = base_mblocks;
 164        }
 165     }
 166   }
 167   /* Commit the mega block(s) to phys mem */
 168   if ( ret != (void*)-1 ) {
 169      ret = VirtualAlloc(next_request, size, MEM_COMMIT, PAGE_READWRITE);
 170      if (ret == NULL) {
 171         fprintf(stderr, "getMBlocks: VirtualAlloc failed with: %ld\n", GetLastError());
 172         ret=(void*)-1;
 173      }
 174   }
 175
 176   if (((W_)ret & MBLOCK_MASK) != 0) {
 177     barf("getMBlocks: misaligned block returned");
 178   }
 179
 180   if (ret == (void*)-1) {
 181      barf("getMBlocks: unknown memory allocation failure on Win32.");
 182   }
 183
 184   IF_DEBUG(gc,fprintf(stderr,"Allocated %d megablock(s) at 0x%x\n",n,(nat)ret));
 185   next_request = (char*)next_request + size;
 186
 187   mblocks_allocated += n;
 188
 189   return ret;
 190 }
 191
 192 /* Hand back the physical memory that is allocated to a mega-block.
 193    ToDo: chain the released mega block onto some list so that
 194          getMBlocks() can get at it.
 195
 196    Currently unused.
 197 */
 198 #if 0
 199 void
 200 freeMBlock(void* p, nat n)
 201 {
 202   BOOL rc;
 203
 204   rc = VirtualFree(p, n * MBLOCK_SIZE , MEM_DECOMMIT );
 205
 206   if (rc == FALSE) {
 207 #    ifdef DEBUG
 208      fprintf(stderr, "freeMBlocks: VirtualFree failed with: %d\n", GetLastError());
 209 #    endif
 210   }
 211
 212 }
 213 #endif
 214
 215 #endif