ghc/rts/MBlock.c

   1 /* -----------------------------------------------------------------------------
   2  * $Id: MBlock.c,v 1.15 2000/04/03 15:24:21 rrt 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 #define NON_POSIX_SOURCE
  13
  14 #include "Rts.h"
  15 #include "RtsUtils.h"
  16 #include "RtsFlags.h"
  17 #include "MBlock.h"
  18 #include "BlockAlloc.h"
  19
  20 #ifdef HAVE_UNISTD_H
  21 #include <unistd.h>
  22 #endif
  23
  24 #ifdef HAVE_SYS_TYPES_H
  25 #include <sys/types.h>
  26 #endif
  27
  28 #ifndef mingw32_TARGET_OS
  29 # ifdef HAVE_SYS_MMAN_H
  30 # include <sys/mman.h>
  31 # endif
  32 #endif
  33
  34 #ifdef HAVE_FCNTL_H
  35 #include <fcntl.h>
  36 #endif
  37
  38 #if HAVE_WINDOWS_H
  39 #include <windows.h>
  40 #endif
  41
  42 #if freebsd2_TARGET_OS || freebsd_TARGET_OS
  43 /* Executable is loaded from      0x0
  44  * Shared libraries are loaded at 0x2000000
  45  * Stack is at the top of the address space.  The kernel probably owns
  46  * 0x8000000 onwards, so we'll pick 0x5000000.
  47  */
  48 #define ASK_FOR_MEM_AT 0x50000000
  49
  50 #elif netbsd_TARGET_OS
  51 /* NetBSD i386 shared libs are at 0x40000000
  52  */
  53 #define ASK_FOR_MEM_AT 0x50000000
  54 #elif linux_TARGET_OS
  55 /* Any ideas?
  56  */
  57 #define ASK_FOR_MEM_AT 0x50000000
  58
  59 #elif solaris2_TARGET_OS
  60 /* guess */
  61 #define ASK_FOR_MEM_AT 0x50000000
  62
  63 #elif osf3_TARGET_OS
  64 /* guess */
  65 #define ASK_FOR_MEM_AT 0x50000000
  66
  67 #elif hpux_TARGET_OS
  68 /* guess */
  69 #define ASK_FOR_MEM_AT 0x50000000
  70
  71 #elif _WIN32
  72 /* doesn't matter, we use a reserve/commit algorithm */
  73
  74 #else
  75 #error Dont know where to get memory from on this architecture
  76 /* ToDo: memory locations on other architectures */
  77 #endif
  78
  79 lnat mblocks_allocated = 0;
  80
  81 void *
  82 getMBlock(void)
  83 {
  84   return getMBlocks(1);
  85 }
  86
  87 #ifndef _WIN32
  88 void *
  89 getMBlocks(nat n)
  90 {
  91   static caddr_t next_request = (caddr_t)ASK_FOR_MEM_AT;
  92   caddr_t ret;
  93   lnat size = MBLOCK_SIZE * n;
  94
  95 #ifdef solaris2_TARGET_OS
  96   {
  97       int fd = open("/dev/zero",O_RDONLY);
  98       ret = mmap(next_request, size, PROT_READ | PROT_WRITE,
  99                  MAP_FIXED | MAP_PRIVATE, fd, 0);
 100       close(fd);
 101   }
 102 #elif hpux_TARGET_OS
 103  ret = mmap(next_request, size, PROT_READ | PROT_WRITE,
 104              MAP_ANONYMOUS | MAP_PRIVATE, -1, 0);
 105 #else
 106   ret = mmap(next_request, size, PROT_READ | PROT_WRITE,
 107              MAP_ANON | MAP_PRIVATE, -1, 0);
 108 #endif
 109
 110   if (ret == (void *)-1) {
 111     if (errno == ENOMEM) {
 112       barf("getMBlock: out of memory");
 113     } else {
 114       barf("GetMBlock: mmap failed");
 115     }
 116   }
 117
 118   if (((W_)ret & MBLOCK_MASK) != 0) {
 119     barf("GetMBlock: misaligned block returned");
 120   }
 121
 122   IF_DEBUG(gc,fprintf(stderr,"Allocated %d megablock(s) at %x\n",n,(nat)ret));
 123
 124   next_request += size;
 125
 126   mblocks_allocated += n;
 127
 128   return ret;
 129 }
 130
 131 #else /* _WIN32 */
 132
 133 /*
 134  On Win32 platforms we make use of the two-phased virtual memory API
 135  to allocate mega blocks. We proceed as follows:
 136
 137  Reserve a large chunk of VM (128M at the time), but don't supply a
 138  base address that's aligned on a MB boundary. Instead we round up to the
 139  nearest from the chunk of VM we're given back from the OS (at the
 140  moment we just leave the 'slop' at the beginning of the reserved
 141  chunk unused - ToDo: reuse it .)
 142
 143  Reserving memory doesn't allocate physical storage (not even in the
 144  page file), this is done by committing pages (or mega-blocks in
 145  our case).
 146
 147 */
 148
 149 char* base_non_committed = (char*)0;
 150
 151 /* Reserve VM 128M at the time to try to minimise the slop cost. */
 152 #define SIZE_RESERVED_POOL  ( 128 * 1024 * 1024 )
 153
 154 /* This predicate should be inlined, really. */
 155 /* TODO: this only works for a single chunk */
 156 int
 157 is_heap_alloced(const void* x)
 158 {
 159   return (((char*)(x) >= base_non_committed) &&
 160           ((char*)(x) <= (base_non_committed + SIZE_RESERVED_POOL)));
 161 }
 162
 163 void *
 164 getMBlocks(nat n)
 165 {
 166   static char* base_mblocks       = (char*)0;
 167   static char* next_request       = (char*)0;
 168   void* ret                       = (void*)0;
 169
 170   lnat size = MBLOCK_SIZE * n;
 171
 172   if ( (base_non_committed == 0) ||
 173        (next_request + size > base_non_committed + SIZE_RESERVED_POOL) ) {
 174     base_non_committed = VirtualAlloc ( NULL
 175                                       , SIZE_RESERVED_POOL
 176                                       , MEM_RESERVE
 177                                       , PAGE_READWRITE
 178                                       );
 179     if ( base_non_committed == 0 ) {
 180 # if 1 /*def DEBUG*/
 181          fprintf(stderr, "getMBlocks: VirtualAlloc failed with: %d\n", GetLastError());
 182 # endif
 183          ret=(void*)-1;
 184     } else {
 185     /* The returned pointer is not aligned on a mega-block boundary. Make it. */
 186        base_mblocks = (char*)((unsigned long)base_non_committed & (unsigned long)0xfff00000) + MBLOCK_SIZE;
 187 # if 0
 188        fprintf(stderr, "Dropping %d bytes off of 128M chunk\n",
 189                        (unsigned)base_mblocks - (unsigned)base_non_committed);
 190 # endif
 191
 192        if ( ((char*)base_mblocks + size) > ((char*)base_non_committed + SIZE_RESERVED_POOL) ) {
 193 # if 1 /*def DEBUG*/
 194           fprintf(stderr, "oops, committed too small a region to start with.");
 195 # endif
 196           ret=(void*)-1;
 197        } else {
 198           next_request = base_mblocks;
 199        }
 200     }
 201   }
 202   /* Commit the mega block(s) to phys mem */
 203   if ( ret != (void*)-1 ) {
 204      ret = VirtualAlloc(next_request, size, MEM_COMMIT, PAGE_READWRITE);
 205      if (ret == NULL) {
 206 # if 1 /*def DEBUG*/
 207         fprintf(stderr, "getMBlocks: VirtualAlloc failed with: %d\n", GetLastError());
 208 # endif
 209         ret=(void*)-1;
 210      }
 211   }
 212
 213   if (((W_)ret & MBLOCK_MASK) != 0) {
 214     barf("GetMBlock: misaligned block returned");
 215   }
 216
 217   IF_DEBUG(gc,fprintf(stderr,"Allocated %d megablock(s) at %x\n",n,(nat)ret));
 218
 219   next_request = (char*)next_request + size;
 220
 221   mblocks_allocated += n;
 222
 223   return ret;
 224 }
 225
 226 /* Hand back the physical memory that is allocated to a mega-block.
 227    ToDo: chain the released mega block onto some list so that
 228          getMBlocks() can get at it.
 229
 230    Currently unused.
 231 */
 232 #if 0
 233 void
 234 freeMBlock(void* p, nat n)
 235 {
 236   BOOL rc;
 237
 238   rc = VirtualFree(p, n * MBLOCK_SIZE , MEM_DECOMMIT );
 239
 240   if (rc == FALSE) {
 241 # ifdef DEBUG
 242      fprintf(stderr, "freeMBlocks: VirtualFree failed with: %d\n", GetLastError());
 243 # endif
 244   }
 245
 246 }
 247 #endif
 248
 249 #endif