ghc/rts/MBlock.c

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