1 /* -----------------------------------------------------------------------------
3 * (c) The GHC Team 1998-1999
5 * MegaBlock Allocator Interface. This file contains all the dirty
6 * architecture-dependent hackery required to get a chunk of aligned
7 * memory from the operating system.
9 * ---------------------------------------------------------------------------*/
11 /* This is non-posix compliant. */
12 /* #include "PosixSource.h" */
18 #include "BlockAlloc.h"
29 #ifdef HAVE_SYS_TYPES_H
30 #include <sys/types.h>
32 #ifndef mingw32_TARGET_OS
33 # ifdef HAVE_SYS_MMAN_H
34 # include <sys/mman.h>
44 #include <mach/vm_map.h>
49 lnat mblocks_allocated = 0;
51 /* -----------------------------------------------------------------------------
52 The MBlock Map: provides our implementation of HEAP_ALLOCED()
53 -------------------------------------------------------------------------- */
55 #ifdef MBLOCK_MAP_SIZE
56 StgWord8 mblock_map[MBLOCK_MAP_SIZE]; // initially all zeros
59 /* -----------------------------------------------------------------------------
60 Allocate new mblock(s)
61 -------------------------------------------------------------------------- */
69 /* -----------------------------------------------------------------------------
72 On Unix-like systems, we use mmap() to allocate our memory. We
73 want memory in chunks of MBLOCK_SIZE, and aligned on an MBLOCK_SIZE
74 boundary. The mmap() interface doesn't give us this level of
75 control, so we have to use some heuristics.
77 In the general case, if we want a block of n megablocks, then we
78 allocate n+1 and trim off the slop from either side (using
79 munmap()) to get an aligned chunk of size n. However, the next
80 time we'll try to allocate directly after the previously allocated
81 chunk, on the grounds that this is aligned and likely to be free.
82 If it turns out that we were wrong, we have to munmap() and try
83 again using the general method.
84 -------------------------------------------------------------------------- */
86 #if !defined(mingw32_TARGET_OS) && !defined(cygwin32_TARGET_OS)
88 // A wrapper around mmap(), to abstract away from OS differences in
89 // the mmap() interface.
92 my_mmap (void *addr, lnat size)
96 #if defined(solaris2_TARGET_OS) || defined(irix_TARGET_OS)
98 int fd = open("/dev/zero",O_RDONLY);
99 ret = mmap(addr, size, PROT_READ | PROT_WRITE, MAP_PRIVATE, fd, 0);
103 ret = mmap(addr, size, PROT_READ | PROT_WRITE,
104 MAP_ANONYMOUS | MAP_PRIVATE, -1, 0);
105 #elif darwin_TARGET_OS
106 // Without MAP_FIXED, Apple's mmap ignores addr.
107 // With MAP_FIXED, it overwrites already mapped regions, whic
108 // mmap(0, ... MAP_FIXED ...) is worst of all: It unmaps the program text
109 // and replaces it with zeroes, causing instant death.
110 // This behaviour seems to be conformant with IEEE Std 1003.1-2001.
111 // Let's just use the underlying Mach Microkernel calls directly,
112 // they're much nicer.
116 if(addr) // try to allocate at adress
117 err = vm_allocate(mach_task_self(),(vm_address_t*) &ret, size, FALSE);
118 if(!addr || err) // try to allocate anywhere
119 err = vm_allocate(mach_task_self(),(vm_address_t*) &ret, size, TRUE);
121 if(err) // don't know what the error codes mean exactly
122 barf("memory allocation failed (requested %lu bytes)", size);
124 vm_protect(mach_task_self(),ret,size,FALSE,VM_PROT_READ|VM_PROT_WRITE);
126 ret = mmap(addr, size, PROT_READ | PROT_WRITE | PROT_EXEC,
127 MAP_ANON | MAP_PRIVATE, -1, 0);
130 if (ret == (void *)-1) {
131 if (errno == ENOMEM ||
132 (errno == EINVAL && sizeof(void*)==4 && size >= 0xc0000000)) {
133 // If we request more than 3Gig, then we get EINVAL
134 // instead of ENOMEM (at least on Linux).
135 errorBelch("out of memory (requested %lu bytes)", size);
136 stg_exit(EXIT_FAILURE);
138 barf("getMBlock: mmap: %s", strerror(errno));
145 // Implements the general case: allocate a chunk of memory of 'size'
149 gen_map_mblocks (lnat size)
154 // Try to map a larger block, and take the aligned portion from
155 // it (unmap the rest).
157 ret = my_mmap(0, size);
159 // unmap the slop bits around the chunk we allocated
160 slop = (W_)ret & MBLOCK_MASK;
162 if (munmap(ret, MBLOCK_SIZE - slop) == -1) {
163 barf("gen_map_mblocks: munmap failed");
165 if (slop > 0 && munmap(ret+size-slop, slop) == -1) {
166 barf("gen_map_mblocks: munmap failed");
169 // ToDo: if we happened to get an aligned block, then don't
170 // unmap the excess, just use it. For this to work, you
171 // need to keep in mind the following:
172 // * Calling my_mmap() with an 'addr' arg pointing to
173 // already my_mmap()ed space is OK and won't fail.
174 // * If my_mmap() can't satisfy the request at the
175 // given 'next_request' address in getMBlocks(), that
176 // you unmap the extra mblock mmap()ed here (or simply
177 // satisfy yourself that the slop introduced isn't worth
181 // next time, try after the block we just got.
182 ret += MBLOCK_SIZE - slop;
187 // The external interface: allocate 'n' mblocks, and return the
193 static caddr_t next_request = (caddr_t)HEAP_BASE;
195 lnat size = MBLOCK_SIZE * n;
198 if (next_request == 0) {
199 // use gen_map_mblocks the first time.
200 ret = gen_map_mblocks(size);
202 ret = my_mmap(next_request, size);
204 if (((W_)ret & MBLOCK_MASK) != 0) {
206 #if 0 // defined(DEBUG)
207 errorBelch("warning: getMBlock: misaligned block %p returned when allocating %d megablock(s) at %p", ret, n, next_request);
210 // unmap this block...
211 if (munmap(ret, size) == -1) {
212 barf("getMBlock: munmap failed");
214 // and do it the hard way
215 ret = gen_map_mblocks(size);
219 // Next time, we'll try to allocate right after the block we just got.
220 // ToDo: check that we haven't already grabbed the memory at next_request
221 next_request = ret + size;
223 IF_DEBUG(gc,debugBelch("Allocated %d megablock(s) at %p\n",n,ret));
226 for (i = 0; i < n; i++) {
227 MARK_HEAP_ALLOCED( ret + i * MBLOCK_SIZE );
230 mblocks_allocated += n;
235 #else /* defined(mingw32_TARGET_OS) || defined(cygwin32_TARGET_OS) */
238 On Win32 platforms we make use of the two-phased virtual memory API
239 to allocate mega blocks. We proceed as follows:
241 Reserve a large chunk of VM (256M at the time, or what the user asked
242 for via the -M option), but don't supply a base address that's aligned on
243 a MB boundary. Instead we round up to the nearest mblock from the chunk of
244 VM we're handed back from the OS (at the moment we just leave the 'slop' at
245 the beginning of the reserved chunk unused - ToDo: reuse it .)
247 Reserving memory doesn't allocate physical storage (not even in the
248 page file), this is done later on by committing pages (or mega-blocks in
252 char* base_non_committed = (char*)0;
253 char* end_non_committed = (char*)0;
255 /* Default is to reserve 256M of VM to minimise the slop cost. */
256 #define SIZE_RESERVED_POOL ( 256 * 1024 * 1024 )
258 /* Number of bytes reserved */
259 static unsigned long size_reserved_pool = SIZE_RESERVED_POOL;
264 static char* base_mblocks = (char*)0;
265 static char* next_request = (char*)0;
266 void* ret = (void*)0;
269 lnat size = MBLOCK_SIZE * n;
271 if ( (base_non_committed == 0) || (next_request + size > end_non_committed) ) {
272 if (base_non_committed) {
273 /* Tacky, but if no user-provided -M option is in effect,
274 * set it to the default (==256M) in time for the heap overflow PSA.
276 if (RtsFlags.GcFlags.maxHeapSize == 0) {
277 RtsFlags.GcFlags.maxHeapSize = size_reserved_pool / BLOCK_SIZE;
281 if (RtsFlags.GcFlags.maxHeapSize != 0) {
282 size_reserved_pool = BLOCK_SIZE * RtsFlags.GcFlags.maxHeapSize;
283 if (size_reserved_pool < MBLOCK_SIZE) {
284 size_reserved_pool = 2*MBLOCK_SIZE;
287 base_non_committed = VirtualAlloc ( NULL
292 if ( base_non_committed == 0 ) {
293 errorBelch("getMBlocks: VirtualAlloc failed with: %ld\n", GetLastError());
296 end_non_committed = (char*)base_non_committed + (unsigned long)size_reserved_pool;
297 /* The returned pointer is not aligned on a mega-block boundary. Make it. */
298 base_mblocks = (char*)((unsigned long)base_non_committed & (unsigned long)~MBLOCK_MASK) + MBLOCK_SIZE;
300 debugBelch("getMBlocks: Dropping %d bytes off of 256M chunk\n",
301 (unsigned)base_mblocks - (unsigned)base_non_committed);
304 if ( ((char*)base_mblocks + size) > end_non_committed ) {
305 debugBelch("getMBlocks: oops, committed too small a region to start with.");
308 next_request = base_mblocks;
312 /* Commit the mega block(s) to phys mem */
313 if ( ret != (void*)-1 ) {
314 ret = VirtualAlloc(next_request, size, MEM_COMMIT, PAGE_READWRITE);
316 debugBelch("getMBlocks: VirtualAlloc failed with: %ld\n", GetLastError());
321 if (((W_)ret & MBLOCK_MASK) != 0) {
322 barf("getMBlocks: misaligned block returned");
325 if (ret == (void*)-1) {
326 barf("getMBlocks: unknown memory allocation failure on Win32.");
329 IF_DEBUG(gc,debugBelch("Allocated %d megablock(s) at 0x%x\n",n,(nat)ret));
330 next_request = (char*)next_request + size;
332 mblocks_allocated += n;
335 for (i = 0; i < n; i++) {
336 MARK_HEAP_ALLOCED ( ret + i * MBLOCK_SIZE );
342 /* Hand back the physical memory that is allocated to a mega-block.
343 ToDo: chain the released mega block onto some list so that
344 getMBlocks() can get at it.
350 freeMBlock(void* p, nat n)
354 rc = VirtualFree(p, n * MBLOCK_SIZE , MEM_DECOMMIT );
358 debugBelch("freeMBlocks: VirtualFree failed with: %d\n", GetLastError());