ghc/rts/MBlock.c

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