ghc/rts/MBlock.c

   1 /* -----------------------------------------------------------------------------
   2  * $Id: MBlock.c,v 1.23 2001/08/14 13:40:09 sewardj 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 macosx_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 128M at the time to try to minimise the slop cost. */
 119 #define SIZE_RESERVED_POOL  ( 128 * 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 #ifdef ENABLE_WIN32_DLL_SUPPORT
 142     if (base_non_committed)
 143         barf("Windows programs can only use 128Mb of heap; sorry!");
 144 #endif
 145     base_non_committed = VirtualAlloc ( NULL
 146                                       , SIZE_RESERVED_POOL
 147                                       , MEM_RESERVE
 148                                       , PAGE_READWRITE
 149                                       );
 150     if ( base_non_committed == 0 ) {
 151 # if 1 /*def DEBUG*/
 152          fprintf(stderr, "getMBlocks: VirtualAlloc failed with: %d\n", GetLastError());
 153 # endif
 154          ret=(void*)-1;
 155     } else {
 156     /* The returned pointer is not aligned on a mega-block boundary. Make it. */
 157        base_mblocks = (char*)((unsigned long)base_non_committed & (unsigned long)0xfff00000) + MBLOCK_SIZE;
 158 # if 0
 159        fprintf(stderr, "Dropping %d bytes off of 128M chunk\n",
 160                        (unsigned)base_mblocks - (unsigned)base_non_committed);
 161 # endif
 162
 163        if ( ((char*)base_mblocks + size) > ((char*)base_non_committed + SIZE_RESERVED_POOL) ) {
 164 # if 1 /*def DEBUG*/
 165           fprintf(stderr, "oops, committed too small a region to start with.");
 166 # endif
 167           ret=(void*)-1;
 168        } else {
 169           next_request = base_mblocks;
 170        }
 171     }
 172   }
 173   /* Commit the mega block(s) to phys mem */
 174   if ( ret != (void*)-1 ) {
 175      ret = VirtualAlloc(next_request, size, MEM_COMMIT, PAGE_READWRITE);
 176      if (ret == NULL) {
 177 # if 1 /*def DEBUG*/
 178         fprintf(stderr, "getMBlocks: VirtualAlloc failed with: %d\n", GetLastError());
 179 # endif
 180         ret=(void*)-1;
 181      }
 182   }
 183
 184   if (((W_)ret & MBLOCK_MASK) != 0) {
 185     barf("GetMBlock: misaligned block returned");
 186   }
 187
 188   IF_DEBUG(gc,fprintf(stderr,"Allocated %d megablock(s) at %x\n",n,(nat)ret));
 189
 190   next_request = (char*)next_request + size;
 191
 192   mblocks_allocated += n;
 193
 194   return ret;
 195 }
 196
 197 /* Hand back the physical memory that is allocated to a mega-block.
 198    ToDo: chain the released mega block onto some list so that
 199          getMBlocks() can get at it.
 200
 201    Currently unused.
 202 */
 203 #if 0
 204 void
 205 freeMBlock(void* p, nat n)
 206 {
 207   BOOL rc;
 208
 209   rc = VirtualFree(p, n * MBLOCK_SIZE , MEM_DECOMMIT );
 210
 211   if (rc == FALSE) {
 212 # ifdef DEBUG
 213      fprintf(stderr, "freeMBlocks: VirtualFree failed with: %d\n", GetLastError());
 214 # endif
 215   }
 216
 217 }
 218 #endif
 219
 220 #endif